代码之家 › 专栏 › 技术社区 › mr.bjerre

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

data-manipulation time-series data.table r

mr.bjerre · 技术社区 · 6 年前

想象一下 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

我希望跟踪每行中每个状态处于当前状态的时间。我想考虑我的资料是否被审查过。也就是说,一个解决方案应该总是返回 NA 对于每一个 id 直到观察到状态的变化。另一种解决方案应该把第一次观察当作状态刚刚改变到那个状态。我的结果 小精灵 应该回来

   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]

但我相信它可能会被解决得更聪明,更健壮,更有效率。

2 回复 | 直到 6 年前

mr.bjerre 6 年前

未经审查的是

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]

mr.bjerre 6 年前

我已经解决了这个问题

dtable[, 
       (paste0('time_in_', columns, '_censored')) := 
         lapply(.SD, function(col) {
           rles = rle(col)
           res = rep(NA, rles$lengths[1])
           if (length(rles$lengths) > 1){
             res = c(res, unlist(sapply(rle(col)$lengths[-1], function(x) 1:x-1)))
           }
           return(as.integer(res))
         }), 
       by='id', .SDcols = columns]
dtable[, 
       (paste0('time_in_', columns)) := 
         lapply(.SD, function(col) {
           rles = rle(col)
           if (length(rles$lengths) > 1){
             res = unlist(sapply(rle(col)$lengths, function(x) 1:x-1))
           } else {
             res = 0:(rles$lengths[1]-1)
           }
           return(as.integer(res))
         }), 
       by='id', .SDcols = columns]

评估结果为

   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