时间戳

首页 > 解决方案 > 使用 purrr 地图在日期上嵌套循环

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

问题描述

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

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

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

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

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

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

标签： rdatenested-loopspurrr

解决方案

对不起，purrr我没有-solution。但是使用滚动连接data.table将很快完成。

功能：
对于labs. 它会在labdat之前找到最后一个dosingdosdat 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

推荐阅读