rollapplyr on missing records related by date

Question

How do I apply rollapplyr on the following data to allow it be sensitive to the date field? Because currently I am able to apply the rolling (blind to the date) over the dataset with eg. 4-quarters period and minimum of 2 observations in the 4 quarters.

#creating the data
   set.seed(123)
    data.frame(id=c(1,1,1,1,1,2,2,2,2,2), 
               date=as.Date(as.character(c(20040930, 20041231, 20050331, 20050630, 20050930, 20040930, 20050331, 20050630, 20051231, 20060331)), format = "%Y%m%d"),
               col_a=round(runif(10, 0, 100),0),
               col_b=round(runif(10, 0, 100),0))

   id       date col_a col_b
1   1 2004-09-30     3    10
2   1 2004-12-31     8     5
3   1 2005-03-31     4     7
4   1 2005-06-30     9     6
5   1 2005-09-30     9     1
6   2 2004-09-30     0     9
      <missing>
7   2 2005-03-31     5     2
8   2 2005-06-30     9     0
      <missing>
9   2 2005-12-31     6     3
10  2 2006-03-31     5    10

This is what I have attempted so far, but this will not take into consideration of the missing records, eg. id=2's 2005-09-30 record.

library(zoo)
data %>%
  group_by(id) %>% 
  mutate(score = (col_a + col_b) / rollapplyr(col_b, 4, mean, fill=NA, by.column=TRUE, partial=2)) %>% 
  ungroup %>% select(id, date, col_a, col_b, score)

And this is what I got after applying the above function

      id date       col_a col_b score
   <dbl> <date>     <dbl> <dbl> <dbl>
 1     1 2004-09-30     3    10 NA   
 2     1 2004-12-31     8     5  1.73
 3     1 2005-03-31     4     7  1.5 
 4     1 2005-06-30     9     6  2.14
 5     1 2005-09-30     9     1  2.11
 6     2 2004-09-30     0     9 NA   
 7     2 2005-03-31     5     2  1.27
 8     2 2005-06-30     9     0  2.45
 9     2 2005-12-31     6     3  2.57
10     2 2006-03-31     5    10  4   

However what I am expecting is it will take into consideration the missing quarters itself automatically. This is my expected output

       id date       col_a col_b score
   <dbl> <date>     <dbl> <dbl> <dbl>
 1     1 2004-09-30     3    10 NA   
 2     1 2004-12-31     8     5  1.73
 3     1 2005-03-31     4     7  1.5 
 4     1 2005-06-30     9     6  2.14
 5     1 2005-09-30     9     1  2.11
 6     2 2004-09-30     0     9 NA   
                <missing>
 7     2 2005-03-31     5     2  1.27
 8     2 2005-06-30     9     0  2.45
                <missing>
 9     2 2005-12-31     6     3  **5.4**
10     2 2006-03-31     5    10  **3.46**  

Note that the "<missing>" will not be shown in the output, I just put for visual purpose. So eg. row 10 will only use row 8,9 and 10's records because the missing row is counted as a row too. How do I achieve that?

Note that eg. for row 10, n=3 should be used for the averaging not n=4 as it shouldn't include the missing rows.

Answer 1

One option would be to create the complete rows of 'date' for all 'id's before the group_by

library(tidyverse)
library(zoo)
complete(data, id, date, fill = list(col_a = 0, col_b = 0)) %>% 
      group_by(id) %>% 
      mutate(score = (col_a + col_b) / 
         rollapplyr(col_b, 4, sum, fill=NA, by.column=TRUE, partial=2)) %>% 
      ungroup %>% 
      select(id, date, col_a, col_b, score) %>%
      right_join(data)
# A tibble: 10 x 5
#      id date       col_a col_b  score
#   <dbl> <date>     <dbl> <dbl>  <dbl>
# 1     1 2004-09-30     3    10 NA    
# 2     1 2004-12-31     8     5  0.867
# 3     1 2005-03-31     4     7  0.5  
# 4     1 2005-06-30     9     6  0.536
# 5     1 2005-09-30     9     1  0.526
# 6     2 2004-09-30     0     9 NA    
# 7     2 2005-03-31     5     2  0.636
# 8     2 2005-06-30     9     0  0.818
# 9     2 2005-12-31     6     3  1.8  
#10     2 2006-03-31     5    10  1.15 

data

data <- structure(list(id = c(1, 1, 1, 1, 1, 2, 2, 2, 2, 2),
  date = structure(c(12691, 
 12783, 12873, 12964, 13056, 12691, 12873, 12964, 13148, 13238
 ), class = "Date"), col_a = c(3, 8, 4, 9, 9, 0, 5, 9, 6, 5), 
col_b = c(10, 5, 7, 6, 1, 9, 2, 0, 3, 10)), row.names = c(NA, 
 -10L), class = "data.frame")