Блог

Главная - Вопросы по программированию - Объедините два фрейма данных на основе ближайшей даты, если они находятся в определенной близости друг от друга

Объедините два фрейма данных на основе ближайшей даты, если они находятся в определенной близости друг от друга

#r #date #join #merge #data.table

Вопрос:

Я хотел бы объединить два фрейма данных (df1 и df2) на основе ближайшей даты, но только в том случае, если даты из двух фреймов данных находятся в пределах 3 месяцев друг от друга.

Я хотел бы «полностью соединить» два фрейма данных (т. Е. Включить все строки как из df1, так и из df2).

Кроме того, я не хочу, чтобы строка дублировалась из одного фрейма данных, если в другом фрейме данных в течение 3-месячного окна имеется несколько строк.

Как бы я хотел, чтобы данные выглядели

См. также df3 в ПРИМЕРЕ ДАННЫХ.

 ID  Date.df1     Date.df2   V1_df1  V2_df1  V1_df2   V2_df2
100    NA       07/11/2015    NA      NA      93.3    93.3
100 01/11/2015  03/11/2015    9.3    10.6     93.3    95.5
100 23/12/2016  27/12/2016     8     10.3     97.78   97.78
100 04/11/2017  13/11/2017    9.3     11      98.9    98.89
100 09/11/2018      NA       10.3    9.6       NA     NA
101 07/11/2015  07/11/2015     7     6.6      97.78   97.78
101 21/01/2017  19/12/2016     6     7.3      95.7    95.5
101 18/11/2017      NA        7.6    6.6       NA     NA
101 22/01/2019      NA        6.5     7        NA     NA
102 27/09/2017  26/08/2017     5      7       94.8    94.8
102 01/10/2018      NA        8.6    7.3       NA      NA
102 15/09/2019      NA         9      8        NA      NA
103     NA      14/11/2015     NA     NA      97.7     97

Что я пробовал

Я попробовал следующее (основываясь на ответе crestor ниже), но когда я запускаю его с моими полными наборами данных, некоторые строки не включаются. Я думаю, что для строк во фрейме данных, когда есть соответствующие данные в другом наборе данных, но это превышает три месяца… Как это можно преодолеть?

 df1 %>%
  full_join(df2, by = "ID") %>%
  mutate(diff = abs(Date.df2 - Date.df1)) %>%
  filter(
    (!is.na(Date.df2) amp;
      (is.na(Date.df1) | (diff < months(3)))) |
    (!is.na(Date.df1) amp;
      (is.na(Date.df2) | (diff < months(3))))  
  ) %>%
  arrange(ID, Date.df1, Date.df2) %>%
  group_by(ID, Date.df1) %>%
  filter(row_number() == 1) %>%
  ungroup()

Я также попробовал ниже, но не уверен, как это изменить, чтобы строки соединялись только в том случае, если они находятся в течение трех месяцев друг от друга.

 library(data.table)

# coerce to data.table and append join columns to preserve the original columns 
setDT(df1)[, join_date := Date.df1]
setDT(df2)[, join_date := Date.df2]

# rolling join, ordered by ID and date
df1[df2, on = .(ID, join_date), roll = "nearest"] [order(ID, join_date)]

Приведенный выше код выдает этот вывод:

 ID  Date.df1    V1_df1  V2_df1  join_date   Date.df2    V1_df2  V2_df2
100 01/11/2015  9.3      10.6   03/11/2015  03/11/2015  93.3    95.5
100 01/11/2015  9.3      10.6   07/11/2015  07/11/2015  93.3    93.3
100 23/12/2016  8        10.3   27/12/2016  27/12/2016  97.78   97.78
100 04/11/2017  9.3       11    13/11/2017  13/11/2017  98.9    98.89
101 07/11/2015  7         6.6   07/11/2015  07/11/2015  97.78   97.78
101 21/01/2017  6         7.3   19/12/2016  19/12/2016  95.7    95.5
102 27/09/2017  5          7    26/08/2017  26/08/2017  94.8    94.8
103     NA      NA        NA    14/11/2015  14/11/2015  97.7    97

ПРИМЕРЫ ДАННЫХ

 
df1 <- structure(list(ID = c(100L, 100L, 100L, 100L, 101L, 101L, 101L, 
101L, 102L, 102L, 102L), Date.df1 = structure(c(16740, 17158, 
17474, 17844, 16746, 17187, 17488, 17918, 17436, 17805, 18154
), class = "Date"), V1_df1 = c(9.3, 8, 9.3, 10.3, 7, 6, 7.6, 
6.5, 5, 8.6, 9), V2_df1 = c(10.6, 10.3, 11, 9.6, 6.6, 7.3, 6.6, 
7, 7, 7.3, 8)), row.names = c(NA, -11L), class = "data.frame")

df2 <- structure(list(ID = c(100L, 100L, 100L, 100L, 101L, 101L, 102L, 
103L), Date.df2 = structure(c(16742, 16746, 17162, 17483, 16746, 
17154, 17404, 16753), class = "Date"), V1_df2 = c(93.3, 93.3, 
97.78, 98.9, 97.78, 95.7, 94.8, 97.7), V2_df2 = c(95.5, 93.3, 
97.78, 98.89, 97.78, 95.5, 94.8, 97)), row.names = c(NA, -8L), class = "data.frame")

Ответ №1:

Что-то похожее на это:

 library(lubridate)
library(tidyverse)


df1 <- df1 %>%
  as_tibble() %>%
  mutate(across(starts_with("Date."), dmy))
df2 <- df2 %>%
  as_tibble() %>%
  mutate(across(starts_with("Date."), dmy))
df3 <- df3 %>%
  as_tibble() %>%
  mutate(across(starts_with("Date."), dmy)) %>%
  arrange(ID, Date.df1, Date.df2)

df1 %>%
  left_join(df2, by = "ID") %>%
  mutate(diff = abs(Date.df2 - Date.df1)) %>%
  filter(
    !is.na(Date.df2) amp;
      (is.na(Date.df1) | (diff < months(3)))
  ) %>%
  arrange(ID, Date.df1, Date.df2) %>%
  group_by(ID, Date.df1) %>%
  filter(row_number() == 1) %>%
  ungroup()
#> # A tibble: 8 x 8
#>      ID Date.df1   V1_df1 V2_df1 Date.df2   V1_df2 V2_df2 diff   
#>   <int> <date>      <dbl>  <dbl> <date>      <dbl>  <dbl> <drtn> 
#> 1   100 2015-11-01    9.3   10.6 2015-11-03   93.3   95.5  2 days
#> 2   100 2016-12-23    8     10.3 2016-12-27   97.8   97.8  4 days
#> 3   100 2017-11-04    9.3   11   2017-11-13   98.9   98.9  9 days
#> 4   100 NA           NA     NA   2015-11-03   93.3   95.5 NA days
#> 5   101 2015-11-07    7      6.6 2015-11-07   97.8   97.8  0 days
#> 6   101 2017-01-21    6      7.3 2016-12-19   95.7   95.5 33 days
#> 7   102 NA            5      7   2017-08-26   94.8   94.8 NA days
#> 8   103 NA           NA     NA   2015-11-14   97.7   97   NA days

Комментарии:

1. Спасибо за все вышесказанное. Я хочу включить все строки из df1 и df2 (я обновил вопрос, чтобы сделать его более понятным после вашего ответа). Используя предложенный вами код, я отредактировал left_join до full_join, а также обновил фильтр, однако не все строки включены (см. Мой отредактированный код, о котором идет речь выше).

2. Спецификации не соответствуют результату примера «df3». Если вы притворяетесь, что получили разумное предложение, вам нужно построить правильный пример.

Ответ №2:

Вероятно, есть более краткий способ сделать это, но ниже дан ответ на мой вопрос. Об этом сообщил ответ от крестора.

 library(lubridate)
library(tidyverse)

# dates in date format
df1$Date.df1 <- as.Date(df1$Date.df1, "%d/%m/%Y")
df2$Date.df2 <- as.Date(df2$Date.df2, "%d/%m/%Y")


#join rows in df1 and df2 that are nearest in submission date and within two months of each other
df1 <- df1 %>%
  as_tibble() %>%
  mutate(across(starts_with("Date."), ymd))

df2 <- df2 %>%
  as_tibble() %>%
  mutate(across(starts_with("Date."), ymd))

df_join <- df1 %>%
  inner_join(df2, by = "ID") %>%
  mutate(timediffvar = abs(time_length(difftime(Date.df1, Date.df2),"months"))) %>%
  filter(
    (timediffvar <= 3)
  ) %>%
  arrange(timediffvar) %>%
  group_by(ID, Date.df1) %>%
  filter(row_number() == 1) %>%
  ungroup() %>%
  arrange(timediffvar) %>%
  group_by(ID, Date.df2) %>%
  filter(row_number() == 1) %>%
  ungroup() 

# identify entries not in the joined above
df1_notjoined <- anti_join(df1, df_join, by=c("ID", "Date.df1"))
df2_notjoined <- anti_join(df2, df_join, by=c("ID", "Date.df2"))


# join all entries together
mergevars_df1 <- names(df1)
mergevars_df2 <- names(df2)

df3  <- df_join %>%
                  full_join(df1_notjoined,  by = mergevars_df1) %>%
                  full_join(df2_notjoined,  by = mergevars_df2) %>%
                  arrange(ID, Date.df1, Date.df2) %>%
                  select("ID", "Date.df1", "Date.df2", "V1_df1","V2_df1","V1_df2","V2_df2")
Метки: ,