通过R中的因子向量化cumsum

Question

我试图在一个非常大的数据框(约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)

我知道那里有很多使用规范的split-apply-combine方法,从概念上讲它是直观的,但我尝试使用以下方法:

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

当我尝试运行此代码时,它非常慢.我得到的变化是其中一部分原因('by'也没有帮助).itemcode变量有超过70K的不同值,因此它应该是矢量化的.有没有办法使用cumsum对其进行矢量化？如果没有,任何帮助都将得到真正的赞赏.非常感谢.

Answer 1

基本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)
}

Answer 2

通过修改后的示例输入/输出，您可以使用以下基本 R 方法（除其他外）：

transform(df, cum.goodpX = ave(goodp, itemcode, cumsum(goodp == 0), FUN = cumsum))
#   itemcode goodp cum.goodp cum.goodpX
#1        a1     0         0          0
#2        a1     1         1          1
#3        a1     1         2          2
#4        a1     0         0          0
#5        a1     1         1          1
#6        a2     1         1          1
#7        a2     1         2          2
#8        a3     0         0          0
#9        a4     0         0          0
#10       a4     1         1          1
#11       a5     1         1          1
#12       a6     1         1          1
#13       a6     1         2          2
#14       a6     0         0          0
#15       a6     1         1          1

注意：我cum.goodp在输入中添加了列df并创建了一个新列cum.goodpX，以便您可以轻松比较两者。

但当然，您可以对包使用许多其他方法，无论是 @MartinMorgan 建议的方法，还是使用 dplyr 或 data.table（仅举两个选项）。对于大型数据集，这些可能比基本 R 方法快得多。

下面是在 dplyr 中的实现方法：

library(dplyr)
df %>% 
   group_by(itemcode, grp = cumsum(goodp == 0)) %>% 
   mutate(cum.goodpX = cumsum(goodp))

您的问题的评论中已经提供了 data.table 选项。