CODEWITHSUNDEEP
rdatetime-seriesrolling-computation
arg0naut91
arg0naut91

Reputation: 14774

Rolling window function for irregular time series that can handle duplicates

I have the following data.frame: 

    grp  nr   yr
 1:   A 1.0 2009
 2:   A 2.0 2009
 3:   A 1.5 2009
 4:   A 1.0 2010
 5:   B 3.0 2009
 6:   B 2.0 2010
 7:   B  NA 2011
 8:   C 3.0 2014
 9:   C 3.0 2019
10:   C 3.0 2020
11:   C 4.0 2021

Desired output:

   grp  nr   yr nr_roll_period_3
1    A 1.0 2009               NA
2    A 2.0 2009               NA
3    A 1.5 2009               NA
4    A 1.0 2010               NA
5    B 3.0 2009               NA
6    B 2.0 2010               NA
7    B  NA 2011               NA
8    C 3.0 2014               NA
9    C 3.0 2019               NA
10   C 3.0 2020               NA
11   C 4.0 2021         3.333333

The logic:

Currently I have this function:

calculate_rolling_window <-

  function(dt, date_col, calc_col, id, k) {

    require(data.table)

    return(setDT(dt)[
      , paste(calc_col, "roll_period", k, sep = "_") := 
        sapply(get(date_col), function(x) mean(get(calc_col)[between(get(date_col), x - k + 1, x)])),
      by = mget(id)])

  }

It works fine for the regular cases, where there is no duplicates in the date column. However, with duplicates it fails: 

    grp  nr   yr nr_roll_period_3
 1:   A 1.0 2009         1.500000
 2:   A 2.0 2009         1.500000
 3:   A 1.5 2009         1.500000
 4:   A 1.0 2010         1.375000
 5:   B 3.0 2009               NA
 6:   B 2.0 2010               NA
 7:   B  NA 2011               NA
 8:   C 3.0 2014               NA
 9:   C 3.0 2019               NA
10:   C 3.0 2020               NA
11:   C 4.0 2021         3.333333

Any ideas on how to handle this? No need for exclusively data.table approach.

Upvotes: 3

Views: 401

Answers (1)

Uwe
Uwe

Reputation: 42592

This can be solved by grouping in a non-equi join to aggregate over a rolling window of length k, filtering for k consecutive years, and an update join:

library(data.table)
k <- 3L
# group by join parameters of a non-equi join
mDT <- setDT(DT)[.(grp = grp, upper = yr, lower = yr - k), 
                 on = .(grp, yr <= upper, yr > lower), 
                 .(uniqueN(x.yr), mean(nr)), by = .EACHI]
# update join with filtered intermediate result
DT[mDT[V1 == k], on = .(grp, yr), paste0("nr_roll_period_", k) := V2]
DT

which returns OP's expected result:

    grp  nr   yr nr_roll_period
 1:   A 1.0 2009             NA
 2:   A 2.0 2009             NA
 3:   A 1.5 2009             NA
 4:   A 1.0 2010             NA
 5:   B 3.0 2009             NA
 6:   B 2.0 2010             NA
 7:   B  NA 2011             NA
 8:   C 3.0 2014             NA
 9:   C 3.0 2019             NA
10:   C 3.0 2020             NA
11:   C 4.0 2021       3.333333

The intermediate result mDT contains the rolling mean V2 over k periods and the count of unique/distinct years V1 within each period. It is created by a non-equi join of DT with a data.table containing the upper and lower bounds which is created on-the-fly by .(grp = grp, upper = yr, lower = yr - k).

mDT

    grp   yr   yr V1       V2
 1:   A 2009 2006  1 1.500000
 2:   A 2009 2006  1 1.500000
 3:   A 2009 2006  1 1.500000
 4:   A 2010 2007  2 1.375000
 5:   B 2009 2006  1 3.000000
 6:   B 2010 2007  2 2.500000
 7:   B 2011 2008  3       NA
 8:   C 2014 2011  1 3.000000
 9:   C 2019 2016  1 3.000000
10:   C 2020 2017  2 3.000000
11:   C 2021 2018  3 3.333333

This is filtered for rows which contain exactly k distinct years:

mDT[V1 == k]

   grp   yr   yr V1       V2
1:   B 2011 2008  3       NA
2:   C 2021 2018  3 3.333333

Finally, this is joined with DT to append the new column to DT.

Note, that mean() returns NA by default if there is an NA in the input data.

Data

library(data.table)
DT <- fread(text = "rn    grp  nr   yr
 1:   A 1.0 2009
 2:   A 2.0 2009
 3:   A 1.5 2009
 4:   A 1.0 2010
 5:   B 3.0 2009
 6:   B 2.0 2010
 7:   B  NA 2011
 8:   C 3.0 2014
 9:   C 3.0 2019
10:   C 3.0 2020
11:   C 4.0 2021", drop = 1L)

Upvotes: 6

Related Questions