---
title: "PKPD Example"
output: 
  rmarkdown::html_vignette:
    toc: true
    df_print: kable
    
vignette: >
  %\VignetteIndexEntry{PKPD_Example}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---
```{r, include = FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  dev.args = list(png = list(type = "cairo"))
)
library(coveffectsplot)
library(mrgsolve)
library(ggplot2)
library(ggstance)
library(ggridges)
library(tidyr)
library(dplyr)
library(table1)
library(patchwork)
theme_set(theme_bw())
#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 a PKPD Model using `mrgsolve`
Here we use a two-compartment PK model linked to an indirect response PD model with the drug inhibiting the rate constant of input (Kin). The model included several covariates effects on Clearance, Volume and Kin. The baseline PD response is controlled by the ratio of Kin/Kout.
```{r pkpdmodel, collapse=TRUE }
codepkpdmodelcov <- '
$PARAM
CL = 4, V=10 , KA=0.5, Vp =50, Qp= 10,
CLALB = -0.8, CLSEX = 0.2, CLWT = 1,
VSEX   = 0.07, VWT = 1,
KIN  = 3, KOUT =  0.06,  IC50 =  3,  IMAX = 0.999  
gamma = 0.548,
KINWT=0.4 , KINAGE=-0.08, KINHEALTHY =1.5,
WT=66, SEX=0, ALB =45, AGE=62, HEALTHY = 0   

$CMT GUT CENT PER RESP
$GLOBAL
#define CP   (CENT/Vi)
#define CPER (PER/Vpi)
#define INH  (IMAX*pow(CP,gamma)/(pow(IC50,gamma)+pow(CP,gamma)))
#define PDRESP RESP

$MAIN
double KAi = KA;
double Vpi = Vp *pow((WT/70.0),    1);
double Qpi = Qp *pow((WT/70.0), 0.75);
double CLi = CL *
    pow((ALB/45.0), CLALB)*
    (SEX == 1.0 ? (1.0+CLSEX) : 1.0)*
    pow((WT/66), CLWT)*exp(ETA(1)); 
double Vi = V *
    (SEX == 1.0 ? (1.0+VSEX) : 1.0)*
    pow((WT/66), VWT)*exp(ETA(2));  
double KINi = KIN *
  pow((AGE/62), KINAGE)*
  (HEALTHY == 1.0 ? KINHEALTHY : 1.0)*
  pow((WT/66), KINWT)*exp(ETA(3));
double RESP_0 = KINi/KOUT;

$OMEGA
0.3 
0.01 0.3
$OMEGA
0.25

$ODE
dxdt_GUT    = -KAi *GUT;
dxdt_CENT   =  KAi *GUT  - (CLi+Qpi)*CP  + Qpi*CPER;
dxdt_PER    =                   Qpi*CP   - Qpi*CPER;
dxdt_RESP   =  KINi*(1-INH) - KOUT*RESP;

$CAPTURE CP PDRESP
'
modpkpdsim <- mcode("codepkpdmodelcov", codepkpdmodelcov)
```
### Simulate Reference Subjects with BSV
We simulate at reference covariate values with between subject variability (BSV) and then we show a plot of the PK and PD profiles of five random subjects.
```{r pkpdsimulation, fig.width=7,fig.height=4, message=FALSE }
idata <- tibble(
  ID = 1:100, WT = 66,
  ALB = 45, AGE = 62,SEX = 0, HEALTHY=0)
ev1 <- ev(time = 0, amt = 100,
          cmt = 1, ii = 24, addl = 20)
data.dose <- ev(ev1)
data.dose <- as.data.frame(data.dose)
data.all <- merge(idata, data.dose)

set.seed(678549)
outputpkpdsim <- modpkpdsim %>%
  data_set(data.all) %>%
  carry.out(WT, ALB, AGE, SEX, HEALTHY,
            CLi, KINi, KOUT) %>%
  mrgsim(end = 24*28, delta = 0.25)
outputpkpdsim <- as.data.frame(outputpkpdsim)
outputpkpdsim$HEALTHY <- as.factor(outputpkpdsim$HEALTHY)

yvar_names <- c(
  'CP'="Plasma Concentrations",
  'RESP'="PD Response"
)
set.seed(678549)
outputpkpdsimlong <- outputpkpdsim[outputpkpdsim$ID %in%
sample(unique(outputpkpdsim$ID), 5), ] %>% 
  gather(key,value,CP,RESP)

ggplot(data =outputpkpdsimlong ,
       aes(time, value, group = ID)) +
  geom_line(alpha = 0.8, size = 0.3) +
  facet_grid(key ~ID,scales="free_y",switch="y",
             labeller = labeller(key=yvar_names)) +
  labs(y = "", color = "Sex", x = "Time (h)")+
  theme(strip.placement = "outside",
        axis.title.y=element_blank())

```

### Compute PD Parameters and Summarize BSV 
Here we compute the PD baseline (where we start), nadir response (minimum response achieved) and the delta (difference) between the baseline and nadir. We then summarize and report the BSV around these parameters as ranges of 50 and 90% of patients. We then show a plot of the first 10 replicates as an example of the simulated PD profiles. Since the code is similar to the PK Example vignette it is not shown.
```{r computenca , fig.width=7 , message=FALSE }
NCATYPICAL <- outputpkpdsim %>%
  group_by(ID, HEALTHY, WT, SEX, AGE, ALB) %>%
  summarise (
    nadir = min(PDRESP, na.rm = TRUE),
    baselinepd = PDRESP[1],
    deltapd = baselinepd-nadir
  ) %>%
  gather(paramname, paramvalue,nadir,baselinepd,deltapd)
NCATYPICAL <- NCATYPICAL %>%
group_by (paramname)
NCATYPICALREF <- NCATYPICAL%>%
  group_by (paramname) %>%
  mutate(medparam = median(paramvalue),
         paramvalue = paramvalue / medparam) 
  BSVRANGESSTD<- NCATYPICALREF %>%
  summarize(
    P05 = quantile(paramvalue, 0.05),
    P25 = quantile(paramvalue, 0.25),
    P50 = quantile(paramvalue, 0.5),
    P75 = quantile(paramvalue, 0.75),
    P95 = quantile(paramvalue, 0.95)
  )
BSVRANGESSTD
```
## Construct ans Simulate at Combinations of Covariate of Interest
Similarly to the PK Example vignette we generate covariate combinations of interest and we simulate with uncertainty using an invented varcov matrix.
```{r covcomb , fig.width=7 }
reference.values <- data.frame(WT = 66,ALB = 45, AGE = 62, SEX = 0, HEALTHY = 0)   
covcomb <- expand.modelframe(
  WT  = c(40,66,90), 
  AGE = c(42,62,82),
  ALB = c(40,45,50),
  SEX = c(0,1),#Refernce is for SEX =0
  HEALTHY = c(0,1),#Refernce is for HEALTHY =0
  rv = reference.values)
covcomb$ID <- 1:nrow(covcomb)
covcomb <- covcomb[!duplicated(
  paste(covcomb$WT,covcomb$ALB,covcomb$AGE,covcomb$HEALTHY,covcomb$SEX)),]
covcomb
```
```{r, fig.width=7 ,message=FALSE, include=FALSE}
thmeans <- c(4,10,0.5,50,10,
             -0.8,0.2,1,
             0.07,1,
             3, 0.06,3,0.999,0.548,
             0.4,-0.08,1.5)
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))

nsim <- 100 # for vignette to make it run faster otherwise increase to 1000
sim_parameters <- MASS::mvrnorm(n = nsim, mu=as.numeric(thmeans),
                                Sigma=thevarcovmatrix, empirical = TRUE)
# library(mvtnorm) rmvnorm is another option that can be explored

colnames(sim_parameters) <- colnames(thevarcovmatrix) <- c("CL","V","KA",
                                                           "Vp","Qp",
                                                           "CLALB","CLSEX","CLWT",
                                                           "VSEX","VWT",
                                                           "KIN","KOUT","IC50", 
                                                           "IMAX","gamma",
                                                           "KINWT", "KINAGE",
                                                           "KINHEALTHY")
sim_parameters<- as.data.frame(sim_parameters)
set.seed(678549)
iter_sims <- NULL
for(i in 1:nsim) {
  covcomb$covname<- NULL
  covcomb$ID <- 1:nrow(covcomb)
  idata <- as.data.frame(covcomb)
  ev1 <- ev(time = 0, amt = 100, cmt = 1, ii = 24, addl = 20)
  data.dose <- ev(ev1)
  data.dose<-as.data.frame(data.dose)
  data.all<-merge(idata,data.dose)
  data.all$amt<- 100
  data.all$CL <- as.numeric(sim_parameters[i,1])
  data.all$V <- as.numeric(sim_parameters[i,2])
  data.all$KA <- as.numeric(sim_parameters[i,3])
  data.all$Vp <- as.numeric(sim_parameters[i,4])
  data.all$Qp <- as.numeric(sim_parameters[i,5])
  data.all$CLALB <- as.numeric(sim_parameters[i,6])
  data.all$CLSEX <- as.numeric(sim_parameters[i,7])
  data.all$CLWT <- as.numeric(sim_parameters[i,8])
  data.all$VSEX <- as.numeric(sim_parameters[i,9])
  data.all$VWT <- as.numeric(sim_parameters[i,10])
  data.all$KIN <- as.numeric(sim_parameters[i,11])
  data.all$KOUT <- as.numeric(sim_parameters[i,12])
  data.all$IC50 <- as.numeric(sim_parameters[i,13])
  data.all$IMAX <- as.numeric(sim_parameters[i,14])
  data.all$gamma <- as.numeric(sim_parameters[i,15])
  data.all$KINWT <- as.numeric(sim_parameters[i,16])
  data.all$KINAGE <- as.numeric(sim_parameters[i,17])
  data.all$KINHEALTHY <- as.numeric(sim_parameters[i,18])
  out <- modpkpdsim %>%
    data_set(data.all) %>%
    carry.out(ALB,AGE, HEALTHY, WT,SEX,amt,CLi,KINi,KOUT) %>%
    zero_re() %>% 
    mrgsim(start=0,end=24*28,delta=0.25) 
  dfsimunc <- as.data.frame(out%>% mutate(rep = i) )
  iter_sims <- rbind(iter_sims,dfsimunc)
}
```

```{r, fig.width=7 ,message=FALSE, warning=FALSE}
ggplot(iter_sims[iter_sims$rep<=10,], aes(time/24,PDRESP,col=factor(WT),linetype=factor(HEALTHY) ) )+
  geom_line(aes(group=interaction(ID,rep)),alpha=0.3,size=0.3)+
  facet_grid(ALB~ AGE,labeller = label_both)+
  labs(linetype="Healthy",
       colour="Weight (kg)",
       caption ="Simulation\nwith Uncertainty without BSV\nreplicates 1 to 10" ,
       x="Days", y = "PD Response")

```

### Compute PD Parameters and Distributions Plots   
Similar to the above we compute the PD parameters, standardize by the median and provide a plot. Since the code is similar to the PK Example vignette it is not shown.
```{r, fig.width=7,fig.height=6, include=FALSE, message=FALSE}
out.df.univariatecov <- as.data.frame(iter_sims)
out.df.univariatecov <- out.df.univariatecov %>% 
  arrange(rep,ID,time)
out.df.univariatecov.nca <- out.df.univariatecov %>% 
  group_by(rep,ID, HEALTHY, WT, SEX, AGE, ALB) %>%
 summarise (
    nadir = min(PDRESP, na.rm = TRUE),
    baselinepd = PDRESP[1],
    deltapd = baselinepd-nadir
  )%>%
  gather(paramname, paramvalue,nadir,baselinepd,deltapd)

out.df.univariatecov.nca <- out.df.univariatecov.nca %>% 
  arrange(rep,ID)

REFVALUES <- out.df.univariatecov.nca%>%
  ungroup()%>%
  filter(HEALTHY==0, SEX==0,WT==66,AGE==62,ALB==45)%>%
  group_by(paramname) %>%
  dplyr::summarize(medparam = median(paramvalue))

out.df.univariatecov.nca <- left_join(out.df.univariatecov.nca,REFVALUES)

out.df.univariatecov.nca <- out.df.univariatecov.nca%>%
  group_by (paramname) %>%
  mutate(paramvalue= paramvalue / medparam ) 

out.df.univariatecov.nca <- out.df.univariatecov.nca %>% 
  ungroup() %>% 
  dplyr::mutate( covname = case_when(
    ID== 1 ~ "Weight",
    ID== 2 ~ "REF",
    ID== 3 ~ "Weight",
    ID== 4 ~ "Albumin",
    ID== 5 ~ "Albumin",
    ID== 6 ~ "Age",
    ID== 7 ~ "Age",
    ID== 8 ~ "Sex",
    ID== 9 ~ "Healthy"
  ),
  covvalue =case_when(
    ID== 1 ~ paste(WT,"kg"), 
    ID== 2 ~ "66 kg-Female-45 g/L\n62 years-healthy",
    ID== 3 ~ paste(WT,"kg"),
    ID== 4 ~ paste(ALB,"g/L"),
    ID== 5 ~ paste(ALB,"g/L"),
    ID== 6 ~ paste(AGE,"years"),
    ID== 7 ~ paste(AGE,"years"),
    ID== 8 ~ "Male",
    ID== 9 ~ "Diseased"
  )
  )

out.df.univariatecov.nca$covname <- factor(as.factor(out.df.univariatecov.nca$covname ),
                          levels =  c("Weight","Sex","Albumin","Age",
                                      "Healthy", "REF")
)

out.df.univariatecov.nca$covvalue <-factor(as.factor(out.df.univariatecov.nca$covvalue ),
                                               levels =  c("40 kg",
                                                           "66 kg",
                                                           "90 kg",
                                                           "Male",
                                                           "40 g/L",
                                                           "50 g/L",
                                                           "42 years",
                                                           "82 years",
                                                           "Diseased",
"66 kg-Female-45 g/L\n62 years-healthy")
)
# the order of y ticks is controlled by the factor levels.
```

```{r, fig.width=7,message=FALSE}
ggplot(out.df.univariatecov.nca,
       aes(x=paramvalue,y=covvalue,fill=factor(..quantile..),height=..ndensity..))+
  facet_grid(covname~paramname,scales="free_y",space="free")+
  annotate( "rect",
            xmin = 0.5,
            xmax = 2,
            ymin = -Inf,
            ymax = Inf,
            fill = "gray",alpha=0.4
  )+
  stat_density_ridges(
    geom = "density_ridges_gradient", calc_ecdf = TRUE,
    quantile_lines = TRUE, rel_min_height = 0.001,scale=0.9,
    quantiles = c(0.05,0.5, 0.95)) +
  scale_fill_manual(
    name = "Probability", values = c("#FF0000A0", "white","white", "#0000FFA0"),
    labels = c("(0, 0.05]", "(0.05, 0.5]","(0.5, 0.95]", "(0.95, 1]")
  )+
  stat_summaryh(aes(x=paramvalue,y=covvalue),fun.data="median_hilow_h",
                color="steelblue",
                geom="pointrangeh",size=0.5,position=position_nudge(y=-0.1),
                fun.args = list(conf.int=0.9),inherit.aes = FALSE)+
  geom_vline( aes(xintercept = 1),size = 1)+
  theme_bw()+
  labs(x="Effects Relative to parameter reference value",y="")+
  scale_x_continuous(breaks=c(0.25,0.5,0.8,1/0.8,1/0.5,1/0.25))+
  scale_x_log10()
```

### Summarize, add BSV and Use `forest_plot`
We will show how a multiple parameters, multiple covariates plot  and table can be done.
```{r, fig.width=7, fig.height=6 ,message=FALSE}
coveffectsdatacovrep <- out.df.univariatecov.nca %>% 
  dplyr::group_by(paramname,covname,covvalue) %>% 
  dplyr::summarize(
    mid= median(paramvalue),
    lower= quantile(paramvalue,0.05),
    upper = quantile(paramvalue,0.95))

coveffectsdatacovreplabel<-   coveffectsdatacovrep %>%
  mutate(
    label= covvalue,
    LABEL = paste0(format(round(mid,2), nsmall = 2),
                   " [", format(round(lower,2), nsmall = 2), "-",
                   format(round(upper,2), nsmall = 2), "]"))

```

```{r, fig.width=7, fig.height=7 ,message=FALSE}
coveffectsdatacovrepbsv <- coveffectsdatacovrep[coveffectsdatacovrep$covname=="REF",]
coveffectsdatacovrepbsv$covname <- "BSV"
coveffectsdatacovrepbsv$covvalue <- "50% of patients"
coveffectsdatacovrepbsv$label <-    "50% of patients"
coveffectsdatacovrepbsv$lower <- BSVRANGESSTD$P25
coveffectsdatacovrepbsv$upper <- BSVRANGESSTD$P75

coveffectsdatacovrepbsv2 <- coveffectsdatacovrep[coveffectsdatacovrep$covname=="REF",]
coveffectsdatacovrepbsv2$covname <- "BSV"
coveffectsdatacovrepbsv2$covvalue <- "90% of patients"
coveffectsdatacovrepbsv2$label <-    "90% of patients"
coveffectsdatacovrepbsv2$lower <- BSVRANGESSTD$P05
coveffectsdatacovrepbsv2$upper <- BSVRANGESSTD$P95
coveffectsdatacovrepbsv<- rbind(coveffectsdatacovrep,coveffectsdatacovrepbsv,coveffectsdatacovrepbsv2)
coveffectsdatacovrepbsv <- coveffectsdatacovrepbsv %>% 
  mutate(
    label= covvalue,
    LABEL = paste0(format(round(mid,2), nsmall = 2),
                   " [", format(round(lower,2), nsmall = 2), "-",
                   format(round(upper,2), nsmall = 2), "]"))
coveffectsdatacovrepbsv<- as.data.frame(coveffectsdatacovrepbsv)
coveffectsdatacovrepbsv$label <- as.factor(coveffectsdatacovrepbsv$covvalue )
coveffectsdatacovrepbsv$label <- reorder(coveffectsdatacovrepbsv$label,
                                         coveffectsdatacovrepbsv$lower)


coveffectsdatacovrepbsv$covname <-factor(as.factor(coveffectsdatacovrepbsv$covname ),
                                               levels =
                                           c("Weight","Sex","Albumin","Age",
                                      "Healthy", "REF", "BSV")
)

interval_legend_text = "Median (points)\n90% CI (horizontal lines)"
interval_bsv_text = "BSV (points)\nPrediction Intervals (horizontal lines)"



png("./coveffectsplotpd.png",width =9 ,height = 9,units = "in",res=72)
coveffectsplot::forest_plot(coveffectsdatacovrepbsv,
                            ref_area = c(0.5, 1/0.5),
                            x_range = c(0.25,4),
                            strip_placement = "outside",
                            base_size = 16,
                            y_label_text_size = 12,
                            xlabel = "Fold Change Relative to Reference",
                            ref_legend_text =
                              "Reference (vertical line)\nClinically relevant limits\n(gray area)",
                            area_legend_text =
                              "Reference (vertical line)\nClinically relevant limits\n(gray area)",
                            interval_legend_text = interval_legend_text,
                            interval_bsv_text = interval_bsv_text,
                            facet_formula = "covname~paramname",
                            facet_switch = "y",
                            facet_scales = "free_y",
                            facet_space = "free",
                            paramname_shape = FALSE,
                            table_position = "below",
                            table_text_size=4,
                            plot_table_ratio = 1,
                            table_facet_switch = "both",
                            show_table_facet_strip = "both",
                            show_table_yaxis_tick_label = TRUE,
                            logxscale = TRUE,
                            major_x_ticks = c(0.5,1,1/0.5),
                            return_list = FALSE)
dev.off()


```
![Covariate Effects Plot.](./coveffectsplotpd.png)

