R中的迭代过滤答案

【问题标题】：Iterative filtering in RR中的迭代过滤
【发布时间】：2022-02-21 15:59:34
【问题描述】：

我有一个诊所患者就诊的数据集。每个患者可以多次访问。每个患者由一个 study_id 标识，每次就诊由一个 disease_id 标识。我想迭代过滤数据框，以便删除上次访问后 28 天内发生的访问。

我不能简单地计算所有访问之间的间隔，然后删除那些发生在 28 天内的访问。在过滤数据帧时需要迭代计算间隔。

在下面的示例中，您可以看到患者 0003 出现了 3 次。访问 1 始终保留。第 2 次访问应在第 1 次访问 7 天后删除。访问 2 删除后，第 3 次访问将在第 1 次访问后 29 天出现，因此应保留。但是，如果我计算所有间隔，然后过滤掉任何间隔为 28 天或更短的访问，则访问 2 和 3 都将被删除（因为访问 2 发生在访问 1 后 7 天，访问 3 发生在访问 2 后 22 天） .

study_id	illness_id	illness_date
0001	000103/12/2007	2007/12/03
0002	000224/03/2008	2008/03/24
0002	000226/04/2008	2008/04/26
0002	000217/07/2008	2008/07/17
0002	000221/08/2008	2008/08/21
0002	000225/08/2008	2008/08/25
0003	000329/09/2008	2008/09/29
0003	000306/10/2008	2008/10/06
0003	000328/10/2008	2008/10/28

正确过滤的数据框应该是：

study_id	illness_id	illness_date
0001	000103/12/2007	2007/12/03
0002	000224/03/2008	2008/03/24
0002	000226/04/2008	2008/04/26
0002	000217/07/2008	2008/07/17
0002	000221/08/2008	2008/08/21
0003	000329/09/2008	2008/09/29
0003	000328/10/2008	2008/10/28

感谢您的帮助 - 我是 R 新手，正在努力解决迭代和循环问题。如果有一个涉及 dplyr 过滤器的简单解决方案，那就太好了。

针对下面的一些建议，我发布另一个示例以尝试使问题更清晰

无法在每位患者首次就诊时固定“比较器”行。它需要遍历数据框，因为过滤是迭代完成的。对不起，如果这在 OP 中不清楚。这是一个示例，其中应删除第 2、3 和 5 行，而应保留第 1、4 和 6 行。

第 2 行是第 1 行之后的 8 天，因此被删除。第 3 行是第 1 行之后的 26 天，因此被删除。第 4 行是第 1 行之后的 41 天，因此被保留并成为该患者后续就诊的比较对象。第 5 行是第 4 行之后的 6 天，因此被删除。第 6 行是第 4 行之后的 31 天，因此被保留并成为该患者后续就诊的比较对象。

study_id	illness_id	illness_date
0001	000119/12/2007	19/12/2007
0001	000127/12/2007	27/12/2007
0001	000114/01/2008	14/01/2008
0001	000129/01/2008	29/01/2008
0001	000104/02/2008	04/02/2008
0001	000129/02/2008	29/02/2008

这是@sbarbit提供的v优雅解决方案 - 真诚的感谢！！

df1 <- df |>
arrange(study_id, illness_date) |> 
mutate(comparator = purrr::accumulate(illness_date,~ifelse(.y - .x > 28, .y,.x))) |>
mutate(daydiff = illness_date - lag(comparator, 1,0)) |>
mutate(daydiff = as.numeric(daydiff)) |>
filter(daydiff > 28)

【问题讨论】：

标签： r dplyr iteration filtering

【解决方案1】：

这里我使用purrr::accumulate 仅传播距前一个日期超过 28 天的日期，否则保留前一个日期。然后，根据与更新的前一行的比较来过滤行。

数据：

df <- data.frame(illness_id = c("000103/12/2007",
                                "000224/03/2008",
                                "000226/04/2008",
                                "000217/07/2008",
                                "000221/08/2008",
                                "000225/08/2008",
                                "000329/09/2008",
                                "000306/10/2008",
                                "000328/10/2008"),

                 illness_date = as.Date(c("2007/12/03",
                                          "2008/03/24",
                                          "2008/04/26",
                                          "2008/07/17",
                                          "2008/08/21",
                                          "2008/08/25",
                                          "2008/09/29",
                                          "2008/10/06",
                                          "2008/10/28"),
                                       format  = "%Y/%m/%d"),

                 study_id = c("0001",
                              "0002",
                              "0002",
                              "0002",
                              "0002",
                              "0002",
                              "0003",
                              "0003",
                              "0003"))

这里我展示了没有过滤步骤的算法来说明它是如何工作的：

library(dplyr)
library(purrr)

df |>
  group_by(study_id) |>
  arrange(illness_date, by_group = TRUE) |>
  mutate(comparator = purrr::accumulate(illness_date,~ifelse(.y - .x > 28, .y,.x))) |>
  mutate(daydiff = illness_date - lag(comparator, 1,0))

+ # A tibble: 9 x 5
# Groups:   study_id [3]
  illness_id     illness_date study_id comparator daydiff
  <chr>          <date>       <chr>         <dbl>   <dbl>
1 000103/12/2007 2007-12-03   0001          13850   13850
2 000224/03/2008 2008-03-24   0002          13962   13962
3 000226/04/2008 2008-04-26   0002          13995      33
4 000217/07/2008 2008-07-17   0002          14077      82
5 000221/08/2008 2008-08-21   0002          14112      35
6 000225/08/2008 2008-08-25   0002          14112       4
7 000329/09/2008 2008-09-29   0003          14151   14151
8 000306/10/2008 2008-10-06   0003          14151       7
9 000328/10/2008 2008-10-28   0003          14180      29

这里我添加过滤步骤：

df |>
  group_by(study_id) |>
  arrange(illness_date, by_group = TRUE) |>
  mutate(comparator = purrr::accumulate(illness_date,~ifelse(.y - .x > 28, .y,.x))) |>
  mutate(daydiff = illness_date - lag(comparator, 1,0)) |>
  filter(daydiff > 28)

# A tibble: 7 x 5
# Groups:   study_id [3]
  illness_id     illness_date study_id comparator daydiff
  <chr>          <date>       <chr>         <dbl>   <dbl>
1 000103/12/2007 2007-12-03   0001          13850   13850
2 000224/03/2008 2008-03-24   0002          13962   13962
3 000226/04/2008 2008-04-26   0002          13995      33
4 000217/07/2008 2008-07-17   0002          14077      82
5 000221/08/2008 2008-08-21   0002          14112      35
6 000329/09/2008 2008-09-29   0003          14151   14151
7 000328/10/2008 2008-10-28   0003          14180      29

【讨论】：

感谢您的快速回复。我不确定代码的 ifelse 部分是如何工作的，但总体而言，该解决方案不起作用，因为距上次访问
@arji_barji 可能是代码的描述不是最佳的。我对其进行了编辑以增加清晰度。您是在实际数据帧上尝试过，还是根据算法的描述假设它不起作用？在我看来，这正是你想要的。您能否发布一个会失败的数据框（将dput(df) 附加到您的 OP）？
感谢您的明确解释。完美运行！ :) 我做了一些小改动来安排 fx 以保持 df 的正确顺序（并将 daydiff 转换为数字以帮助交叉检查），但这是优雅的解决方案！我不是 100% 确定 "~ifelse(.y - .x > 28, .y,.x)" 是做什么的？有时间能解释一下语法吗？
@arji_barji 公式语法例如~ .x + 2 是定义 tidyverse 中接受的函数的紧凑方法（请参阅 this）。相当于function(a,b) ifelse(b - a > 28, b, a)
(+1) 很好地使用累积！记住这似乎是一个有用的模式。一个建议：在这里使用“比较器”，我认为您发现的是 28 天内连续不断的日期的开始。由于区间长度已经融入其中，因此稍后通过相同差异进行过滤有点多余。相反，您可以只过滤与连续开始日期不同的当前日期，即illness_date != comparator。

【解决方案2】：

这应该可以解决问题：

df %>% 
  mutate(illness_date = as.Date(illness_date, 
                                format = "%Y/%m/%d")) %>% 
  group_by(study_id) %>% 
  mutate(time_since_first_visit = illness_date - min(illness_date)) %>% 
  filter(time_since_first_visit == 0 | time_since_first_visit > 28)

【讨论】：

感谢您的快速回复。遗憾的是，这不起作用，因为比较器行不能作为第一次访问固定，而是需要“滚动”通过数据帧，因为过滤是迭代完成的。抱歉，如果这在 OP 中不清楚。我添加了另一个示例以尝试使其更清晰。

【解决方案3】：

这是一个返回要删除的行的函数，以及一个使用data.table按组调用它的示例。

fFilter <- function(v, gap) {
  blnDrop <- logical(length(v))
  if (length(v) > 1L) {
    prev <- v[1]
    
    for (i in 2:length(v)) {
      if (v[i] - prev <= gap) blnDrop[i] <- TRUE else prev <- v[i]
    }
  }
  
  blnDrop
}

library(data.table)

dt <- data.table(id = rep(1:3, c(1, 5, 3)), date = as.Date(c("2007/12/3", "2008/3/24", "2008/4/26", "2008/7/17", "2008/8/21", "2008/8/25", "2008/9/29", "2008/10/6", "2008/10/28")))
setorder(dt, id, date)
dt[,drop := fFilter(date, 28), by = "id"][drop == FALSE, 1:(length(dt) - 1L)]
#>    id       date
#> 1:  1 2007-12-03
#> 2:  2 2008-03-24
#> 3:  2 2008-04-26
#> 4:  2 2008-07-17
#> 5:  2 2008-08-21
#> 6:  3 2008-09-29
#> 7:  3 2008-10-28

【讨论】：