通过 R 中的因子向量化 cumsum

我正在尝试在一个非常大的数据帧（约 220 万行）中创建一个列，用于计算每个因子级别的 1 的累积和，并在达到新的因子级别时重置。下面是一些与我自己的类似的基本数据。

itemcode <- c('a1', 'a1', 'a1', 'a1', 'a1', 'a2', 'a2', 'a3', 'a4', 'a4', 'a5', 'a6', 'a6', 'a6', 'a6')
goodp <- c(0, 1, 1, 0, 1, 1, 1, 0, 0, 1, 1, 1, 1, 0, 1)
df <- data.frame(itemcode, goodp)

我希望输出变量 cum.goodp 看起来像这样：

cum.goodp <- c(0, 1, 2, 0, 1, 1, 2, 0, 0, 1, 1, 1, 2, 0, 1)

我知道有很多使用规范的拆分-应用-组合方法的方法，该方法在概念上是直观的，但我尝试使用以下方法：

k <- transform(df, cum.goodp = goodp*ave(goodp, c(0L, cumsum(diff(goodp != 0)), FUN = seq_along, by = itemcode)))

当我尝试运行这段代码时，速度非常非常慢。我知道转换是原因的一部分（“by”也没有帮助）。 itemcode 变量有超过 70K 个不同的值，因此它可能应该被矢量化。有没有办法使用 cumsum 对其进行矢量化？如果没有，任何帮助都将非常感激。非常感谢。

基本 R 方法是计算整个向量的 cumsum，并使用游程编码捕获子列表的几何形状。找出每个组的开始，并创建新组

start <- c(TRUE, itemcode[-1] != itemcode[-length(itemcode)]) | !goodp
f <- cumsum(start)

将这些总结为游程编码，并计算总和

r <- rle(f)
x <- cumsum(x)

然后使用几何得到每个嵌入和需要校正的偏移量

offset <- c(0, x[cumsum(r$lengths)])

并计算更新值

x - rep(offset[-length(offset)], r$lengths)

这是一个函数

cumsumByGroup <- function(x, f) {
    start <- c(TRUE, f[-1] != f[-length(f)]) | !x
    r <- rle(cumsum(start))
    x <- cumsum(x)
    offset <- c(0, x[cumsum(r$lengths)])
    x - rep(offset[-length(offset)], r$lengths)
}

这是应用于示例数据的结果

> cumsumByGroup(goodp, itemcode)
 [1] 0 1 2 0 1 1 2 0 0 1 1 1 2 0 1

它的性能

> n <- 1 + rpois(1000000, 1)
> goodp <- sample(c(0, 1), sum(n), TRUE)
> itemcode <- rep(seq_along(n), n)
> system.time(cumsumByGroup(goodp, itemcode))
   user  system elapsed 
   0.55    0.00    0.55 

dplyr 解决方案大约需要 70 秒。

@alexis_laz 解决方案既优雅又比我的快 2 倍

cumsumByGroup1 <- function(x, f) {
    start <- c(TRUE, f[-1] != f[-length(f)]) | !x
    cs = cumsum(x)
    cs - cummax((cs - x) * start)
}