Nested loop on dates using purrr map

user_14273468 0
Viewed 103

In a clinical trial, let's assume that I have :

(i) a dosing history file ('dosing'), with within-patient dose increase,

(ii) a lab parameter values file ('lab'), with assessment performed at dates that are not matching the dosing event dates.

I would like to add a column to the lab value file containing the dose received at the last dosing event. This is in preparation for an analysis of the lab values where the dose enters as a time-varying covariate. Below is a rather primitive code using for loops.

How could we obtain the same dataframe (or tibble) using functions from the purrr package? Thanks a lot!

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
purrr nested-loops r date
2 Answers

Sorry, no purrr-solotion from me. But using a rolling join on data.table will do the trick pretty fast.

functionality:
For each row in labs. it will find the last dosdat in dosing with the same ID before labdat, and add the values dosdat and doslev to the 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
user_63562780

If you're looking for a tidyverse solution, I would suggest you this one:

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

However, it is less efficient than the data.table solution because you need to complete the dosing dataframe first.

The solution is based on this data:

#' 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))
)
user_99182650
Related