---
title: "Exposure Response Example"
output: 
  rmarkdown::html_vignette:
    toc: true
    df_print: kable
    
vignette: >
  %\VignetteIndexEntry{Exposure_Response_Example}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r, include = FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  message =FALSE,
  warning =FALSE,
  fig.width = 7,
  comment = "#>",
  dev.args = list(png = list(type = "cairo"))
)
library(coveffectsplot)
library(ggplot2)
library(dplyr)
library(tidyr)
library(mrgsolve)
library(ggridges)
library(ggstance)
library(Rcpp)
theme_set(theme_bw())
nsim <- 100 # for vignette to make it run faster otherwise increase to 1000
#utility function to simulate varying one covariate at a time keeping the rest at the reference
expand.modelframe <- function(..., rv, covcol="covname") {
  args <- list(...)
  df <- lapply(args, function(x) x[[1]])
  df[names(rv)] <- rv
  res <- lapply(seq_along(rv), function(i) {
    df[[covcol]] <- names(rv)[i]
    df[[names(rv)[i]]] <- args[[names(rv)[i]]]
    as.data.frame(df)
  })
  do.call(rbind, res)
}

```
## Specifying an Exposure Response Model using `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.

```{r exprespmodel, collapse=TRUE }
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
```

```{r exprespmodeplotl, collapse=TRUE }
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")
```

## Computing the Odds Ratios
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)$$

```{r, collapse=TRUE }
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")
```

```{r plot2, collapse=TRUE }

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")
```