Search code examples
rloopspiperowdelete-row

Remove observations according to a pattern in R

I have a dataframe with observations of injuries in soccer. Unfortunately I have several teams for each injury to choose from. This is what a section of the dataframe looks like:

df_x = data.frame(injury_id=c(250, 250, 100, 328, 328, 329, 329, 330, 330, 15, 5106, 5106, 5106),
 player_id=c(109, 109, 39728, 2374, 2374, 2374, 2374, 2374, 2374, 26, 59016, 59016, 59016), 
 season=c(2011, 2011, 2010, 2010, 2010, 2010, 2010, 2010, 2010, 2010, 2012, 2012, 2012), 
 inury_from=c("2011-09-13", "2011-09-13", "2011-03-03", "2011-04-21", "2011-04-21", "2010-11-23", "2010-11-23", "2010-10-01", "2010-10-01", "2011-02-24", "2012-09-16", "2012-09-16", "2012-09-16"),
 injury_until=c("2011-09-27", "2011-09-27", "2011-03-17", "2011-08-31", "2011-08-31", "2011-03-14", "2011-03-14", "2010-11-22", "2010-11-22", "2011-02-28", "2012-10-28", "2012-10-28", "2012-10-28"),
 team_id=c(1, 2, 3, 4, 5, 4, 5, 4, 5, 6, 7, 8, 9),
 member_since=c("1998-07-01", NA, "2009-07-01", "2008-07-01", NA, "2008-07-01", NA, "2008-07-01", NA, "2002-07-01", "2012-07-01", "2013-01-01", "2011-07-01"))

enter image description here

My goal is to have only one line for each injury_id. The following dataframe should come out as result:

df_result_x = data.frame(injury_id=c(250, 100, 328, 329, 330, 15, 5106),
 player_id=c(109, 39728, 2374, 2374, 2374, 26, 59016),
 season=c(2011, 2010, 2010, 2010, 2010, 2010, 2012),
 inury_from=c("2011-09-13", "2011-03-03", "2011-04-21", "2010-11-23", "2010-10-01", "2011-02-24", "2012-09-16"),
 injury_until=c("2011-09-27", "2011-03-17", "2011-08-31", "2011-03-14", "2010-11-22", "2011-02-28", "2012-10-28"),
 team_id=c(1, 3, 4, 4, 4, 6, 7),
 member_since=c("1998-07-01", "2009-07-01", "2008-07-01", "2008-07-01", "2008-07-01", "2002-07-01", "2012-07-01"))

enter image description here

The algorithm to select for observations with multiple injury_ids:

  • delete lines that have NA at member_since.
  • delete all rows whose member_since is later than injury_until.
  • If duplicate observations remain choose the observation with the later date in member_since.

enter image description here

Can I do this via a pipe or do I have to use a loop?

Thank you.

UPDATE 11-10-2020:

df_x2 = data.frame(injury_id=c(250, 250, 100, 328, 328, 329, 329, 330, 330, 15, 5106, 5106, 5106),
                  player_id=c(109, 109, 39728, 2374, 2374, 2374, 2374, 2374, 2374, 26, 59016, 59016, 59016),
                  season=c(2011, 2011, 2010, 2010, 2010, 2010, 2010, 2010, 2010, 2010, 2012, 2012, 2012),
                  inury_from=c("2011-09-13", "2011-09-13", "2011-03-03", "2011-04-21", "2011-04-21", "2010-11-23", "2010-11-23", "2010-10-01", "2010-10-01", "2011-02-24", "2012-09-16", "2012-09-16", "2012-09-16"),
                  injury_until=c("2011-09-27", "2011-09-27", "2011-03-17", "2011-08-31", "2011-08-31", "2011-03-14", "2011-03-14", "2010-11-22", "2010-11-22", "2011-02-28", "2012-10-28", "2012-10-28", "2012-10-28"),
                  team_id=c(1, 2, 3, 4, 5, 4, 5, 4, 5, 6, 8, 9, 7),
                  member_since=c("1998-07-01", NA, "2009-07-01", "2008-07-01", NA, "2008-07-01", NA, "2008-07-01", NA, "2002-07-01", "2013-01-01", "2011-07-01", "2012-12-31"))
Solution

  • We can use slice after grouping by 'injury_id'

    library(dplyr)
df_x %>%
    group_by(injury_id) %>%
    slice(1) %>% 
    ungroup

    or with distinct

    df_x %>%
      distinct(injury_id, .keep_all = TRUE)

    Or if the NA elements are not in order, do an arrange on the 'injury_id', followed by the logical vector based on NA elements in 'member_since' (so that NAs will be last) and the Date converted 'member_since' and then use distinct to select the first unique row based on the 'injury_id' column

    df_x %>%
    arrange(injury_id, is.na(member_since), as.Date(member_since)) %>%
    distinct(injury_id, .keep_all = TRUE)

    Update

    Based on the comments

    df_x %>%
    filter(!is.na(member_since)) %>%
    mutate(injury_until = as.Date(injury_until), 
          member_since = as.Date(member_since)) %>% 
    mutate(ind = injury_until - member_since) %>% 
    group_by(injury_id)  %>%
    filter(ind == min(ind[ind > 0])) %>%
    select(-ind)

    -output

    # A tibble: 7 x 7
# Groups:   injury_id [7]
#  injury_id player_id season inury_from injury_until team_id member_since
#      <dbl>     <dbl>  <dbl> <chr>      <date>         <dbl> <date>      
#1       250       109   2011 2011-09-13 2011-09-27         1 1998-07-01  
#2       100     39728   2010 2011-03-03 2011-03-17         3 2009-07-01  
#3       328      2374   2010 2011-04-21 2011-08-31         4 2008-07-01  
#4       329      2374   2010 2010-11-23 2011-03-14         4 2008-07-01  
#5       330      2374   2010 2010-10-01 2010-11-22         4 2008-07-01  
#6        15        26   2010 2011-02-24 2011-02-28         6 2002-07-01  
#7      5106     59016   2012 2012-09-16 2012-10-28         7 2012-07-01