r - 基于当前行值和前面的行平均数据帧

Question

我有一个简单的数据集，其形式如下

df<- data.frame(c(10, 10, 10,  10,  10,  10,  10,  10, 10, 10, 10, 10, 10, 10, 10, 10, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20),   
                c(80,  80,  80,  80,  80,  80,  80,  80, 90, 90, 90, 90, 90, 90, 90, 90, 80,  80,  80,  80,  80,  80,  80,  80, 90, 90, 90, 90, 90, 90, 90, 90),
                c(1,    1,   2,   2,   3,   3,   4,   4,     1,   1,    2, 2,   3,    3,   4,   4,  1,    1,   2,   2,   3,   3,   4,   4,     1,   1,    2, 2,   3,    3,   4,   4),
                c(25,   75,  20,  40,  60,  50,  20,  10,  20,  30,  40,  60, 25,   75,  20,  40, 5,   5,  2,  4,  6,  5,  2,  1,  2,  3,  4,  6, 2,   7,  2,  4))

colnames(df)<-c("car_number", "year", "marker", "val")

实际上，我想做的很简单:根据 car_number，我想找到与 marker 相关的值的平均值以及前面的值3 个值。所以对于上面的示例数据，我想要的输出是

car=10, year=80 1: 50
car=10, year=80 2: 40
car=10, year=80 3: 45
car=10, year=80 4: 37.5

car=10, year=90 1: 31.25
car=10, year=90 2: 36.25
car=10, year=90 3: 35
car=10, year=90 4: 38.75


car=20, year=80 1: 5
car=20, year=80 2: 4
car=20, year=80 3: 4.5
car=20, year=80 4: 3.75

car=20, year=90 1: 3.125
car=20, year=90 2: 3.625
car=20, year=90 3: 3.375
car=20, year=90 4: 3.750

请注意，为简化示例，上面的标记 成对出现。实际数据并非如此，所以我认为通用解决方案将包含某种 group_by (?)

欢迎任何有效的解决方案!

---

这是第二个示例数据集和输出:

df<- data.frame(c(10, 10, 10,  10,  10,  10,  10,  10, 10, 10, 10, 10, 10, 10, 10, 10, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20),   
                c(80,  80,  80,  80,  80,  80,  80,  80, 90, 90, 90, 90, 90, 90, 90, 90, 80,  80,  80,  80,  80,  80,  80,  80, 90, 90, 90, 90, 90, 90, 90, 90),
                c(1,    2,   2,   2,   3,   3,   4,   4,     1,   1,    2, 2,   3,    3,   3,   4,  1,    1,   1,   2,   3,   3,   4,   4,     4,   1,    2, 2,   3,    3,   3,   4),
                c(25,   75,  20,  40,  60,  50,  20,  10,  20,  30,  40,  60, 25,   75,  20,  40, 5,   5,  2,  4,  6,  5,  2,  1,  2,  3,  4,  6, 2,   7,  2,  4))

colnames(df)<-c("car_number", "year", "marker", "val")

输出是(基于上面的规则)

car=10, year=80 1: Mean{{25}]                                  = 25
car=10, year=80 2: Mean[{40, 20, 75, 25}]                      = 40
car=10, year=80 3: Mean[{50, 60, 40, 20, 75, 25}]              = 45
car=10, year=80 4: Mean[{10, 20, 50, 60, 40, 20, 75, 25}]      = 37.5

car=10, year=90 1: Mean[{30, 20, 10, 20, 50, 60, 40, 20, 75}] = 36.11
car=10, year=90 2: Mean[{60, 40, 30, 20, 10, 20, 50, 60}]     = 36.25
car=10, year=90 3: Mean[{20, 75, 25, 60, 40, 30, 20, 10, 20}] = 33.33
car=10, year=90 4: Mean[{40, 20, 75, 25, 60, 40, 30, 20}]     = 38.75

car=20, year=80 1: Mean[{2, 5, 5}]                   = 4
car=20, year=80 2: Mean[{4, 2, 5, 5}]                = 4
car=20, year=80 3: Mean[{5, 6, 4, 2, 5, 5}]          = 4.5
car=20, year=80 4: Mean[{2, 1, 2, 5, 6, 4, 2, 5, 5}] = 3.55

car=20, year=90 1: Mean[{3, 2, 1, 2, 5, 6, 4}]       = 3.29
car=20, year=90 2: Mean[{6, 4, 3, 2, 1, 2, 5, 6}]    = 3.625
car=20, year=90 3: Mean[{2, 7, 2, 6, 4, 3, 2, 1, 2}] = 3.22
car=20, year=90 4: Mean[{4, 2, 7, 2, 6, 4, 3}]       = 4

Answer 1

第一个group_by 计算car_number、year、marker 的平均值，并保留其权重(number行数)。
car_number 的第二个 group_by 允许我们检索滞后均值和权重以计算所需的均值:

library(purrr)
library(dplyr)
df %>% 
  arrange(car_number, year, marker) %>% 
  group_by(car_number, year, marker) %>% 
  summarise(mean_1 = mean(val, na.rm = TRUE), weight = n()) %>% 
  group_by(car_number) %>% 
  mutate(mean_2 = pmap_dbl(
    list(mean_1, lag(mean_1), lag(mean_1, 2), lag(mean_1, 3),
         weight, lag(weight), lag(weight, 2), lag(weight, 3)),
    ~ weighted.mean(c(..1, ..2, ..3, ..4),
                    c(..5, ..6, ..7, ..8),
                    na.rm = TRUE)
  )) %>%
  ungroup()

结果:

# # A tibble: 16 × 6
#    car_number  year marker mean_1 weight mean_2
#         <dbl> <dbl>  <dbl>  <dbl>  <int>  <dbl>
# 1          10    80      1   50.0      2 50.000
# 2          10    80      2   30.0      2 40.000
# 3          10    80      3   55.0      2 45.000
# 4          10    80      4   15.0      2 37.500
# 5          10    90      1   25.0      2 31.250
# 6          10    90      2   50.0      2 36.250
# 7          10    90      3   50.0      2 35.000
# 8          10    90      4   30.0      2 38.750
# 9          20    80      1    5.0      2  5.000
# 10         20    80      2    3.0      2  4.000
# 11         20    80      3    5.5      2  4.500
# 12         20    80      4    1.5      2  3.750
# 13         20    90      1    2.5      2  3.125
# 14         20    90      2    5.0      2  3.625
# 15         20    90      3    4.5      2  3.375
# 16         20    90      4    3.0      2  3.750

编辑 0.2.2.9000 之前的 purrr 版本的替代语法:

df %>% 
  arrange(car_number, year, marker) %>% 
  group_by(car_number, year, marker) %>% 
  summarise(mean_1 = mean(val, na.rm = TRUE), weight = n()) %>% 
  group_by(car_number) %>% 
  mutate(mean_2 = pmap_dbl(
    list(mean_1, lag(mean_1), lag(mean_1, 2), lag(mean_1, 3),
         weight, lag(weight), lag(weight, 2), lag(weight, 3)),
    function(a, b, c, d, e, f, g, h)
      weighted.mean(c(a, b, c, d),
                    c(e, f, g, h),
                    na.rm = TRUE)
  )) %>%
  ungroup()