R - rollapply 多个 "by" 值
R - rollapply with multiple "by" values
我正在努力寻找一种有效的方法来执行以下代码：
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)
Price is a vector (ncol = 1)
这仍然提供了我正在寻找的答案，但我正在寻找是否有替代方法可能是一种有效的方法。非常感谢任何帮助。
注意：已经在 SO 上查看了问题“”。没看懂流程。
可重现的数据
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 也可以是向量，解决方案有效
解决方案
将您的函数重写为 return 一个 data.frame 并使用 N 值
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 毫秒
正如您想要的替代高效方式，这里是使用 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)
所以在未来，提供示例数据可以让那些试图提供帮助的人更容易。此外，它可以加快包含包和 library 语句等的速度，以便它们可以 运行 您的代码逐字记录。 （请参阅 reprex 包以获取有用的工具来提出一个好问题）。
我喜欢使用 apply 系列和基于列表的处理，所以我倾向于以下以及 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 class 调度（并且从所有的句点中删除句点很痛苦我的代码是在我知道那个方便的花絮之前写的）。 Further reading on style
假设输入向量是 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)
我正在努力寻找一种有效的方法来执行以下代码：
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)
Price is a vector (ncol = 1)
这仍然提供了我正在寻找的答案，但我正在寻找是否有替代方法可能是一种有效的方法。非常感谢任何帮助。
注意：已经在 SO 上查看了问题“
可重现的数据
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 也可以是向量，解决方案有效
解决方案
将您的函数重写为 return 一个 data.frame 并使用 N 值
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 毫秒
正如您想要的替代高效方式，这里是使用 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)
所以在未来，提供示例数据可以让那些试图提供帮助的人更容易。此外，它可以加快包含包和 library 语句等的速度，以便它们可以 运行 您的代码逐字记录。 （请参阅 reprex 包以获取有用的工具来提出一个好问题）。
我喜欢使用 apply 系列和基于列表的处理，所以我倾向于以下以及 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 class 调度（并且从所有的句点中删除句点很痛苦我的代码是在我知道那个方便的花絮之前写的）。 Further reading on style
假设输入向量是 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)