mrgsolve
Here we illustrate the approach using a Binary response linked to exposure (AUC) via a saturating EMAX function. Weight is a covariate on Clearance. We also have a disease severity categorical covariate on EMAX where patient with severe disease have a lower EMAX.
exprespmodel <- '
$PLUGIN Rcpp
$PARAM
TVCL = 10, WTCL = 0.75,
TVEMAX = 5, SEVEMAX = 3,AUC50 = 10,
BASEP = 0.1,
WT=70, SEV = 0,DOSE = 75
$OMEGA
0.1
$PRED
double CL = TVCL *
pow((WT/70.0), WTCL)*exp(ETA(1));
double EMAX = TVEMAX + SEVEMAX*(SEV == 1) ;
double Intercept = log(BASEP/(1-BASEP));
capture CLi = CL;
capture AUC = DOSE/CL;
capture LGST = Intercept + (EMAX*AUC/(AUC50+AUC));
capture P1 = 1/(1+exp(-LGST));
capture DV = R::runif(0,1)< P1 ? 1 : 0;
'
modexprespsim <- mcode("exprespmodel", exprespmodel)
simdata <- expand.idata(SEV=c(0,1),
DOSE = c(0,25,50,75),
ID = 1:1000) %>%
dplyr::mutate(WT = exp(rnorm(n(),log(70),0.3)))
set.seed(466548)
simout <- modexprespsim %>%
data_set(simdata) %>%
zero_re() %>%
carry.out(WT, DOSE, SEV) %>%
mrgsim()%>%
as.data.frame
ggplot(simout, aes(AUC,DV,col=factor(SEV))) +
facet_grid(~cut_interval(WT,2))+
geom_point()+
geom_smooth(method = "glm",se=FALSE,
method.args = list(family = "binomial"))+
labs(color="Severity",y="Probability of Being Cured")+
theme_bw() +
theme(legend.position = "top")
Here we show how the odds ratios can be computed. We already know that the distribution of AUC depends on the Dose and on the clearance distributions. The model had three estimated parameters shown in Red, the dose and two other covariates shown in green. A Change in body weight will trigger a change in Clearance which in turn will control the AUC. To define an odds ratio we need to define changes in covariate values for example odds ratio between Severity = 1 and Severity = 0 (everything else being equal). For nonlinear relationship we need to define a change in covariate value e.g. AUC = 10 / AUC = 5 and AUC = 15 / AUC = 10.
where: \[AUC = \left(\frac { \color{green}{Dose}} {CL \times \left( \frac { \color{green}{Weight}} {70}\right)^{WTCL} \times exp(\eta{CL}) }\right)\] \[\color{red}{E_{max}}= E_{max} \left(intercept \right) + SevE_{max}\times\left(\color{green}{Severity} = 1\right) \] \[log(odds) = \color{red}{Intercept} + \left( \frac {\color{red}{E_{max}} \times \color{blue}{AUC}} {\color{red}{AUC_{50}} +\color{blue}{AUC} }\right)\]
thmeans <- c(10,0.75, #TVCL WTCL
5,3, # TVEMAX SEVEMAX
10, # AUC50
0.1) #BASEP
thvariances<- (thmeans*0.15)^2
thecorrelations <- matrix(ncol=length(thmeans),nrow=length(thmeans))
diag(thecorrelations)<- 1
thecorrelations[lower.tri(thecorrelations, diag = FALSE)]<- 0.2
thecorrelations[upper.tri(thecorrelations, diag = FALSE)]<- 0.2
thevarcovmatrix<- diag(sqrt(thvariances))%*%thecorrelations%*%diag(sqrt(thvariances))
sim_parameters <- MASS::mvrnorm(n = nsim, mu=as.numeric(thmeans),
Sigma=thevarcovmatrix, empirical = TRUE)
colnames(sim_parameters) <- colnames(thevarcovmatrix) <- c("TVCL","WTCL",
"TVEMAX","SEVEMAX","AUC50",
"BASEP")
sim_parameters<- as.data.frame(sim_parameters)
reference.values <- data.frame(WT = 70, DOSE = 75, SEV = 0 )
covcomb <- expand.modelframe(
WT = c(50,60,70,80,90),
DOSE = c(0,50,75,100),
SEV = c(0,1),
rv = reference.values)
covcomb <- covcomb[!duplicated(
paste(covcomb$WT,covcomb$WT,covcomb$DOSE,covcomb$SEV)),]
covcomb$ID <- 1:nrow(covcomb)
iter_sims <- NULL
for(i in 1:nsim) {
idata <- as.data.frame(covcomb)
idata$covname<- NULL
data.all <- idata
data.all$TVCL <- as.numeric(sim_parameters[i,1])
data.all$WTCL <- as.numeric(sim_parameters[i,2])
data.all$TVEMAX <- as.numeric(sim_parameters[i,3])
data.all$SEVEMAX <- as.numeric(sim_parameters[i,4])
data.all$AUC50 <- as.numeric(sim_parameters[i,5])
data.all$BASEP <- as.numeric(sim_parameters[i,6])
out <- modexprespsim %>%
data_set(data.all) %>%
carry.out(CL,WT, DOSE, SEV, AUC) %>%
zero_re() %>%
mrgsim()%>%
as.data.frame
dfsimunc <- as.data.frame(out%>% mutate(rep = i) )
iter_sims <- rbind(iter_sims,dfsimunc)
}
ggplot(iter_sims, aes(DOSE,P1,col=factor(SEV) ) )+
geom_point(aes(group=interaction(ID,rep)),alpha=0.5,size=3)+
facet_grid(SEV~ WT,labeller = label_both)
iter_sims <- iter_sims %>%
mutate(LGST = exp(LGST))%>%
gather(paramname,paramvalue,P1,LGST)%>%
ungroup() %>%
dplyr::mutate( covname = case_when(
ID== 1 ~ "Weight",
ID== 2 ~ "Weight",
ID== 3 ~ "REF",
ID== 4 ~ "Weight",
ID== 5 ~ "Weight",
ID== 6 ~ "DOSE",
ID== 7 ~ "DOSE",
ID== 8 ~ "DOSE",
ID== 9 ~ "SEV"
),
covvalue =case_when(
ID== 1 ~ paste(WT,"kg"),
ID== 2 ~ paste(WT,"kg"),
ID== 3 ~ "70 kg\nSevere\n75 mg",
ID== 4 ~ paste(WT,"kg"),
ID== 5 ~ paste(WT,"kg"),
ID== 6 ~ paste(DOSE,"mg"),
ID== 7 ~ paste(DOSE,"mg"),
ID== 8 ~ paste(DOSE,"mg"),
ID== 9 ~ "Not Severe"
) )
iter_sims$covname <-factor(as.factor(iter_sims$covname ),
levels = c("SEV","Weight","DOSE","REF"))
iter_sims$covvalue <- factor(as.factor(iter_sims$covvalue),
levels = c("0 mg","50 mg","100 mg",
"50 kg","60 kg","80 kg", "90 kg",
"70 kg\nSevere\n75 mg", "Not Severe"))
coveffectsdatacovrep <- iter_sims %>%
dplyr::group_by(paramname,ID,WT,DOSE,SEV,covname,covvalue) %>%
dplyr::summarize(
mid= median(paramvalue),
lower= quantile(paramvalue,0.05),
upper = quantile(paramvalue,0.95))
yvar_names <- c(
'LGST'="Odds Ratio",
'P1'="Probability"
)
ggplot(iter_sims,aes(x=paramvalue,y=covvalue))+
stat_density_ridges(aes(fill=factor(..quantile..),height=..ndensity..),
geom = "density_ridges_gradient", calc_ecdf = TRUE,
quantile_lines = TRUE, rel_min_height = 0.001,scale=0.9,
quantiles = c(0.05,0.25,0.5,0.75, 0.95))+
facet_grid(covname~paramname,scales="free",switch="both",
labeller = labeller(paramname=yvar_names))+
scale_fill_manual(
name = "Probability", values = c("#FF0000A0",
"#0000FFA0", "white","white",
"#0000FFA0","#FF0000A0"),
labels = c("(0, 0.05]", "(0.05, 0.25]",
"(0.25, 0.5]","(0.5, 0.75]",
"(0.75, 0.95]","(0.95, 1]")
)+
theme_bw()+
theme(axis.title = element_blank(),strip.placement = "outside")
ggplot(coveffectsdatacovrep,
aes(x=mid,y=covvalue))+
geom_pointrangeh(aes(xmin=lower,xmax=upper))+
facet_grid(covname~paramname,scales="free",switch="both",
labeller = labeller(paramname=yvar_names)) +
theme(axis.title = element_blank(),strip.placement = "outside")