r - R 中数据表中状态变量的跟踪时间

Question

想象一个 data.table在R给

library(data.table)
dtable = data.table(
  id = c(rep(1, 3), rep(2, 4), rep(3, 2)),
  time = c(seq(1, 3, 1), seq(1, 4, 1), seq(3, 4)),
  state_1 = c('A', 'A', 'B', 'A', 'B', 'B', 'B', 'A', 'A'),
  state_2 = c('A', 'B', 'A', NA, 'B', 'B', NA, 'A', 'A')
)

计算结果为

   id time state_1 state_2
1:  1    1       A       A
2:  1    2       A       B
3:  1    3       B       A
4:  2    1       A    <NA>
5:  2    2       B       B
6:  2    3       B       B
7:  2    4       B    <NA>
8:  3    3       A       A
9:  3    4       A       A

我想跟踪每行中的每个状态处于当前状态的时间。我希望考虑我的数据是否经过左删失。 IE。一种解决方案应始终返回 NA对于每个 id 的第一次观察直到观察到状态的变化。另一个解决方案应该将第一个观察结果视为状态刚刚更改为该状态。我的结果 data.table应该返回

   id time state_1 state_2 time_in_state_1_censored time_in_state_2_censored time_in_state_1 time_in_state_2
1:  1    1       A       A                 NA                 NA               0               0
2:  1    2       A       B                 NA                  0               1               0
3:  1    3       B       A                  0                  0               0               0
4:  2    1       A    <NA>                 NA                 NA               0               0
5:  2    2       B       B                  0                  0               0               0
6:  2    3       B       B                  1                  1               1               1
7:  2    4       B    <NA>                  2                  0               2               0
8:  3    3       A       A                 NA                 NA               0               0
9:  3    4       A       A                 NA                 NA               1               1

我已经通过使用 rle 部分解决了非审查部分(在 id < 3 上)

dtable[id < 3, 
       (paste0('time_in_', columns)) := 
         lapply(.SD, function(col) unlist(sapply(rle(col)$lengths, function(x) 1:x-1))), 
       by='id', .SDcols = columns]

但我相信它可能可以更智能、更稳健和更高效地解决。

Answer 1

未经审查的是

dtable[, v := rowid(rleid(state_1)) - 1L, by = id]

从那里，要获得经过审查的，我会......

# label spells in each state
dtable[, spell_num := rleid(state_1), by=id]

# overwrite with NA for the first spell
dtable[, vc := v][spell_num == 1L, vc := NA]

要为多个状态列执行此操作，我会使用一个循环:

for (s in sprintf("state_%s", 1:2)){
  sid = sub(".*_(.*)$", "\\1", s)
  outnm_un = sprintf("v_%s", sid)
  outnm_cs = sprintf("vc_%s", sid)

  # label spells in each state
  dtable[, spell_num := rleidv(.SD), by=id, .SDcols = s]

  # create uncensored var
  dtable[, (outnm_un) := rowid(spell_num) - 1L, by=id]

  # overwrite with NA for the first spell to get the censored var
  dtable[, (outnm_cs) := get(outnm_un)][spell_num == 1L, (outnm_cs) := NA]

}

# clean up
dtable[, spell_num := NULL]
rm(s, sid, outnm_un, outnm_cs)

给出

   id time state_1 state_2 v vc v_1 vc_1 v_2 vc_2
1:  1    1       A       A 0 NA   0   NA   0   NA
2:  1    2       A       B 1 NA   1   NA   0    0
3:  1    3       B       A 0  0   0    0   0    0
4:  2    1       A      NA 0 NA   0   NA   0   NA
5:  2    2       B       B 0  0   0    0   0    0
6:  2    3       B       B 1  1   1    1   1    1
7:  2    4       B      NA 2  2   2    2   0    0
8:  3    3       A       A 0 NA   0   NA   0   NA
9:  3    4       A       A 1 NA   1   NA   1   NA

简化编辑

按照上面的解可以压缩成

columns = c('state_1', 'state_2')
censor = TRUE

dtable[, (paste0('time_in_', columns)) := lapply(.SD, function(sd_col){
  spell_num = rleid(sd_col)
  v = rowid(spell_num) - 1
  if (isTRUE(censor)) v[spell_num == 1] <- NA
  v
}), by=id, .SDcols = columns]