Iterative filtering in R

Viewed 175

I have a dataset of patient visits at a clinic. Each individual patient can visit on multiple occasions. Each patient is identified by a study_id and each visit by an illness_id. I want to iteratively filter the dataframe so that a visit that occurs within 28 days of a previous visit is removed.

I cannot simply calculate the interval between all visits and then remove those which occur within 28 days. The intervals need to be calculated iteratively as the dataframe is filtered.

In the example below you can see patient 0003 presented three times. Visit 1 is always retained. Visit 2 should be removed as it occurred 7 days after Visit 1. Once Visit 2 is removed, Visit 3 would occur 29 days after Visit 1 and so should be retained. However if I calculate all the intervals and then filter out any visits with an interval of 28 days or less, both Visits 2 and 3 would be removed (because Visit 2 occurred 7 days after Visit 1 and Visit 3 occurred 22 days after Visit 2).

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

The correctly filtered dataframe should be:

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

Thanks for any help - I am new to R and am struggling to get my head around iteration and loops. If there is a simple solution involving dplyr filter that would be great.


IN RESPONSE TO SOME SUGGESTIONS BELOW I AM POSTING ANOTHER EXAMPLE TO TRY AND MAKE THE QUESTION CLEARER

The 'comparator' row cannot be fixed at the first visit for each patient. It needs to roll through the dataframe as the filtering is done iteratively. Sorry if this was not clear in the OP. Here is an eg where rows 2, 3 and 5 should be removed, and rows 1, 4 and 6 should be retained.

Row 2 is 8 days after row 1, so is removed. Row 3 is 26 days after row 1, so is removed. Row 4 is 41 days after row 1, so is retained and becomes the comparator for subsequent visits for this patient. Row 5 is 6 days after row 4, so is removed. Row 6 is 31 days after row 4 so is retained and becomes the comparator for subsequent visits for this patient.

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

Here is the v elegant solution provided by @sbarbit - sincere thanks!!

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)
3 Answers

Here I use purrr::accumulate to propagate only dates that are more than 28 days from the preceding date, otherwise keep the preceding date. Then, rows are filtered based on the comparison with the updated preceding row.

DATA:

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"))

Here I show the algorithm without the filtering step to illustrate how it works:

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

Here I add the filtering step:

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   

This should do the trick:

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)

Here is a function that returns the rows to drop and an example of calling it by group using 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
Related