Заполните пропущенный интервал дат по группе r

Question

У меня большой набор данных, который включает периоды дат с различными болезненными состояниями для каждого идентификатора и контрольной даты. Я хотел бы добавить «исправное» состояние для всех пропущенных периодов дат в пределах +/- 5 лет от контрольной даты для каждого идентификатора.

Я попытался изменить решение здесь: Заполнить пропущенные диапазоны дат , но не удалось. Желательно, чтобы я придерживался структуры data.table. Любые советы приветствуются!

Пример данных:

DT <- fread("
id  reference_date  period_start  period_end   Status
1   2010-01-10      2004-06-22    2005-03-15   1
1   2010-01-10      2008-10-11    2008-10-12   1
1   2010-01-10      2014-11-05    2016-01-03   2
2   2013-05-10      2012-02-01    2012-03-01   2
2   2014-06-11      2012-02-01    2012-03-01   2
3   2011-08-14      NA            NA           NA 
")

Желаемый результат:

DT <- fread("
id  reference_date  period_start  period_end   Status
1   2010-01-10      2004-06-22    2005-03-15   1
1   2010-01-10      2005-03-16    2008-10-10   0   
1   2010-01-10      2008-10-11    2008-10-12   1
1   2010-01-10      2008-10-13    2014-11-04   0
1   2010-01-10      2014-11-05    2016-01-03   2
2   2013-05-10      2008-05-10    2012-01-31   0
2   2013-05-10      2012-02-01    2012-03-01   2
2   2013-05-10      2012-03-02    2018-05-10   0
2   2014-06-11      2009-06-11    2012-01-31   0
2   2014-06-11      2012-02-01    2012-03-01   2
2   2014-06-11      2012-03-02    2019-06-11   0
3   2011-08-14      2006-08-14    2016-08-14   0 
")

Комментарий: для первой строки +/- 5 год интервал с 2005-01-10 по 2015-01-10. Однако из-за продолжающегося болезненного состояния, которое заканчивается 2005-03-15, «здоровый» период начинается в 2005-03-16. Поскольку для каждого идентификатора может быть несколько ссылочных дат, будут присутствовать повторяющиеся периоды дат (как отмечено для идентификатора 2: 2012-02-01-2012-03-01), и они в порядке. Наконец, идентификаторы без болезненных состояний представлены NA (как идентификатор 3).

РЕДАКТИРОВАТЬ: у меня были некоторые проблемы с реальными данными, поэтому я немного подправил решение; также добавлено, чтобы статус свернулся за интервал дат:

 DT2 <- DT[,{

        # +/-5 years from t0
        sdt <- seq(reference_date, by="-5 years", length.out=2L)[2L]
        edt <- seq(reference_date, by="5 years", length.out=2L)[2L]

        if(is.na(start[1L])) {
          # replace NA with full time interval for 'healthy'
          .(period_start=sdt, period_end=edt, status='notsick')
        } else{
          # Add date for -5 years if it is the minimum, otherwise use existing minimum
          if (sdt < period_start[1L]) {
            period_start <- c(sdt, period_start)
          }
          # Add date for +5 years if it is the maximum, otherwise use existing maximum
          if (edt > period_end[.N]) {
            period_end <- c(period_end,edt)
          }
          dates=unique(sort(c(period_start, period_end+1L)))
          .(start=dates[-length(dates)],end=dates[-1L]-1,status='')
        }
      },
      .(id,reference_date)]

      ## (c). Collapse status for overlapping periods
      DT <- DT[DT2, on = .(id,reference_date, period_start <= period_start, period_end >= period_end), {
        status <- paste(status, collapse = ";")
        .(status=status)},
        by = .EACHI, allow.cartesian = TRUE]

Answer 1

здесь есть опция:

interweave <- function(x, y) c(rbind(x, y)) #see ref
ans <- DT[, {
        sdt <- seq(reference_date, by="-5 years", length.out=2L)[2L]
        edt <- seq(reference_date, by="5 years", length.out=2L)[2L]

        if(is.na(period_start[1L])) {
            .(period_start=sdt, period_end=edt, Status=0L)
        } else {    
            if (sdt < period_start[1L]) {
                period_start <- c(sdt, period_start)
            } 
            ps <- as.IDate(sort(interweave(period_start, period_end+1L)))

            if (period_end[.N] > edt) {
                ps <- ps[-length(ps)]
                pe <- period_end[.N]
            } else {
                pe <- edt
            }
            .(period_start=ps, period_end=c(ps[-1L] - 1, pe), Status=0L)
        }
    },
    .(id, reference_date)]
ans[DT, on=setdiff(names(DT), "Status"), Status := i.Status]
ans

данные:

library(data.table)
DT <- fread("
id  reference_date  period_start  period_end   Status
1   2010-01-10      2004-06-22    2005-03-15   1
1   2010-01-10      2008-10-11    2008-10-12   1
1   2010-01-10      2014-11-05    2016-01-03   2
2   2013-05-10      2012-02-01    2012-03-01   2
2   2014-06-11      2012-02-01    2012-03-01   2
3   2011-08-14      NA            NA           NA 
")
cols <- c("reference_date","period_start","period_end")
DT[, (cols) := lapply(.SD, as.IDate, format="%Y-%m-%d"), .SDcols=cols]

Ссылка: Чередование, переплетение или чередование двух векторов