在R中按时间范围合并两个数据帧答案

【问题标题】：Merging two data frames by time range in R在R中按时间范围合并两个数据帧
【发布时间】：2020-10-26 15:18:55
【问题描述】：

我正在处理牛的生育数据。在一个表（数据框）中，我所拥有的是记录在一头奶牛身上进行的所有服务（如授精）。在另一张表中，我得到了妊娠诊断（阳性或阴性）。两者都有一个唯一的 ID (animal_id)。我的挑战是成功地将两个表合并到正确的数据范围内，这意味着我需要的是与正确的授精记录相关的妊娠检查。这是两个表的外观示例，

animal_id     service_date
610710        2005-10-22
610710        2006-12-03
610710        2006-12-27
610710        2007-12-02
610710        2008-01-17
610710        2008-03-04

另一张表相同，但日期（event_date）和诊断不同，

 animal_id     event_date        event_description
    610710     2006-06-16           PP
    610710     2007-02-15           PP
    610710     2008-01-09           PN
    610710     2008-04-09           PP
    610710     2009-06-16           PP

所以我想做的是以日期互补的方式合并两个表，这意味着如果在 2005 年 10 月 12 日执行服务，当我加入两个表时，该行将链接到最近的日期事件表，最接近的意思是稍后 - 因为授精发生在诊断之前。所以想要的输出应该是这样的，

    animal_id    service_date       event_date     event_description
 1   610710       2005-10-22              NA               NA
 2   610710           NA              2006-06-16           PP
 3   610710       2006-12-03          2007-02-15           PP
 4   610710       2006-12-27          2007-02-15           PP
 5   610710       2007-12-02          2008-01-09           PN
 6   610710       2008-01-17          2008-04-09           PP
 7   610710       2008-03-04              NA               NA  
 8   610710           NA              2009-06-16           PP

在最终输出中，我希望大量记录不会与任何内容合并，例如示例输出中的第 1 行。 2005 年 10 月进行了一次服务，但我对那头牛的第一次诊断是在 2006 年 6 月 - 可能缺少一些服务记录。不幸的是，这是可以预料的。对于此示例，只有第 5 行和第 6 行有意义。对于第 3 行和第 4 行，我只考虑第 4 行，因为这可能是导致怀孕的授精。

这在 R 中是否可行？

谢谢！

【问题讨论】：

您也可以共享来自事件数据框的数据吗？还有什么是合并应该发生的日期范围？
嗨@KarthikS，感谢您的评论。我也添加了来自事件的数据。日期范围的棘手之处在于它是“灵活的”（至少可以这么说）...... service_date 之后 60 天之内的任何事情都是相当大的
为清楚起见，如果您为此示例数据提供了预期的输出，将会有所帮助。谢谢！（预先，我怀疑这最好使用以下之一来完成：data.table、SQL/sqldf 或 fuzzyjoin。）
嗨@r2evans，感谢您的评论。我添加了一个示例输出和一些额外的信息，希望这会有所帮助。谢谢！
为什么 2006-06-16 event_date 与 2005-10-22 service_date 不匹配？

标签： r date-range

【解决方案1】：

您要求的是“非 equi”或“范围”连接。 Base R（或dplyr，缺少dbplyr）不支持此功能，但可以使用其他一些包来完成。

总的来说，我创建了event_date_lag，以便我们限制每行的返回数量。（没有它，我们会得到多个匹配项。）

模糊连接

out <- fuzzyjoin::fuzzy_full_join(
  services, events,
  by = c("animal_id" = "animal_id",
         "service_date" = "event_date_lag",
         "service_date" = "event_date"),
  match_fun = list(`==`, `>=`, `<=`))
# not sure why fuzzyjoin is splitting animal_id
out <- transform(out, animal_id = ifelse(is.na(animal_id.x), animal_id.y, animal_id.x))
out$animal_id.x <- out$animal_id.y <- out$event_date_lag <- NULL
# ordering here primarily to compare with your desired output
out[with(out, order(ifelse(is.na(service_date), event_date, service_date))),]
#   service_date event_date event_description animal_id
# 6   2005-10-22       <NA>              <NA>    610710
# 7         <NA> 2006-06-16                PP    610710
# 1   2006-12-03 2007-02-15                PP    610710
# 2   2006-12-27 2007-02-15                PP    610710
# 3   2007-12-02 2008-01-09                PN    610710
# 4   2008-01-17 2008-04-09                PP    610710
# 5   2008-03-04 2008-04-09                PP    610710
# 8         <NA> 2009-06-16                PP    610710

sqldf

SQL 通常支持非相等或范围连接的概念。 sqldf 包没有什么特别之处，只是它提供了原生 SQL 体验（通过 RSQLite），没有将数据上传到 SQL DBMS 并在此查询中将其拉回的开销或麻烦。虽然 sqldf 确实发生了这种情况，但它自动化了大部分工作，允许使用 SQL 直接处理 R 对象。

如果碰巧您已经从 DBMS 获取数据，那么 SQL 连接是迄今为止最有效的：从源头连接。

sqldf::sqldf(
  "select svc.animal_id, svc.service_date,
     ev.event_date, ev.event_description
   from services svc
     left join events ev on svc.animal_id=ev.animal_id
       and svc.service_date between ev.event_date_lag and ev.event_date
   order by svc.service_date, ev.event_date")
#   animal_id service_date event_date event_description
# 1    610710   2005-10-22       <NA>              <NA>
# 2    610710   2006-12-03 2007-02-15                PP
# 3    610710   2006-12-27 2007-02-15                PP
# 4    610710   2007-12-02 2008-01-09                PN
# 5    610710   2008-01-17 2008-04-09                PP
# 6    610710   2008-03-04 2008-04-09                PP

数据表

虽然我经常使用它，但如果你还没有使用它，那么它可能比你需要的多一点（它的学习曲线虽然值得，但可能很陡峭）。

注意事项：

data.table-semantics（Y[X]，实际上是“X 左连接 Y”）支持内连接、左连接和右连接，但不支持全连接、半连接或反连接。虽然使用交叉连接（笛卡尔积）可能是可能的，但这会增加内存使用量并且（imo）不是最好的方法。
连接倾向于将左侧（Y[X] 中的X）变量重命名为右侧的变量。这可能会造成混淆，实际上它会掩盖实际的合并前值，因此我将复制 service_date 以使其分开。
我在这里使用as.data.table 只是为了得到答案，而不是因为需要区分data.frame 和data.table 变量。如果您要切换到data.table，那么setDT 是最佳选择。
如果您选择此选项但不继续其他data.table 操作，请确保使用setDF 或as.data.frame 转换回正常的data.frame；有足够的细微差别，不这样做将是一个问题。

library(data.table)
svcDT <- as.data.table(services)
evDT <- as.data.table(events)
evDT[svcDT[,sdate:=service_date],
     on = .(animal_id == animal_id, event_date_lag <= sdate, event_date >= sdate)
     ][, event_date_lag := NULL ]
#    animal_id event_date event_description service_date
# 1:    610710 2005-10-22              <NA>   2005-10-22
# 2:    610710 2006-12-03                PP   2006-12-03
# 3:    610710 2006-12-27                PP   2006-12-27
# 4:    610710 2007-12-02                PN   2007-12-02
# 5:    610710 2008-01-17                PP   2008-01-17
# 6:    610710 2008-03-04                PP   2008-03-04

数据

services <- read.table(header = TRUE, text = "
animal_id     service_date
610710        2005-10-22
610710        2006-12-03
610710        2006-12-27
610710        2007-12-02
610710        2008-01-17
610710        2008-03-04")
services$service_date <- as.Date(services$service_date)

events <- read.table(header = TRUE, text = "
 animal_id     event_date        event_description
    610710     2006-06-16           PP
    610710     2007-02-15           PP
    610710     2008-01-09           PN
    610710     2008-04-09           PP
    610710     2009-06-16           PP")
events$event_date <- as.Date(events$event_date)
events$event_date_lag <- ave(events$event_date, events$animal_id, FUN=function(a) c(a[1][NA], a[-length(a)]))
events
#   animal_id event_date event_description event_date_lag
# 1    610710 2006-06-16                PP           <NA>
# 2    610710 2007-02-15                PP     2006-06-16
# 3    610710 2008-01-09                PN     2007-02-15
# 4    610710 2008-04-09                PP     2008-01-09
# 5    610710 2009-06-16                PP     2008-04-09

【讨论】：

非常感谢您的选择和帮助。不幸的是，他们都没有工作。这些问题很可能在我这边（抱歉，我不是经验丰富的 R 用户）。模糊连接选项因“错误：向量内存耗尽（达到限制？）而崩溃 - 数据集非常大。sqldf 选项失败，因为我无法正确加载包（xcrun 问题，也试图解决这个问题）。data.table 没有'不输出到任何东西。它运行，不抱怨，但它不产生输出。一旦我解决了问题，我会更新你。谢谢你的帮助！

【解决方案2】：

使用末尾注释中可重复显示的输入，使用rbind_rows 将它们绑定在一起，然后使用arrange 按日期对它们进行排序。然后定义逻辑列collapse，如果当前行有service_date，下一行有event_date，并且它们之间的间隔小于或等于90 天，则为TRUE——将90 更改为您想要的任何值。然后按animal_id 分组，每次遇到service_date 时，组号增加1，并进一步按行分组，除非当前行的collapse 等于TRUE，然后将其放在与下一行相同的组中以便它与下一行的event_date 匹配。最后汇总组并删除临时列。

请注意，这种方法会维护没有对应服务日期的事件行，并确保每个事件日期不匹配多个服务日期。

library(dplyr)

bind_rows(DF1, DF2) %>%
  arrange(coalesce(service_date, event_date)) %>%
  group_by(animal_id, group = cumsum(!is.na(service_date))) %>%
  mutate(collapse = !is.na(service_date) & !is.na(lead(event_date)) & 
       lead(event_date) - service_date <= 90) %>%
  group_by(n = 1:n() + collapse, .add = TRUE) %>%
  summarize(animal_id = first(animal_id), 
    service_date = first(service_date), 
    event_date = last(event_date), 
    event_description = last(event_description), .groups = "drop") %>%
  select(-group, -n)

给予：

# A tibble: 8 x 4
  animal_id service_date event_date event_description
      <int> <date>       <date>     <chr>            
1    610710 2005-10-22   NA         <NA>             
2    610710 NA           2006-06-16 PP               
3    610710 2006-12-03   NA         <NA>             
4    610710 2006-12-27   2007-02-15 PP               
5    610710 2007-12-02   2008-01-09 PN               
6    610710 2008-01-17   NA         <NA>             
7    610710 2008-03-04   2008-04-09 PP               
8    610710 NA           2009-06-16 PP

sqldf

我们可以使用 sqldf 包遵循几乎相同的逻辑：

library(sqldf)

sqldf("with b0 as 
        (select *, NULL event_date, NULL event_description from DF1 
        union 
        select animal_id, NULL service_date, event_date, event_description from DF2),
       b1 as (select *, coalesce(service_date, event_date) date1 
           from both order by animal_id, date1),
       b2 as (select *, lead(event_date) over () lead_event_date 
               from b1),
       b3 as (select *, coalesce(lead_event_date - service_date <= 90, 0) + 
                  row_number() over () coll 
                from b2)
      select distinct animal_id,
             group_concat(service_date) service_date, 
             group_concat(event_date) event_date, 
             group_concat(event_description) event_description 
        from b3 group by coll")

给予：

  animal_id service_date event_date event_description
1    610710   2005-10-22       <NA>              <NA>
2    610710         <NA> 2006-06-16                PP
3    610710   2006-12-03       <NA>              <NA>
4    610710   2006-12-27 2007-02-15                PP
5    610710   2007-12-02 2008-01-09                PN
6    610710   2008-01-17       <NA>              <NA>
7    610710   2008-03-04 2008-04-09                PP
8    610710         <NA> 2009-06-16                PP

注意

DF1 <- structure(list(animal_id = c(610710L, 610710L, 610710L, 610710L, 
610710L, 610710L), service_date = structure(c(13078, 13485, 13509, 
13849, 13895, 13942), class = "Date")), row.names = c(NA, -6L
), class = "data.frame")

DF2 <- structure(list(animal_id = c(610710L, 610710L, 610710L, 610710L, 
610710L), event_date = structure(c(13315, 13559, 13887, 13978, 
14411), class = "Date"), event_description = c("PP", "PP", "PN", 
"PP", "PP")), row.names = c(NA, -5L), class = "data.frame")

【讨论】：

非常感谢您的帮助和cmets！我无法尝试 sqldf 选项，因为我在加载该包时遇到问题（使用 xcrun，试图解决该问题），但第一个选项并没有给我与你相同的输出。不知道为什么。我没有得到匹配的日期，而是每个 service_date 得到一行，每个 events_date 得到一行。我正在调查它，一旦我找出问题所在，我会更新你，只是想感谢你的帮助！
复制最后Note中的输入，粘贴到R中，然后运行body中的代码。请注意，日期属于 Note 中的 Date 类。由于问题没有以可重现的形式提供输入，我们无法判断您有什么。如果您无法安装 sqldf，那么您的 R 安装可能有问题。如果您使用的是没有 tcltk 的非标准构建，这可能是个问题。