R中向量中的連續/滾動總和

Question

假設在 RI 中有以下向量：

[1 2 3 10 20 30]

我如何執行一個操作，從而在每個索引處對 3 個連續元素求和，從而得到以下向量：

[6 15 33 60]

其中第一個元素 = 1+2+3，第二個元素 = 2+3+10 等等......？ 謝謝

Answer 1

你擁有的是一個向量，而不是一個數組。 您可以使用 zoo 包中的rollapply功能來獲取所需的內容。

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

查看?rollapply以了解有關rollapply作用以及如何使用它的更多詳細信息。

Answer 2

我整理了一個包來處理這些類型的“滾動”功能，它提供類似於zoo的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

Answer 5

如果您需要真正的速度，請嘗試

rsum.cumdiff <- function(x, n = 3L) (cs <- cumsum(x))[-(1:(n-1))] - c(0,cs[1:(length(x)-n)])

這一切都在基礎 R 中，更新 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]}))
rsum.cumdiff <- function(x, n = 3L) (cs <- cumsum(x))[-(1:(n-1))] - c(0, cs[1:(length(x)-n)])

all.equal(rsum.rollapply(x), rsum.sapply(x))
# [1] TRUE
all.equal(rsum.sapply(x), rsum.filter(x))
# [1] TRUE
all.equal(rsum.filter(x), rsum.outer(x))
# [1] TRUE
all.equal(rsum.outer(x), rsum.cumsum(x))
# [1] TRUE
all.equal(rsum.cumsum(x), rsum.cumdiff(x))
# [1] TRUE

library(microbenchmark)
microbenchmark(
  rsum.rollapply(x),
  rsum.sapply(x),
  rsum.filter(x),
  rsum.cumsum(x),
  rsum.outer(x),
  rsum.cumdiff(x)
)

# Unit: microseconds
#               expr      min        lq       mean    median        uq       max neval
#  rsum.rollapply(x) 3369.211 4104.2415 4630.89799 4391.7560 4767.2710 12002.904   100
#     rsum.sapply(x)  850.425  999.2730 1355.56383 1086.0610 1246.5450  6915.877   100
#     rsum.filter(x)   48.970   67.1525   97.28568   96.2430  113.6975   248.728   100
#     rsum.cumsum(x)   47.515   62.7885   89.12085   82.1825  106.6675   230.303   100
#      rsum.outer(x)   69.819   85.3340  160.30133   92.6070  109.0920  5740.119   100
#    rsum.cumdiff(x)    9.698   12.6070   70.01785   14.3040   17.4555  5346.423   100

## R version 3.5.1 "Feather Spray"
## zoo and microbenchmark compiled under R 3.5.3

奇怪的是，通過微基准測試，一切都變得更快了：

microbenchmark(
       rsum.rollapply(x),
       rsum.sapply(x),
       rsum.filter(x),
       rsum.cumsum(x),
       rsum.outer(x),
       rsum.cumdiff(x)
   )

# Unit: microseconds
#               expr      min        lq       mean    median        uq      max neval
#  rsum.rollapply(x) 3127.272 3477.5750 3869.38566 3593.4540 3858.9080 7836.603   100
#     rsum.sapply(x)  844.122  914.4245 1059.89841  965.3335 1032.2425 5184.968   100
#     rsum.filter(x)   47.031   60.8490   80.53420   74.1830   90.9100  260.365   100
#     rsum.cumsum(x)   45.092   55.2740   69.90630   64.4855   81.4555  122.668   100
#      rsum.outer(x)   68.850   76.6070   88.49533   82.1825   91.8800  166.304   100
#    rsum.cumdiff(x)    9.213   11.1520   13.18387   12.1225   13.5770   49.456   100

Answer 6

庫runner ，也可以使用

x <- c(1, 2, 3, 10, 20, 30)

runner::sum_run(x, k=3, na_pad = T)
#> [1] NA NA  6 15 33 60

---

或slider也很有用

x <- c(1, 2, 3, 10, 20, 30)

slider::slide_sum(x, before = 2, complete = T)
#> [1] NA NA  6 15 33 60

^{由reprex 包( v2.0.0 ) 於 2021 年 6 月 14 日創建}