r - 使用 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中找到labdat之前具有相同ID的最后一个dosdat，并添加值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