Найти сумму предыдущих n строк в dataframe

Я хочу найти сумму строк в таблице данных. Например:

id = 1:10
vals = c(4,7,2,9,7,0,4,6,1,8)
test = data.frame(id,vals)

так, для n=3, Я хотел бы вычислить следующий столбец как:

test$sum = c(NA, NA, 13,18,18,16,11,10,11,15)

ближе всего я пришел к созданию нового столбца, используя:

test$valprevious = c(NA, head(test$vals,-1)

затем с помощью цикла повторить это n раз, потом sum через колонки. Я уверен, что это не самый эффективный метод, есть ли какие-либо функции, которые обращаются к n предыдущих строк? Или по-другому. это?

8
dataframe r

1 ответов

можно использовать :

rollsum(test$vals, k = 3, fill = NA, align = 'right')

в качестве альтернативы, вы можете использовать Reduce С shift С data.table пакет:

library(data.table)
setDT(test)[, sums := Reduce(`+`, shift(vals, 0:2))]

что дает тот же результат:

> test
    id vals sums
 1:  1    4   NA
 2:  2    7   NA
 3:  3    2   13
 4:  4    9   18
 5:  5    7   18
 6:  6    0   16
 7:  7    4   11
 8:  8    6   10
 9:  9    1   11
10: 10    8   15

хорошая базовая альтернатива R, предложенная @alexis_laz в комментариях:

n <- 3
cs <- cumsum(test$vals)
test$sums <- c(rep_len(NA, n - 1), tail(cs, -(n - 1)) - c(0, head(cs, -n)))

еще два варианта, предложенные @Khashaa в комментариях:

# with base R
n <- 3
test$sums <- c(rep_len(NA, n - 1), rowSums(embed(test$vals, n)))

# with RcppRoll
library(RcppRoll)
test$sums <- roll_sumr(test$vals, 3)

критерии:

как отметил @alexis_laz в комментариях, некоторые из решений могут создать накладные расходы при пересчете сумм и повторном создании length-векторы. Это может привести к различиям в скорости вычислений.

# creating function of the different solutions:
alexis_laz <- function(test) {n <- 3; cs <- cumsum(test$vals); test$sums <- c(rep_len(NA, n - 1), tail(cs, -(n - 1)) - c(0, head(cs, -n)))}
khashaa <- function(test) {n <- 3; test$sums <- c(rep_len(NA, n - 1), rowSums(embed(test$vals, n)))}
rcpp_roll <- function(test) test$sums <- roll_sumr(test$vals, 3)
zoo_roll <- function(test) test$sums <- rollsumr(test$vals, k=3, fill=NA)
dt_reduce <- function(test) setDT(test)[, sums := Reduce(`+`, shift(vals, 0:2))]

запуск бенчмарка на небольшом примере набор данных:

library(microbenchmark)
microbenchmark(alexis_laz(test),
               khashaa(test),
               rcpp_roll(test), 
               zoo_roll(test), 
               dt_reduce(test), 
               times = 10)

что дает:

Unit: microseconds
             expr     min      lq     mean   median      uq     max neval cld
 alexis_laz(test)  61.390  99.507 107.7025 108.7515 122.849 131.376    10 a  
    khashaa(test)  35.758  92.596  94.1640 100.4875 103.264 112.779    10 a  
  rcpp_roll(test)  26.727  99.709  96.1154 106.1295 114.483 116.553    10 a  
   zoo_roll(test) 304.586 389.991 390.7553 398.8380 406.352 419.544    10   c
  dt_reduce(test) 254.837 258.979 277.4706 264.0625 269.711 389.606    10  b

Как видите,RcppRoll решение и два базовых R-решения @Alexis_laz и @Khashaa значительно быстрее, чем zoo и data.table решения (но все еще в микросекундах, поэтому не о чем беспокоиться).

С гораздо большим набором данных:

test <- data.frame(id=rep(1:10,1e7), vals=sample(c(4,7,2,9,7,0,4,6,1,8),1e7,TRUE))

картина меняется:

Unit: milliseconds
             expr        min         lq      mean    median        uq       max neval  cld
 alexis_laz(test)  3181.4270  3447.1210  4392.166  4801.410  4889.001  5002.363    10  b  
    khashaa(test)  6313.4829  7305.3334  7478.831  7680.176  7723.830  7859.335    10   c 
  rcpp_roll(test)   373.0379   380.9457  1286.687  1258.165  2062.388  2417.733    10 a   
   zoo_roll(test) 38731.0369 39457.2607 40566.126 40940.586 41114.990 42207.149    10    d
  dt_reduce(test)  1887.9322  1916.8769  2128.567  2043.301  2218.635  2698.438    10 a

теперь RcppRoll решение ясно самое быстрое следовать data.table решение.

15