Объединение двух фреймов данных по временному диапазону в R

ProgramBox

Объединение двух фреймов данных по временному диапазону в R

Post author:admin
Запись опубликована:26 февраля, 2023
Post category:Вопросы по программированию

#r #date-range

#r #диапазон дат

Вопрос:

Я работаю с данными о фертильности крупного рогатого скота. В одной таблице (фрейме данных) у меня есть запись всех услуг, выполненных в корове (например, осеменения). В другой таблице я получаю диагноз беременности (положительный или отрицательный). Оба имеют уникальный идентификатор (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 года была проведена служба, но первый диагноз, который я поставил для этой коровы, был поставлен в июне 2006 года — вероятно, отсутствует ряд записей об обслуживании. К сожалению, этого следовало ожидать. Для этого примера имеют смысл только строки 5 и 6. Для строк 3 и 4 я бы рассмотрел только строку 4, поскольку это, вероятно, оплодотворение, которое привело к беременности.

Возможно ли это вообще в R?

Спасибо!

1. Можете ли вы также обмениваться данными из events dataframe? Также, каков диапазон дат, в пределах которого должно произойти слияние?

2. Привет @KarthikS, спасибо за ваш комментарий. Я также добавил данные из событий. Сложность диапазона дат заключается в том, что он «гибкий» (если не сказать больше)….. Все, что происходит до 60 дней после service_date, было бы значительным

3. Для ясности было бы полезно, если бы вы предоставили ожидаемый результат для этого образца данных. Спасибо! (Я подозреваю, что лучше всего это будет сделано с помощью одного из: data.table , SQL/ sqldf , или fuzzyjoin .)

4. Привет @r2evans, спасибо за ваш комментарий. Я добавил пример выходных данных и некоторую дополнительную информацию, надеюсь, это будет полезно. Спасибо!

5. Почему fhe 2006-06-16 event_date не сопоставляется с service_date 2005-10-22?

Ответ №1:

То, что вы запрашиваете, — это соединение «неравномерное» или «диапазон». Это не поддерживается базовым R (или dplyr отсутствует dbplyr ), но может быть выполнено с некоторыми другими пакетами.

Для всех я создаю event_date_lag так, чтобы мы ограничивали количество возвратов для каждой строки. (Без этого мы получили бы несколько совпадений.)

fuzzyjoin

 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 (via RSQLite ) без накладных расходов или хлопот, связанных с загрузкой ваших данных в СУБД SQL и извлечением их обратно в этом запросе. Хотя это на самом деле то, что происходит с sqldf , это автоматизирует большую часть этого, позволяя работать непосредственно с объектами R с использованием SQL.

Если случайно вы уже получаете свои данные из СУБД, то соединение 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 -( Y[X] , которая фактически является «X left join Y») поддерживает внутренние, левые и правые, но не полные, полу- или антисоединения. Хотя это может быть возможно с использованием перекрестного соединения (декартова произведения), это приводит к резкому увеличению использования памяти и является (imo) не лучшим способом.
объединение имеет тенденцию переименовывать переменные левой стороны ( X in Y[X] ) в переменные справа. Это может сбить с толку, и фактически это может замаскировать фактические значения перед слиянием, поэтому я продублирую service_date , чтобы сохранить их отдельно.
Я использую as.data.table здесь только для ответа SO, а не потому, что требуется различать data.frame data.table переменные и . Если вы переключаетесь на data.table , то setDT это канонический путь.
Если вы выберете это, но не продолжите другие data.table операции, убедитесь, что вы преобразовали обратно в обычный data.frame режим, используя setDF или as.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

1. Большое вам спасибо за варианты и за вашу помощь. К сожалению, ни один из них не сработал. Проблемы, скорее всего, с моей стороны (извините за это, я не опытный пользователь R). Опция fuzzyjoin завершается сбоем с ошибкой «Ошибка: векторная память исчерпана (достигнут предел?) — наборы данных очень большие. Параметры sqldf не работают, потому что я не могу правильно загрузить пакет (проблема с xcrun, также пытаюсь решить эту проблему). data.table ни во что не выводится. Он запускается, не жалуется, но не генерирует выходные данные. Я обновлю вас, как только устраню проблемы. Спасибо за вашу помощь!

Ответ №2:

Используя входные данные, воспроизводимые в примечании в конце, свяжите их вместе, используя rbind_rows , а затем отсортируйте их по дате, используя arrange . Затем определите логический столбец collapse , который является ИСТИННЫМ, если текущая строка имеет a service_date , а следующая строка имеет an event_date , и они разделены меньше или равны 90 дням — измените 90 на то, что вы хотите. Затем группируйте по animal_id и номер группы, который увеличивается на 1 каждый раз service_date , когда встречается a, и далее группируйте по строкам, за исключением случаев, когда текущая строка имеет 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) amp; !is.na(lead(event_date)) amp; 
       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")

1. Большое вам спасибо за вашу помощь и комментарии! Я не смог попробовать опцию sqldf, потому что у меня возникли проблемы с загрузкой этого пакета (с помощью xcrun, пытаясь решить эту проблему), но первый вариант не дает мне того же результата, что и у вас.. Не уверен, почему. Я не получаю совпадающих дат, вместо этого я получаю одну строку для service_date и одну строку для events_date. Я изучаю это и обновлю вас, как только выясню, что не так, просто хотел поблагодарить вас за вашу помощь!

2. Скопируйте входные данные из примечания в конце, вставьте их в R, а затем запустите код в теле. Имейте в виду, что даты относятся к классу Date в Примечании. Мы не можем сказать, что у вас есть, поскольку вопрос не предоставил входные данные в воспроизводимой форме. Если вы не можете установить sqldf, то, вероятно, что-то не так с вашей установкой R. Если вы используете нестандартную сборку без tcltk, это может быть проблемой.