r объединить и создать фрейм данных на основе ограничения по времени

Question

У меня есть набор данных с двумя столбцами, ID и Start_Date, как показано ниже

  ID        Start_Date
  19        2016-11-24
  19        2016-11-26
  3C        2016-01-16
  3C        2016-03-18
  14        2018-03-03
  14        2018-01-19

Второй набор данных, который содержит некоторые случайные данные о покупке для каждого ID в различные даты

  ID      Transaction_Date     Item
  19      2015-10-24           Pop
  19      2015-12-11           Crackers
  19      2017-11-25           Honey  
  19      2018-03-14           PBJ
  19      2018-11-24           Roku_Stick
  19      2019-01-10           Pop
  19      2019-02-15           LipBalm  
  19      2019-03-25           Pop
  3C      2015-04-16           Honey
  3C      2016-02-20           PBJ
  3C      2016-08-04           Crackers
  3C      2019-05-12           Roku_Stick          
  14      2017-07-11           Pop   
  14      2018-09-26           Pop          

Мои намерения

1) Объединить два набора данных с помощью ID, что легко, я знаю, мы можем сделать это, используя функцию merge, df_result <- merge(df1, df2, by = "ID", all = TRUE)

2) Сохранять только строки из 2-го набора данных, которые находятся в пределах 2 лет от Start_Date в 1-м наборе данных для каждого идентификатора.

Что я имею в виду под этим, рассмотрим 1-е наблюдение в наборе данных 1, например ID19 StartDate составляет 2016-10-24.Таким образом, эти строки из 2-го набора данных включены, и эти строки исключены

  ID      Transaction_Date   Item         Status
  19      2015-10-24          Pop         Exclude, because earlier than start date 2016-11-24
  19      2015-10-24          Crackers    Exclude, because earlier than start date 2016-11-24      
  19      2017-11-25         Honey        Include, because transaction occurs after the start date 2016-11-24  and within 2 years of 2016-10-24 
  19      2018-03-14         PBJ          Include, because transaction occurs after the start date 2016-11-24  and within 2 years of 2016-10-24 
  19      2018-11-24         Roku_Stick   Include, because transaction occurs after the start date 2016-11-24  and within 2 years of 2016-10-24 
  19      2019-01-10         Pop          Exclude, because transaction is after 2 years of start date 2016-11-24
  19      2019-02-15         Lip Balm     Exclude, because transaction is after 2 years of start date 2016-11-24 
  19      2019-03-25         Pop          Exclude, because transaction is after 2 years of start date 2016-11-24 

Окончательный ожидаемый набор данных

   ID      Start_Date   Pop   Crackers  Honey  PBJ  Roku_Stick  Lip Balm
   19      2017-11-24   No    Yes       Yes    Yes  Yes         No

Аналогично

   ID      Start_Date   Pop   Crackers  Honey  PBJ  Roku_Stick  LipBalm
   19      2016-11-26   No    Yes       Yes    Yes  Yes         No
   3C      2016-01-16   No    Yes       No     Yes  No          No
   14      2018-03-03   Yes   No        No     No   No          No 
   14      2018-01-19   Yes   No        No     No   No          No 

Я знаю очень долгоспособ сделать это с помощью

merge,

if-else Start_Date +2 <= Transaction_Date, Include, Exclude,

df <- df[ subset(Include),]

df <- long to wide.

IЯ заинтересован в изучении очень эффективного подхода к преобразованию этого набора данных.Любая помощь очень ценится.Заранее спасибо.

######## Воспроизводимые наборы данных

df1 <- structure(list(ID = structure(c(2L, 2L, 3L, 3L, 1L, 1L), .Label = c("14", 
"19", "3c"), class = "factor"), Start_Date = structure(c(3L, 
4L, 1L, 2L, 6L, 5L), .Label = c("2016-01-16", "2016-03-18", "2016-11-24", 
"2016-11-26", "2018-01-19", "2018-03-03"), class = "factor")), .Names = c("ID", 
"Start_Date"), row.names = c(NA, -6L), class = "data.frame")

df2 <- structure(list(ID = structure(c(2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
3L, 3L, 3L, 3L, 1L, 1L), .Label = c("14", "19", "3C"), class = "factor"), 
    Transaction_Date = structure(c(2L, 3L, 7L, 8L, 10L, 11L, 
    12L, 13L, 1L, 4L, 5L, 14L, 6L, 9L), .Label = c("2015-04-16", 
    "2015-10-24", "2015-12-11", "2016-02-20", "2016-08-04", "2017-07-11", 
    "2017-11-25", "2018-03-14", "2018-09-26", "2018-11-24", "2019-01-10", 
    "2019-02-15", "2019-03-25", "2019-05-12"), class = "factor"), 
    Item = structure(c(6L, 1L, 3L, 5L, 7L, 6L, 4L, 6L, 3L, 5L, 
    2L, 7L, 6L, 6L), .Label = c("Crackers", "Crakerss", "Honey", 
    "LipBalm", "PBJ", "Pop", "Roku_Stick"), class = "factor")), .Names = c("ID", 
"Transaction_Date", "Item"), row.names = c(NA, -14L), class = "data.frame")

Answer 1

Вот решение tidyverse.Сначала мы присоединяемся, а затем конвертируем даты в Date объекты.Затем мы применяем два ограничения filter, используя некоторые lubridate инструменты (%m+% years(2)), select столбцы, которые мы хотим сохранить, создаем дополнительный столбец, где все равно TRUE, чтобы у нас было что-то для spread в столбцы для каждого элемента.fill = F заполняет пропущенные значения FALSE вместо NA.

library(lubridate)
library(dplyr)
library(tidyr)

df2 %>% 
  dplyr::left_join(df1, by = "ID") %>% 
  dplyr::mutate(Transaction_Date = as.Date(Transaction_Date),
         Start_Date = as.Date(Start_Date)) %>% 
  dplyr::filter(Transaction_Date < (Start_Date %m+% years(2)) & Transaction_Date >= Start_Date) %>% 
  dplyr::select(ID, Start_Date, Item) %>% 
  dplyr::mutate(ItemTrue = TRUE) %>% 
  tidyr::spread(Item, ItemTrue, fill = F)

  ID Start_Date Crackers Honey   PBJ   Pop Roku_Stick
1 14 2018-01-19    FALSE FALSE FALSE  TRUE      FALSE
2 14 2018-03-03    FALSE FALSE FALSE  TRUE      FALSE
3 19 2016-11-24    FALSE  TRUE  TRUE FALSE      FALSE
4 19 2016-11-26    FALSE  TRUE  TRUE FALSE       TRUE
5 3C 2016-01-16     TRUE FALSE  TRUE FALSE      FALSE
6 3C 2016-03-18     TRUE FALSE FALSE FALSE      FALSE

Данные:

df1 <- read.table(header = TRUE, stringsAsFactors = F, text = "
ID        Start_Date
19        2016-11-24
19        2016-11-26
3C        2016-01-16
3C        2016-03-18
14        2018-03-03
14        2018-01-19")

df2 <- read.table(header = TRUE, stringsAsFactors = F, text = "
ID      Transaction_Date     Item
19      2015-10-24           Pop
19      2015-12-11           Crackers
19      2017-11-25           Honey  
19      2018-03-14           PBJ
19      2018-11-24           Roku_Stick
19      2019-01-10           Pop
19      2019-02-15           LipBalm  
19      2019-03-25           Pop
3C      2015-04-16           Honey
3C      2016-02-20           PBJ
3C      2016-08-04           Crackers
3C      2019-05-12           Roku_Stick          
14      2017-07-11           Pop   
14      2018-09-26           Pop")

Answer 2

Пакет fuzzyjoin создан для удовлетворения этой потребности.Вы можете использовать fuzzy_left_join(), чтобы увидеть совпадения, если вы хотите выделить каждый шаг кода

library(tidyverse)
library(fuzzyjoin)

df_dates <-
  df1 %>% 
  mutate(
    Start_Date = ymd(Start_Date),
    End_Date = Start_Date %m+% years(2),
    Status = "Yes"
  )

df_items <-
  df2 %>% 
  mutate(Transaction_Date = as.Date(Transaction_Date))

fuzzy_join(
  df_items, df_dates,
  by = c("ID" = "ID", 
         "Transaction_Date" = "Start_Date",
         "Transaction_Date" = "End_Date"),
  match_fun = list(`==`, `>=`, `<=`)
) %>%
select(ID = ID.x, Item, Start_Date, Status) %>%
distinct() %>%
spread(Item, Status, fill = "No")

#  ID Start_Date Crackers Honey PBJ Pop Roku_Stick
#1 14 2018-01-19       No    No  No yes         No
#2 14 2018-03-03       No    No  No yes         No
#3 19 2016-11-24       No   Yes Yes  No        Yes
#4 19 2016-11-26       No   Yes Yes  No        Yes
#5 3C 2016-01-16      Yes    No Yes  No         No
#6 3C 2016-03-18      Yes    No  No  No         No