R-滾動應用多個“ by”值

Question

我試圖找到一種有效的方法來執行以下代碼：

library(zoo)
MaPrice <- function(x,N) {
    Mavg <- rollapply(x, N, mean)
    colnames(Mavg) <- "MaPrice"
    Mavg
}

Price.MA.1Hr <- MaPrice(out, 12)
Price.MA.2Hr <- MaPrice(out, 24)
Price.MA.4Hr <- MaPrice(out, 48)
Price.MA.6Hr <- MaPrice(out, 72)

我想出的解決方案如下：

MaPrice <- function(x,N) {
    MA <- matrix( ,nrow = nrow(x), ncol = length(N))
    for (i in 1:length(N)) {
        MA[,i]<- rollapply(x, N[i], mean)
    }
    MA
}

N <- c(1,2,4,6,8,12)

Price.MA <- MaPrice(Price, N)

價格是一個向量（ncol = 1）

這仍然提供了我正在尋找的答案，但是我正在尋找是否有另一種也許有效的方法。 任何幫助是極大的贊賞。

注意：已經在SO上查看了“ 使用不同的參數多次滾動應用 ”問題。 不了解過程。

Answer 1

可復制的數據

N <- c(1,2,4,6,8,12)
set.seed(1)
Price <- data.frame(x=runif(20)*10)

#            x
# 1  2.6550866
# 2  3.7212390
# 3  5.7285336
# 4  9.0820779
# etc

注意 Price也可以是一個矢量，並且該解決方案有效

解

重寫您的函數以返回使用N值的data.frame

MaPrice <- function(x,N) {
               Mavg <- data.frame(N = N, avg = rollapply(x, N, mean))
               Mavg
            }

您可以使用purrr::map_df遍歷N

library(purrr)
Price.MA <- map_df(N, ~MaPrice(Price,.x))

輸出量

    N         x
1   1 2.6550866
2   1 3.7212390
3   1 5.7285336
4   1 9.0820779
5   1 2.0168193
# etc

比較解決方案

由於您可能會對性能感興趣

使Price成為25,000個元素的向量

N <- c(1,2,4,6,8,12)
set.seed(1)
Price <- runif(25000)*10

# parallel solution
library(parallel)
library(zoo)
PoGibas <- function(Price, N) {
               res <- mclapply(N, function(i) 
                         data.frame(i, rollapply(Price, i, mean)))
               # Final result
               do.call("rbind", res)
           }

# map_df solution
library(purrr)
MaPrice <- function(x,N) {
               Mavg <- data.frame(N = N, avg = rollapply(x, N, mean))
               Mavg
            }

CP <- function(Price, N) {
           Price.MA <- map_df(N, ~MaPrice(Price,.x))
       }

# mapply solution
out <- tbl_df(Price)
CArendt <- function() {
                mapply(function(x, n) {
                     rollapply(x, n, mean, fill = NA, align = "right")
                }, list(out), list(1, 2, 4, 6, 8, 12)) %>% tbl_df()
           }

# lapply zoo solution
library(zoo)
library(dplyr)
GG <- function(v, w) {
         z <- zoo(v)
         zz <- do.call("merge", lapply(setNames(w, w), rollmeanr, x = z))
}

使用microbechmark比較解決方案

library(microbenchmark)
microbenchmark(CP(Price,N), PoGibas(Price,N), CArendt())


              expr       min        lq      mean    median        uq       max
      CP(Price, N)  298.7038  308.9860  345.8867  334.0053  377.5278  468.1461
 PoGibas(Price, N)  306.3882  319.5721  358.8717  372.9655  388.6214  488.5565
         CArendt() 2589.2316 2647.2216 2762.0759 2682.7357 2733.5398 8746.8235
      GG(Price, N)  785.3042  853.5904  876.4554  869.0996  895.1906 1010.1746
 neval
   100
   100
   100
   100

解決方案的平均時間為353、371、876和> 2,000毫秒

Answer 2

如果您想使用其他有效的方法，這里使用parallel的解決方案。 我正在對N向量應用rollapply （沒有循環的理由），但不是並行應用，而是並行運行這些東西。

# Packages
library(parallel)
library(zoo)
# Input
N     <- 1:4
Price <- 1:10
# Main computation
res <- mclapply(N, function(i) 
                   data.frame(i, rollapply(Price, i, mean)))
# Final result
do.call("rbind", res)

Answer 3

因此，將來，提供示例數據可以使那些想提供幫助的人更輕松。 此外，它還可以加快處理速度，使其包括軟件包和library語句，從而使它們可以逐字運行您的代碼。 （請參閱reprex程序包，以獲取有用的工具，以提出一個很好的問題）。

我喜歡使用apply系列和基於列表的處理，因此我會與dplyr一起使用以下dplyr 。 適應apply家庭可以使這類任務變得簡單。 本質上， mapply遍歷列表，將第i個元素應用於函數的第i個調用（並在需要時回收）。

library(zoo)
library(dplyr)


out <- tbl_df(randu[, 1])

## example with one
out %>% mutate(test = rollapply(., 12, mean, fill = NA))
#> # A tibble: 400 x 2
#>       value      test
#>       <dbl>     <dbl>
#>  1 0.000031        NA
#>  2 0.044495        NA
#>  3 0.822440        NA
#>  4 0.322291        NA
#>  5 0.393595        NA
#>  6 0.309097 0.4633195
#>  7 0.826368 0.5074730
#>  8 0.729424 0.5794351
#>  9 0.317649 0.5804980
#> 10 0.599793 0.5593651
#> # ... with 390 more rows

## example with multiple, using mapply - basically just applying rollapply...
mapply(function(x, n) {
  rollapply(x, n, mean, fill = NA, align = "right")
}, list(out), list(1, 2, 4, 6, 8, 12)) %>% tbl_df()
#> # A tibble: 400 x 6
#>          V1        V2        V3        V4        V5    V6
#>       <dbl>     <dbl>     <dbl>     <dbl>     <dbl> <dbl>
#>  1 0.000031        NA        NA        NA        NA    NA
#>  2 0.044495 0.0222630        NA        NA        NA    NA
#>  3 0.822440 0.4334675        NA        NA        NA    NA
#>  4 0.322291 0.5723655 0.2973143        NA        NA    NA
#>  5 0.393595 0.3579430 0.3957053        NA        NA    NA
#>  6 0.309097 0.3513460 0.4618558 0.3153248        NA    NA
#>  7 0.826368 0.5677325 0.4628377 0.4530477        NA    NA
#>  8 0.729424 0.7778960 0.5646210 0.5672025 0.4309676    NA
#>  9 0.317649 0.5235365 0.5456345 0.4830707 0.4706699    NA
#> 10 0.599793 0.4587210 0.6183085 0.5293210 0.5400821    NA
#> # ... with 390 more rows

## with lapply - probably more appropriate
lapply(list(1, 2, 4, 6, 8, 12)
, FUN = function(x, n) {
  return(rollapply(x, n, mean, fill = NA, align = "right"))
}, x = out) %>% setNames(., paste0("v", 1:6)) %>% do.call(bind_cols, .)
#> # A tibble: 400 x 6
#>          v1        v2        v3        v4        v5    v6
#>       <dbl>     <dbl>     <dbl>     <dbl>     <dbl> <dbl>
#>  1 0.000031        NA        NA        NA        NA    NA
#>  2 0.044495 0.0222630        NA        NA        NA    NA
#>  3 0.822440 0.4334675        NA        NA        NA    NA
#>  4 0.322291 0.5723655 0.2973143        NA        NA    NA
#>  5 0.393595 0.3579430 0.3957053        NA        NA    NA
#>  6 0.309097 0.3513460 0.4618558 0.3153248        NA    NA
#>  7 0.826368 0.5677325 0.4628377 0.4530477        NA    NA
#>  8 0.729424 0.7778960 0.5646210 0.5672025 0.4309676    NA
#>  9 0.317649 0.5235365 0.5456345 0.4830707 0.4706699    NA
#> 10 0.599793 0.4587210 0.6183085 0.5293210 0.5400821    NA
#> # ... with 390 more rows

最后一點-我絕對建議您避免使用. 在變量名中使用句點，因為句點用於S3類分發（並且在我不知道該技巧之前，從我編寫的所有代碼中刪除句點一直很痛苦）。 有關樣式的進一步閱讀

Answer 4

假設輸入向量為v這將給出一個動物園對象zz其第i列是使用w[i]形成的。 如果需要，可以使用as.data.frame(zz)或coredata(zz)分別生成data.frame或矩陣。 如果列名不重要setNames(w, w)可以減少為w 。

# inputs
v <- 1:100  # data
w <- c(12, 24, 48, 72)

z <- zoo(v)
zz <- do.call("merge", lapply(setNames(w, w), rollmeanr, x = z))

或如果向量列表足夠，則：

lapply(setNames(w, w), rollmean, x = v)