如何在 R 中基于 2 个标准进行左连接/合并：数字匹配和日期范围评估

Question

我有两个数据框：摘要和拖拽。我想在 hauled 中创建一个新列，它根据 2 个匹配条件返回 summary$rfp_id 中的值：

1. 将摘要$company_id 与 hauled$company_id 进行匹配
2. 将hauled$trans_date与summary$start_date和summary$end_date进行比较，并根据以下可能结果的解释返回最接近匹配的rfp_id。

摘要数据框：

rfp_id	开始日期	结束日期	公司_id
1	2022 年 12 月 30 日	2023年2月28日	7
2	2022 年 4 月 1 日	2022 年 6 月 30 日	8
3	2022 年 7 月 1 日	2022 年 8 月 30 日	8
4	2022 年 1 月 16 日	2023 年 1 月 16 日	9
5	2023 年 1 月 1 日	2023 年 2 月 6 日	9

拖运的数据帧（rfp_id = 期望的结果）：

跨#	公司_id	trans_日期	rfp_id
11	7	2023 年 1 月 14 日	1
12	8	2022 年 7 月 2 日	3
13	8	2022 年 3 月 20 日	2
14	8	2022 年 9 月 1 日	3
15	9	2023 年 1 月 15 日	5

第一个示例 (trans# = 11) 返回 rfp_id = 1，因为公司 7 在摘要中仅出现一次，并且 hauled$trans_date 1/14/2023 落在开始/结束日期 12/30/2022 和 2/28/ 之间2023.

第二个示例 (trans# = 12) 返回 rfp_id = 3，因为 7/2/2022 的 trans_date 落在 7/1/2022-8/30/2022 之间（而不是在 4/1/2022-6/30/ 2022）。

第三个示例 (trans# = 13 )返回 rfp_id = 2，因为 3/20/2022 的 trans_date 不在开始/结束日期范围内，但它最接近 4/1/2022 的 start_date

第四个示例 (trans# = 14 ) 返回 rfp_id = 3，因为 9/1/2022 的 trans_date 不在开始/结束日期范围内，但它最接近 8/30/2022 的 end_date。

第五个示例 (trans# = 15) 返回 rfp_id = 5，因为当 trans_date 介于 2 个或更多开始/结束日期范围之间时，要返回的 rfp_id 将以最新 end_date 为准 

我在 R 方面没有很强的背景。我尝试过的大部分内容都来自 chatgpt。它吐出的代码在执行时不断抛出“多对多”错误。

Answer 1

好吧，这可行，但现在还为时过早，我百分百确定有一种更优雅、更省力的方法，我只是还没有看到它。也许喝完咖啡后：

library(tidyverse)
# you can just load the required packages when you streamline this code, but I'm lazy.

# Preparing data from OP
summary_df <- tribble(
  ~rfp_id,  ~start_date,    ~end_date,  ~company_id,
  1,    "12/30/2022",   "2/28/2023",    7,
  2,    "4/1/2022", "6/30/2022",    8,
  3,    "7/1/2022", "8/30/2022",    8,
  4,    "1/16/2022",    "1/16/2023",    9,
  5,    "1/1/2023", "2/6/2023", 9
)

summary_df <- summary_df |> mutate(across(ends_with("_date"), ~ as.Date(.x, format = "%m/%d/%Y")))

hauled_df <- tribble(
  ~trans_no,    ~company_id,    ~trans_date,
  11,   7,  "1/14/2023",
  12,   8,  "7/2/2022",
  13,   8,  "3/20/2022",
  14,   8,  "9/1/2022",
  15,   9,  "1/15/2023",
)

hauled_df$trans_date <- as.Date(hauled_df$trans_date, format = "%m/%d/%Y")

我假设总是至少有一个公司 ID 匹配 - 如果这是错误的，请在此处添加测试。 我还假设，如果在所有范围之外，您想要最近的范围边界（开始或结束）。

hauled_df$rfp_id <- unlist(pmap(.l = hauled_df,
                             .f = \(trans_no,   company_id, trans_date) {
                               com_id = company_id
                               summary_df |>
                                 filter(company_id == com_id) |>
                                 mutate(score = case_when(
                                   trans_date >= start_date & trans_date <= end_date ~ 0,
                                   trans_date < start_date ~ as.integer(start_date - trans_date),
                                   .default = as.integer(trans_date - end_date)
                                 )) |>
                                 filter(score == min(score)) |>
                                 filter(end_date == max(end_date)) |>
                                 select(rfp_id)
                             }
))

输出：

> hauled_df
# A tibble: 5 × 4
  trans_no company_id trans_date rfp_id
     <dbl>      <dbl> <date>      <dbl>
1       11          7 2023-01-14      1
2       12          8 2022-07-02      3
3       13          8 2022-03-20      2
4       14          8 2022-09-01      3
5       15          9 2023-01-15      5

说明：

pmap(.l = hauled_df,

pmap

是并行映射 - 基本上它将函数应用于牵引 df 的每一行，将该行的

trans_no, company_id, trans_date

值输入到函数中：

.f = \(trans_no, company_id, trans_date) {
     com_id = company_id # almost certainly unnecessary
     summary_df |>
     filter(company_id == com_id) |>

复制

summary_df

并过滤掉所有不匹配公司 ID 的行。 然后，我们将对剩余的每一行进行评分 - 越低越好/优先级越高。 在日期范围内得分 0。在日期范围外得分 x，其中 x 是范围边缘之前或之后的天数。

     mutate(score = case_when(
     trans_date >= start_date & trans_date <= end_date ~ 0, # inside the date range
     trans_date < start_date ~ as.integer(start_date - trans_date), # before the date range
     .default = as.integer(trans_date - end_date) # after the date range
                                 )) |>

然后，我们需要首先取最好（最低）的

score

，对最新的

end_date

进行平局，并从剩下的一行中提取

rfp_id

：

                                 filter(score == min(score)) |>
                                 filter(end_date == max(end_date)) |>
                                 select(rfp_id)
                             }