在R语言中为多状态数据生成状态转移列与转移时间列

我有一个包含患者ID、随访起始日期start_date，以及四种健康状态（A、B、C、D）对应日期列的数据框，需要为每个患者生成状态转移标签列，以及各状态间的转移时间间隔列。

输入数据 #

数据构造代码 #

df <- data.frame(ID = c(1,2,3,4,5,6),
                 start_date = as.Date(c("2008-02-04","2011-12-04","2002-04-08","1998-03-04","1996-02-02","2010-08-05")),
                 StateA = as.Date(c("2011-02-01","2020-09-01",NA,"2010-06-01",NA,"2015-02-02")),
                 StateB = as.Date(c("2010-02-01","2018-09-01","2012-03-01",NA,NA,NA)), 
                 StateC = as.Date(c("2010-04-01",NA,"2012-06-01","2003-05-01","2000-02-01",NA)),
                 StateD=as.Date(c("2011-05-01",NA,"2019-09-10","2014-03-05",NA,"2015-02-08"))
)

数据预览 #

ID start_date     StateA     StateB     StateC     StateD
1  1 2008-02-04 2011-02-01 2010-02-01 2010-04-01 2011-05-01
2  2 2011-12-04 2020-09-01 2018-09-01       <NA>       <NA>
3  3 2002-04-08       <NA> 2012-03-01 2012-06-01 2019-09-10
4  4 1998-03-04 2010-06-01       <NA> 2003-05-01 2014-03-05
5  5 1996-02-02       <NA>       <NA> 2000-02-01       <NA>
6  6 2010-08-05 2015-02-02       <NA>       <NA> 2015-02-08

期望输出 #

ID      State       Date Time         Transition
1   1 start_date 2008-02-04    0               <NA>
2   1     StateB 2010-02-01  728     none to StateB
3   1     StateC 2010-04-01   59   StateB to StateC
4   1     StateA 2011-02-01  306  StateBC to StateA
5   1     StateD 2011-05-01   89 StateBCA to StateD
6   2 start_date 2011-12-04    0               <NA>
7   2     StateB 2018-09-01 2463     none to StateB
8   2     StateA 2020-09-01  731   StateB to StateA
9   3 start_date 2002-04-08    0               <NA>
10  3     StateB 2012-03-01 3615     none to StateB
11  3     StateC 2012-06-01   92   StateB to StateC
12  3     StateD 2019-09-10 2657  StateBC to StateD
13  4 start_date 1998-03-04    0               <NA>
14  4     StateC 2003-05-01 1884     none to StateC
15  4     StateA 2010-06-01 2588   StateC to StateA
16  4     StateD 2014-03-05 1373  StateCA to StateD
17  5 start_date 1996-02-02    0               <NA>
18  5     StateC 2000-02-01 1460     none to StateC
19  6 start_date 2010-08-05    0               <NA>
20  6     StateA 2015-02-02 1642     none to StateA
21  6     StateD 2015-02-08    6   StateA to StateD

解决方案 #

使用dplyr、tidyr和purrr包处理数据，代码如下：

library(dplyr)
library(tidyr)
library(purrr)
library(glue)
library(stringr)

result <- df %>%
  # 宽格式转长格式，每个状态对应一行
  pivot_longer(cols = -ID, names_to = "State", values_to = "Date") %>%
  # 过滤无日期的状态
  filter(!is.na(Date)) %>%
  # 按ID和日期排序，确保状态时间顺序正确
  arrange(ID, Date) %>%
  group_by(ID) %>%
  mutate(
    # 计算与上一个状态的间隔天数，起始日期间隔为0
    Time = as.numeric(Date - lag(Date, default = first(Date))),
    # 提取状态缩写：start_date为空，StateX提取X
    state_abbr = case_when(
      State == "start_date" ~ "",
      TRUE ~ str_remove(State, "State")
    ),
    # 累积拼接状态缩写，得到到当前行的所有状态组合
    cum_abbr = accumulate(state_abbr, ~paste0(.x, .y))
  ) %>%
  mutate(
    # 获取前一行的累积状态组合
    prev_cum_abbr = lag(cum_abbr),
    # 生成转移标签
    Transition = case_when(
      row_number() == 1 ~ NA_character_,
      row_number() == 2 ~ glue("none to {State}"),
      TRUE ~ glue("{prev_cum_abbr} to {State}")
    )
  ) %>%
  # 整理输出列
  select(ID, State, Date, Time, Transition) %>%
  ungroup()

# 查看完整结果
print(result, n = Inf)

代码说明 #

1. 格式转换：pivot_longer将宽格式转为长格式，方便按时间顺序处理每个状态；
2. 过滤无效数据：移除日期为NA的行，只保留有明确时间点的状态；
3. 排序：按患者ID和日期升序排列，保证状态按时间先后顺序展示；
4. 时间间隔计算：用lag获取上一个状态的日期，计算天数差，起始日期的间隔设为0；
5. 状态缩写与累积：提取每个状态的缩写，并用accumulate累积拼接，得到到当前状态为止的所有前序状态组合；
6. 转移标签生成：根据前序状态组合生成转移描述，第一行无转移标签，第二行标记为从无状态转入，后续行标记为从之前所有状态组合转入当前状态；
7. 结果整理：选择需要的列并取消分组，得到最终输出。

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