trjhtr

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

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"