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

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

我的数据集结构如下：

栏目：

Date    Hour_Min    Y(response variable)

这些数据是每小时一次的，我需要创建一个每日循环的移动平均值，但按小时/分钟分类。换句话说，如果我使用31天窗口，对于给定的一天，Hour_Min 00:00的运行平均数据点将采用所讨论的一天的平均值以及前15天和后15天Hour_Min 00:00的数据点。然后通过数据帧在当天的1:00等时间重复该操作

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

我尝试的一种方法是使用tidyr的spread函数从长格式切换到宽格式，以创建如下数据帧：

Date    Y_Hour_Min_0000    Y_Hour_Min_0100    Y_Hour_Min_0200    etc...

如果我能以这种方式更改格式，我就可以创建每个Y_Hour_Min_的运行平均值的新列。。。。专栏。然后，我需要将所有内容重新组合成长格式（另一个我不确定如何处理的任务）

但是，我无法让spread函数工作，因此它将Date作为与每个Y_Hour_Min_…关联的分组变量。。。。专栏

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

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

模拟数据：

### 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))

###创建小时/日期向量：
date我想试一下，但它并不完美。希望有人能进来给我加油

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)

第一件事是按照你说的做，然后尝试长格式。通常我认为这个问题最好是在
hour\u min
列中使用
dplyr
的
groupby
，并在那里进行滚动平均，但我不确定如何做到这一点

我注意到的第一件事是，在给定的一天，一行有一个重复的值。凌晨1点有两个观测值，这打破了我们的
排列
，因此我使用
切片（-7441）

所以，让我们传播你的df

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

我做的下一件事是使用
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))}

我希望这能有所帮助。
我认为这可以奏效：

编辑：按照注释中的建议，通过向
rollappy（）
函数添加
fill=NA
参数来简化代码

# 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))
}


这适用于所有情况（大量数据不太容易查看，但看起来似乎有效）

适用于NAs。。如果你有
c（4，5，NA）
，你看到的是5点和前后1的窗口，你想要4+5/2还是4+5/3？使用rollapply时，它似乎是4+5/2，因为它会使用
NA.rm忽略NA。谢谢！我对答案进行了编辑，以纳入建议。不知道我第一次怎么会错过这个选择。
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)

# 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))
}

# 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 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)