[1] Import and format dataset

#### ** compound information ====
compound_name <-"Perjeta"


full <- read.csv("../ptz.ppk.nmdata.new.csv") %>% filter(CC=="")
full <- full %>%
          mutate(RATE = ifelse(is.na(RATE), 0, RATE),
                 CMT = 1)

nrow(full %>% filter (MDV==0)) #4387 #check the consistency with "TOT. NO. OF OBS RECS:" in .lst file
## [1] 4387
uniqueID<- full %>% distinct(ID, .keep_all = TRUE)

[2] Mrgsolve Simulations

Model Summary

## load model

mod <- mread("../PKcase_Perjeta_valid.cpp")
## Building PKcase_Perjeta_valid_cpp ... done.
see(mod)
## 
## Model file:  PKcase_Perjeta_valid.cpp 
## [PROB] 
## Perjeta 
## 
## Author: Jenny Nguyen / Tong Lu
## Source: run20d.lst
## 
## Time unit: day
## Volume units: L
## Validated: Yes (Tong Lu May 2020)
## 
## [PKMODEL] // option to use analytical solution for 1- and 2- cpt models
## cmt = "CENT PERIPH", depot = FALSE
## 
## [PARAM] @annotated // list model parameters and covariates
## TVCL  :  0.235   : Clearance (L/day), theta 1
## TVV1  :  3.11    : Volume of central compartment (L), theta 2
## TVQ   :  0.534   : Intercompartmental clearance (L/day), theta 3
## TVV2  :  2.46    : Volume of peripheral compartment (L), theta 4
## LBWCL :  0.516   : Effect of LBW on CL, theta 5
## LBWV1 :  0.747   : Effect of LBW on V1, theta 6
## ALBCL : -1.06    : Effect of ALBU on CL, theta 7
## LBWV2 :  0.83    : Effect of LBW on V2, theta 8
## LBW   : 48       : Typical individual value of LBW
## ALBU  :  3.9     : Typical individual value of ALBU
## 
## [OMEGA] @annotated @block // describe between-subject variability
## ETA_CL :  0.116                   : ETA on CL
## ETA_V1 :  0.0239   0.0342         : ETA on V1
## ETA_V2 : -0.0416   0.0179   0.211 : ETA on V2
## 
## [SIGMA] @annotated // describe residual error
## ADD : 0.0328 : Additive Error (log scale)
## 
## [MAIN] // NONMEM equivalent: $PK
## 
## // effect of covariates on parameters 
## double CLCOV = pow((LBW/48), LBWCL) * pow((ALBU/3.9), ALBCL);
## double V1COV = pow((LBW/48), LBWV1);
## double V2COV = pow((LBW/48), LBWV2); 
## 
## // PK parameters
## double CL    = TVCL * CLCOV * exp(ETA_CL); 
## double V1    = TVV1 * V1COV * exp(ETA_V1);
## double Q     = TVQ;
## double V2    = TVV2 * V2COV * exp(ETA_V2);
## 
## [TABLE] // NONMEM equivalent: $ERROR
## double val = CENT/V1;
## double IPRED = 0; 
## 
## if (val > 0) IPRED = log(val); 
##  
## double DV = IPRED + ADD;
## double DVnormal = exp(DV);
## double IPREDnormal = exp(IPRED); 
## 
## [CAPTURE] @annotated
## IPREDnormal : Concentration without residual variability (normal scale)
## DVnormal    : Concentration with residual variability (normal scale)
## IPRED : Concentration without residual variability (log scale)
## DV    : Concentration with residual variability (log scale)

Run Simulations

## ** [2.2] PRED Comparisons  ====

set.seed(9909)
out <- 
  mod %>%
  zero_re %>% 
  data_set(full) %>% 
  carry_out(CC, ID, STUD, TIME, NTIM, AMT, RATE, MDV, EVID, BWT, ALBU) %>% 
  mrgsim(tad = FALSE) %>% #if = TRUE, it will show "There was a problem finding time of first dose". The reason is the tad determination fails due to dose not found (ID with observation but not dosing record)
  as.data.frame

out <- out %>% filter(MDV==0)
#View(out)

## ** [2.3] IPRED and DV Comparisons  ====

### MRGSOLVE simulations
n_reps <- 1000

mrg_obsonly <- c()

start.time <- Sys.time()
set.seed(9909)
for (i in 1:n_reps) {
  suppressMessages(mrg_obsonly[[i]] <-     
                     mod %>% 
                     data_set(full) %>% 
                     carry_out(CC, ID, STUD, TIME, NTIM, AMT, RATE, MDV, EVID, BWT, ALBU) %>% 
                     mrgsim() %>% 
                     mutate(REP = i) %>% 
                     as.data.frame())
  
  if (i%%100 == 0) {
    print(paste("Sim", i))
  }
}
## [1] "Sim 100"
## [1] "Sim 200"
## [1] "Sim 300"
## [1] "Sim 400"
## [1] "Sim 500"
## [1] "Sim 600"
## [1] "Sim 700"
## [1] "Sim 800"
## [1] "Sim 900"
## [1] "Sim 1000"
end.time <- Sys.time()
time.taken <- end.time - start.time

mrg_sim <- rbindlist(mrg_obsonly) %>% filter(MDV==0)
# names(mrg_sim)
  • Time to run simulations: 37.035023

[3] Checking PRED

#### ** [3.1] Generating PREDs ====

## MRGSOLVE: run with zero_re() --> IPREDS == DVS == PREDS 
## NONMEM: run simulation once, output PRED
# for NM sim, you must at least output ID, TIME, NTIM, REP, MDV and IPRED

#### ** [3.2] Plot ====
nm_pred <- read.table("../NONMEM/sim20d.tab")
colnames(nm_pred) <- c("ID", "STUD", "TIME", "NTIM", "AMT", "RATE", "EVID", "MDV", "LBW", "ALBU", "PRED", "IPRED", "DV")

nm_pred <- nm_pred %>% filter(MDV==0)
#View(nm_pred)

out <- out %>% filter(MDV==0)

pred.plot<-tibble(x=nm_pred$PRED,y=out$IPRED)

ggplot(pred.plot,aes(x,y))+
  geom_point()+
  labs(title="PRED Comparisons",x="NONMEM",y="MRGSOLVE")+
  geom_abline(slope=1,intercept = 0,color="red")

[4] Checking IPREDs and DVs

#### ** 

nm_sim <- fread('../NONMEM/sim20d_1000rep.tab')
colnames(nm_sim) <- c("REP", "ID", "STUD", "TIME", "NTIM", "AMT", "RATE", "EVID", "MDV", "LBW", "ALBU", "PRED", "IPRED", "DV")

nm_sim <- nm_sim %>% filter(MDV==0)
mrg_sim <- mrg_sim %>% filter(MDV==0)

IPRED

uniq_ids <- unique(mrg_sim$ID)
id_nums <- unique(mrg_sim$ID)[1:32]# choose the first 32 individuals to plot
nrow <- 4; ncol<- 4
pagecount<- ceiling(length(id_nums)/(nrow*ncol))

mrg_summary_ipred <- c()
nm_summary_ipred <- c()

for (i in id_nums) {
  mrg_dat <- mrg_sim[mrg_sim$ID == i, ]
  nm_dat  <- nm_sim[nm_sim$ID == i, ]
  
  mrg_sum <- 
    mrg_dat %>% 
    group_by(TIME) %>% 
    summarise(med = median(IPRED), lo = quantile(IPRED,0.05), hi = quantile(IPRED,0.95)) %>% 
    mutate(ID = i)
  
  nm_sum <- 
    nm_dat %>% 
    group_by(TIME) %>% 
    summarise(med = median(IPRED), lo = quantile(IPRED,0.05), hi = quantile(IPRED,0.95)) %>% 
    mutate(ID = i)
  
  mrg_summary_ipred <- rbind(mrg_summary_ipred, mrg_sum)
  nm_summary_ipred  <- rbind(nm_summary_ipred, nm_sum)
}

mrg_summary_ipred<-mrg_summary_ipred %>% as.data.table()
nm_summary_ipred<-nm_summary_ipred %>% as.data.table()

nm_ipred <- melt(nm_summary_ipred, id.vars = c("ID", "TIME"))
mrg_ipred <- melt(mrg_summary_ipred, id.vars = c("ID", "TIME"))

## plot
for(i in 1:pagecount){
  print(
    ggplot() + 
      ggtitle("[IPRED] Lines: mrgsolve, Points: nonmem") + 
      geom_line(data = mrg_ipred, aes(TIME, value, col = variable, group = variable), lwd = 1) +
      geom_point(data = nm_ipred, aes(TIME,value),col = "black", size = 1) + 
      scale_color_brewer(palette = "Set2", labels = c("50th", "5th", "95th")) +
      facet_wrap_paginate (~ID, scales = "free", ncol = 4, nrow = 4, page = i)
  )
}

DV

mrg_summary_dv <- c()
nm_summary_dv <- c()

for (i in id_nums) {
  mrg_dat <- mrg_sim[mrg_sim$ID == i, ]
  nm_dat  <- nm_sim[nm_sim$ID == i, ]
  
  mrg_sum <- 
    mrg_dat %>% 
    group_by(TIME) %>% 
    summarise(med = median(DV), lo = quantile(DV,0.05), hi = quantile(DV,0.95)) %>% 
    mutate(ID = i)
  
  nm_sum <- 
    nm_dat %>% 
    group_by(TIME) %>% 
    summarise(med = median(DV), lo = quantile(DV,0.05), hi = quantile(DV,0.95)) %>% 
    mutate(ID = i)
  
  mrg_summary_dv <- rbind(mrg_summary_dv, mrg_sum)
  nm_summary_dv  <- rbind(nm_summary_dv, nm_sum)
}
mrg_summary_dv<-mrg_summary_dv %>% as.data.table()
nm_summary_dv<-nm_summary_dv %>% as.data.table()

nm_dv <- melt(nm_summary_dv, id.vars = c("ID",  "TIME"))
mrg_dv <- melt(mrg_summary_dv, id.vars = c("ID", "TIME"))

## plot
for(i in 1:pagecount){
  print(
    ggplot() + 
      ggtitle("[DV] Lines: mrgsolve, Points: nonmem") + 
      geom_line(data = mrg_dv, aes(TIME, value, col = variable, group = variable), lwd = 1) +
      geom_point(data = nm_dv, aes(TIME,value),col = "black", size = 0.75) + 
      scale_color_brewer(palette = "Set2", labels = c("50th", "5th", "95th")) +
      facet_wrap_paginate (~ID, scales = "free", ncol = 4, nrow = 4, page = i)
  )
}

[5] Checking IPREDs and DVs with Bands

## calculate percentiles for each replication (pick a study to plot; use nominal time to plot)


mrg_ipred <- c()
nm_ipred <- c()

mrg_sim_band<- mrg_sim %>% filter(STUD ==2572)
nm_sim_band<- nm_sim %>% filter(STUD ==2572)
for (i in 1:1000) {
  #  mrg_sim <- mrg_reps[[i]]
  mrg_sim_rep <- mrg_sim_band[mrg_sim_band$REP == i, ] 
  nm_sim_rep <- nm_sim_band[nm_sim_band$REP == i, ] 
  
  mrg_sum <- 
    mrg_sim_rep %>% 
    group_by(NTIM) %>% 
    summarise(med = median(IPRED), lo = quantile(IPRED,0.05), hi = quantile(IPRED,0.95)) %>% 
    mutate(rep = i)
  
  nm_sum <- 
    nm_sim_rep %>% 
    group_by(NTIM) %>% 
    summarise(med = median(IPRED), lo = quantile(IPRED,0.05), hi = quantile(IPRED,0.95)) %>% 
    mutate(rep = i)
  
  mrg_ipred <- rbind(mrg_ipred, mrg_sum)
  nm_ipred <- rbind(nm_ipred, nm_sum)
  
  if (i%%100 == 0) {
    print(i)
  }
}
## [1] 100
## [1] 200
## [1] 300
## [1] 400
## [1] 500
## [1] 600
## [1] 700
## [1] 800
## [1] 900
## [1] 1000
#View(mrg_ipred)
#View(nm_ipred)

IPRED

Mrgsolve Code

dat_05 <- 
  mrg_ipred %>% 
  group_by(NTIM) %>% 
  summarise(medn = median(lo), low = quantile(lo,0.05), high = quantile(lo,0.95)) %>% 
  mutate(group = "lo")

dat_95 <- 
  mrg_ipred %>% 
  group_by(NTIM) %>% 
  summarise(medn = median(hi), low = quantile(hi,0.05), high = quantile(hi,0.95)) %>% 
  mutate(group = "hi")

dat_50 <- 
  mrg_ipred %>% 
  group_by(NTIM) %>% 
  summarise(medn = median(med), low = quantile(med,0.05), high = quantile(med,0.95)) %>% 
  mutate(group = "med")

dat2plot <- list(dat_05, dat_50, dat_95)
dat2plot2 <-  rbindlist(dat2plot)
dat2plot2$group <- as.factor(dat2plot2$group)
mrg_plot <- dat2plot2

NONMEM Code

dat_05_2 <-
  nm_ipred %>% 
  group_by(NTIM) %>% 
  summarise(medn = median(lo), low = quantile(lo,0.05), high = quantile(lo,0.95)) %>% 
  mutate(group = "lo")

dat_95_2 <- 
  nm_ipred %>% 
  group_by(NTIM) %>% 
  summarise(medn = median(hi), low = quantile(hi,0.05), high = quantile(hi,0.95)) %>% 
  mutate(group = "hi")

dat_50_2 <- 
  nm_ipred %>% 
  group_by(NTIM) %>% 
  summarise(medn = median(med), low = quantile(med,0.05), high = quantile(med,0.95)) %>% 
  mutate(group = "med")

dat2plot_2 <- list(dat_05_2, dat_50_2, dat_95_2)
dat2plot2_2 <-  rbindlist(dat2plot_2)
dat2plot2_2$group <- as.factor(dat2plot2_2$group)
nm_plot <- melt(dat2plot2_2, id.vars=c("NTIM", "group"))
mycols <- c("#7fc97f", "#beaed4", "#fdc086")

ggplot() + 
  ggtitle("[IPRED, nrep=1000, STUD=2572] Lines and shade: mrgsolve, Points: nonmem") + 
  geom_line(data = mrg_plot,
            aes(x = NTIM,
                y = medn, 
                col = group), 
            size = 1.5) + 
  geom_ribbon(data = mrg_plot,
              aes(x = NTIM,
                  ymin=low, 
                  ymax=high, 
                  fill = group), 
              alpha = 0.5) +
  geom_point(data = nm_plot, 
             aes(x = NTIM,
                 y = value,
                 col = group), 
             size = 2) + 
  scale_color_manual(values = mycols, labels = c("5th", "50th", "95th"), name = "Percentile") +
  scale_fill_manual(values = mycols, labels = c("5th", "50th", "95th"), name = "Percentile") +
  theme(legend.text = element_text(size=20),
        legend.title = element_text(size=20),
        axis.text = element_text(size=20),
        axis.title = element_text(size=20, face = "bold"),
        plot.title = element_text(size=25, face = "bold")) +  
  xlab("Time (day)") +
  ylab("Concentration")#+

#  xlim(0, 25)#+ show certain time range 
#  scale_y_log10()

DV

## calculate percentiles for each replication (pick a study to plot; use nominal time to plot)

mrg_dv <- c()
nm_dv <- c()

for (i in 1:1000) {
  #  mrg_sim <- mrg_reps[[i]]
  mrg_sim_rep <- mrg_sim_band[mrg_sim_band$REP == i, ] 
  nm_sim_rep <- nm_sim_band[nm_sim_band$REP == i, ] 
  
  mrg_sum <- 
    mrg_sim_rep %>% 
    group_by(NTIM) %>% 
    summarise(med = median(DV), lo = quantile(DV,0.05), hi = quantile(DV,0.95)) %>% 
    mutate(rep = i)
  
  nm_sum <- 
    nm_sim_rep %>% 
    group_by(NTIM) %>% 
    summarise(med = median(DV), lo = quantile(DV,0.05), hi = quantile(DV,0.95)) %>% 
    mutate(rep = i)
  
  mrg_dv <- rbind(mrg_dv, mrg_sum)
  nm_dv <- rbind(nm_dv, nm_sum)
  
  if (i%%100 == 0) {
    print(i)
  }
}
## [1] 100
## [1] 200
## [1] 300
## [1] 400
## [1] 500
## [1] 600
## [1] 700
## [1] 800
## [1] 900
## [1] 1000
#View(mrg_ipred)
#View(nm_ipred)

Mrgsolve code

## ** mrgsolve  ====
dat_05 <- 
  mrg_dv %>% 
  group_by(NTIM) %>% 
  summarise(medn = median(lo), low = quantile(lo,0.05), high = quantile(lo,0.95)) %>% 
  mutate(group = "lo")

dat_95 <- 
  mrg_dv %>% 
  group_by(NTIM) %>% 
  summarise(medn = median(hi), low = quantile(hi,0.05), high = quantile(hi,0.95)) %>% 
  mutate(group = "hi")

dat_50 <- 
  mrg_dv %>% 
  group_by(NTIM) %>% 
  summarise(medn = median(med), low = quantile(med,0.05), high = quantile(med,0.95)) %>% 
  mutate(group = "med")

dat2plot <- list(dat_05, dat_50, dat_95)
dat2plot2 <-  rbindlist(dat2plot)
dat2plot2$group <- as.factor(dat2plot2$group)
mrg_plot <- dat2plot2

NONMEM Code

dat_05_2 <-
  nm_dv %>% 
  group_by(NTIM) %>% 
  summarise(medn = median(lo), low = quantile(lo,0.05), high = quantile(lo,0.95)) %>% 
  mutate(group = "lo")

dat_95_2 <- 
  nm_dv %>% 
  group_by(NTIM) %>% 
  summarise(medn = median(hi), low = quantile(hi,0.05), high = quantile(hi,0.95)) %>% 
  mutate(group = "hi")

dat_50_2 <- 
  nm_dv %>% 
  group_by(NTIM) %>% 
  summarise(medn = median(med), low = quantile(med,0.05), high = quantile(med,0.95)) %>% 
  mutate(group = "med")

dat2plot_2 <- list(dat_05_2, dat_50_2, dat_95_2)
dat2plot2_2 <-  rbindlist(dat2plot_2)
dat2plot2_2$group <- as.factor(dat2plot2_2$group)
nm_plot <- melt(dat2plot2_2, id.vars=c("NTIM", "group"))
mycols <- c("#7fc97f", "#beaed4", "#fdc086")

ggplot() + 
  ggtitle("[DV, nrep=1000, STUD=2572] Lines and shade: mrgsolve, Points: nonmem") + 
  geom_line(data = mrg_plot,
            aes(x = NTIM,
                y = medn, 
                col = group), 
            size = 1.5) + 
  geom_ribbon(data = mrg_plot,
              aes(x = NTIM,
                  ymin=low, 
                  ymax=high, 
                  fill = group), 
              alpha = 0.5) +
  geom_point(data = nm_plot, 
             aes(x = NTIM,
                 y = value,
                 col = group), 
             size = 2) + 
  scale_color_manual(values = mycols, labels = c("5th", "50th", "95th"), name = "Percentile") +
  scale_fill_manual(values = mycols, labels = c("5th", "50th", "95th"), name = "Percentile") +
  theme(legend.text = element_text(size=20),
        legend.title = element_text(size=20),
        axis.text = element_text(size=20),
        axis.title = element_text(size=20, face = "bold"),
        plot.title = element_text(size=25, face = "bold")) +  
  xlab("Time (day)") +
  ylab("Concentration")#+

#  xlim(0, 25)#+ show certain time range 
#  scale_y_log10()