How to detect the closest value below and above a given reference variable in a data frame in R?

A custom function to do this -

library(dplyr)

cols <- df1 %>% select(starts_with('var')) %>% names

closest_to_right <- function(x, y) {
  tmp <- y - x
  if(any(tmp > 0, na.rm = TRUE)) 
     cols[tmp %in% min(tmp[tmp > 0], na.rm = TRUE)] else NA
}

closest_to_left <- function(x, y) {
  tmp <- y - x
  if(any(tmp < 0, na.rm = TRUE)) 
     cols[tmp %in% max(tmp[tmp < 0], na.rm = TRUE)] else NA
}

df1 %>%
  rowwise() %>%
  mutate(closest_to_left = closest_to_left(reference_day, c_across(starts_with('var'))),
         closest_to_right = closest_to_right(reference_day, c_across(starts_with('var')))) %>%
  ungroup

#     id gender reference_day var1       var2       var3       closest_to_left closest_to_right
#  <int> <chr>  <date>        <date>     <date>     <date>     <chr>           <chr>           
#1     1 female 2019-06-05    2015-03-11 NA         2018-11-10 var3            NA              
#2     2 male   NA            2016-12-09 2019-05-26 2019-06-23 NA              NA              
#3     3 male   2019-06-05    2019-08-31 2015-04-19 2016-12-17 var3            var1            
#4     4 male   2019-06-05    NA         2015-09-19 2015-05-16 var2            NA              
#5     5 male   2019-06-05    2015-07-23 NA         NA         var1            NA        

Here is a base R solution. Probably there are simpler ways.

nms <- names(df1[-(1:3)])
res <- apply(df1[-(1:2)], 1, \(x){
  d <- difftime(x[1], x[-1])
  if(any(!is.na(d))){
    if(any(d > 0, na.rm = TRUE)) {
      i <- which((d > 0) & (d == min(d[d > 0], na.rm = TRUE)))
      closest_left <- nms[i]
    } else closest_left <- NA
    if(any(d < 0, na.rm = TRUE)){
      j <- which((d < 0) & (d == min(d[d < 0], na.rm = TRUE)))
      closest_right <- nms[j]
    } else closest_right <- NA
    c(closest_left = closest_left, closest_right = closest_right)
  } else c(closest_left = NA, closest_right = NA)
})

res <- cbind(df1, t(res))
res
#>   id gender reference_day       var1       var2       var3 closest_left closest_right
#> 1  1 female    2019-06-05 2015-03-11       <NA> 2018-11-10         var3          <NA>
#> 2  2   male          <NA> 2016-12-09 2019-05-26 2019-06-23         <NA>          <NA>
#> 3  3   male    2019-06-05 2019-08-31 2015-04-19 2016-12-17         var3          var1
#> 4  4   male    2019-06-05       <NA> 2015-09-19 2015-05-16         var2          <NA>
#> 5  5   male    2019-06-05 2015-07-23       <NA>       <NA>         var1          <NA>

^{Created on 2022-02-06 by the reprex package (v2.0.1)}

Here's a relatively simple tidyverse approach. First we define a function to pick the closest match before or after the reference_day within each group, then we apply that in each case to add the two new columns. I use the side parameter to define whether we want matches on the side with negative time differences (before) or positive (after).

closest <- function(df, side = -1) {
  df %>%
    pivot_longer(-c(id:reference_day)) %>%
    group_by(id, gender) %>%
    arrange(value) %>%
    mutate(dif = (value - reference_day) * side) %>%
    filter(dif > 0) %>%
    slice_min(dif) %>%
    select(name) %>%
    ungroup()
}

df1 %>%
  left_join(df1 %>% closest(-1) %>% rename("left" = "name")) %>%
  left_join(df1 %>% closest(1) %>% rename("right" = "name"))

Result

  id gender reference_day       var1       var2       var3 left right
1  1 female    2019-06-05 2015-03-11       <NA> 2018-11-10 var3  <NA>
2  2   male          <NA> 2016-12-09 2019-05-26 2019-06-23 <NA>  <NA>
3  3   male    2019-06-05 2019-08-31 2015-04-19 2016-12-17 var3  var1
4  4   male    2019-06-05       <NA> 2015-09-19 2015-05-16 var2  <NA>
5  5   male    2019-06-05 2015-07-23       <NA>       <NA> var1  <NA>

Here is another tidyverse approach:

1. First we calculate the difference of each var to the reference
2. Bring in long format
3. remove diff_ in varname
4. Create a helper column using only negative values
5. group and arrange
6. identify closest to left and right again with redefining the helper column: now with only positive values.
7. fill both closest columns to select each first row of the group with slice.

df1 %>% 
  mutate(across(contains("var"), ~ parse_number(as.character(. - reference_day)), .names = "diff_{.col}")) %>% 
  pivot_longer(cols = contains("diff")) %>% 
  mutate(name = str_remove(name, '\\w+\\_'),
         helper = ifelse(value > 0, NA_real_, value)) %>% 
  group_by(id) %>% 
  arrange(desc(helper), .by_group = TRUE) %>% 
  mutate(closest_to_left = ifelse(helper == max(helper, na.rm = TRUE), name, NA_character_),
         helper = ifelse(value < 0, NA_real_, value),
         closest_to_right = ifelse(helper == min(helper, na.rm = TRUE), name, NA_character_)) %>% 
  fill(closest_to_left, .direction = "downup") %>% 
  fill(closest_to_right, .direction = "downup") %>% 
  slice(1) %>% 
  select(-c(name, value, helper))

     id gender reference_day var1       var2       var3       closest_to_left closest_to_right
  <int> <chr>  <date>        <date>     <date>     <date>     <chr>           <chr>           
1     1 female 2019-06-05    2015-03-11 NA         2018-11-10 var3            NA              
2     2 male   NA            2016-12-09 2019-05-26 2019-06-23 NA              NA              
3     3 male   2019-06-05    2019-08-31 2015-04-19 2016-12-17 var3            var1            
4     4 male   2019-06-05    NA         2015-09-19 2015-05-16 var2            NA              
5     5 male   2019-06-05    2015-07-23 NA         NA         var1            NA