如何使用 lag/lead 和 ifelse/case_when （或其他解决方案）处理 R 中的纵向症状数据？答案

【问题标题】：How to deal with longitudinal symptom data in R using lag/lead and ifelse/case_when (or other solution)?如何使用 lag/lead 和 ifelse/case_when （或其他解决方案）处理 R 中的纵向症状数据？
【发布时间】：2020-02-11 12:02:56
【问题描述】：

你好堆栈溢出社区，

我对 R 比较陌生（9 个月），这是我第一个使用 reprex 的堆栈溢出问题，非常感谢任何帮助。尽管我对基本 R 解决方案持开放态度，但我主要使用 tidyverse。

问题：

我每天有大约 21,000 行症状数据，其中变量超过 10 个。我希望能够通过使用规则来定义发作的开始和结束来对疾病的“恶化”（在这种情况下是肺部疾病的胸部感染）进行分类，以便我以后可以计算发作的持续时间、发作的类型（这取决于症状的组合）和接受的治疗。与涉及患者的任何数据集一样，存在缺失值。如果缺少少于 2 天的数据，我会从最近一天开始估算。

以下代码是一个简化的组成示例，仅涉及 1 个症状。

加重规则：恶化开始 = 症状恶化 2 天 (>= 3) 恶化消退 = 正常呼吸 5 天 (

理想情况下，我希望能够识别所有发生恶化的日子。

这是数据：

#load packages
library(tidyverse)

#load data

id <- "A"

day <- c(1:50)

symptom <- c(2,2,2,2,2,2,2,2,2,2,2,3,2,2,2,2,NA,NA,NA,2,2,2,3,3,3,4,4,3,3,2,3,2,2,3,3,2,2,2,2,2,2,3,2,2,2,2,2,3,2,2)


df <- data.frame(id,day,symptom)

#Data Dictionary
#Symptom: 1 = Better than usual, 2 = Normal/usual, 3 = Worse than usual, 4 = Much worse than usual

我尝试过的：

我尝试通过结合使用 lag() 和 lead() 以及条件语句 case_when() 和 ifelse() 来解决这个问题。


df %>% 
  mutate_at(vars("symptom"), #used for more variables within vars() argument
            .funs = list(lead1 = ~ lead(., n = 1),
                         lead2 = ~ lead(., n = 2),
                         lead3 = ~ lead(., n = 3),
                         lead4 = ~ lead(., n = 4),
                         lead5 = ~ lead(., n = 5),
                         lag1 = ~ lag(., n = 1),
                         lag2 = ~ lag(., n = 2),
                         lag3 = ~ lag(., n = 3))) %>%

  mutate(start = case_when(symptom <= 2 ~ 0,
                                        symptom >= 3 ~
                                        ifelse(symptom >= lag2 & symptom <= lag1,1,0)),

         end = case_when(symptom >=3 ~ 
                                      ifelse(lead1 <=2 &
                                             lead2 <=2 &
                                             lead3 <=2 &
                                             lead4 <=2 &
                                             lead5 <=2,1,0)))

我的主要问题是复杂性。随着我构建更多症状和规则，我必须引用其中包含 ifelse()/case_when() 语句的不同变量。我确信有一个更优雅的解决方案可以解决我的问题。

另一个问题是，在“恶化”期间，exacerbation_start 变量只能在开始时使用，而不能在剧集中使用。同样，对于 exacerbation_end，它仅适用于已经发生恶化的情况。我尝试使用 ifelse() 语句来指代何时发生恶化，但无法使其发挥作用并遵守我想要的规则。

我想要的输出是：

   id  day   symptom  start   end   exacerbation
1   A   1       2        0     0        0
2   A   2       2        0     0        0
3   A   3       2        0     0        0
4   A   4       2        0     0        0       
5   A   5       2        0     0        0        
6   A   6       2        0     0        0           
7   A   7       2        0     0        0          
8   A   8       2        0     0        0          
9   A   9       2        0     0        0           
10  A  10       2        0     0        0      
11  A  11       2        0     0        0          
12  A  12       3        0     0        0           
13  A  13       2        0     0        0    
14  A  14       2        0     0        0      
15  A  15       2        0     0        0          
16  A  16       2        0     0        0     
17  A  17      NA        0     0        0        
18  A  18      NA        0     0        0          
19  A  19      NA        0     0        0          
20  A  20       2        0     0        0       
21  A  21       2        0     0        0            
22  A  22       2        0     0        0       
23  A  23       3        0     0        0           
24  A  24       3        1     0        1                    
25  A  25       3        0     0        1              
26  A  26       4        0     0        1                  
27  A  27       4        0     0        1     
28  A  28       3        0     0        1          
29  A  29       3        0     0        1   
30  A  30       2        0     0        1 
31  A  31       3        0     0        1
32  A  32       2        0     0        1    
33  A  33       2        0     0        1   
34  A  34       3        0     0        1  
35  A  35       3        0     1        1  
36  A  36       2        0     0        0     
37  A  37       2        0     0        0 
38  A  38       2        0     0        0     
39  A  39       2        0     0        0  
40  A  40       2        0     0        0   
41  A  41       2        0     0        0 
42  A  42       3        0     0        0 
43  A  43       2        0     0        0
44  A  44       2        0     0        0 
45  A  45       2        0     0        0      
46  A  46       2        0     0        0   
47  A  47       2        0     0        0      
48  A  48       3        0     0        0   
49  A  49       2        0     0        0  
50  A  50       2        0     0        0

期待您的回复！

编辑

我已经添加了 50 多行数据来模拟多次恶化以及右删失和 NA 的问题。我还包括了第二个参与者“B”，看看这是否是问题的原因。

id <- c("A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A",
        "A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A",
        "A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A",
        "B","B","B","B","B","B","B","B","B","B","B","B","B","B","B","B",
        "B","B","B","B","B","B","B","B","B","B","B","B","B","B","B","B",
        "B","B","B","B","B","B","B","B","B","B","B","B","B","B","B","B","B","B")

day <- c(1:50,1:50)

symptom <- c(2,3,3,3,3,2,2,2,2,2,2,3,2,2,2,2,NA,NA,NA,2,2,2,3,3,3,4,4,3,3,2,3,2,2,3,3,2,2,2,2,2,2,3,2,2,2,2,2,3,2,2,           2,2,2,2,2,2,3,2,3,3,2,3,2,3,2,2,2,2,2,2,3,3,3,3,NA,NA,NA,2,2,2,3,2,2,2,2,2,3,2,2,3,NA,NA,NA,3,3,3,3,3,3,2)

df <- data.frame(id,day,symptom)

     id day symptom start end   exacerbation censor
1    A   1       2     0   0            0      0
2    A   2       3     1   0            1      0
3    A   3       3     0   0            1      0
4    A   4       3     0   0            1      0
5    A   5       3     0   1            1      0
6    A   6       2     0   0            0      0
7    A   7       2     0   0            0      0
8    A   8       2     0   0            0      0
9    A   9       2     0   0            0      0
10   A  10       2     0   0            0      0
11   A  11       2     0   0            0      0
12   A  12       3     0   0            0      0
13   A  13       2     0   0            0      0
14   A  14       2     0   0            0      0
15   A  15       2     0   0            0      0
16   A  16       2     0   0            0      0
17   A  17      NA     0   0            0      0
18   A  18      NA     0   0            0      0
19   A  19      NA     0   0            0      0
20   A  20       2     0   0            0      0
21   A  21       2     0   0            0      0
22   A  22       2     0   0            0      0
23   A  23       3     1   0            1      0
24   A  24       3     0   0            1      0
25   A  25       3     0   0            1      0
26   A  26       4     0   0            1      0
27   A  27       4     0   0            1      0
28   A  28       3     0   0            1      0
29   A  29       3     0   0            1      0
30   A  30       2     0   0            1      0
31   A  31       3     0   0            1      0
32   A  32       2     0   0            1      0
33   A  33       2     0   0            1      0
34   A  34       3     0   0            1      0
35   A  35       3     0   0            1      0
36   A  36       2     0   0            1      0
37   A  37       2     0   0            1      0
38   A  38       2     0   0            1      0
39   A  39       2     0   0            1      0
40   A  40       2     0   0            1      0
41   A  41       2     0   1            1      0
42   A  42       3     0   0            0      0
43   A  43       2     0   0            0      0
44   A  44       2     0   0            0      0
45   A  45       2     0   0            0      0
46   A  46       2     0   0            0      0
47   A  47       2     0   0            0      0
48   A  48       3     0   0            0      0
49   A  49       2     0   0            0      0
50   A  50       2     0   0            0      0
51   B   1       2     0   0            0      0
52   B   2       2     0   0            0      0
53   B   3       2     0   0            0      0
54   B   4       2     0   0            0      0
55   B   5       2     0   0            0      0
56   B   6       2     0   0            0      0
57   B   7       3     0   0            0      0
58   B   8       2     0   0            0      0
59   B   9       3     0   0            0      0
60   B  10       3     1   0            1      0
61   B  11       2     0   0            1      0
62   B  12       3     0   0            1      0
63   B  13       2     0   0            1      0
64   B  14       3     0   0            1      0
65   B  15       2     0   0            1      0
66   B  16       2     0   0            1      0
67   B  17       2     0   0            1      0
68   B  18       2     0   0            1      0
69   B  19       2     0   1            1      0
70   B  20       2     0   0            0      0
71   B  21       3     1   0            1      0
72   B  22       3     0   0            1      0
73   B  23       3     0   0            1      0
74   B  24       3     0   0            1      0
75   B  25      NA     0   0            0      1
76   B  26      NA     0   0            0      1
77   B  27      NA     0   0            0      1
78   B  28       2     0   0            0      1
79   B  29       2     0   0            0      1
80   B  30       2     0   0            0      1
81   B  31       3     0   0            0      1
82   B  32       2     0   0            0      1
83   B  33       2     0   0            0      1
84   B  34       2     0   0            0      1
85   B  35       2     0   0            0      1
86   B  36       2     0   0            0      1
87   B  37       3     0   0            0      0
88   B  38       2     0   0            0      0
89   B  39       2     0   0            0      0
90   B  40       3     0   0            0      0
91   B  41      NA     0   0            0      0
92   B  42      NA     0   0            0      0
93   B  43      NA     0   0            0      0
94   B  44       3     1   0            1      0
95   B  45       3     0   0            1      0
96   B  46       3     0   0            1      0
97   B  47       3     0   0            1      0
98   B  48       3     0   0            1      0
99   B  49       3     0   0            1      0
100  B  50       2     0   0            1      0
>

【问题讨论】：

你如何对待NA？例如。如果您在第 13 3 行插入症状会发生什么？
一个很好的问题，需要事先考虑。我计划对缺失数据的任何恶化进行正确审查。这可能会导致事件丢失，但会减少偏差。我不知道缺失的日子中是否有一个 3 （因此他们的恶化继续）或全部 2 （随后他们的恶化结束）。这是编码“恶化规则”被证明是困难的另一个原因。另一种选择是由独立审查员手动评估症状数据（这是最不受欢迎的选择！）但这本身就会给分析带来潜在的偏差

标签： r dplyr

【解决方案1】：

这里尝试一种更优雅和可扩展的方式来编写您的算法：

首先，您不必计算lead 和lag 调用，就可以使用case_when。值得注意的是，我发现明确编写case_when 的TRUE 选项是一种很好的做法。这是一些代码。

df2=df %>% 
  mutate(
    exacerbation_start = case_when(
      is.na(symptom) ~ NA_real_,
      symptom <= 2 ~ 0,
      symptom >= 3 & symptom >= lag(symptom, n=2) & symptom <= lag(symptom, n=1) ~ 1,
      TRUE ~ 0
    ),
    exacerbation_end = case_when(
      symptom >=3 ~ ifelse(lead(symptom, n=1) <=2 &
                             lead(symptom, n=2) <=2 & lead(symptom, n=3) <=2 &
                             lead(symptom, n=4) <=2 & lead(symptom, n=5) <=2,
                           1,0),
      TRUE ~ NA_real_
    )
  )
all.equal(df1,df2) #TRUE

或者，如果您的算法对所有症状都相同，您可能需要使用自定义函数：

get_exacerbation_start = function(x){
  case_when( 
    is.na(x) ~ NA_real_, 
    x <= 2 ~ 0,
    x >= 3 & x >= lag(x, n=2) & x <= lag(x, n=1) ~ 1,
    TRUE ~ 0
  )
}
get_exacerbation_end = function(x){
  case_when(
    x >=3 ~ ifelse(x >=3 & lead(x, n=1) <=2 & 
                     lead(x, n=2) <=2 & lead(x, n=3) <=2 & 
                     lead(x, n=4) <=2 & lead(x, n=5) <=2,
                   1,0),
    TRUE ~ NA_real_
  )
}
df3=df %>% 
  mutate(
    exacerbation_start = get_exacerbation_start(symptom),
    exacerbation_end = get_exacerbation_end(symptom)
  )

all.equal(df1,df3) #also TRUE

后一种方式在调用mutate_at 时可能会更加强大。

编辑：看到你的编辑后，这里是一个尝试得到恶化期。在我看来，代码相当丑陋，我不确定row_number 应该这样使用。

df_final=df %>% 
  transmute(
    id,day,symptom, 
    start = get_exacerbation_start(symptom),
    end = get_exacerbation_end(symptom),
    exacerbation = row_number()>=which(start==1)[1] & row_number()<=which(end==1)[1]
  )

【讨论】：

其次，对于恶化 = row_number() >=which(start...etc，它适用于第一次定义的恶化，但对于之后的任何恶化都显示为 FALSE。有什么办法吗？也许通过从它们发生的时间开始对恶化进行排名，或者将恶化 1、恶化 2、恶化 3 等作为变量，然后重新组织数据框？

【解决方案2】：

我可能会用一种不那么复杂的方法回来，但试试这个：

library(dplyr)
library(tidyr)

df %>%
  group_by(id,
           idx = with(
             rle(
               case_when(symptom <= 2 ~ 'normal', 
                         symptom >= 3 ~ 'worse',
                         TRUE ~ symptom %>% as.character)),
             rep(seq_along(lengths), lengths)
             )
           ) %>%
  mutate(
    trajectory = case_when(cumsum(symptom <= 2) == 5 ~ 2, cumsum(symptom >= 3) == 2 ~ 1)
    ) %>%
  group_by(id) %>% fill(trajectory) %>% 
  mutate(
    trajectory = replace_na(trajectory, 0),
    start = +(trajectory == 1 & lag(trajectory) == 2),
    end = +(trajectory == 2 & lag(trajectory) == 1),
    exacerbation = +(trajectory == 1 | start == 1 | end == 1)
  ) %>% 
  select(-idx, -trajectory) %>% as.data.frame

输出：

   id day symptom start end exacerbation
1   A   1       2     0   0            0
2   A   2       2     0   0            0
3   A   3       2     0   0            0
4   A   4       2     0   0            0
5   A   5       2     0   0            0
6   A   6       2     0   0            0
7   A   7       2     0   0            0
8   A   8       2     0   0            0
9   A   9       2     0   0            0
10  A  10       2     0   0            0
11  A  11       2     0   0            0
12  A  12       3     0   0            0
13  A  13       2     0   0            0
14  A  14       2     0   0            0
15  A  15       2     0   0            0
16  A  16       2     0   0            0
17  A  17      NA     0   0            0
18  A  18      NA     0   0            0
19  A  19      NA     0   0            0
20  A  20       2     0   0            0
21  A  21       2     0   0            0
22  A  22       2     0   0            0
23  A  23       3     0   0            0
24  A  24       3     1   0            1
25  A  25       3     0   0            1
26  A  26       4     0   0            1
27  A  27       4     0   0            1
28  A  28       3     0   0            1
29  A  29       3     0   0            1
30  A  30       2     0   0            1
31  A  31       3     0   0            1
32  A  32       2     0   0            1
33  A  33       2     0   0            1
34  A  34       3     0   0            1
35  A  35       3     0   0            1
36  A  36       2     0   0            1
37  A  37       2     0   0            1
38  A  38       2     0   0            1
39  A  39       2     0   0            1
40  A  40       2     0   1            1
41  A  41       2     0   0            0
42  A  42       3     0   0            0
43  A  43       2     0   0            0
44  A  44       2     0   0            0
45  A  45       2     0   0            0
46  A  46       2     0   0            0
47  A  47       2     0   0            0
48  A  48       3     0   0            0
49  A  49       2     0   0            0
50  A  50       2     0   0            0

【讨论】：

1) 我怎样才能在 3 个连续 NA 之后正确审查任何数据，直到满足“结束”规则，即 5 个连续
2) 在几个示例中，开始规则没有立即开始（在前几行内）出现恶化。有没有办法添加一个条件，如果没有先前的数据，则假设
只是确保您已经看到我已经更新了数据。非常感谢任何帮助。