Somme consecutive / rotative in un vettore in R

Supponiamo che RI abbia il seguente vettore:

[1 2 3 10 20 30] 

Come eseguo un’operazione in cui ad ogni indice vengono sumti 3 elementi consecutivi, risultando nel seguente vettore:

 [6 15 33 60] 

dove il primo elemento = 1 + 2 + 3, il secondo elemento = 2 + 3 + 10 ecc …? Grazie

Quello che hai è un vettore, non un array. Puoi utilizzare la funzione rollapply dal pacchetto zoo per ottenere ciò di cui hai bisogno.

 > x <- c(1, 2, 3, 10, 20, 30) > #library(zoo) > rollapply(x, 3, sum) [1] 6 15 33 60 

Dai un’occhiata a ?rollapply per ulteriori dettagli su cosa fa rollapply e come usarlo.

Ho creato un pacchetto per la gestione di questo tipo di funzioni di roll-up che offrono funzionalità simili a quelle del rollapply , ma con Rcpp sul backend. Controlla RcppRoll su CRAN.

 library(microbenchmark) library(zoo) library(RcppRoll) x <- rnorm(1E5) all.equal( m1 <- rollapply(x, 3, sum), m2 <- roll_sum(x, 3) ) ## from flodel rsum.cumsum <- function(x, n = 3L) { tail(cumsum(x) - cumsum(c(rep(0, n), head(x, -n))), -n + 1) } microbenchmark( unit="ms", times=10, rollapply(x, 3, sum), roll_sum(x, 3), rsum.cumsum(x, 3) ) 

mi da

 Unit: milliseconds expr min lq median uq max neval rollapply(x, 3, sum) 1056.646058 1068.867550 1076.550463 1113.71012 1131.230825 10 roll_sum(x, 3) 0.405992 0.442928 0.457642 0.51770 0.574455 10 rsum.cumsum(x, 3) 2.610119 2.821823 6.469593 11.33624 53.798711 10 

Potresti trovarlo utile se la velocità è un problema.

Se la velocità è un problema, puoi usare un filtro di convoluzione e tagliare le estremità:

 rsum.filter <- function(x, n = 3L) filter(x, rep(1, n))[-c(1, length(x))] 

O ancora più veloce, scrivilo come la differenza tra due somme cumulative:

 rsum.cumsum <- function(x, n = 3L) tail(cumsum(x) - cumsum(c(rep(0, n), head(x, -n))), -n + 1) 

Entrambi usano solo le funzioni di base. Alcuni parametri:

 x <- sample(1:1000) rsum.rollapply <- function(x, n = 3L) rollapply(x, n, sum) rsum.sapply <- function(x, n = 3L) sapply(1:(length(x)-n+1),function(i){ sum(x[i:(i+n-1)])}) library(microbenchmark) microbenchmark( rsum.rollapply(x), rsum.sapply(x), rsum.filter(x), rsum.cumsum(x) ) # Unit: microseconds # expr min lq median uq max neval # rsum.rollapply(x) 12891.315 13267.103 14635.002 17081.5860 28059.998 100 # rsum.sapply(x) 4287.533 4433.180 4547.126 5148.0205 12967.866 100 # rsum.filter(x) 170.165 208.661 269.648 290.2465 427.250 100 # rsum.cumsum(x) 97.539 130.289 142.889 159.3055 449.237 100 

Immagino anche che tutti i metodi saranno più veloci se x e tutti i pesi applicati fossero interi anziché numeri.

Usando solo la base R puoi fare:

 v <- c(1, 2, 3, 10, 20, 30) grp <- 3 res <- sapply(1:(length(v)-grp+1),function(x){sum(v[x:(x+grp-1)])}) > res [1] 6 15 33 60 

Un altro modo, più velocemente di quanto sapply (paragonabile a @ flodel’s rsum.cumsum ), è il seguente:

 res <- rowSums(outer(1:(length(v)-grp+1),1:grp,FUN=function(i,j){v[(j - 1) + i]})) 

Ecco il benchmark di flodel aggiornato:

 x <- sample(1:1000) rsum.rollapply <- function(x, n = 3L) rollapply(x, n, sum) rsum.sapply <- function(x, n = 3L) sapply(1:(length(x)-n+1),function(i){sum(x[i:(i+n-1)])}) rsum.filter <- function(x, n = 3L) filter(x, rep(1, n))[-c(1, length(x))] rsum.cumsum <- function(x, n = 3L) tail(cumsum(x) - cumsum(c(rep(0, n), head(x, -n))), -n + 1) rsum.outer <- function(x, n = 3L) rowSums(outer(1:(length(x)-n+1),1:n,FUN=function(i,j){x[(j - 1) + i]})) library(microbenchmark) microbenchmark( rsum.rollapply(x), rsum.sapply(x), rsum.filter(x), rsum.cumsum(x), rsum.outer(x) ) # Unit: microseconds # expr min lq median uq max neval # rsum.rollapply(x) 9464.495 9929.4480 10223.2040 10752.7960 11808.779 100 # rsum.sapply(x) 3013.394 3251.1510 3466.9875 4031.6195 7029.333 100 # rsum.filter(x) 161.278 178.7185 229.7575 242.2375 359.676 100 # rsum.cumsum(x) 65.280 70.0800 88.1600 95.1995 181.758 100 # rsum.outer(x) 66.880 73.7600 82.8795 87.0400 131.519 100