\$\begingroup\$
\$\endgroup\$
Thanks to @josliber's help (Rolling mean lag function), I was able to speed up a rolling mean function for different groups and rollmean lengths.
Now I'd like to add to this function the ability to loop through different variables and bind everything together.
Minimum reproducible example
library(zoo)
dat <- data.frame(fips = rep(c(1001, 1003), each = 100),
x = rnorm(200),
x2 = rnorm(200),
x3 = rnorm(200))
allFipsRM3 = function(dat, varName, len){
do.call(rbind, lapply(split(dat, dat$fips), function(x) {
all.rm <- as.data.frame(sapply(len, function(l) c(rollmean(x[,varName], l), rep(NA, l-1))))
colnames(all.rm) <- paste0(varName, "_rm", len)
cbind(data.frame(fips=x$fips[1]), all.rm, data.frame(year=seq_len(nrow(x))-1))
}))
}
outdat3 <- allFipsRM3(dat, "x", c(1, 2))
fips x_rm1 x_rm2 year
1001.1 1001 1.3482892 1.3043620 0
1001.2 1001 1.2604348 0.2990267 1
1001.3 1001 -0.6623813 -0.4243813 2
1001.4 1001 -0.1863812 0.2806624 3
1001.5 1001 0.7477061 -0.5111745 4
1001.6 1001 -1.7700551 -0.8463731 5
1 Answer 1
\$\begingroup\$
\$\endgroup\$
Answering my own question here, but certainly open to suggestions.
library(RcppRoll)
# Loop through n = 10
for (i in 1:10){
# Create custom col labels
lab1 <- paste0("x_", i)
lab2 <- paste0("x2_", i)
lab3 <- paste0("x3_", i)
# Loop through each fips and calculate rollingmean
dat <- dat %>%
group_by(fips) %>%
mutate(!!lab1 := roll_mean(x, i, align = "left", fill = "NA"),
!!lab2 := roll_mean(x2, i, align = "left", fill = "NA"),
!!lab3 := roll_mean(x3, i, align = "left", fill = "NA")) %>%
ungroup()
# Progress bar for loop
print(i)
}
> names(dat)
[1] "fips" "x" "x2" "x3" "x_1" "x2_1" "x3_1" "x_2" "x2_2" "x3_2" "x_3" "x2_3"
[13] "x3_3" "x_4" "x2_4" "x3_4" "x_5" "x2_5" "x3_5" "x_6" "x2_6" "x3_6" "x_7" "x2_7"
[25] "x3_7" "x_8" "x2_8" "x3_8" "x_9" "x2_9" "x3_9" "x_10" "x2_10" "x3_10"
answered Mar 2, 2018 at 6:35
lang-r