如何在R中的数据框中检测低于和高于给定参考变量的最接近值？答案

【问题标题】：How to detect the closest value below and above a given reference variable in a data frame in R?如何在R中的数据框中检测低于和高于给定参考变量的最接近值？
【发布时间】：2022-02-07 01:23:25
【问题描述】：

考虑以下随机 MWE。

对于每一行，我试图确定哪个变量的值最接近常量reference_day，哪个变量的值最接近常量reference_day。 p>

df1 <-
  structure(
    list(id = 1:5,
      gender = c("female", "male", "male", "male", "male"),
      reference_day = structure(c(18052, NA, 18052, 18052, 18052), class = "Date"),
      var1 = structure(c(16505, 17144, 18139, NA, 16639), class = "Date"),
      var2 = structure(c(NA, 18042, 16544, 16697, NA), class = "Date"),
      var3 = structure(c(17845, 18070, 17152, 16571, NA), class = "Date")),
  row.names = c(NA, -5L), class = "data.frame")

df1

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

我想要的结果是这样的：

  id gender reference_day       var1       var2       var3 closest_to_left closest_to_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>

经过多次试验和错误，我实际上能够使用 dplyr 的 case_when 函数找到解决方案，但它需要大量的样板代码，这让我认为必须有一个更聪明的解决方案。

我个人更喜欢使用 dplyr，但非常感谢任何帮助。

【问题讨论】：

标签： r date dplyr closest

【解决方案1】：

执行此操作的自定义函数 -

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

【讨论】：

代码简洁高效，完美运行。但是我可以问一个问题：如果我收集正确，该函数会通过从列表cols 中提取一个元素来返回“获胜者”的名称——即最接近的名称。但是该函数如何在语句cols[tmp %in% max(tmp[tmp < 0], na.rm = TRUE)] 中获取该列表的正确索引？
tmp 与cols 的长度相同。 max(tmp[tmp < 0], na.rm = TRUE) 将始终返回一个值，因此 tmp %in% max(...) 也将只有一个 TRUE 值（如果连续没有相同的日期）。从cols中提取对应的值。
非常感谢您的澄清。假设有一个额外的行df1 <- df1 %>% add_row(id = 6, gender = "female", reference_day = as.Date("2019-06-05"), var1 = NA, var2 = as.Date("2020-01-01"), var3 = as.Date("2020-01-01"))。现在有两个相同的日期 - 现实世界中的常见情况 - 自定义函数抛出错误 closest_to_right must be size 1, not 2. 你会去first(cols[tmp %in% min(tmp[tmp > 0], na.rm = TRUE)]) else NA吗？（我试过了，它似乎有效。）

【解决方案2】：

这是一个基本的 R 解决方案。可能还有更简单的方法。

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>

^{由reprex package (v2.0.1) 于 2022-02-06 创建}

【讨论】：

我测试了代码，并确认它可以完美运行。初学者可能会注意到，即使在此处发布的任务如此简单的任务中，基本 R 也不像 dplyr 命令链那样“人类可读”。但是，在这个解决方案中还有很多东西需要学习，对此我很感激。

【解决方案3】：

这是一个相对简单的 tidyverse 方法。首先，我们定义一个函数来选择每个组中 reference_day 之前或之后最接近的匹配，然后我们在每种情况下应用它来添加两个新列。我使用side 参数来定义我们是希望在具有负时间差（之前）还是正时间差（之后）的一侧进行匹配。

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

结果

  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>

【讨论】：

我真的很喜欢这个答案，因为它的逻辑对于初学者来说很容易理解。我不是只运行这个函数，而是把它拆开，然后逐行运行。但是，我想到了一个问题：arrange(value) %>% 行的目的是什么？毕竟，这可能是多余的吗？

【解决方案4】：

这是另一个tidyverse 方法：

首先我们计算每个 var 与参考的差异
引入长格式
删除变量名中的diff_
仅使用负值创建辅助列
分组整理
通过重新定义辅助列再次向左和向右标识closest：现在只有正值。
填充两个最近的列以使用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

【讨论】：

又是一个很好的解决方案，并且还可以从这段代码中学到很多东西。该解决方案与其他一些 dplyr/tidyverse 解决方案的不同之处在于，数据是一次性处理的，无需使用自定义函数。当我运行代码时，抛出了一些“没有非缺失参数”[最小/最大]，但这是意料之中的事情。之前我没有意识到您可以在单个 mutate 函数的中间使用“更改开关”（这里：变量“helper”）！