gpt4 book ai didi

使用 sapply 复制嵌套循环

转载 作者:行者123 更新时间:2023-12-04 15:39:12 28 4
gpt4 key购买 nike

我想用 sapply 或其他应用函数复制一个嵌套循环。我有一个包含 100 只股票的月 yield 的数据集。我想计算每只股票的 t-6 到 t-2 月返回之和。这里 t 代表每个观察值。为此,我创建了以下嵌套循环。现在我想对 apply family 做同样的事情。我试过了,但没有用。我想我做错了。请检查我的代码。

x <- matrix(rnorm(1e4), nrow=100, ncol=100)
s=6
k=1
XSMOM = x
XSMOM[1:nrow(XSMOM),1:ncol(XSMOM)] <- NA
# Using nested loops
for (i in 1:ncol(x)){

for (t in (s + 1):nrow(x)){
XSMOM[t,i] = sum(x[(t-s):(t-1-k),i])

}
}
## using sapply
sapply(1:ncol(x),function(m)
sapply(s+1:nrow(x),function(n)
sum(x[(n-s):(n-s-k),m])

最佳答案

代码中有一些错误。请注意,您应该提供一个最小 示例。

x <- matrix(rnorm(50), nrow=10, ncol=5)
XSMOM <- matrix(NA_real_, ncol = ncol(x), nrow = nrow(x))

s=6; k=1

sapply(1:ncol(x),
function(i) { # need curly bracket; changed var from m to i to match loop
sapply((s+1):nrow(x),function(t) { # need curly bracket; changed from n to t
sum(x[(t-s):(t-1-k),i]) # copied original loop function; you had n-s-k
})
})

要获得更快的速度,您可以查看

library(data.table)
simplify2array(shift(frollsum(as.data.frame(x), n = s-1), 2))

library(RcppRoll)
XSMOM <- matrix(NA_real_, ncol = ncol(x), nrow = nrow(x))

XSMOM[-(1:s), ] <- roll_sumr(x, n = s-1)[(s-1):(nrow(x) - k - 1), ]
XSMOM

一切的表现:

# for x <- matrix(rnorm(1E4), nrow=100, ncol=100)
# A tibble: 6 x 13
expression min median `itr/sec` mem_alloc
<bch:expr> <bch:t> <bch:t> <dbl> <bch:byt>
1 original_loop 19.8ms 20.5ms 48.2 140.71KB
2 double_sapply 27.2ms 27.7ms 35.1 624.49KB
3 apply_sapply 20.5ms 21.1ms 46.5 827.84KB
4 zoo_rollapply 120.6ms 122.1ms 8.19 11.04MB
5 rcpp_roll 243.6us 250.8us 3771. 400.53KB
6 dt_froll_shift 720.3us 806.9us 1186. 2.01MB

# code for reference
library(data.table)
library(zoo)
library(RcppRoll)
library(bench)

x <- matrix(rnorm(1E4), nrow=100, ncol=100)
# x <- matrix(rnorm(50), nrow=10, ncol=5)
s=6
k=1
XSMOM <- matrix(NA_real_, ncol = ncol(x), nrow = nrow(x))

bench::mark(
original_loop = {
XSMOM <- matrix(NA_real_, ncol = ncol(x), nrow = nrow(x))

for (i in 1:ncol(x)){
for (t in (s + 1):nrow(x)){
XSMOM[t,i] = sum(x[(t-s):(t-1-k),i])
}
}
XSMOM
}
,
double_sapply = {
XSMOM <- matrix(NA_real_, ncol = ncol(x), nrow = nrow(x))
XSMOM[-(1:s), ] <- sapply(1:ncol(x),
function(i) {
sapply((s+1):nrow(x),function(t) {
sum(x[(t-s):(t-1-k),i])
}
)
}
)
XSMOM
}
,
apply_sapply = {
XSMOM <- matrix(NA_real_, ncol = ncol(x), nrow = nrow(x))
XSMOM[-(1:s), ] <- apply(x, 2,
function(col) {
sapply((s+1):nrow(x), function(t) {
sum(col[(t-s):(t-1-k)])
})
})
XSMOM
}
,
zoo_rollapply = {
# XSMOM <- rollapplyr(x,
# by.column = T,
# width = list(-s:-(k + 1)),
# sum,
# fill = NA)
XSMOM <- matrix(NA_real_, ncol = ncol(x), nrow = nrow(x))
XSMOM[-(1:s), ] <-head(rollsumr(x, by.column = T, k = s-1), -(k+1))
XSMOM
}
,
rcpp_roll = {
XSMOM <- matrix(NA_real_, ncol = ncol(x), nrow = nrow(x))
XSMOM[-(1:s), ] <- roll_sumr(x, n = s-1)[(s-1):(nrow(x) - k - 1), ]
XSMOM
}
,
dt_froll_shift = {
simplify2array(shift(frollsum(as.data.frame(x), n = s-1), 2))
}
)

关于使用 sapply 复制嵌套循环,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/58578466/

28 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com