Filter based on row value being within a list and date value of row below it being within 30 days of date value in original row

Viewed 169

Hi I have this dataset:

Data_List <- "I611|I613|I614|I639"

df <- 
  read.table(textConnection("ID   Code   Date1 Date2
A I611 01/01/2021 03/01/2021
A L111 04/01/2021 09/01/2021
B L111 01/01/2021 03/01/2021
B Z538 08/01/2021 11/01/2021
C I613 09/08/2021 09/09/2021
C I639 10/09/2021 18/09/2021
C I639 19/11/2021 22/11/2021
D L111 01/01/2021 02/01/2021                          
D I639 03/01/2021 04/01/2021
D B111 11/01/2021 14/01/2021"), header=TRUE)

What I am looking to do is filter rows where 'Code' value is within Data_List and the value in the row immediately below it for 'Date1' column is within 30 days of the value in Date2 column of original row (the row that matches its 'Code' value in Data_List). If these conditions are matched, both rows should be kept (and any subsequent rows where these conditions are matched for each grouped ID).

So from the above dataset we would end up with the below:

ID Code Date1 Date2
A I611 01/01/2021 03/01/2021
A L111 04/01//2021 09/01/2021
C I613 09/08/2021 09/09/2021
C I639 10/09/2021 18/09/2021
D I639 03/01/2021 04/01/2021
D B111 11/01/2021 14/01/2021

So for ID A we have 2 retained records as first record is a match to Data_List for 'Code' value and below column Date1 is within 30 days of the first record's Date2 so both are retained.

For ID B we have no retained records as there are only two records and the first record is not within Data_List for 'Code' value.

For ID C we have 2 retained records as first record is a match within Data_list for 'Code' and second is within 30 days for Date1 of the Date2 value in first record. The third ID = 'C' record is not retained as its Date1 value is not within 30 days of Date2 in record above it.

For ID D we again have 2 matches but this is for the 2nd and 3rd rows which apply, thus demonstrating that sometimes the 'loop' does not start on row 1.

If anyone could assist with this filtering that would be very much appreciated, thank you.

4 Answers

I propose this. It matches the requirements as I understand them, though it does not matches the expected output.

df <- 
  read.table(textConnection("ID   Code   Date1 Date2
A I611 01/01/2021 03/01/2021
A L111 04/01/2021 09/01/2021
B L111 01/01/2021 03/01/2021
B Z538 08/01/2021 11/01/2021
C I613 09/08/2021 09/09/2021
C I639 10/09/2021 18/09/2021
C I639 19/11/2021 22/11/2021
D L111 01/01/2021 02/01/2021                          
D I639 03/01/2021 04/01/2021
D B111 11/01/2021 14/01/2021"), header=TRUE)


Data_List <- "I611|I613|I614|I639"

library(data.table)
library(lubridate)


Data_List <- base::strsplit(Data_List, split = "|", fixed = TRUE)[[1]]

setDT(df)
df[, `:=`(Date1 = dmy(Date1), Date2 = dmy(Date2), keep = FALSE) ]
df[, next_date := shift(Date2, 1L, type="lead")]
df[, date_limit := (Date1 + duration(30, 'days')) ]

df[(next_date < date_limit) & (Code %in% Data_List) , keep := TRUE]
df[, previous_id := shift(ID, 1L, type="lag")]
df[, previous_keep := shift(keep, 1L, type="lag")]

df[keep | ((ID == previous_id) & previous_keep), .(ID, Code, Date1, Date2)]

Here's an approach using tidyverse and lubridate:

library(tidyverse)
library(lubridate)

We first transform Data_list to a character vector of codes and coerce df to a tibble with date columns in a suitable format.

Data_List <- unlist(str_split("I611|I613|I614|I639", "\\|"))
df <- df %>% as_tibble() %>% mutate(across(starts_with("Date"), dmy))

Next, we group df by ID and filter accordingly. cs serves as an identifier for rows to be removed since they don't have preceding rows with Code matching an entry in Data_List in their group (cs is 0 for these rows). The second condition is for the 30-days window.

df %>% group_by(ID) %>%
  mutate(cs = cumsum(Code %in% Data_List)) %>% 
  filter(
    cs != 0,
    (lead(Date1) - Date2) <= 30 | (Date1 - lag(Date2)) <= 30
  ) %>% 
  select(-cs) %>% ungroup()

Result:

# A tibble: 6 × 4
  ID    Code  Date1      Date2     
  <chr> <chr> <date>     <date>    
1 A     I611  2021-01-01 2021-01-03
2 A     L111  2021-01-04 2021-01-09
3 C     I613  2021-08-09 2021-09-09
4 C     I639  2021-09-10 2021-09-18
5 D     I639  2021-01-03 2021-01-04
6 D     B111  2021-01-11 2021-01-14
library(data.table)
setDT(df, key = "ID")
Data_List = unlist(strsplit(Data_List, "|", fixed = TRUE))
dvars = paste0('Date', 1:2)
df[, (dvars) := lapply(.SD, as.Date, "%d/%m/%Y"), .SDcols = dvars]

df[, keep := {
       tmp = Code %chin% Data_List
       replace(tmp, seq_along(Code) > which.max(tmp), NA)
     }, 
   by = ID]
df[, connected := (Date1 - shift(Date2, fill = NA)) <= 30, by = ID]

df[!sapply(!keep, isTRUE), .SD[any(keep)],  by = ID
   ][, .SD[cummin((fcoalesce(keep, connected)))], by = ID
     ][, !c("keep", "connected")]


# Key: <ID>
#        ID   Code      Date1      Date2
#    <char> <char>     <Date>     <Date>
# 1:      A   I611 2021-01-01 2021-01-03
# 2:      A   I611 2021-01-01 2021-01-03
# 3:      C   I613 2021-08-09 2021-09-09
# 4:      C   I613 2021-08-09 2021-09-09
# 5:      D   I639 2021-01-03 2021-01-04
# 6:      D   I639 2021-01-03 2021-01-04
  • Data_List has been a regex syntax, so just pass it into grepl() to determine where Code are matched.
  • cumany() from dplyr identify those rows at or behind where the matches of Code take place.
library(dplyr)

df %>%
  mutate(across(contains('Date'), as.Date, '%d/%m/%Y')) %>%
  group_by(ID) %>%
  filter(cumany(grepl(Data_List, Code)),
         lead(Date1) - Date2 <= 30 | Date1 - lag(Date2) <= 30) %>%
  ungroup()

# # A tibble: 6 × 4
#   ID    Code  Date1      Date2     
#   <chr> <chr> <date>     <date>    
# 1 A     I611  2021-01-01 2021-01-03
# 2 A     L111  2021-01-04 2021-01-09
# 3 C     I613  2021-08-09 2021-09-09
# 4 C     I639  2021-09-10 2021-09-18
# 5 D     I639  2021-01-03 2021-01-04
# 6 D     B111  2021-01-11 2021-01-14
Related