Как сравнить две строки дат в R и преобразовать в одну строку

Question

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

• Если интервалы перекрываются, оставьте одну строку с самой ранней и самой поздней датами четырех значений
• Если интервалы не совпадают перекрываются, но время между интервалами меньше или равно 60 дням, сделайте то же, что и выше: таким образом, сохраните одну строку с самой ранней и последней датами из четырех значений
• Если интервалы не перекрываются, и время между интервалами больше 60 дней, ничего не делать (сохранить обе строки)

Данные:

names <- c("John", "John", "Rick", "Rick", "Katie", "Katie", "Harry", "Harry" )
date1 <- c("1-3-2016", "18-5-2016", "13-1-2018", "4-2-2020", "5-1-2019", "29-1-2020", "27-8-2018", "4-2-2020")
date2 <- c("16-4-2020", "13-2-2020", "2-3-2020", "16-2-2020", "25-2-2020", "10-4-2020", "27-6-2019", "8-4-2020")
df1 <- data.frame(names,date1,date2)

Желаемый результат:

names <- c("John", "Rick", "Katie", "Harry", "Harry")
date1 <- c("1-3-2016", "13-1-2018", "5-1-2019", "27-8-2018", "4-2-2020")
date2 <- c("16-4-2020", "16-4-2020", "10-4-2020", "27-6-2019", "8-4-2020")
df2 <- data.frame(names,date1,date2)

Преобразование даты:

df1$date1 <- as.Date(df1$date1, "%d-%m-%Y")
df1$date2 <- as.Date(df1$date2, "%d-%m-%Y")

Answer 1

Я использовал слегка измененные образцы данных, чтобы убедиться, что интервалы, которые находятся на расстоянии <= 60 дней друг от друга, объединяются, как описано в вопросе .. </p>

образец данных

names <- c("John", "John", "Rick", "Rick", "Katie", "Katie", "Harry", "Harry" )
date1 <- c("1-3-2016", "28-4-2020", "13-1-2018", "4-2-2020", "5-1-2019", "29-1-2020", "27-8-2018", "4-2-2020")
date2 <- c("16-4-2020", "28-5-2020", "2-3-2020", "16-2-2020", "25-2-2020", "10-4-2020", "27-6-2019", "8-4-2020")
df1 <- data.frame(names,date1,date2)

  names     date1     date2
1  John  1-3-2016 16-4-2020
2  John 28-4-2020 28-5-2020 # !! <-- altered so interval-gap with line 1 <= 60 days
3  Rick 13-1-2018  2-3-2020
4  Rick  4-2-2020 16-2-2020
5 Katie  5-1-2019 25-2-2020
6 Katie 29-1-2020 10-4-2020
7 Harry 27-8-2018 27-6-2019
8 Harry  4-2-2020  8-4-2020

names <- c("John", "Rick", "Katie", "Harry", "Harry")
date1 <- c("1-3-2016", "13-1-2018", "5-1-2019", "27-8-2018", "4-2-2020")
date2 <- c("28-5-2020", "2-3-2020", "10-4-2020", "27-6-2019", "8-4-2020")
df2 <- data.frame(names,date1,date2)

  names     date1     date2
1  John  1-3-2016 28-5-2020  # !! <-- joined, since gap <= 60 days
2  Rick 13-1-2018  2-3-2020  # !! <-- fixed type in your sample data provided
3 Katie  5-1-2019 10-4-2020
4 Harry 27-8-2018 27-6-2019
5 Harry  4-2-2020  8-4-2020

код

В коде используются пакеты data.table и intervals. Поскольку intervals работает только с числовыми c (целыми или действительными) интервалами, столбцы даты преобразуются в числовые c перед созданием / расширением / -слиянием интервалов и возвращаются в формат даты после обработки.

Что делает код ниже:

1. L oop (lapply() по частям разделения (с использованием data.table::split() с by-argument., По имени. keep.by = FALSE используется, поскольку он нам не нужен, и имя также сохраняется в именах созданного списка.
2. Для каждого cunck (= name) определяет интервалы на основе двух столбцов даты, и расширить эти интервалы на половину значения переменной gap (в приведенном ниже коде установлено значение 60). Таким образом, каждый интервал увеличивается на 30 дней до и после. Затем он объединяет перекрывающиеся / соприкасающиеся (расширенные) интервалы и, наконец, удаляет расширения.
3. Используйте data.table::rbindlist(), чтобы объединить все результаты вместе.
4. установить имена столбцов и преобразовать числа c значения относятся к формату данных

.

library( data.table )
library( intervals )
#set maximum gap between intervals
gap = 60
#set data to data.table format
setDT(df1)
#set dates to numeric (required by the intervals-package)
df1[, c("date1", "date2") := lapply( .SD, as.numeric ), .SDcols = c("date1", "date2") ]
#where the magic happens (see text above for explanation )
ans <- data.table::rbindlist(
  lapply( split( df1 , by = "names", keep.by = FALSE ), function(x) {
    as.data.table(
    intervals::close_intervals( intervals::contract( intervals::reduce( intervals::expand( 
            intervals::Intervals( x, type = "Z" ), 
            gap/2 ) ), gap/2 ) 
      )
    )
  }),
  use.names = TRUE, idcol = "name" )
#use names from df1
setnames( ans, names(ans), names(df1) )
#set numeric back to date
ans[, c("date1", "date2") := lapply( .SD, as.Date, origin = "1970-01-01" ), .SDcols = c("date1", "date2") ]

вывод

   names      date1      date2
1:  John 2016-03-01 2020-05-28
2:  Rick 2018-01-13 2020-03-02
3: Katie 2019-01-05 2020-04-10
4: Harry 2018-08-27 2019-06-27
5: Harry 2020-02-04 2020-04-08

Answer 2

Вот один из способов (вероятно, не самый краткий) с использованием dplyr. Сначала мы конвертируем даты в формат Date, затем для каждого имени

1. выясняем, начинается ли второй интервал более чем через 60 дней после первого. Если это так, мы помечаем обе строки как keep_both. Мы отсортировали даты, чтобы знать, что вторая строка появится позже.
2. для строк, которые не отмечены keep_both, получите минимальную и максимальную даты. Обратите внимание, что я предполагаю, что интервалы расположены в правильном порядке, т.е. date2 позже, чем date1 в каждой строке здесь.
3. фильтруйте данные, чтобы сохранить только первую строку от каждого имени, если мы не сохраняя оба.

Результат соответствует желаемому результату, за исключением опечатки на Рике.

names <- c("John", "John", "Rick", "Rick", "Katie", "Katie", "Harry", "Harry")
date1 <- c("1-3-2016", "18-5-2016", "13-1-2018", "4-2-2020", "5-1-2019", "29-1-2020", "27-8-2018", "4-2-2020")
date2 <- c("16-4-2020", "13-2-2020", "2-3-2020", "16-2-2020", "25-2-2020", "10-4-2020", "27-6-2019", "8-4-2020")
df1 <- data.frame(names, date1, date2)

library(tidyverse)

df1 %>%
  mutate(across(c(date1, date2), lubridate::dmy)) %>%
  arrange(names, date1, date2) %>%
  group_by(names) %>%
  mutate(
    keep_both = any((date1 - lag(date2)) > 60, na.rm = TRUE),
    new_date1 = if_else(keep_both, date1, min(date1)),
    new_date2 = if_else(keep_both, date2, max(date2)),
  ) %>%
  filter(keep_both | row_number() == 1) %>%
  select(names, date1 = new_date1, date2 = new_date2)
#> # A tibble: 5 x 3
#> # Groups:   names [4]
#>   names date1      date2     
#>   <chr> <date>     <date>    
#> 1 Harry 2018-08-27 2019-06-27
#> 2 Harry 2020-02-04 2020-04-08
#> 3 John  2016-03-01 2020-04-16
#> 4 Katie 2019-01-05 2020-04-10
#> 5 Rick  2018-01-13 2020-03-02

^{Создано 13.07.2020 пакетом REPEX (v0.3.0)}