Data.table 替代 pmap 和 reduce？

Question

如果可能的话，希望能更快地完成这个过程。我有两个非常大的数据框（下面提供了缩写示例）。

df1 是一个较短的数据框，其中每一行代表一位住院患者。 eid 是每个 hopsitalisation，pid 是患者 id，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 是与 df1 中相同的 pid 匹配的患者 ID。药物是处方药的类型。 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 的每种药物创建一列。我已经展示了药物'a'的示例如下：

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_c 等

df1 有 400,000 行，但 df2 有 2 亿行

有没有比我上面描述的更快更有效的流程？

谢谢

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

由reprex package (v0.2.0) 于 2018 年 9 月 28 日创建。