如何按每个 ID 的最近日期合并数据框（和重复值）？

Question

我尝试按日期加入两个数据框（按个人分组）。

我已经制作了两者的示例数据帧（真实的df1是5700行，真实的df2是287行）。

df1 有 ID（包括一些不在 df2 中的）、日期和行为值。

df2 有 ID（尽管比 df1 少）、日期（比 df1 少）和激素值。

我的目标是将给定个体的激素从 df2 中最近的日期匹配到 df1 中的最近日期（尽可能匹配，但只复制 df1 中 df2 的激素值当最近的日期相隔小于或等于 2 天时）。

我希望在新数据框底部打印与日期不匹配的激素，这样它们就不会丢失（df3 中的示例）

df1
ID    Date        behavior
a     1-12-2020   0
b     1-12-2020   1
b     1-13-2020   1
c     1-12-2020   2
d     1-12-2020   0
c     1-13-2020   1
c     1-14-2020   0
c     1-15-2020   1
c     1-16-2020   2

df2
ID    Date        hormone
a     1-10-2020   20
b     1-18-2019   70
c     1-10-2020   80
c     1-16-2020   90

#goal dataframe

df3
ID    Date        behavior hormone
a     1-12-2020   0        20
b     1-12-2020   1        NA [> 2 days from hormone]
b     1-13-2020   1        NA [> 2 days from hormone]
c     1-12-2020   2        80
d     1-12-2020   0        NA [no matching individual in df2]
c     1-13-2020   1        NA [> 2 days from hormone]
c     1-14-2020   0        90
c     1-15-2020   1        90
c     1-16-2020   2        90
b     1-18-2019   NA       70 [unmatched hormone at bottom of df3]

这里是创建这些数据框的代码：

df1 <- data.frame(ID = c("a", "b", "b", "c", "d", "c", "c","c", "c"),
                 date = c("1-12-2020", "1-12-2020", "1-13-2020", "1-12-2020", "1-12-2020","1-13-2020","1-14-2020","1-15-2020","1-16-2020"),
behavior = c(0,1,1,2,0,1,0,1,2) )

df2 <- data.frame(ID = c("a", "b", "c", "c"),
                 date = c("1-10-2020", "1-18-2019", "1-10-2020", "1-16-2020"),
hormone = c(20,70,80,90) )

df1$date<-as.factor(df1$date)
df1$date<-strptime(df1$date,format="%m-%d-%Y")
#for nearest date function to work
df1$date<-as.Date(df1$date,"%m/%d/%y")

df2$date<-as.factor(df2$date)
df2$date<-strptime(df2$date,format="%m-%d-%Y")
#for nearest date function to work
df2$date<-as.Date(df2$date,"%m/%d/%y")

我已经能够使用论坛上一个问题的函数（下面的链接和代码）来匹配最近的日期并重复填写，但我无法限制匹配的时间范围，或者在新行中打印不匹配的日期。有没有办法做到这一点？

这就是我开始工作的基础（代码如下）： How to match by nearest date from two data frames?

# Function to get the index specifying closest or after
Ind_closest_or_after <- function(d1, d2){
  which.min(ifelse(d1 - d2 < 0, Inf, d1 - d2))
}

# Calculate the indices
closest_or_after_ind <- map_int(.x = df1$date, .f = Ind_closest_or_after, d2 = df2$date)

# Add index columns to the data frames and join
df2 <- df2 %>% 
  mutate(ind = 1:nrow(df2))

df1 <- df1 %>% 
  mutate(ind = closest_or_after_ind)

df3<-left_join(df2, df1, by = 'ind')

这个答案似乎最接近但不限制值： Merge two data frames by nearest date and ID

#function to do all but limit dates and print unmatched
library(data.table)
setDT(df2)[, date := date]
df2[df1, on = .(ID, date = date), roll = 'nearest']

Answer 1

您可以通过过滤所有可能的组合来加入表格（使用expand_grid 进行交叉乘积）：

library(tidyverse)
library(lubridate)
#> 
#> Attaching package: 'lubridate'
#> The following objects are masked from 'package:base':
#> 
#>     date, intersect, setdiff, union
df1 <- data.frame(ID = c("a", "b", "b", "c", "d", "c", "c","c", "c"),
                  date = c("1-12-2020", "1-12-2020", "1-13-2020", "1-12-2020", "1-12-2020","1-13-2020","1-14-2020","1-15-2020","1-16-2020"),
                  behavior = c(0,1,1,2,0,1,0,1,2) )

df2 <- data.frame(ID = c("a", "b", "c", "c"),
                  date = c("1-10-2020", "1-18-2019", "1-10-2020", "1-16-2020"),
                  hormone = c(20,70,80,90) )

joined <-
  df1 %>%
  rename_all(~ paste0(., ".1")) %>%
  expand_grid(df2 %>% rename_all(~ paste0(., ".2"))) %>%
  mutate(across(starts_with("date"), ~ .x %>%  parse_date(format = "%m-%d-%Y"))) %>%
  mutate(time_diff = abs(date.1 - date.2)) %>%
  filter(time_diff <= days(2) & ID.1 == ID.2) %>%
  select(ID = ID.1, behavior = behavior.1, hormone = hormone.2)
joined
#> # A tibble: 5 x 3
#>   ID    behavior hormone
#>   <chr>    <dbl>   <dbl>
#> 1 a            0      20
#> 2 c            2      80
#> 3 c            0      90
#> 4 c            1      90
#> 5 c            2      90

df1 %>%
  left_join(joined) %>%
  full_join(df2) %>%
  as_tibble() %>%
  distinct(ID, behavior, .keep_all = TRUE) %>%
  arrange(ID, behavior)
#> Joining, by = c("ID", "behavior")
#> Joining, by = c("ID", "date", "hormone")
#> # A tibble: 9 x 4
#>   ID    date      behavior hormone
#>   <chr> <chr>        <dbl>   <dbl>
#> 1 a     1-12-2020        0      20
#> 2 a     1-10-2020       NA      20
#> 3 b     1-12-2020        1      NA
#> 4 b     1-18-2019       NA      70
#> 5 c     1-14-2020        0      90
#> 6 c     1-13-2020        1      90
#> 7 c     1-12-2020        2      80
#> 8 c     1-10-2020       NA      80
#> 9 d     1-12-2020        0      NA

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

这将为每个（ID、行为）对生成一行。您可以替换它，例如ID, date 在任何给定时间点对于每个 ID 只有一个时间点。