不同分母的除法的累积和R

Question

好的，以下是我希望使用高效、优雅的解决方案（如data.table或dplyr）来解决的问题。

定义：

DT = data.table(group=c(rep("A",3),rep("B",5)),value=c(2,9,2,3,4,1,0,3))

   time group value  
1:    1     A     2  
2:    2     A     9 
3:    3     A     2 
4:    1     B     3     
5:    2     B     4 
6:    3     B     1 
7:    4     B     0 
8:    5     B     3 

我想要的是按组累计求和的值，这些值在观察时根据其倒序排列进行除法。

   time group value    RESULT
1:    1     A     2  2.000000
2:    2     A     9 10.000000
3:    3     A     2  7.166667
4:    1     B     3  3.000000
5:    2     B     4  5.500000
6:    3     B     1  4.000000
7:    4     B     0  2.583333
8:    5     B     3  4.933333

在第5行，结果为：4/1 + 3/2 = 5.5。因为在时间2时，B组有2个观测值，最后一个被除以1，之前的被除以1。 接下来在第6行，结果为：1/1 + 4/2+ 3/3 = 4。由于在时间3时，B组有3个观测值，最后一个被除以1，之前的被除以2，再之前的被除以3。在第7行：0/1 + 1/2 + 4/3 + 3/4 = 2.583333，以此类推… 数据量很大，因此避免使用循环至关重要！

- EdM

Answer 1

我会使用矩阵代数：

n_max = DT[, .N, by=group][, max(N)]
m     = matrix(0, n_max, n_max)
m[]   = ifelse( col(m) >= row(m), 1 / (col(m) - row(m) + 1 ), m)

DT[, res := value %*% m[seq_len(.N), seq_len(.N)], by=group ]

   group value       res
1:     A     2  2.000000
2:     A     9 10.000000
3:     A     2  7.166667
4:     B     3  3.000000
5:     B     4  5.500000
6:     B     1  4.000000
7:     B     0  2.583333
8:     B     3  4.933333

- Frank

Answer 2

您可以在一系列的分组长度上应用*apply函数，使序列索引为value，反转则可将其除以该值。使用dplyr：

library(tidyverse)

DT %>% group_by(group) %>% 
    mutate(result = sapply(seq(n()), function(x){sum(value[seq(x)] / rev(seq(x)))}))

## Source: local data frame [8 x 3]
## Groups: group [2]
## 
##    group value    result
##   <fctr> <dbl>     <dbl>
## 1      A     2  2.000000
## 2      A     9 10.000000
## 3      A     2  7.166667
## 4      B     3  3.000000
## 5      B     4  5.500000
## 6      B     1  4.000000
## 7      B     0  2.583333
## 8      B     3  4.933333

或者使用purrr::map_dbl代替sapply，

DT %>% group_by(group) %>% 
    mutate(result = map_dbl(seq(n()), ~sum(value[seq(.x)] / rev(seq(.x)))))

这将会返回相同的结果。你也可以使用base R来实现相同的逻辑：

DT$result <- ave(DT$value, 
                 DT$group, 
                 FUN = function(v){sapply(seq_along(v), 
                                          function(x){sum(v[seq(x)] / rev(seq(x)))})})

DT

##   group value    result
## 1     A     2  2.000000
## 2     A     9 10.000000
## 3     A     2  7.166667
## 4     B     3  3.000000
## 5     B     4  5.500000
## 6     B     1  4.000000
## 7     B     0  2.583333
## 8     B     3  4.933333

虽然我没有进行基准测试，但这些方法应该足够快地完成大多数任务。如果速度是最重要的因素，我怀疑@Frank的答案可能更快。

- alistaire

Answer 3

如果你有足够的内存可用，可以使用笛卡尔积来预先分配行，这样在by操作中所做的操作就更简单，并且可以利用data.table的GForce优化。这可能比其他解决方案更快，因为它基本上通过使用更多优化的代码来交换内存。

> DT[, .SD
     ][DT, on='group', allow.cartesian=T
     ][, setnames(.SD, 'i.time', 'groupRow')
     ][time <= groupRow
     ][, timeRev := .N:1, .(group, groupRow)
     ][, res := value / timeRev
     ][, .(res=sum(res)), .(group, groupRow, i.value)
     ][, groupRow := NULL
     ][, setnames(.SD, 'i.value', 'value')
     ]
   group value    res
1:     A     2  2.000
2:     A     9 10.000
3:     A     2  7.167
4:     B     3  3.000
5:     B     4  5.500
6:     B     1  4.000
7:     B     0  2.583
8:     B     3  4.933
> 

- Clayton Stanley

---

DT[, .SD]与DT是相同的，所以你这样做只是为了使括号对齐吗？ - Frank

@Frank Yep我更在意代码格式和可读性，而不是内存复制。这只是我的个人观点。 - Clayton Stanley