Data.table альтернатива pmap и уменьшить?

Question

Надеясь ускорить этот процесс, если это возможно.У меня есть два очень больших кадра данных (сокращенные примеры приведены ниже).

df1 - это более короткий кадр данных, где каждая строка представляет госпитализацию пациента.eid - это каждая гопситализация, pid - это идентификатор пациента, а doa - целое число даты.

library(tidyverse)
library(data.table)
library(purrr)

eid <- seq(1,4,1)
pid <- c(rep(111,2),rep(222,1),333)
doa <- as.numeric(c(1500,1100,600,200))
df1 <- as_tibble(cbind(eid,pid,doa))

df2 - это, как правило, более длинный фрейм данных, где каждая строка представляет конкретный рецепт лекарства.pid - это идентификатор пациента, который совпадает с тем же pid в df1.наркотик - это тип лекарства, который выписывают.dop - это дата, указанная как целое число.

pid <- c(rep(111,2),rep(222,3))
drug <- c('a','a','b','c','a')
dop <- as.numeric(c(550,900,950,1000,500))
df2 <- as_tibble(cbind(pid,drug,dop))

Фактически я хочу столбец для каждого лекарства, добавленного к df1.Я показал пример для препарата «а», как показано ниже:

df2 <- df2 %>% 
filter(drug=='a')

drug <- pmap(list(df1$pid,df1$doa),
function (x,y)
list(case_when(
#id match
df2$pid==x &  y-as.numeric(df2$dop) < 365 &y-as.numeric(df2$dop) > 0 ~1,
#id match and drug discharge <365 days
T ~ 0)
))

drug

dat <- data.table(matrix(unlist(drug),nrow=dim(df1)[1],byrow = T))

fun1 <- function (x) ifelse(x==1,T,F)

dat <- dat[,drug_a:=Reduce('|',lapply(.SD, fun1)), .SDcols = 1:3]

Конечный результат, который я хочу, - это кадр данных, похожий на

df1 <- cbind(df1,dat[,'drug_a'])    

Но для drug_a, drug_b, drug_cetc

df1 имеет 400 000 строк, но df2 имеет 200 миллионов строк

Есть ли более быстрый и эффективный процесс, чем я описал выше?

Спасибо

Answer 1

Если я правильно понял ваш вопрос, вы можете попробовать это.Это не в data.table, но вы просто пытаетесь избежать петель.Подобные вещи сложно сравнить без исходных данных, потому что не каждая функция масштабируется одинаково, но я ожидаю, что она будет намного быстрее и чище, чем ваш текущий метод, и распространяется на столько лекарств, сколько вам нужно.

library(tidyverse)
df1 <- tibble(
  eid = seq(1, 4, 1),
  pid = c(rep(111, 2), rep(222, 1), 333),
  doa = as.numeric(c(1500, 1100, 600, 200))
)
df2 <- tibble(
  pid = c(rep(111, 2), rep(222, 3)),
  drug = c("a", "a", "b", "c", "a"),
  dop = as.numeric(c(550, 900, 950, 1000, 500))
)

df1 %>%
  left_join(df2, by = "pid") %>% # one row per patient-hospitaliation-drug-prescription
  mutate(days_since_prescription = doa - dop) %>%
  group_by(eid, pid, drug) %>%
  summarise(within_365 = any(days_since_prescription < 365 & days_since_prescription > 0)) %>% 
  ungroup() %>% # now one row per patient-hospitalisation-drug
  spread(drug, within_365, sep = "_") %>% # now one row per patient-hospitalisation
  select(-drug_NA) %>% # cleanup tasks
  mutate_at(vars(starts_with("drug")), replace_na, replace = FALSE) # skip this if you want to preserve knowing whether a prescription took place
#> # A tibble: 4 x 5
#>     eid   pid drug_a drug_b drug_c
#>   <dbl> <dbl> <lgl>  <lgl>  <lgl> 
#> 1     1   111 FALSE  FALSE  FALSE 
#> 2     2   111 TRUE   FALSE  FALSE 
#> 3     3   222 TRUE   FALSE  FALSE 
#> 4     4   333 FALSE  FALSE  FALSE

Создано в 2018-09-28 пакетом Представ (v0.2.0).