R中向量中的连续/滚动总和

Question

假设在RI中有以下向量:

[1 2 3 10 20 30]

如何执行一个操作,在每个索引处对3个连续元素求和,得到以下向量:

[6 15 33 60]

其中第一个元素= 1 + 2 + 3,第二个元素= 2 + 3 + 10等......？谢谢

Answer 1

你拥有的是一个向量,而不是一个数组.您可以使用rollapplyzoo包中的函数来获取所需内容.

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

请查看?rollapply有关rollapply使用它的方法和使用方法的更多详细信息.

Answer 2

我整理了一个包,用于处理这些类型的'滚动'功能,提供类似于zoos的功能rollapply,但在后端使用Rcpp.查看CRAN上的RcppRoll.

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)
)

给我

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

如果考虑速度,您可能会发现它很有用.

Answer 3

如果速度是一个问题,你可以使用卷积滤波器并切断两端:

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)

两者都只使用基本功能.一些基准:

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

另外,我想所有方法都会更快,如果x所有应用的权重都是整数而不是数字.

Answer 4

只使用基数R你可以做到:

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

另一种方式,比sapply更快(与@ flodel相比rsum.cumsum),如下:

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

这是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