按R中的因子向量化累积和

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

---

itemcode一种基本的R方法是计算整个向量的总和，并使用游程编码捕获子列表的几何结构。找出每个组的开始，并创建新组

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

这里有一个函数

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

这就是表现

> 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 

>n goodp itemcode system.time（cumsumByGroup（goodp，itemcode））
用户系统运行时间
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)
}

cumsumByGroup1对于修改后的示例输入/输出，您可以使用以下基本R方法（以及其他方法）：

注意：我在输入
df
中添加了列
cum.goodp
，并创建了一个新列
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选项。
您能显示预期的输出吗？@akrun这是一个r问题也许您正在寻找转换（df，cum.goodp=ave（goodp，itemcode，FUN=cumsum））
但我真的不清楚。
dt[，cum\u goodp:=cumsum（goodp），by=“itemcode”]
如果
dt@jvalenti，那么您可以使用
transform（df，cum.goodpX=ave（goodp，itemcode，cumsum（goodp==0），FUN=cumsum））
除非对所有0和1都有警告，否则类似的方法可以是：
cs=cumsum（x）；cs-cummax（（cs-x）*开始）
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 

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

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

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