Question

我认为这个问题可能对处理长期环境变量数据平滑的其他人感兴趣。

我的数据集结构如下：

列：

Date    Hour_Min    Y(response variable)

这些数据是每小时一次，我需要创建diel循环的移动平均值，但是按Hour_Min分类。换句话说，如果我要使用31天的窗口，则在给定的一天，Hour_Min 00:00的运行平均数据点将采用当前平均数据点与之前的Hour_Min 00:00的数据点。接下来的15天。然后，这将通过数据框重复当天的1小时等。

不幸的是，数据也有很多NA，这对于移动窗口平均值是有问题的，尽管我认为可以使用zoo包中的rollapply来解决。

我尝试过的一种方法是使用tidyr的扩展功能从长格式切换到宽格式，以创建这样的数据帧：

Date    Y_Hour_Min_0000    Y_Hour_Min_0100    Y_Hour_Min_0200    etc...

如果我可以用这种方式更改格式，那么我可以创建每个Y_Hour_Min _....列的运行平均值的新列。然后，我需要将所有内容聚集在一起，以长格式（另一项任务我不确定如何处理）。

但是，我无法使扩散功能起作用，因此它将Date保持为与每个Y_Hour_Min _....列关联的分组变量。

另一个可能更优雅的解决方案是，如果有一种方法可以使用rollapply和自定义函数的某种组合在一个步骤中创建单个新列。

对于如何为此任务实现代码的任何想法将不胜感激。下面我有一个简单的代码来模拟我的数据集：

模拟数据：

### Create vector of hours/dates:

date <- seq(as.POSIXct("2016-01-01 00:00"), as.POSIXct("2016-12-30 
23:00"), by="hour")

### Create vector of noisy sine function:

d <- 365
n <- 24*d # number of data points
t <- seq(from = 0, to = 2*d*pi, length.out=24*d)
a <- 6
b <- 1
c.norm <- rnorm(n)
amp <- 3
y <- a*sin(b*t)+c.norm*amp+15

### Randomly insert NAs into data:
ind <- which(y %in% sample(y, 1000))
y[ind]<-NA

### Create test dataframe:

df <- data.frame(dt = date, y = y) %>%
  separate(dt, c("date", "hour_min"), sep=" ") %>%
  mutate(date = as.Date(date))

Answer 1

我认为这可行：

编辑：根据评论中的建议，将fill = NA参数添加到rollapply()函数，以简化代码。

# add a complete date + time stamp
df$date_time <- paste(df$date, df$hour_min)

# make new column to store median data
df$median_y <- NA

# set rolling median width
width_roll <- 31

# do a rolling median for each hour, one at a time
# add NAs where no median can be calculated
for (i in levels(factor(df$hour_min))) {
  df[df$hour_min == i, "median_y"] <- rollapply(df[df$hour_min == i, "y"],
                                                width = width_roll,
                                                median,
                                                na.rm = TRUE,
                                                fill = NA))
}

方法只是按照您的建议使用rollapply()功能，但一次只能使用一个特定的小时。然后将其中的每一个依次放回新的列中。

以下是全年仅一小时的示例，这样可以更容易地显示中值平滑。

# Examples:

# plot one hour plus rolling median over time
# here i = "23:00:00"
plot(x = as.POSIXct(df[df$hour_min == i, "date_time"]),
     y = df[df$hour_min == i, "y"],
     type = "l",
     col = "blue",
     ylab = "y values",
     xlab = i)
lines(x = as.POSIXct(df[df$hour_min == i, "date_time"]),
      y = df[df$hour_min == i, "median_y"],
      lwd = 3)
legend("topleft", 
       legend = c("raw", "median"), 
       col = c("blue", "black"), 
       lwd = 3)

Plot for a single hour

这适用于所有事情（很多数据不那么容易看，但看起来很有效）。

# plot all the data
plot(x = as.POSIXct(df$date_time),
     y = df$y,
     type = "l",
     col = "blue",
     ylab = "y values",
     xlab = "Date")
lines(x = as.POSIXct(df$date_time),
      y = df$median_y,
      lwd = 3)
legend("topleft", 
       legend = c("raw", "median"), 
       col = c("blue", "black"), 
       lwd = 3)

Plot for all data

Answer 2

我会对它采取一个裂缝，但它并不完美。希望有人能进来帮我。但

<强> TL：DR

df2 <- df %>% slice(-7441) %>% spread(hour_min, y)

mov_avg <- function(x) {c(rep(NA, 15), rollapply(x, width = list(-15:15), FUN = mean, align="center", na.rm=T), rep(NA, 15))}

avgs <- as.data.frame(matrix(unlist(lapply(df2[,2:ncol(df2)], mov_avg)), nrow = nrow(df2), byrow = FALSE))
colnames(avgs) <- paste0("avg_", colnames(df2[,2:ncol(df2)]))

final_df <- cbind(df2, avgs) %>%
  gather(2:ncol(.), key = "hour_min", value = "value") %>%
  arrange(date, hour_min)

深度：

从你的起点开始..我添加了set.seed(1)所以我们都可以齐心协力。

您的初始起点：

### Create vector of hours/dates:
set.seed(1)
date <- seq(as.POSIXct("2016-01-01 00:00"), as.POSIXct("2016-12-30 
                                                       23:00"), by="hour")

### Create vector of noisy sine function:

d <- 365
n <- 24*d # number of data points
t <- seq(from = 0, to = 2*d*pi, length.out=24*d)
a <- 6
b <- 1
c.norm <- rnorm(n)
amp <- 3
y <- a*sin(b*t)+c.norm*amp+15

### Randomly insert NAs into data:
ind <- which(y %in% sample(y, 1000))
y[ind]<-NA

### Create test dataframe:

df <- data.frame(dt = date, y = y) %>%
  separate(dt, c("date", "hour_min"), sep=" ") %>%
  mutate(date = as.Date(date))

首先要做的就是你说的话并尝试长格式。通常情况下，我认为在dplyr列上使用group_by hour_min并在那里进行滚动平均，这个问题最好，但我不知道如何那样做。

我注意到的第一件事是在给定的一天有一行的重复值。凌晨1点有两个观察点，它打破了我们的spread，因此我使用slice(-7441)

删除了该观察结果

所以让我们传播你的df。

df2 <- df %>% slice(-7441) %>% spread(hour_min, y)

正如我们所看到的，数据帧现在是365个观察长（日期），25列宽（日期+24小时）

dim(df2)
[1] 365  25

我做的下一件事就是使用rollapply，这不是完美的。使用rollapply时，我们可以给它width = list(-15:15)。这将是过去15天和未来15天，平均所有31天。问题是前15天没有过去15天，过去15天没有未来15.所以我用NA s填充了这些。我希望有人可以解决这部分答案。

我创建了一个自定义函数来执行此操作：

mov_avg <- function(x) {c(rep(NA, 15), rollapply(x, width = list(-15:15), FUN = mean, align="center", na.rm=T), rep(NA, 15))}

如果我们只是做rollapply，我们将得到一个长度为335的向量。我在正面和背面填充了15个，以便我们获得所需的365.

接下来，我们希望在整个数据框架中lapply具有该功能。这将为我们提供24个长度为365的向量列表。然后，我们希望将其转换为数据帧并将其绑定到当前的数据帧。

最后，我们gather将所有列恢复为长格式arrange

avgs <- as.data.frame(matrix(unlist(lapply(df2[,2:ncol(df2)], mov_avg)), nrow = nrow(df2), byrow = FALSE))
colnames(avgs) <- paste0("avg_", colnames(df2[,2:ncol(df2)]))

final_df <- cbind(df2, avgs) %>%
  gather(2:ncol(.), key = "hour_min", value = "value") %>%
  arrange(date, hour_min)

我希望这会有所帮助。

如何从多年数据中创建diel循环的运行中位数？

2 个答案: