使用 purrr 地图在日期上嵌套循环

Question

在临床试验中，假设我有：

(i) 给药历史文件（“给药”），患者体内剂量增加，

(ii) 实验室参数值文件（“实验室”），在与给药事件日期不匹配的日期进行评估。

我想在实验室值文件中添加一列，其中包含在最后一次给药事件中收到的剂量。这是为分析剂量作为时变协变量输入的实验室值做准备。下面是使用for 循环的相当原始的代码。

我们如何使用 purrr 包中的函数获得相同的数据帧（或 tibble）？ 非常感谢！

library(tidyverse)

#' Dosing file
#' ----------------------------------
dosdatID1<-c("2020-06-06", "2020-06-15", "2020-06-22", "2020-07-07", "2020-07-17")
dosdatID2<-c("2020-06-05", "2020-06-08", "2020-06-24", "2020-06-27")
dosing<-data.frame(
  ID=c(rep(1, 5), rep(2, 4)),
  dosrec=c(1:5, 1:4),
  doslev=c(c(0.1, 0.1, 0.1, 0.9, 0.9), c(0.2, 0.2, 0.3, 0.3)), 
  dosdat=as.Date(c(dosdatID1, dosdatID2)))

#' Lab values file
#' ----------------------------------
labdatID1<-c("2020-06-17", "2020-06-24", "2020-07-08")
labdatID2<-c("2020-06-06", "2020-06-26")
labs<-data.frame(
  ID=c(rep(1, 3), rep(2, 2)),
  labrec=c(1:3, 1:2),
  labval=round(c(rnorm(3, 10, 5), rnorm(2, 15, 5)), 2),
  labdat=as.Date(c(labdatID1, labdatID2))
)

labs$dos_current <- NA

# unique subject ID
u_subj<-unique(labs$ID)

# number of subjects
n_subj<-length(u_subj)

for(s in 1:n_subj){
  # subset the labs dataset for one particular subject s
  labs_1<-labs[which(labs$ID == u_subj[s]),]
  # unique lab records for subject s
  u_labrec <- unique(labs_1$labrec)
  # number of unique lab records for this particular subject s
  n_labrec <- length(u_labrec)
  
  for(lb in 1:n_labrec){
    # extract the date of this labrec
    dt_labrec <- labs_1$labdat[which(labs_1$labrec == u_labrec[lb])]
    ### get the current dose from the dosing dataset
    # subset the dosing dataset for one particular subject s
    dosing_1 <- dosing[which(dosing$ID == u_subj[s]),]
    # order the dates in decreasing order
    dosing_1 <- dosing_1[ order(dosing_1$dosdat, decreasing = TRUE), ]
    # get the latest dosing date which is less than or equal to the date of the labrec
    doslev <- dosing_1$doslev[grep("TRUE", dosing_1$dosdat <= dt_labrec)[1]]
    # input the current dose level into the labs dataset
    labs$dos_current[which(labs$ID == u_subj[s] & labs$labrec == u_labrec[lb])] <- doslev
  }
}

labs

Answer 1

抱歉，我没有purrr-solotion。但是在data.table 上使用滚动连接会很快完成。

功能：
对于labs 中的每一行。它将在dosing 中找到最后一个dosdat，在labdat 之前具有相同的ID，并将值dosdat 和doslev 添加到labs-data.table。

library( data.table )
#make them data.tables
setDT(dosing);setDT(labs)
#now rolling join by reference
labs[, c("dosdat", "doslev") := dosing[labs, .(dosdat = x.dosdat, doslev), 
                                       on = .(ID, dosdat = labdat), 
                                       roll = TRUE]][]
#    ID labrec labval     labdat     dosdat doslev
# 1:  1      1   2.67 2020-06-17 2020-06-15    0.1
# 2:  1      2  16.62 2020-06-24 2020-06-22    0.1
# 3:  1      3  11.64 2020-07-08 2020-07-07    0.9
# 4:  2      1   8.85 2020-06-06 2020-06-05    0.2
# 5:  2      2  10.91 2020-06-26 2020-06-24    0.3

Answer 2

如果您正在寻找tidyverse 解决方案，我建议您使用这个：

full_dosing <- dosing %>%
 mutate(labdat = dosdat) %>% 
 group_by(ID) %>% 
 complete(labdat = seq(min(labdat), max(labdat), "day"), ID) %>% 
 fill(dosdat, dosrec, doslev) %>% 
 ungroup()
 
left_join(labs, full_dosing, by = c("ID", "labdat"))

  ID labrec labval     labdat dosrec doslev     dosdat
1  1      1   4.92 2020-06-17      2    0.1 2020-06-15
2  1      2   2.89 2020-06-24      3    0.1 2020-06-22
3  1      3  14.01 2020-07-08      4    0.9 2020-07-07
4  2      1   3.92 2020-06-06      1    0.2 2020-06-05
5  2      2  17.58 2020-06-26      3    0.3 2020-06-24

但是，它比data.table 解决方案效率低，因为您需要先complete dosing 数据帧。

---

解决方案基于此数据：

#' Dosing file
#' ----------------------------------
dosdatID1<-c("2020-06-06", "2020-06-15", "2020-06-22", "2020-07-07", "2020-07-17")
dosdatID2<-c("2020-06-05", "2020-06-08", "2020-06-24", "2020-06-27")
dosing<-data.frame(
 ID=c(rep(1, 5), rep(2, 4)),
 dosrec=c(1:5, 1:4),
 doslev=c(c(0.1, 0.1, 0.1, 0.9, 0.9), c(0.2, 0.2, 0.3, 0.3)), 
 dosdat=as.Date(c(dosdatID1, dosdatID2)))

#' Lab values file
#' ----------------------------------
labdatID1<-c("2020-06-17", "2020-06-24", "2020-07-08")
labdatID2<-c("2020-06-06", "2020-06-26")
labs<-data.frame(
 ID=c(rep(1, 3), rep(2, 2)),
 labrec=c(1:3, 1:2),
 labval=round(c(rnorm(3, 10, 5), rnorm(2, 15, 5)), 2),
 labdat=as.Date(c(labdatID1, labdatID2))
)