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

Cumulative Sum of a division with varying denominators R

好的,这是我希望使用高效、优雅的解决方案(例如 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,依此类推...

数据量大,避免循环必不可少!

我会使用矩阵代数:

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

您可以 *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)))))

其中returns同样的事情。您也可以将相同的逻辑转换为基础 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 的回答可能会更快。

如果您有空闲内存,可以使用笛卡尔连接来预分配行,这样在 by 内完成的操作会更简单,并且可以利用 data.table 的 GForce 优化。这个 may/may 并不比其他解决方案快,因为它基本上以内存换取在 by.

中使用更优化的代码
> 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
>