I have come up with some code to calculate a rolling mean for panel data (a row in the data contains values of one subject from one day). Since I had a few more specific requirements the code became quite complicated. Too complicated for an application not too rare, in my eyes.
Here's what I needed:
rolling mean (mean of the values of (a) the previous 3 days excluding the "current" day, (b) calculated only if there is a minimum of 2 non-missing values in this window)
respecting the panel structure
Not too complicated, right?
For 1. I decided to use rollapplyr() and mean( , na.rm = T), to exclude the current day (a) I decided to use a self made lag function and for (b) a if-statement. And for 2. I wrapped everything in a tapply() (with unlist()) in order to respect the panel structure.
Here's the code example:
library(zoo)
# example data (with missings)
set.seed(1)
df = data.frame(subject = rep(c("a", "b"), each = 10), day = rep(1:10, 2), value = rnorm(20))
df$value[15:17] = NA
# lag function (sensitive to "single day" subjects)
lag <- function(x, l = 1) {
if (length(x) > 1) (c(rep(NA, l), x[1:(length(x)-l)])) else (NA)
}
# calculate rolling mean
df$roll_mean3 = unlist(tapply(df$value, df$subject,
FUN = function(x) lag(rollapplyr(x, width = 3, fill = NA, partial = T,
FUN = function(x) ifelse(sum(!is.na(x)) > 1, mean(x, na.rm = T), NA)))))
df
As I said this solution seems overly complicated for a situation that I think is not that far out there.
Do you have suggestions on how to do this in a simpler (less error prone) way? Have I missed some basic functionalities that allow to handle panel data more easily?
For illustration, the output of my code is:
subject day value roll_mean3
1 a 1 -0.6264538 NA
2 a 2 0.1836433 NA
3 a 3 -0.8356286 -0.221405243
4 a 4 1.5952808 -0.426146366
5 a 5 0.3295078 0.314431838
6 a 6 -0.8204684 0.363053321
7 a 7 0.4874291 0.368106730
8 a 8 0.7383247 -0.001177187
9 a 9 0.5757814 0.135095124
10 a 10 -0.3053884 0.600511703
11 b 1 1.5117812 NA
12 b 2 0.3898432 NA
13 b 3 -0.6212406 0.950812202
14 b 4 -2.2146999 0.426794608
15 b 5 NA -0.815365744
16 b 6 NA -1.417970234
17 b 7 NA NA
18 b 8 0.9438362 NA
19 b 9 0.8212212 NA
20 b 10 0.5939013 0.882528703
Use ave to run rollapply separately on each subject. Then when using rollapply note that the width can be a list containing a vector (or vectors) of offsets so list(-seq(3)) means prior 3 elements. See ?rollapply for more info on the arguments.
Mean <- function(x) if (sum(!is.na(x)) >= 2) mean(x, na.rm = TRUE) else NA
roll <- function(x) rollapply(x, list(-seq(3)), Mean, fill = NA, partial = TRUE)
transform(df, roll = ave(value, subject, FUN = roll))