如何按ID分组为半规则日期序列的NA依次递加/减12个月补全？

需求说明 #

需对按id分组的半规则日期序列（观测间隔约12个月）进行缺失值插补，规则如下：

• 连续NA值：在前一个有效日期基础上增加12个月
• 反向补全：在后一个有效日期基础上减少12个月（类似nocb逻辑但反向推算）

数据示例 #

数据生成代码 #

library(data.table)
library(lubridate)

dt <- data.table(id=sort(rep(1:3, 11)),
           wave=rep(1:11,3),
           date=seq.Date(as.Date("2009-05-01"), as.Date("2019-05-01"), by="year") %m+% days(sample(-31:31, 33, replace = T)),
           random_na=sample(0:1, 33, replace=T))
 
dt[, date:=fifelse(random_na==1, NA_Date_, date)]
dt[, random_na:=NULL]

原始缺失数据 #

生成的原始数据示例：

id wave       date
 1:  1    1 2009-04-03
 2:  1    2 2010-04-25
 3:  1    3       <NA>
 4:  1    4       <NA>
 5:  1    5       <NA>
 6:  1    6 2014-04-10
 7:  1    7 2015-05-14
 8:  1    8 2016-05-10
 9:  1    9       <NA>
10:  1   10 2018-04-08
11:  1   11 2019-05-29
12:  2    1 2009-04-29
13:  2    2       <NA>
14:  2    3 2011-04-26
15:  2    4 2012-03-31
16:  2    5 2013-05-30
17:  2    6 2014-03-31
18:  2    7 2015-05-06
19:  2    8 2016-04-13
20:  2    9       <NA>
21:  2   10 2018-05-05
22:  2   11 2019-05-28
23:  3    1       <NA>
24:  3    2 2010-04-27
25:  3    3       <NA>
26:  3    4       <NA>
27:  3    5 2013-05-15
28:  3    6 2014-05-15
29:  3    7       <NA>
30:  3    8       <NA>
31:  3    9 2017-05-24
32:  3   10       <NA>
33:  3   11 2019-05-06

期望插补结果 #

插补后的目标数据示例：

id wave       date
 1:  1    1 2009-04-03
 2:  1    2 2010-04-25
 3:  1    3 2011-04-25
 4:  1    4 2012-04-25
 5:  1    5 2013-04-25
 6:  1    6 2014-04-10
 7:  1    7 2015-05-14
 8:  1    8 2016-05-10
 9:  1    9 2017-05-10
10:  1   10 2018-04-08
11:  1   11 2019-05-29
12:  2    1 2009-04-29
13:  2    2 2010-04-29
14:  2    3 2011-04-26
15:  2    4 2012-03-31
16:  2    5 2013-05-30
17:  2    6 2014-03-31
18:  2    7 2015-05-06
19:  2    8 2016-04-13
20:  2    9 2017-04-13
21:  2   10 2018-05-05
22:  2   11 2019-05-28
23:  3    1 2009-04-27
24:  3    2 2010-04-27
25:  3    3 2011-04-27
26:  3    4 2012-04-27
27:  3    5 2013-05-15
28:  3    6 2014-05-15
29:  3    7 2015-05-15
30:  3    8 2016-05-15
31:  3    9 2017-05-24
32:  3   10 2018-05-24
33:  3   11 2019-05-06

解决方案 #

利用data.table的分组递推功能，结合lubridate的日期运算实现需求：

# 加载所需包
library(data.table)
library(lubridate)

# 正向填充：前向递推，NA值基于前一个有效日期加12个月
dt[, date_forward := date, by = id]
dt[, date_forward := Reduce(function(x, y) if(is.na(y)) x %m+% months(12) else y, 
                           date_forward, accumulate = TRUE), 
   by = id]

# 反向填充：后向递推，NA值基于后一个有效日期减12个月
dt[, date_backward := date, by = id]
dt[, date_backward := Reduce(function(x, y) if(is.na(x)) y %m-% months(12) else x, 
                             rev(date_backward), accumulate = TRUE) %>% rev(), 
   by = id]

# 合并填充结果：优先用正向填充，剩余NA用反向填充覆盖
dt[, date := fifelse(is.na(date_forward), date_backward, date_forward)]

# 清理临时列
dt[, c("date_forward", "date_backward") := NULL]

代码说明 #

• Reduce(..., accumulate = TRUE)实现逐行递推计算：正向填充时，每遇到NA就基于前一个结果加12个月；
• 反向填充时先反转序列，用同样逻辑处理后再反转回来，覆盖开头的NA；
• fifelse合并两种填充结果，确保所有缺失值都被正确插补。

内容的提问来源于stack exchange，提问作者eobrien