[英]Replicating nested loop with sapply
我想用 sapply 或其他應用函數復制一個嵌套循環。 我有一個包含 100 只股票的月收益的數據集。 我想計算每只股票的 t-6 到 t-2 月收益之和。這里 t 代表每個觀察值。 為此,我創建了以下嵌套循環。 現在我想對應用家庭做同樣的事情。 我已經嘗試過,但它不起作用。 我想我做錯了。 請檢查我的代碼。
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
})
})
為了提高速度,您可以查看rcpproll或data.table
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))
}
)
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.