mutate new column based on date interval

Edited 2/4-2023

Data:

library(dplyr)

DF<-data.frame(
  stringsAsFactors = FALSE,
                ID = c(1L,2L,2L,3L,3L,3L,4L,4L,
                       4L,4L,5L,5L,6L,6L,6L,7L,7L,7L,7L,7L),
             COLOR = c("BLUE","RED","BLUE","RED",
                       "RED","BLUE","RED","BLUE","BLUE","BLUE","BLUE",
                       "BLACK","GREEN","GRAY","GRAY","RED","BLUE","BLUE",
                       "BLUE","BLUE"),
        COLOR_DATE = c("2001-01-01","2001-01-01",
                       "2002-02-02","2001-01-01","2002-02-02","2008-08-08",
                       "2001-01-01","2002-02-02","2009-09-09","2009-09-09",
                       "2001-01-01","2006-06-06","2001-01-01","2008-01-01",
                       "2008-01-01","2001-01-01","2002-02-02","2003-03-03",
                       "2004-04-04","2007-07-07")
)

Desired output:

       ID COLOR COLOR_DATE TRUE_COLOR
1   1  BLUE 2001-01-01       BLUE
2   2   RED 2001-01-01        MIX
3   2  BLUE 2002-02-02        MIX
4   3   RED 2001-01-01        MIX
5   3   RED 2002-02-02        MIX
6   3  BLUE 2008-08-08        MIX
7   4   RED 2001-01-01       BLUE
8   4  BLUE 2002-02-02       BLUE
9   4  BLUE 2009-09-09       BLUE
10  4  BLUE 2009-09-09       BLUE
11  5  BLUE 2001-01-01       BLUE
12  5 BLACK 2006-06-06       BLUE
13  6 GREEN 2001-01-01       <NA>
14  6  GRAY 2008-01-01       <NA>
15  6  GRAY 2008-01-01       <NA>
16  7   RED 2001-01-01       BLUE
17  7  BLUE 2002-02-02       BLUE
18  7  BLUE 2003-03-03       BLUE
19  7  BLUE 2004-04-04       BLUE
20  7  BLUE 2007-07-07       BLUE

Logic:

When only RED COLOR in same ID then TRUE_COLOR = RED.
When only BLUE COLOR in same ID then TRUE_COLOR = BLUE.
When both RED and BLUE COLOR in same ID then TRUE_COLOR = MIX.

However,
If the COLOR has been the same for at least the 5 recent years, then TRUE_COLOR = RED or BLUE (as in sample data ID 4 and 7).

Other COLOR than RED or BLUE are ignored.

Finally, RED123, and BLUE234 should be interpreted as RED and BLUE, respectively.

How to solve?

library(tidyverse); library(lubridate)
blu_red <- quo(COLOR2 %in% c("BLUE", "RED"))
DF %>%
  mutate(COLOR2 = str_extract(COLOR, "BLUE|RED"), 
         COLOR_DATE = as.Date(COLOR_DATE)) %>% 
  arrange(COLOR_DATE) %>% 
  group_by(ID) %>%
  mutate(
    TRUE_COLOR = case_when(
      isTRUE(all(!(!!blu_red))) ~ NA,
      isTRUE(n() == 1 & !!blu_red) ~ COLOR2,
      isTRUE(n() == 1 & !(!!blu_red)) ~ NA,
      isTRUE((last(COLOR_DATE) - COLOR_DATE[last(which(COLOR2 != lag(COLOR2)))]) >= years(5) & 
        last(COLOR2) %in% c("BLUE", "RED")) ~ last(COLOR2),
      isTRUE(all(COLOR2[!!blu_red] == "BLUE")) ~ "BLUE",
      isTRUE(all(COLOR2[!!blu_red] == "RED")) ~ "RED",
      TRUE ~ "MIX")) %>% 
  ungroup() %>% 
  select(- COLOR2) %>% 
  arrange(ID)

This solution is quite nice: we first find the color corresponding to each ID and then use dplyr::left_join() to add this back to the original table. If we don't find a color for an ID, then left_join() will automatically fill this in with NA.

library(tidyverse)
library(lubridate) # If tidyverse >= 2.0.0 is not installed

id_color <- DF %>%
  mutate(
    red_blue = case_match(
      COLOR,  # Determine if a color is red, blue or neither
      c("RED", "RED123") ~ "RED",
      c("BLUE", "BLUE234") ~ "BLUE",
      .default = NA   # Ignore all colors that are not red/blue
    ),
    date = ymd(COLOR_DATE)  # Convert the COLOR_DATE to a date
  ) %>%
  drop_na(red_blue) %>%  # Remove colors that are not red/blue
  group_by(ID) %>%
  # Only include dates such that the range of dates cover the last 5 years
  dplyr::filter(date == last(date) | lead(date) >= last(date) - years(5)) %>%
  summarise(
    TRUE_COLOR = if_else(
      length(unique(red_blue)) == 1,
      first(red_blue), "MIX"
    )
  )

left_join(DF, id_color)
#> Joining with `by = join_by(ID)`
#> # A tibble: 20 × 4
#>       ID COLOR COLOR_DATE TRUE_COLOR
#>    <int> <chr> <chr>      <chr>     
#>  1     1 BLUE  2001-01-01 BLUE      
#>  2     2 RED   2001-01-01 MIX       
#>  3     2 BLUE  2002-02-02 MIX       
#>  4     3 RED   2001-01-01 MIX       
#>  5     3 RED   2002-02-02 MIX       
#>  6     3 BLUE  2008-08-08 MIX       
#>  7     4 RED   2001-01-01 BLUE      
#>  8     4 BLUE  2002-02-02 BLUE      
#>  9     4 BLUE  2009-09-09 BLUE      
#> 10     4 BLUE  2009-09-09 BLUE      
#> 11     5 BLUE  2001-01-01 BLUE      
#> 12     5 BLACK 2006-06-06 BLUE      
#> 13     6 GREEN 2001-01-01 <NA>      
#> 14     6 GRAY  2008-01-01 <NA>      
#> 15     6 GRAY  2008-01-01 <NA>      
#> 16     7 RED   2001-01-01 BLUE      
#> 17     7 BLUE  2002-02-02 BLUE      
#> 18     7 BLUE  2003-03-03 BLUE      
#> 19     7 BLUE  2004-04-04 BLUE      
#> 20     7 BLUE  2007-07-07 BLUE