Ускорение фильтрации интервалов времени - R - PullRequest
0 голосов
/ 03 сентября 2018

У меня есть два набора данных о госпитализации (admission) с датами госпитализации и лабораторными результатами (test) с датами тестирования. Пациенты имеют персональный идентификатор (patient_id), а у каждого пациента свой идентификационный номер (admission_id). Набор данных лабораторных испытаний содержит только идентификатор пациента. Некоторые воспроизводимые примеры данных:

admission <- data.frame(
  patient_id = c("a", "a", "b", "b", "c", "c", "d", "d", "e", "e"),
  admission_id = c(1, 2, 1, 2, 1, 2, 1, 2, 1, 2),
  start_date = as.Date(
    c(
      "2010-10-22",
      "2013-04-30",
      "2009-02-08", 
      "2015-12-12",
      "2013-01-08", 
      "2015-02-27",
      "2009-08-02",
      "2011-12-19",
      "2011-09-02",
      "2016-05-25"
    )
    ),
  end_date = as.Date(
    c(
      "2010-10-23", 
      "2013-05-03",
      "2009-02-12",
      "2015-12-12",
      "2013-01-15",
      "2015-02-27",
      "2009-08-06",
      "2011-12-26",
      "2011-09-06",
      "2016-05-31"
    )
  )
  )

test <- data.frame(
  patient_id = c("a", "a", "b", "b", "c", "c", "d", "d", "e", "e"),
  test_date = as.Date(
    c(
      "2010-10-23",
      "2013-04-01",
      "2009-02-08",
      "2015-12-12",
      "2013-06-01",
      "2015-02-28",
      "2009-10-08",
      "2011-12-21",
      "2011-09-02",
      "2016-05-26"
    )
  )
)

Задача также состоит в том, чтобы назначить (admission_id) тестовым данным для создания реального уникального идентификатора. Пока что мой подход заключается в dplyr::left_join на patient_id и filter(test_date %within% interval(start_date, end_date) с использованием пакета lubridate.

library(dplyr)
data <- test %>% left_join(admission)

library(lubridate)
data %>% filter(test_date %within% interval(start_date, end_date))

Результат:

  patient  test_date admission_id start_date   end_date
1       a 2010-10-23            1 2010-10-22 2010-10-23
2       b 2009-02-08            1 2009-02-08 2009-02-12
3       b 2015-12-12            2 2015-12-12 2015-12-12
4       d 2011-12-21            2 2011-12-19 2011-12-26
5       e 2011-09-02            1 2011-09-02 2011-09-06
6       e 2016-05-26            2 2016-05-25 2016-05-31

Это хорошо работает для этого небольшого примера, но очень медленно для больших наборов данных (> 100 000 строк / наблюдений).

Любая идея, как ускорить это с другим подходом?

1 Ответ

0 голосов
/ 04 сентября 2018

Используйте foverlaps data.table - это быстро для больших объектов данных:

> # here is a solution using the 'foverlaps' function in 'data.table'
> library(data.table)

> admission <- data.frame(
+   patient_id = c("a", "a", "b", "b", "c", "c", "d", "d", "e", "e"),
+   admission_id = c(1, 2, 1, 2, 1, 2, 1, 2, 1, 2),
+ .... [TRUNCATED] 

> test <- data.frame(
+   patient_id = c("a", "a", "b", "b", "c", "c", "d", "d", "e", "e"),
+   test_date = as.Date(
+     c(
+       "2010-10-23",
+  .... [TRUNCATED] 

> # add dummy dates to test after making data.tables
> setDT(admission)

> setDT(test)

> test[, `:=`(start_date = test_date, end_date = test_date)]

> setkey(admission, start_date, end_date)  # set the key that is required

> foverlaps(test, admission)[
+   !is.na(patient_id)][,  # remove non-matches
+     `:=`(i.patient_id = NULL, i.start_date = NULL, i.end_date = NULL)] .... [TRUNCATED] 
   patient_id admission_id start_date   end_date  test_date
1:          a            1 2010-10-22 2010-10-23 2010-10-23
2:          b            1 2009-02-08 2009-02-12 2009-02-08
3:          b            2 2015-12-12 2015-12-12 2015-12-12
4:          d            2 2011-12-19 2011-12-26 2011-12-21
5:          e            1 2011-09-02 2011-09-06 2011-09-02
6:          e            2 2016-05-25 2016-05-31 2016-05-26
>
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...