Overview

This document contains exploratory plots for ordinal response data as well as the R code that generates these graphs. The plots presented here are based on simulated data (see: PKPD Datasets). Data specifications can be accessed on Datasets and Rmarkdown template to generate this page can be found on Rmarkdown-Template. You may also download the Multiple Ascending Dose PK/PD dataset for your reference (download dataset).

Ordinal data can be thought of as categorical data that has a natural order. For example, mild, moderate or severe. Another example could be Grade 1, Grade 2, Grade 3. Ordinal data can also come out of stratifying continuous data, for example binning a continuous variable into quartiles, or defining (arbitrary or meaningful) cutoffs for a continuous variable. Since ordinal data has a natural order, it is important to preserve that order when creating plots.

Setup

# remove reference to home directory in libPaths
.libPaths(grep("home", .libPaths(), value=TRUE, invert=TRUE))
.libPaths(grep("usr", .libPaths(), value=TRUE, invert=TRUE))

# add localLib to libPaths for locally installed packages
.libPaths(c("localLib", .libPaths()))

# will load from first filepath first, then look in .libPaths for more packages not in first path
# version matches package in first filepath, in the case of multiple instances of a package

# library(rmarkdown)
library(gridExtra)
library(grid)
library(ggplot2)
library(dplyr)
library(RxODE)
library(caTools)

#flag for labeling figures as draft
  draft.flag      = TRUE

## ggplot settings
theme_set(theme_bw(base_size=12))

Define Useful Graphics Functions

# annotation of plots with status of code
AnnotateStatus <- function(draft.flag, log.y=FALSE, log.x=FALSE, fontsize=7, color="grey") {
  
  x.pos <- -Inf
  if (log.x)
    x.pos <- 0
  
  y.pos <- -Inf
  if (log.y)
    y.pos <- 0
  
  if(draft.flag) {
    annotateStatus <- annotate("text",
                               label="DRAFT",
                               x=x.pos, y=y.pos,
                               hjust=-0.1, vjust=-1.0,
                               cex=fontsize,
                               col=color, alpha=0.7, fontface="bold")
  } else {
    annotateStatus <- NULL
  }
  
  return(annotateStatus)
}

Load Dataset

my.data <- read.csv("../Data/Multiple_Ascending_Dose_Dataset2.csv")

my.data$TRTACT <- factor(my.data$TRTACT,levels = c("Placebo",paste(unique(my.data$DOSE[my.data$DOSE!=0]),"mg")))

my.data$Severity <- my.data$LIDV
my.data[my.data$CMT!=5,]$Severity <- NA
my.data$Severity_label <- factor(plyr::mapvalues(my.data$Severity,c(1,2,3), c("Mild", "Moderate","Severe")), levels = c("Mild","Moderate","Severe"))

Provide an overview of the data

Percent of subjects by response category over time, faceted by dose

data_to_plot <- my.data[my.data$CMT==5,]

data_to_plot$Response <- factor(data_to_plot$Severity_label, levels = rev(levels(data_to_plot$Severity_label)))
# data_to_plot$Response <- data_to_plot$Severity_label

gg <- ggplot(data = data_to_plot, aes(x = factor(PROFDAY), fill = Response)) + theme_bw()
gg <- gg + geom_bar(position = "fill") + scale_y_continuous(labels = scales::percent)
gg <- gg + ylab("Responder Rate (%)") + xlab("Time (days)") + guides(fill=guide_legend(""))
gg <- gg + scale_fill_brewer(palette=6)
gg + facet_grid(.~TRTACT)

Explore variability

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. If coloring by dose, do the individuals in the different dose groups overlap across doses? Does there seem to be more variability at higher or lower concentrations?

Spaghetti plots of ordinal response over time, faceted by dose

data_to_plot <- my.data[my.data$CMT==5,]
set.seed(12345)
data_to_plot$Severity2 <- jitter(data_to_plot$Severity, amount=0.1)
data_to_plot$DAY2 <- jitter(data_to_plot$PROFDAY, amount=0.1)

gg <- ggplot(data = data_to_plot, 
               aes(x=DAY2,y=Severity2))+theme_bw()
  gg <- gg + geom_point( size=2, alpha = 0.3) +  geom_line( aes(group = ID), alpha = 0.3) 
  gg <- gg + guides(color=guide_legend(""),fill=guide_legend(""))
  gg <- gg  + xlab("Time (days)")
  gg <- gg + facet_grid(~TRTACT)
    gg <- gg + ylab("Severity") + scale_y_continuous(breaks=c(1,2,3), labels=c("Mild","Moderate","Severe"))
gg

Explore irregularities in profiles

Plot individual profiles in order to inspect them for any irregularities. Inspect the profiles for outlying data points that may skew results or bias conclusions.

Ordinal response over time, faceted by individual, individual line plots

data_to_plot <- my.data[my.data$CMT==5,]

gg <- ggplot(data = data_to_plot, 
               aes(x=PROFDAY,y=Severity_label))+theme_bw()
  gg <- gg + geom_point( size=2) +  geom_line( aes(group = ID)) 
  gg <- gg + guides(color=guide_legend(""),fill=guide_legend(""))
  gg <- gg  + xlab("Time (days)")+ scale_x_continuous(breaks = seq(0,max(data_to_plot$PROFDAY)+1,7))
  gg <- gg + facet_wrap(~ID+TRTACT,ncol = length(unique(data_to_plot$ID))/length(unique(data_to_plot$DOSE)) )
    gg <- gg + ylab("Severity") #+ scale_y_continuous(labels=scales::percent)
gg

Explore covariate effects on PD

(coming soon)

Explore Dose-Response Relationship

Percent of subjects by response category against dose, faceted by time

data_to_plot <- my.data[my.data$CMT==5,]
data_to_plot$DAY_label <- paste("Day", data_to_plot$PROFDAY)
data_to_plot$DAY_label[data_to_plot$DAY_label=="Day 0"] = "Baseline"
data_to_plot <- data_to_plot[data_to_plot$DAY_label%in%c("Day 5"),]

# data_to_plot$DAY_label <- factor(data_to_plot$DAY_label, levels = rev(sort(unique(data_to_plot$DAY_label))))

data_to_plot$Response <- factor(data_to_plot$Severity_label, levels = rev(levels(data_to_plot$Severity_label)))

gg <- ggplot(data = data_to_plot, aes(x = factor(DOSE), fill = Response)) + theme_bw()
gg <- gg + geom_bar(position = "fill") + scale_y_continuous(labels = scales::percent)
gg <- gg + ylab("Responder Rate (%)") + xlab("Dose (mg)") + guides(fill=guide_legend(""))
gg <- gg + scale_fill_brewer(palette=6)
gg + facet_grid(.~DAY_label)

Percent of subjects by response category against dose, faceted by day

data_to_plot <- my.data[my.data$CMT==5,]
data_to_plot$DAY_label <- paste("Day", data_to_plot$PROFDAY)
data_to_plot$DAY_label[data_to_plot$DAY_label=="Day 0"] = "Baseline"
data_to_plot <- data_to_plot[data_to_plot$DAY_label%in%c("Day 1","Day 3","Day 5"),]

# data_to_plot$DAY_label <- factor(data_to_plot$DAY_label, levels = rev(sort(unique(data_to_plot$DAY_label))))

data_to_plot$Response <- factor(data_to_plot$Severity_label, levels = rev(levels(data_to_plot$Severity_label)))

gg <- ggplot(data = data_to_plot, aes(x = factor(DOSE), fill = Response)) + theme_bw()
gg <- gg + geom_bar(position = "fill") + scale_y_continuous(labels = scales::percent)
gg <- gg + ylab("Responder Rate (%)") + xlab("Dose (mg)") + guides(fill=guide_legend(""))
gg <- gg + scale_fill_brewer(palette=6)
gg + facet_grid(.~DAY_label)

Ordinal response against dose

data_to_plot <- my.data[my.data$CMT==5,]
data_to_plot$DAY_label <- paste("Day", data_to_plot$PROFDAY)
data_to_plot$DAY_label[data_to_plot$DAY_label=="Day 0"] = "Baseline"
data_to_plot <- data_to_plot[data_to_plot$DAY_label%in%c("Day 5"),]


data_to_plot$TRTACT <- factor(data_to_plot$TRTACT, levels = rev(levels(data_to_plot$TRTACT)))

gg <- ggplot(data = data_to_plot, aes(y=DOSE,x=Severity_label))+theme_bw()
gg <- gg + geom_jitter(data = data_to_plot, 
                       aes(color = TRTACT), shape=19,  width = 0.1, height = 0, alpha = 0.5)
gg <- gg + geom_boxplot(width = 0.5, fill = NA, outlier.shape=NA) 
gg <- gg + guides(color=guide_legend(""),fill=guide_legend(""))
gg <- gg + coord_flip() 
gg <- gg + xlab("Severity") + ylab("Dose (mg)")
gg + facet_grid(.~DAY_label)

Ordinal response against dose, faceted by day

data_to_plot <- my.data[my.data$CMT==5,]
data_to_plot$DAY_label <- paste("Day", data_to_plot$PROFDAY)
data_to_plot$DAY_label[data_to_plot$DAY_label=="Day 0"] = "Baseline"
data_to_plot <- data_to_plot[data_to_plot$DAY_label%in%c("Day 1","Day 3","Day 5"),]


data_to_plot$TRTACT <- factor(data_to_plot$TRTACT, levels = rev(levels(data_to_plot$TRTACT)))

gg <- ggplot(data = data_to_plot, aes(y=DOSE,x=Severity_label))+theme_bw()
gg <- gg + geom_jitter(data = data_to_plot, 
                       aes(color = TRTACT), shape=19,  width = 0.1, height = 0, alpha = 0.5)
gg <- gg + geom_boxplot(width = 0.5, fill = NA, outlier.shape=NA) 
gg <- gg + guides(color=guide_legend(""),fill=guide_legend(""))
gg <- gg + coord_flip() 
gg <- gg + xlab("Severity") + ylab("Dose (mg)")
gg + facet_grid(.~DAY_label)

R Session Info

sessionInfo()
## R version 3.4.3 (2017-11-30)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Red Hat Enterprise Linux Server 7.4 (Maipo)
## 
## Matrix products: default
## BLAS/LAPACK: /CHBS/apps/intel/17.4.196/compilers_and_libraries_2017.4.196/linux/mkl/lib/intel64_lin/libmkl_gf_lp64.so
## 
## locale:
##  [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C              
##  [3] LC_TIME=en_US.UTF-8        LC_COLLATE=en_US.UTF-8    
##  [5] LC_MONETARY=en_US.UTF-8    LC_MESSAGES=en_US.UTF-8   
##  [7] LC_PAPER=en_US.UTF-8       LC_NAME=C                 
##  [9] LC_ADDRESS=C               LC_TELEPHONE=C            
## [11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C       
## 
## attached base packages:
## [1] grid      stats     graphics  grDevices utils     datasets  methods  
## [8] base     
## 
## other attached packages:
##  [1] DT_0.2         RxODE_0.6-1    bindrcpp_0.2   haven_1.1.0   
##  [5] readr_1.1.1    readxl_1.0.0   xtable_1.8-2   tidyr_0.7.2   
##  [9] caTools_1.17.1 zoo_1.8-0      dplyr_0.7.4    ggplot2_2.2.1 
## [13] gridExtra_2.3 
## 
## loaded via a namespace (and not attached):
##  [1] Rcpp_0.12.14       RColorBrewer_1.1-2 cellranger_1.1.0  
##  [4] compiler_3.4.3     pillar_1.0.1       plyr_1.8.4        
##  [7] bindr_0.1          forcats_0.2.0      bitops_1.0-6      
## [10] tools_3.4.3        digest_0.6.13      jsonlite_1.5      
## [13] memoise_1.1.0      evaluate_0.10.1    tibble_1.4.1      
## [16] gtable_0.2.0       lattice_0.20-35    pkgconfig_2.0.1   
## [19] rlang_0.1.6        rex_1.1.2          yaml_2.1.16       
## [22] stringr_1.2.0      knitr_1.18         hms_0.4.0         
## [25] htmlwidgets_0.9    rprojroot_1.3-1    glue_1.2.0        
## [28] R6_2.2.2           binom_1.1-1        rmarkdown_1.8     
## [31] reshape2_1.4.3     purrr_0.2.4        magrittr_1.5      
## [34] codetools_0.2-15   backports_1.1.2    scales_0.5.0      
## [37] htmltools_0.3.6    rsconnect_0.8.5    assertthat_0.2.0  
## [40] colorspace_1.3-2   labeling_0.3       stringi_1.1.3     
## [43] lazyeval_0.2.1     munsell_0.4.3      markdown_0.8