R：递归平均

Question

我正在使用 R 编程语言。我有以下数据：

library(dplyr)

my_data = data.frame(id = c(1,1,1,1,2,2,2,3,4,4,5,5,5,5,5), var_1 = sample(c(0,1), 15, replace = TRUE) , var_2 =sample(c(0,1), 15 , replace = TRUE) )

my_data = data.frame(my_data %>% group_by(id) %>% mutate(index = row_number(id)))

my_data = my_data[,c(1,4,2,3)]

数据看起来像这样：

   id index var_1 var_2
1   1     1     0     1
2   1     2     0     0
3   1     3     1     1
4   1     4     0     1
5   2     1     1     0
6   2     2     1     1
7   2     3     0     1
8   3     1     1     0
9   4     1     0     0
10  4     2     0     0
11  5     1     0     0
12  5     2     1     0
13  5     3     0     1
14  5     4     0     0
15  5     5     0     1

我想创建两个新变量（v_1，v_2）。对于每个唯一的“id”：

• v_1：我希望 v_1 是 var_1 的当前值、上一个值和上一个到上一个值的平均值（即索引 = n、索引 = n-1 和索引 = n-2）。如果这是不可能的（例如，对于索引 = 2 和索引 = 1），我希望这个平均值尽可能早。

• v_2：我希望 v_2 是 var_2 的当前值、上一个值和上一个到上一个值的平均值（即索引 = n、索引 = n-1 和索引 = n-2）。如果这是不可能的（例如，对于索引 = 2 和索引 = 1），我希望这个平均值尽可能早。

这将是这样的：

• 第 1 行（id = 1，索引 = 1）：v_1 = var_1（索引 1）
• 第 2 行（id = 1，索引 = 1；id = 1 索引 = 2）：v_1 = (var_1 (索引 1) + var_1 (索引 2))/2
• 第 3 行（id = 1，索引 = 1；id = 1 索引 = 2；id = 1，索引 = 3）：v_1 =（var_1（索引 1）+ var_1（索引 2）+ var_1（索引 3））/3
• 第 4 行（id = 1，索引 = 2；id = 1 索引 = 3；id = 1，索引 = 4）：v_1 =（var_1（索引 2）+ var_1（索引 3）+ var_1（索引 4））/3
• ETC。

我尝试使用以下代码来执行此操作：

average_data = my_data %>% 
   group_by(id) %>% 
   summarise(v_1 = mean(tail(var_1, 3)), 
             v_2 = mean(tail(var_2, 3)))

# final_result
final_data =  merge(x = my_data, y = average_data, by = "id", all.x = TRUE)

但我不确定这是否正确。

有人可以告诉我该怎么做吗？

谢谢！

Answer 1

数据

\n

df <- data.frame(\n    id = c(1L, 1L, 1L, 1L, 2L, 2L, 2L, 3L, 4L, 4L, 5L, 5L, 5L, 5L, 5L),\n    index = c(1L, 2L, 3L, 4L, 1L, 2L, 3L, 1L, 1L, 2L, 1L, 2L, 3L, 4L, 5L),\n    var_1 = c(0L, 0L, 1L, 0L, 1L, 1L, 0L, 1L, 0L, 0L, 0L, 1L, 0L, 0L, 0L),\n    var_2 = c(1L, 0L, 1L, 1L, 0L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 1L)\n  )\n

\n

整洁宇宙

\n

library(tidyverse)\n\ndf %>% \n  group_by(id) %>% \n  mutate(across(starts_with("var_"),\n                .fns = ~zoo::rollapply(data = .x, width = 3, FUN = mean, partial = TRUE, align = "right"),\n                .names = "new_{.col}")) %>% \n  ungroup()\n#> # A tibble: 15 \xc3\x97 6\n#>       id index var_1 var_2 new_var_1 new_var_2\n#>    <int> <int> <int> <int>     <dbl>     <dbl>\n#>  1     1     1     0     1     0         1    \n#>  2     1     2     0     0     0         0.5  \n#>  3     1     3     1     1     0.333     0.667\n#>  4     1     4     0     1     0.333     0.667\n#>  5     2     1     1     0     1         0    \n#>  6     2     2     1     1     1         0.5  \n#>  7     2     3     0     1     0.667     0.667\n#>  8     3     1     1     0     1         0    \n#>  9     4     1     0     0     0         0    \n#> 10     4     2     0     0     0         0    \n#> 11     5     1     0     0     0         0    \n#> 12     5     2     1     0     0.5       0    \n#> 13     5     3     0     1     0.333     0.333\n#> 14     5     4     0     0     0.333     0.333\n#> 15     5     5     0     1     0         0.667\n

\n

^{由reprex 包(v2.0.1)于 2022-06-06 创建}

\n

数据表

\n

library(data.table)\n\nCOLS <- gsub("ar", "", grep("var_", names(df), value = TRUE))\n\nsetDT(df)[, \n          (COLS) := lapply(.SD, function(x) zoo::rollapply(data = x, width = 3, FUN = mean, partial = TRUE, align = "right")),\n          by = id,\n          .SDcols = patterns("var_")][]\n#>     id index var_1 var_2       v_1       v_2\n#>  1:  1     1     0     1 0.0000000 1.0000000\n#>  2:  1     2     0     0 0.0000000 0.5000000\n#>  3:  1     3     1     1 0.3333333 0.6666667\n#>  4:  1     4     0     1 0.3333333 0.6666667\n#>  5:  2     1     1     0 1.0000000 0.0000000\n#>  6:  2     2     1     1 1.0000000 0.5000000\n#>  7:  2     3     0     1 0.6666667 0.6666667\n#>  8:  3     1     1     0 1.0000000 0.0000000\n#>  9:  4     1     0     0 0.0000000 0.0000000\n#> 10:  4     2     0     0 0.0000000 0.0000000\n#> 11:  5     1     0     0 0.0000000 0.0000000\n#> 12:  5     2     1     0 0.5000000 0.0000000\n#> 13:  5     3     0     1 0.3333333 0.3333333\n#> 14:  5     4     0     0 0.3333333 0.3333333\n#> 15:  5     5     0     1 0.0000000 0.6666667\n

\n

^{由reprex 包(v2.0.1)于 2022-06-06 创建}

\n

Answer 2

您可以创建一个函数来完成此任务：

library(tidyverse)

fun <- function(x, k){
   y <- cummean(first(x, k-1))
   if(k > length(x)) y else c(y, zoo::rollmean(x, k))
 }

df %>%
  group_by(id) %>%
  mutate(v_1 = fun(var_1, 3), v_2 = fun(var_2, 3))

# Groups:   id [5]
      id index var_1 var_2   v_1   v_2
   <int> <int> <int> <int> <dbl> <dbl>
 1     1     1     0     1 0     1    
 2     1     2     0     0 0     0.5  
 3     1     3     1     1 0.333 0.667
 4     1     4     0     1 0.333 0.667
 5     2     1     1     0 1     0    
 6     2     2     1     1 1     0.5  
 7     2     3     0     1 0.667 0.667
 8     3     1     1     0 1     0    
 9     4     1     0     0 0     0    
10     4     2     0     0 0     0    
11     5     1     0     0 0     0    
12     5     2     1     0 0.5   0    
13     5     3     0     1 0.333 0.333
14     5     4     0     0 0.333 0.333
15     5     5     0     1 0     0.667