2013-10-05 11 views
9

Supponiamo in RI hanno il seguente vettore:consecutive/somme volventi in un vettore in R

[1 2 3 10 20 30] 

Come si esegue un'operazione per cui ad ogni indice vengono sommati 3 elementi consecutivi, con conseguente vettore seguente:

[6 15 33 60] 

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

risposta

18

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

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

Date un'occhiata a ?rollapply per ulteriori dettagli su ciò che rollapply fa e come usarlo.

+1

grazie questo è proprio quello che volevo. Segnalo come risposta (non posso farlo ora a causa di un limite di tempo). È questo il modo più veloce per farlo? Grazie – user2834313

9

Utilizzando solo la base di R si potrebbe 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ù veloce di sapply (paragonabile a @ di flodel rsum.cumsum), è la seguente:

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

Ecco flodel di benchmark 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 
+0

Fantastico! Grazie. Purtroppo non posso votare perché non ho abbastanza punti. – user2834313

+0

@ user2834313: nessun problema;) – digEmAll

+1

Aggiunto un nuovo modo possibile;) – digEmAll

10

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

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

O anche più veloce, scrive 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 uso solo funzioni di base. Alcuni parametri di riferimento:

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 

Inoltre immagino tutti i metodi sarà più veloce se x e tutti i pesi applicati erano interi, invece di valori numerici.

18

Metto insieme un pacchetto per la gestione di questi tipi di funzioni di "roll-on" che offre funzionalità simili a zoo di 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 dà

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 

Si potrebbe trovare utile se la velocità è una preoccupazione.

+1

nice, +1. Mi chiedo: un 'cumsum basato su Rcpp' sarebbe molto più veloce di quello di R? Le tue funzioni gestiscono correttamente le NA? – flodel

+0

Per cumsum, probabilmente no - questo è già un primitivo, e quindi probabilmente solo un ciclo C.Sulla questione di NA: questo è un buon punto. Sono gestiti in modo incoerente in questo momento. La maggior parte delle operazioni restituisce NA se uno degli elementi in una finestra è NA, sebbene sd restituisca NaN. min e max ignorano le NA, al contrario di R. E suppongo che 'na.option' sia un parametro utile. –

+0

@KevinUshey: Eccellente, grazie. È molto veloce – user2834313

Problemi correlati