Как сделать условную накопительную сумму, которая требует доступа к ранее рассчитанным элементам на лету?

Question

Я пытаюсь эффективно выполнить следующую условную кумулятивную сумму в базе R, но я борюсь с доступом к ранее вычисленным элементам на лету.Код с циклом for:

input <- c(6, 4, 8, 2, 2, 4, 2, 6)    
indx <- c(1, 1, 2, 2, 4, 3, 4, 5)
desired_out <- rep(0, length(input))
for (i in seq_along(desired_out)) {
    print(desired_out[i] <- desired_out[indx[i]] + input[i])
}
# [1] 6
# [1] 10
# [1] 18
# [1] 12
# [1] 14
# [1] 22
# [1] 14
# [1] 20

Желаемым выходом является вектор c(6, 10, 18, 12, 14, 22, 14, 20).Это как условная кумулятивная сумма, потому что вы можете получить результат, набрав cumsum(input)[indx] + input.

Answer 1

sapply должно быть быстрее

sapply(1:length(input), function(i){

  desired_out[i]<<-desired_out[indx[i]] + input[i]

})
[1]  6 10 18 12 14 22 14 20

Answer 2

Если скорость имеет первостепенное значение, код OP можно легко преобразовать в код C ++, используя Rcpp следующим образом:

пример данных:

library(data.table)
set.seed(0L)
M <- 1e6
ngrps <- 1e3
DT <- data.table(input=sample(10, M, replace=TRUE),
    indx=sort(sample(ngrps, M, replace=TRUE)))

# DT <- data.table(input=c(6, 4, 8, 2, 2),    
#         indx=c(1, 1, 2, 2, 4))

код cpp:

library(Rcpp)
system.time(
    cppFunction(
    "NumericVector func(NumericVector input, NumericVector indx) {
        const int len = input.size();
        NumericVector ret(len, 0.0);
        for (int k=0; k<len; k++) {
            ret[k] = ret[indx[k]-1] + input[k];
        }
        return ret;
    }")
)
#  user  system elapsed 
#  0.04    0.05    6.64 

Помните, что в коде C ++ используется индексация с нуля, следовательно, требуется indx[k]-1.

Проверка по примеру OP:

input <- c(6, 4, 8, 2, 2, 4, 2, 6)    
indx <- c(1, 1, 2, 2, 4, 3, 4, 5)
func(input, indx)
#[1]  6 10 18 12 14 22 14 20

Время и пример вызова с *Синтаксис 1016 *:

system.time(DT[, func(input, indx)])
#  user  system elapsed 
#  0.00    0.01    0.02 

Сравнение скорости с циклом R

M <- 1e6
ngrps <- 1e3
input <- sample(10, M, replace=TRUE),
indx <- sort(sample(ngrps, M, replace=TRUE)))
microbenchmark(
  rcpp = func(input, indx),
  Rloop = {
    desired_out <- rep(0, length(input))
    for (i in seq_along(desired_out)) {
      desired_out[i] <- desired_out[indx[i]] + input[i]
    }},
  unit = 'relative',
  times = 100)

# Unit: relative
# expr       min       lq     mean   median       uq       max neval
# rcpp   1.00000  1.00000 1.000000  1.00000 1.000000 1.0000000   100
# Rloop 14.80781 11.37963 6.712257 10.44288 6.244126 0.7554706   100