векторизовать cumsum в R

Question

Я пытаюсь создать столбец в очень большом кадре данных (~ 2,2 миллиона строк), который вычисляет суммарную сумму 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) 

Я понимаю, что есть много там с помощью канонического разделенным применить-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 подход (среди прочих):

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 вариант уже содержится в комментариях к вашему вопросу.

Answer 2

Основополагающий подход 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) 
}