我正在寻找一种方法来为前一周的平均温度创建一个新变量。
我有一个如下所示的数据框
天气数据
Rows: 3,664
Columns: 2
$ dt <date> 2014-01-01, 2014-01-02, 2014-01-03, 2014-01-04, 2014-01…
$ temp <dbl> 6.390000, 6.234167, 6.307500, 4.436250, 4.432917, 8.4508…
我希望做的是获得一个名为
prev.temp我知道如何使用 mutate 创建新列，但在引用方面遇到了困难。我无法分组，因为“前一周”是一个滚动的事情，但我正在努力尝试引用观察日期以及我需要的 7 个信息日期。
我的第一个想法是这样的： mutate(prev.temp = casewhen(date > date - 7,mean(temp))) 但我确信它是不对的。
两种选择：
当“保证”您的日期没有间隙时，“滚动窗口”效果很好。这里的一个假设是 1 行始终是 1 天，因此我们相信情况就是如此。另一个假设是数据是按
dt我们将在这里使用
zoo::rollapplyrpartial=zoo::rollapplyr(weather_data$temp, 7, FUN = mean, na.rm = TRUE, partial = TRUE)
# [1] 9.233254 9.333467 7.414063 7.679054 7.498385 7.193965 7.256155 6.253119 5.893012 6.431630 5.952437 6.051908 6.586221 5.967587 6.388821 6.752706 7.103914
# [18] 6.666444 6.352582 5.871288 6.705206 6.289171 6.352013 6.311438 6.266374 6.316793 6.098056 6.100250 6.496584 6.300014 6.031206 6.968000 6.805867 7.185110
# [35] 6.025666 6.521882 5.456449 4.775102 4.897948 5.185524 4.792596 5.347797 4.325031 5.567295 5.855414 5.920953 6.275780 6.610605 7.298713 8.046237 7.223235
验证数据，第一周的数据应该在这个向量的第7个位置（确实是）：
mean(weather_data$temp[1:7])
# [1] 7.256155
我们需要将其滞后一回数据，这样我们就可以做到
weather_data %>%
mutate(prev.temp = lag(zoo::rollapplyr(temp, 7, FUN = mean, na.rm = TRUE, partial = TRUE)))
# # A tibble: 51 × 3
# dt temp prev.temp
# <date> <dbl> <dbl>
# 1 2023-11-29 9.23 NA
# 2 2023-11-30 9.43 9.23
# 3 2023-12-01 3.58 9.33
# 4 2023-12-02 8.47 7.41
# 5 2023-12-03 6.78 7.68
# 6 2023-12-04 5.67 7.50
# 7 2023-12-05 7.63 7.19
# 8 2023-12-06 2.21 7.26
# 9 2023-12-07 6.91 6.25
# 10 2023-12-08 7.35 5.89
# # ℹ 41 more rows
# # ℹ Use `print(n = ...)` to see more rows
如果您认为您可能有“有间隙的数据”，那么您需要做的就是插入缺失的日期，给它们一个
NAweather_data_gapped <- weather_data[-c(4, 8),]
head(weather_data_gapped, 10)
# # A tibble: 10 × 2
# dt temp
# <date> <dbl>
# 1 2023-11-29 9.23
# 2 2023-11-30 9.43
# 3 2023-12-01 3.58
# 4 2023-12-03 6.78
# 5 2023-12-04 5.67
# 6 2023-12-05 7.63
# 7 2023-12-07 6.91
# 8 2023-12-08 7.35
# 9 2023-12-09 5.12
# 10 2023-12-10 7.47
weather_data_gapped %>%
reframe(dt = seq(min(dt), max(dt), by="day")) %>%
left_join(weather_data_gapped, by = "dt")
# # A tibble: 51 × 2
# dt temp
# <date> <dbl>
# 1 2023-11-29 9.23
# 2 2023-11-30 9.43
# 3 2023-12-01 3.58
# 4 2023-12-02 NA
# 5 2023-12-03 6.78
# 6 2023-12-04 5.67
# 7 2023-12-05 7.63
# 8 2023-12-06 NA
# 9 2023-12-07 6.91
# 10 2023-12-08 7.35
# # ℹ 41 more rows
# # ℹ Use `print(n = ...)` to see more rows
（...然后按照上面的方法做
rollapply非等值连接也可以，也许更类似于您的
case_whenweather_data %>%
mutate(dt0 = dt, dt_from = dt - 8, dt_to = dt - 1, temp) %>%
left_join(weather_data, join_by(between(y$dt, x$dt_from, x$dt_to)), suffix = c("", ".prev")) %>%
summarize(prev.temp = mean(temp.prev, na.rm = TRUE), .by = c(dt0, temp)) %>%
rename(dt = dt0)
# # A tibble: 51 × 3
# dt temp prev.temp
# <date> <dbl> <dbl>
# 1 2023-11-29 9.23 NaN
# 2 2023-11-30 9.43 9.23
# 3 2023-12-01 3.58 9.33
# 4 2023-12-02 8.47 7.41
# 5 2023-12-03 6.78 7.68
# 6 2023-12-04 5.67 7.50
# 7 2023-12-05 7.63 7.19
# 8 2023-12-06 2.21 7.26
# 9 2023-12-07 6.91 6.63
# 10 2023-12-08 7.35 6.34
# # ℹ 41 more rows
# # ℹ Use `print(n = ...)` to see more rows
此方法对于间隙数据和无序数据具有弹性。
样本数据
set.seed(42)
weather_data <- tibble(dt = Sys.Date() - 50:0, temp = runif(51, 1, 10))
head(weather_data, 10)
# # A tibble: 10 × 2
# dt temp
# <date> <dbl>
# 1 2023-11-29 9.23
# 2 2023-11-30 9.43
# 3 2023-12-01 3.58
# 4 2023-12-02 8.47
# 5 2023-12-03 6.78
# 6 2023-12-04 5.67
# 7 2023-12-05 7.63
# 8 2023-12-06 2.21
# 9 2023-12-07 6.91
# 10 2023-12-08 7.35