Sumas consecutivas / rodadas en un vector en R

Supongamos que en RI tenemos el siguiente vector:

[1 2 3 10 20 30] 

¿Cómo realizo una operación mediante la cual en cada índice se sumn 3 elementos consecutivos, lo que da como resultado el siguiente vector:

 [6 15 33 60] 

donde el primer elemento = 1 + 2 + 3, el segundo elemento = 2 + 3 + 10, etc. …? Gracias

Lo que tienes es un vector, no una matriz. Puede usar la función rollapply del paquete zoo para obtener lo que necesita.

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

Eche un vistazo a ?rollapply para obtener más información sobre qué hace rollapply y cómo usarlo.

He creado un paquete para manejar este tipo de funciones de ‘roll’ing que ofrece una funcionalidad similar a rollapply zoo , pero con Rcpp en el back-end. Vea RcppRoll en 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) ) 

me 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 

Puede ser útil si la velocidad es una preocupación.

Si la velocidad es una preocupación, puede usar un filtro de convolución y cortar los extremos:

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

O incluso más rápido, escríbalo como la diferencia entre dos sums acumuladas:

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

Ambos usan funciones básicas solamente. Algunos puntos de referencia:

 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 

También imagino que todos los métodos serán más rápidos si x todos los pesos aplicados fueran enteros en lugar de numéricos.

Usando solo la base R podrías hacer:

 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 

Otra forma, más rápida que sapply (comparable a rsum.cumsum de @ rsum.cumsum ), es la siguiente:

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

Aquí se actualiza el punto de referencia de flodel:

 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