R:每组内每 30 天取一个记录

R: take one record per 30 days within each group

我有一个包含 1000 多个唯一 ID 的数据集,每个 ID 大约有 15 个在不同日期完成的手术代码(记录为天差)

我想在每个ID每个手术码组内每30天只取1条记录

在此处添加演示数据:

   ID Age Diag.Date Surgery.Code Days.diff
1   1  67  4/8/2011         A364       421
2   1  67  4/8/2011         A364      1197
3   1  67  4/8/2011         A364      2207
4   1  67  4/8/2011         A364      2226
5   1  67  4/8/2011         A364      2247
6   1  67  4/8/2011         A364      2254
7   1  67  4/8/2011         A364      2331
8   1  67  4/8/2011         A364      2367
9   1  67  4/8/2011         A364      2905
10  1  67  4/8/2011         A364      2918
11  1  67  4/8/2011         D365      2200
12  1  67  4/8/2011         D441       308
13  1  67  4/8/2011         D443       218
14  1  67  4/8/2011         A446       308
15  2  56  6/4/2018         A453      2260
16  2  56  6/4/2018         D453       645
17  2  56  6/4/2018         D453      3095
18  2  56  6/4/2018         B453       645

2226-2207 天的差异为 19 天,因此第 4 行将被删除,2247-2207 天的差异再次为 40 天,因此第 5 行将被记录。 同样,2254-2247 天的差异是 7 天,因此第 6 行将被删除。 同样,第 10 行将被删除。

感谢任何帮助!

  1. 使用 dplyr::group_by(ID, Surgery.Code) 在个人和手术中进行过滤;
  2. 在每组内,使用Days.diff - dplyr::lag(Days.diff) <= 30测试30天内的相邻行;
  3. 因为 (2) 的结果可能会在删除行时发生变化,所以您需要通过每组一次删除一行来进行迭代,然后 re-testing。您可以使用 while 进行迭代,直到检测不到更多案例。
library(dplyr)

filtered <- surgeries %>% 
  group_by(ID, Surgery.Code) %>% 
  mutate(within30 = if_else(
    Days.diff - lag(Days.diff) <= 30, 
    row_number(), 
    NA_integer_
  ))

while (any(!is.na(filtered$within30))) {
  filtered <- filtered %>% 
    mutate(within30 = if_else(
      Days.diff - lag(Days.diff) <= 30, 
      row_number(), 
      NA_integer_
    )) %>% 
    filter(is.na(within30) | within30 != min(within30, na.rm = TRUE))
}

filtered %>% 
  select(!within30) %>% 
  ungroup()

#> # A tibble: 15 x 5
#>       ID   Age Diag.Date Surgery.Code Days.diff
#>    <int> <int> <chr>     <chr>            <int>
#>  1     1    67 4/8/2011  A364               421
#>  2     1    67 4/8/2011  A364              1197
#>  3     1    67 4/8/2011  A364              2207
#>  4     1    67 4/8/2011  A364              2247
#>  5     1    67 4/8/2011  A364              2331
#>  6     1    67 4/8/2011  A364              2367
#>  7     1    67 4/8/2011  A364              2905
#>  8     1    67 4/8/2011  D365              2200
#>  9     1    67 4/8/2011  D441               308
#> 10     1    67 4/8/2011  D443               218
#> 11     1    67 4/8/2011  A446               308
#> 12     2    56 6/4/2018  A453              2260
#> 13     2    56 6/4/2018  D453               645
#> 14     2    56 6/4/2018  D453              3095
#> 15     2    56 6/4/2018  B453               645

reprex package (v2.0.1)

创建于 2022-03-01