## Overview
<!--START_EXPLANATION-->
This document contains exploratory plots for binary response data as well as the R code that generates these graphs. The plots presented here are based on simulated data ([see: PKPD Datasets](PKPD_Datasets.html)). Data specifications can be accessed on [Datasets](Datasets.html) and Rmarkdown template to generate this page can be found on [Rmarkdown-Template](Rmarkdown/Multiple_Ascending_Dose_PD_binary.Rmd). You may also download the Multiple Ascending Dose PK/PD dataset for your reference ([download dataset](Data/Multiple_Ascending_Dose_Dataset2.csv)).
<!--END_EXPLANATION-->

## Setup

```{r, error = TRUE, echo = TRUE, warning = FALSE, message = FALSE}
library(gridExtra)
library(ggplot2)
library(dplyr)
library(xgxr)
library(tidyr)

#set seed for random number generator (for plots with jitter)
set.seed(12345)

#flag for labeling figures as draft
status = "DRAFT"

# ggplot settings
xgx_theme_set()

#directories for saving individual graphs
dirs = list(
  parent_dir = "Parent_Directory",
  rscript_dir  = "./",
  rscript_name = "Example.R",
  results_dir  = "./",
  filename_prefix   = "",
  filename     = "Example.png")
```

## Load Dataset
<!--START_EXPLANATION-->
The plots presented here are based on simulated data ([see: PKPD Datasets](PKPD_Datasets.html)). You may also download the Multiple Ascending Dose PK/PD dataset for your reference ([download dataset](Data/Multiple_Ascending_Dose_Dataset2.csv)).
<!--END_EXPLANATION-->
```{r, error = TRUE, warning = FALSE, message = FALSE}
data <- read.csv("../Data/Multiple_Ascending_Dose_Dataset2.csv")

DOSE_CMT = 1
PD_CMT = 6
SS_PROFDAY = 6 # steady state prof day
PD_PROFDAYS <- c(0, 2, 4, 6)

#ensure dataset has all the necessary columns
data = data %>%
  mutate(ID      = ID,     #ID   column
         TIME    = TIME,   #TIME column name 
         NOMTIME = NOMTIME,#NOMINAL TIME column name
         PROFDAY = case_when(
           NOMTIME < (SS_PROFDAY - 1)*24 ~ 1 + floor(NOMTIME / 24),
           NOMTIME >= (SS_PROFDAY - 1)*24 ~ SS_PROFDAY
         ), #PROFILE DAY day associated with profile, e.g. day of dose administration
         LIDV    = LIDV,   #DEPENDENT VARIABLE column name
         CENS    = CENS,   #CENSORING column name
         CMT     = CMT,    #COMPARTMENT column
         DOSE    = DOSE,   #DOSE column here (numeric value)
         TRTACT  = TRTACT, #DOSE REGIMEN column here (character, with units),
         DAY_label = ifelse(PROFDAY > 0, paste("Day", PROFDAY), "Baseline")
  )

#create a factor for the treatment variable for plotting
data = data %>%
  arrange(DOSE) %>%
  mutate(TRTACT_low2high = factor(TRTACT, levels = unique(TRTACT)),
         TRTACT_high2low = factor(TRTACT, levels = rev(unique(TRTACT)))) %>%
  select(-TRTACT)    

#create pd binary dataset
pd_data <- data %>%
  filter(CMT == PD_CMT) %>%
  mutate(LIDV_jitter = jitter(LIDV, amount = 0.1)) %>%
  mutate(DAY_jitter = jitter(PROFDAY, amount = 0.1))

#units and labels
  time_units_dataset = "hours"
  time_units_plot    = "days"
  trtact_label       = "Dose"
  dose_label         = "Dose (mg)"
  pd_label           = "Responder Rate (%)"
  pd2_label          = "Response"

```
<!--START_EXPLANATION-->
Binary data is data that can take on one of two values. This often happens when there is a characteristic/event/response, etc. of interest that subjects either have/achieve or they don't. Binary response data can also come out of dichotomizing continuous data. For example in the psoriasis indication the binary response variable PASI90 (yes/no) is defined as subjects achieving a PASI score of at least 90.

There are two broad categories of PK/PD exploratory plots covered on this page

1. *Exposure and Response vs Time*, stratified by dose. You may also have heard these referred to as longitudinal (meaning over time).
2. *Response vs Exposure* at a particular time.  For binomial response vs exposure plots, fitting a logistic regression is often helpful, as you will see below.

These plots are displayed below.

## Provide an overview of the data

We start with *Response vs Time*, or longitudinal plots 

Binary data is often summarized by displaying the percent of subjects in the "yes" category, e.g. the percent of "responders," along with 95% confidence intervals.  For generating confidence intervals, it is useful to bin data points by nominal time; confidence intervals should be calculated using the `binom::binom.exact()` function.

### Responder rate (95% CI) by nominal time, colored or faceted by dose

Questions to ask when looking at these plots

* Does the response rate increase/decrease over time? 
* Does response change with increasing dose?
* Do you notice a plateau in time?
* Do you notice a plateau with dose (Emax)?

**Warning:** Even if you don't see a plateau in response, that doesn't mean there isn't one. Be very careful about using linear models for Dose-Response relationships. Extrapolation outside of the observed dose range could indicate a higher dose is always better (even if it isn't).

When overlaying individual binomial data, it is often helpful to stagger the dots and use transparency, so that it is easier to see individual data points.  If you do so, this should be clearly stated.  
<!--END_EXPLANATION-->
```{r, error = TRUE, cache = TRUE, fig.width = 10, fig.height = 4, warning = FALSE, message = FALSE} 

  gg <- ggplot(data = pd_data, aes(x = NOMTIME, y = LIDV, color = TRTACT_high2low))
  gg <- gg + xgx_stat_ci(distribution = "binomial", position = position_dodge(width = 12), alpha = 0.5)
  gg <- gg + xgx_scale_x_time_units(units_dataset = time_units_dataset, 
                                    units_plot    = time_units_plot)
  gg <- gg + scale_y_continuous(labels = scales::percent)
  gg <- gg + labs(y = pd_label, color = trtact_label)  
  gg <- gg + xgx_annotate_status(status)
  
  #if saving copy of figure, replace xgx_annotate lines with xgx_save() shown below:
  #xgx_save(width,height,dirs,"filename_main",status)
  print(gg)

```

```{r, error = TRUE, cache = TRUE, fig.width = 10, fig.height = 3, warning = FALSE, message = FALSE}

  gg <- ggplot(data = pd_data, aes(x = PROFDAY, y = LIDV))
  gg <- gg + geom_point(aes(x = DAY_jitter, y = LIDV_jitter), size = 2, alpha = 0.3)
  gg <- gg + xgx_stat_ci(conf_level = 0.95, distribution = "binomial", geom = list("line", "ribbon"))

  gg <- gg + xgx_scale_x_time_units(units_dataset = time_units_plot, 
                                    units_plot    = time_units_plot)
  gg <- gg + scale_y_continuous(breaks = seq(0, 1, 0.25), labels = scales::percent)
  gg <- gg + labs(y = pd_label)  
  gg <- gg + facet_grid(~TRTACT_low2high)
  gg <- gg + xgx_annotate_status(status)
  
  #if saving copy of figure, replace xgx_annotate lines with xgx_save() shown below:
  #xgx_save(width,height,dirs,"filename_main",status)
  print(gg)
```

## Explore variability

### Spaghetti plots of binary response over time, faceted by dose
<!--START_EXPLANATION-->
Use spaghetti plots to visualize the extent of variability between individuals. The wider the spread of the profiles, the higher the between subject variability. Distinguish different doses by color, or separate into different panels. 

Binary spaghetti plots may not be as informative as spaghetti plots for continuous data, however you can pick out the transition states from 0 to 1 and back. By looking at the transition states, ask yourself these questions: For each dose group, at what time have most of the subjects "responded"? How wide is the spread of "response time"" across subjects (do all of them respond at the exact same time, or over a range of time?) Do you detect any dampening, or transitioning of response back to no response?
<!--END_EXPLANATION-->
```{r, error = TRUE, cache = TRUE, fig.width = 10, fig.height = 3, warning = FALSE, message = FALSE}
gg <- ggplot(data = pd_data, 
             aes(x = DAY_jitter, y = LIDV_jitter))
gg <- gg + geom_point( size = 2, alpha = 0.3)
gg <- gg + geom_line(aes(group = ID), alpha = 0.3) 
gg <- gg + xgx_scale_x_time_units(units_dataset = time_units_plot, 
                                    units_plot    = time_units_plot)
gg <- gg + scale_y_continuous(breaks = seq(0, 1, 0.25))
gg <- gg + labs(y = pd2_label)  
gg <- gg + facet_grid(~TRTACT_low2high)
gg <- gg + xgx_annotate_status(status)

#if saving copy of figure, replace xgx_annotate lines with xgx_save() shown below:
#xgx_save(width,height,dirs,"filename_main",status)
print(gg)


```

## Explore irregularities in profiles
<!--START_EXPLANATION-->
Plot individual profiles in order to inspect them for any unusual profiles. Look at the pattern of response/non-response over time and whether individuals switch from responder back to non-responder.  
<!--END_EXPLANATION-->

### Response over time, faceted by individual, individual line plots

```{r, error = TRUE, cache = TRUE, fig.width = 10, fig.height = 8, warning = FALSE, message = FALSE}

gg <- ggplot(data = pd_data, 
             aes(x = NOMTIME, y = LIDV))
gg <- gg + geom_point(size = 2) 
gg <- gg + geom_line(aes(group = ID)) 
gg <- gg + xgx_scale_x_time_units(units_dataset = time_units_dataset, 
                                    units_plot  = time_units_plot)
gg <- gg + facet_wrap(~ID + TRTACT_low2high, 
                ncol = 10)
gg <- gg + labs(y = pd2_label)  
gg <- gg + xgx_annotate_status(status)

#if saving copy of figure, replace xgx_annotate lines with xgx_save() shown below:
#xgx_save(width,height,dirs,"filename_main",status)
print(gg)

```

## Explore covariate effects on PD
<!--START_EXPLANATION-->
Stratify by covariates of interest to explore whether any key covariates impact response. For examples of plots and code startifying by covariate, see [Single Ascending Dose Covariate Section](Single_Ascending_Dose_PK.html#explore_covariate_effects_on_pk)

**Warning** Be careful of interpreting covariate effects on PD. Covariate effects on PD could be the result of covariate effects on PK transfering to PD through the PK/PD relationship.

## Explore Dose-Response relationship

One of the key questions when looking at PD markers is to determine if there is a dose-response relationship, and if there is, what dose is necessary to achieve the desired effect? Simple dose-response plots can give insight into these questions.

### Responder rate (95% CI) by dose, for endpoint of interest 

Both linear scale and log scale may be used for dose.  Linear scale helps in seeing a plateau at large doses.  Log-scale often helps to see all dose groups.  If the plot on log-scale looks linear, a log-linear dose-response model could be fit, i.e. Response = Elog*log(1+C).

Questions to consider 

* Do you see any relationship? 
* Does response increase or decrease with dose? 
* Is there a plateau (Emax or Emin) with drug effect? At what dose?

**Warning:** Even if you don't see an Emax, that doesn't mean there isn't one. Be very careful about using linear models for Dose-Response relationships. Extrapolation outside of the observed dose range could indicate a higher dose is always better (even if it isn't).
<!--END_EXPLANATION-->
```{r, error = TRUE, cache = TRUE, fig.width = 8, fig.height = 4, warning = FALSE, message = FALSE} 
pd_data_to_plot <- pd_data %>% subset(PROFDAY == SS_PROFDAY)

gg <- ggplot(data = pd_data_to_plot, aes(x = DOSE,y = LIDV))
gg <- gg + xgx_stat_ci(conf_level = .95,distribution = "binomial", geom = list("point","errorbar"))
gg <- gg + geom_smooth(method = "glm", method.args = list(family = binomial(link = logit)), color = "black")
gg <- gg + scale_y_continuous(breaks = seq(0, 1, 0.25), labels = scales::percent)
gg <- gg + coord_cartesian(ylim = c(0, 1))
gg <- gg + labs(x = dose_label, y = pd_label)
gg <- gg + xgx_annotate_status(status)

pp1 <- gg + ggtitle("Dose on Linear Scale")


## Same plot but on a log scale
pp2 <- gg + scale_x_log10(breaks = unique(pd_data_to_plot$DOSE))+ ggtitle("Dose on Log Scale")

grid.arrange(pp1,pp2,nrow = 1)

```

### Responder rate (95% CI) by dose, faceted by visit
<!--START_EXPLANATION-->
The crossectional Dose-Response curve which looks only at one timepoint defined in the protocol can obscure certain characteristics of the dose-response relationship. For example, if the response variable is much delayed compared to PK the maximal PD effect could occur much later than steady state PK is achieved. Looking only at the defined clinical endpoint has the potential miss this, especially in early clinical trials before the time course of the effect has been characterized. In addtion to looking at longitudinal PD over time (as in previous sections above), plotting the cross-sectional Dose-Response curves for different time points throughout the study can also be helpful. In the figure below, we plot the exposure response relationship at a number of different visits to see how the relationsihp might change over time.
<!--END_EXPLANATION-->
```{r, error = TRUE, cache = TRUE, fig.width = 8, fig.height = 3, warning = FALSE, message = FALSE} 
pd_data_to_plot <- pd_data %>% subset(PROFDAY %in% PD_PROFDAYS)

gg <- ggplot(data = pd_data_to_plot, aes(x = DOSE,y = LIDV))
gg <- gg + xgx_stat_ci(conf_level = .95,distribution = "binomial", geom = list("point","errorbar"))
gg <- gg + geom_smooth(method = "glm", method.args = list(family = binomial(link = logit)), color = "black")
gg <- gg + scale_y_continuous(breaks = seq(0, 1, 0.25), labels = scales::percent)
gg <- gg + coord_cartesian(ylim = c(0, 1))
gg <- gg + labs(x = dose_label, y = pd_label)
gg + facet_grid(~DAY_label)
gg <- gg + xgx_annotate_status(status)

```

## R Session Info
```{r}
sessionInfo()
```