PK - Single Ascending Dose
Alison Margolskee, Andy Stein
Overview
This document contains exploratory plots for single ascending dose PK data as well as the R code that generates these graphs. The plots presented here are based on simulated data (see: PKPD Datasets). You may also download the Single Ascending Dose PK dataset for your reference (download dataset). Data specifications can be accessed on Datasets and Rmarkdown template to generate this page can be found on Rmarkdown-Template.
Setup
library(ggplot2)
library(dplyr)
library(tidyr)
library(xgxr)
#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
#load dataset
pkpd_data <- read.csv("../Data/Single_Ascending_Dose_Dataset2.csv")
#ensure dataset has all the necessary columns
pkpd_data = pkpd_data %>%
mutate(ID = ID, #ID column
TIME = TIME, #TIME column name, time relative to first dose
NOMTIME = NOMTIME,#NOMINAL TIME column name
EVID = EVID ,#EVENT ID, >=1 is dose, otherwise measurement
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),
LIDV_NORM = LIDV/DOSE,
LIDV_UNIT = ifelse(CMT==2, "ng/ml", NA )
)
#create a factor for the treatment variable for plotting
pkpd_data = pkpd_data %>%
arrange(DOSE) %>%
mutate(TRTACT_low2high = factor(TRTACT, levels = unique(TRTACT)),
TRTACT_high2low = factor(TRTACT, levels = rev(unique(TRTACT)))) %>%
select(-TRTACT)
#create pk dataset
pk_data <- pkpd_data %>%
filter(CMT==2)
#perform NCA, for additional plots
NCA = pk_data %>%
group_by(ID, DOSE) %>%
filter(!is.na(LIDV)) %>%
summarize(AUC_last = caTools::trapz(TIME,LIDV),
Cmax = max(LIDV),
SEX = SEX[1], #this part just keeps the SEX and WEIGHTB covariates
WEIGHTB = WEIGHTB[1]) %>%
gather(PARAM, VALUE,-c(ID, DOSE, SEX, WEIGHTB)) %>%
ungroup() %>%
mutate(VALUE_NORM = VALUE/DOSE)
#units and labels
time_units_dataset = "hours"
time_units_plot = "days"
trtact_label = "Dose"
dose_label = "Dose (mg)"
conc_units = "ng/ml"
AUC_units = paste0("h.", conc_units)
conc_label = paste0("Concentration (", conc_units, ")")
concnorm_label = paste0("Normalized Concentration (", conc_units, ")/mg")Provide an overview of the data
Summarize the data in a way that is easy to visualize the general trend of PK over time and between doses. Using summary statistics can be helpful, e.g. Mean +/- SE, or median, 5th & 95th percentiles. Consider either coloring by dose or faceting by dose. Depending on the amount of data one graph may be better than the other.
When looking at summaries of PK over time, there are several things to observe. Note the number of doses and number of time points or sampling schedule. Observe the overall shape of the average profiles. What is the average Cmax per dose? Tmax? Does the elimination phase appear to be parallel across the different doses? Is there separation between the profiles for different doses? Can you make a visual estimate of the number of compartments that would be needed in a PK model?
For PK data, we recommend plotting both on a linear scale, and on a log scale. Linear scale will help you better to see the Cmax, while log scale will help you to detect number of compartments, half-life and potential nonlinearity of clearance.
Concentration over time, colored by Dose, mean +/- 95% CI
gg <- ggplot(data = pk_data, aes(x = NOMTIME, y = LIDV, group= TRTACT_high2low, color = TRTACT_high2low))
gg <- gg + xgx_stat_ci(conf_level = .95)
gg <- gg + xgx_scale_x_time_units(units_dataset = time_units_dataset,
units_plot = time_units_plot)
gg <- gg + labs(y=conc_label,color = trtact_label)
gg <- gg + xgx_annotate_status(status)
gg <- gg + xgx_annotate_filenames(dirs)
#if saving copy of figure, replace xgx_annotate lines with xgx_save() shown below:
#xgx_save(width,height,dirs,"filename_main",status)
print(gg)
print(gg + xgx_scale_y_log10() )
Concentration over time, faceted by Dose, mean +/- 95% CI, overlaid on gray spaghetti plots
gg <- ggplot(data = pk_data, aes(x = TIME, y = LIDV))
gg <- gg + geom_line(aes(group = ID), color = rgb(0.5,0.5,0.5), size = 1, alpha = 0.3)
gg <- gg + geom_point(aes(color = factor(CENS), shape = factor(CENS), alpha = 0.3), size = 2, alpha = 0.3)
gg <- gg + scale_shape_manual(values=c(1,8))
gg <- gg + scale_color_manual(values=c("grey50","red"))
gg <- gg + xgx_stat_ci(aes(x = NOMTIME, color=NULL, group=NULL), conf_level = 0.95)
gg <- gg + xgx_scale_y_log10()
gg <- gg + xgx_scale_x_time_units(units_dataset = time_units_dataset,
units_plot = time_units_plot)
gg <- gg + labs(y=conc_label,color = trtact_label)
gg <- gg + theme(legend.position="none") + facet_grid(.~TRTACT_low2high)
gg <- gg + xgx_annotate_status(status)
gg <- gg + xgx_annotate_filenames(dirs)
#if saving copy of figure, replace xgx_annotate lines with xgx_save() shown below:
#xgx_save(width,height,dirs,"filename_main",status)
print(gg)
Assess the dose linearity of exposure
Dose Normalized Concentration over time, colored by Dose, mean +/- 95% CI
gg <- ggplot(data = pk_data,
aes(x = NOMTIME, y = LIDV_NORM,
group = TRTACT_high2low, color = TRTACT_high2low))
gg <- gg + xgx_stat_ci(conf_level = 0.95, alpha = 0.5, position = position_dodge(1))
gg <- gg + xgx_scale_y_log10()
gg <- gg + xgx_scale_x_time_units(units_dataset = time_units_dataset,
units_plot = time_units_plot)
gg <- gg + labs(y=concnorm_label, color = trtact_label)
gg <- gg + xgx_annotate_status(status)
gg <- gg + xgx_annotate_filenames(dirs)
#if saving copy of figure, replace xgx_annotate lines with xgx_save() shown below:
#xgx_save(width,height,dirs,"filename_main",status)
print(gg)
NCA of dose normalized AUC and Cmax vs Dose
Observe the dose normalized AUC and Cmax over different doses. Does the relationship appear to be constant across doses or do some doses stand out from the rest? Can you think of reasons why some would stand out? For example, the lowest dose may have dose normalized AUC much higher than the rest, could this be due to BLQ observations? If the highest doses have dose normalized AUC much higher than the others, could this be due to nonlinear clearance, with clearance saturating at higher doses? If the highest doses have dose normalized AUC much lower than the others, could there be saturation of bioavailability, reaching the maximum absorbable dose?
gg <- ggplot(data = NCA, aes(x = DOSE, y = VALUE_NORM))
gg <- gg + geom_boxplot(aes(group = DOSE))
gg <- gg + geom_smooth(method = "lm", color = "black")
gg <- gg + facet_wrap(~PARAM, scales = "free_y")
gg <- gg + labs(x = dose_label, y = concnorm_label)
gg <- gg + xgx_annotate_status(status)
gg <- gg + xgx_annotate_filenames(dirs)
#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
Now that the overall trends in the mean data have been observed, look into the between subject variability by plotting spaghetti plots. Consider again whether to color by dose or facet by dose. 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?
Concentration over time, colored by Dose, dots and lines grouped by individual
gg <- ggplot(data = pk_data, aes(x = TIME, y = LIDV))
gg <- gg + geom_line(aes(group = ID, color = factor(TRTACT_high2low)), size = 1, alpha = 0.5)
gg <- gg + geom_point(data = pk_data %>% filter(CENS==0), aes(color = TRTACT_high2low), size = 2, alpha = 0.5)
gg <- gg + geom_point(data = pk_data %>% filter(CENS==1), color="red", shape=8, size = 2, alpha = 0.5)
gg <- gg + xgx_scale_y_log10()
gg <- gg + xgx_scale_x_time_units(units_dataset = time_units_dataset,
units_plot = time_units_plot)
gg <- gg + labs(y = conc_label, color = trtact_label)
gg <- gg + xgx_annotate_status(status)
gg <- gg + xgx_annotate_filenames(dirs)
#if saving copy of figure, replace xgx_annotate lines with xgx_save() shown below:
#xgx_save(width,height,dirs,"filename_main",status)
print(gg)
Concentration over time, faceted by Dose, dots and lines grouped by individual
gg <- ggplot(data = pk_data, aes(x = TIME, y = LIDV))
gg <- gg + geom_line(aes(group = ID), size = 1, alpha = 0.2)
gg <- gg + geom_point(aes(color = factor(CENS), shape = factor(CENS), alpha = 0.3), size = 2, alpha = 0.2)
gg <- gg + scale_shape_manual(values=c(1,8))
gg <- gg + scale_color_manual(values=c("grey50","red"))
gg <- gg + xgx_scale_y_log10()
gg <- gg + xgx_scale_x_time_units(units_dataset = time_units_dataset,
units_plot = time_units_plot)
gg <- gg + labs(y = conc_label, shape = "BLQ", color = "BLQ")
gg <- gg + facet_grid(.~TRTACT_low2high)
gg <- gg + xgx_annotate_status(status)
gg <- gg + xgx_annotate_filenames(dirs)
#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
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. Looking at the shapes of the individual profiles now, do they support your observations made about the mean profile (e.g. number of compartments, typical Cmax, Tmax)?
Plotting individual profiles on top of gray spaghetti plots puts individual profiles into context, and may help identify outlying individuals for further inspection. Are there any individuals that appear to have very high or low Cmax compared to others within the same dose group? What about the timing of Cmax? What about the slope of the elimination phase? Does it appear that any subjects could have received an incorrect dose?
Concentration over time, faceted by individual, individual line plots overlaid on gray spaghetti plots for that dose group
pk_data_rep_by_trt <- list()
for(id in unique(pk_data$ID)){
indiv_data <- pk_data %>% subset(ID == id)
itrtact = unique(indiv_data$TRTACT_low2high)
pk_data_rep_by_trt[[as.character(id)]] <- pk_data %>%
subset(TRTACT_low2high == itrtact) %>%
mutate(ID_rep_by_trt = ID, ID = id)
}
pk_data_rep_by_trt <- bind_rows(pk_data_rep_by_trt)
gg <- ggplot(mapping = aes(x = TIME, y = LIDV))
gg <- gg + geom_line(data = pk_data_rep_by_trt,
aes(group = ID_rep_by_trt),
size = 1, color = rgb(0.5,0.5,0.5), alpha = 0.3)
gg <- gg + geom_line(data = pk_data,
aes(group = ID), size = 1)
gg <- gg + geom_point(data = pk_data %>% filter(CENS==1),
color="red", shape=8, size = 2)
gg <- gg + xgx_scale_y_log10()
gg <- gg + xgx_scale_x_time_units(units_dataset = time_units_dataset,
units_plot = time_units_plot)
gg <- gg + labs(y = conc_label)
gg <- gg + theme(legend.position="none")
gg <- gg + facet_wrap(~ID + TRTACT_low2high,
ncol = 10 )
gg <- gg + theme(panel.grid.minor.x = ggplot2::element_line(color = rgb(0.9,0.9,0.9)),
panel.grid.minor.y = ggplot2::element_line(color = rgb(0.9,0.9,0.9)))
gg <- gg + xgx_annotate_status(status, fontsize = 4, color=rgb(0.5,0.5,1))
gg <- gg + xgx_annotate_filenames(dirs)
#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 PK
Concentration over time, colored by categorical covariate, mean +/- 95% CI
gg <- ggplot(data = pk_data, aes(x = NOMTIME, y = LIDV, color = SEX))
gg <- gg + xgx_stat_ci(conf_level = 0.95)
gg <- gg + xgx_scale_y_log10()
gg <- gg + xgx_scale_x_time_units(units_dataset = time_units_dataset,
units_plot = time_units_plot)
gg <- gg + labs(y = conc_label)
gg <- gg + facet_grid(.~TRTACT_low2high)
gg <- gg + xgx_annotate_status(status)
gg <- gg + xgx_annotate_filenames(dirs)
#if saving copy of figure, replace xgx_annotate lines with xgx_save() shown below:
#xgx_save(width,height,dirs,"filename_main",status)
print(gg)
print(gg + aes(group= WEIGHTB>70, color = WEIGHTB>70) )
Dose Normalized Concentration over time, colored by categorical covariate, mean +/- 95% CI
gg <- ggplot(data = pk_data,
aes(x = NOMTIME,
y = LIDV_NORM,
color = SEX))
gg <- gg + xgx_stat_ci(conf_level = 0.95)
gg <- gg + xgx_scale_y_log10()
gg <- gg + xgx_scale_x_time_units(units_dataset = time_units_dataset,
units_plot = time_units_plot)
gg <- gg + ylab(concnorm_label)
gg <- gg + xgx_annotate_status(status)
gg <- gg + xgx_annotate_filenames(dirs)
#if saving copy of figure, replace xgx_annotate lines with xgx_save() shown below:
#xgx_save(width,height,dirs,"filename_main",status)
print(gg)
print(gg+ aes(color = WEIGHTB>70))
gg <- ggplot(data = NCA, aes(x = SEX, y = VALUE_NORM))
gg <- gg + geom_boxplot(aes(group = SEX))
gg <- gg + ylab("") + xlab("Sex")
gg <- gg + facet_wrap(~PARAM, scales = "free_y")
gg <- gg + xgx_annotate_status(status)
gg <- gg + xgx_annotate_filenames(dirs)
#if saving copy of figure, replace xgx_annotate lines with xgx_save() shown below:
#xgx_save(width,height,dirs,"filename_main",status)
print(gg)
gg <- ggplot(data = NCA, aes(x = WEIGHTB, y = VALUE_NORM))
gg <- gg + geom_point()
gg <- gg + ylab("") + xlab("Body Weight (kg)")
gg <- gg + facet_wrap(~PARAM, scales = "free_y")
gg <- gg + geom_smooth(method="lm")
gg <- gg + xgx_annotate_status(status)
gg <- gg + xgx_annotate_filenames(dirs)
#if saving copy of figure, replace xgx_annotate lines with xgx_save() shown below:
#xgx_save(width,height,dirs,"filename_main",status)
print(gg)
gg + aes(color = SEX)
R Session Info
sessionInfo()## R version 4.1.0 (2021-05-18)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Red Hat Enterprise Linux Server 7.9 (Maipo)
##
## Matrix products: default
## BLAS/LAPACK: /CHBS/apps/EB/software/imkl/2019.1.144-gompi-2019a/compilers_and_libraries_2019.1.144/linux/mkl/lib/intel64_lin/libmkl_gf_lp64.so
##
## locale:
## [1] LC_CTYPE=en_US.UTF-8 LC_NUMERIC=C LC_TIME=en_US.UTF-8 LC_COLLATE=en_US.UTF-8 LC_MONETARY=en_US.UTF-8
## [6] LC_MESSAGES=en_US.UTF-8 LC_PAPER=en_US.UTF-8 LC_NAME=C LC_ADDRESS=C LC_TELEPHONE=C
## [11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] RxODE_1.1.1 survminer_0.4.9 ggpubr_0.4.0 survival_3.4-0 knitr_1.40 broom_1.0.1 caTools_1.18.2 DT_0.26 forcats_0.5.2
## [10] stringr_1.4.1 purrr_0.3.5 readr_2.1.3 tibble_3.1.8 tidyverse_1.3.2 xgxr_1.1.1 zoo_1.8-11 gridExtra_2.3 tidyr_1.2.1
## [19] dplyr_1.0.10 ggplot2_3.3.6
##
## loaded via a namespace (and not attached):
## [1] readxl_1.4.1 backports_1.4.1 Hmisc_4.7-0 plyr_1.8.7 splines_4.1.0 RApiSerialize_0.1.0 crosstalk_1.2.0
## [8] digest_0.6.30 htmltools_0.5.3 fansi_1.0.3 magrittr_2.0.3 checkmate_2.1.0 memoise_2.0.1 googlesheets4_1.0.1
## [15] cluster_2.1.3 tzdb_0.3.0 openxlsx_4.2.4 modelr_0.1.9 RcppParallel_5.1.5 prettyunits_1.1.1 jpeg_0.1-9
## [22] colorspace_2.0-3 rvest_1.0.3 PreciseSums_0.5 haven_2.5.1 xfun_0.34 crayon_1.5.2 RCurl_1.98-1.4
## [29] jsonlite_1.8.3 Exact_2.1 stringfish_0.15.7 glue_1.6.2 gtable_0.3.1 gargle_1.2.1 car_3.0-11
## [36] abind_1.4-5 scales_1.2.1 mvtnorm_1.1-3 DBI_1.1.3 GGally_2.1.2 rstatix_0.7.0 Rcpp_1.0.9
## [43] xtable_1.8-4 progress_1.2.2 htmlTable_2.2.1 foreign_0.8-82 proxy_0.4-26 km.ci_0.5-2 Formula_1.2-4
## [50] dparser_1.3.1-5 htmlwidgets_1.5.4 httr_1.4.4 RColorBrewer_1.1-3 ellipsis_0.3.2 pkgconfig_2.0.3 reshape_0.8.8
## [57] lotri_0.4.2 farver_2.1.1 nnet_7.3-17 sass_0.4.2 dbplyr_2.2.1 binom_1.1-1 deldir_1.0-6
## [64] utf8_1.2.2 tidyselect_1.2.0 labeling_0.4.2 rlang_1.0.6 munsell_0.5.0 cellranger_1.1.0 tools_4.1.0
## [71] cachem_1.0.6 cli_3.4.1 generics_0.1.3 evaluate_0.17 fastmap_1.1.0 sys_3.4 yaml_2.3.6
## [78] fs_1.5.2 zip_2.2.0 pander_0.6.4 survMisc_0.5.5 rootSolve_1.8.2.2 nlme_3.1-160 xml2_1.3.3
## [85] compiler_4.1.0 rstudioapi_0.14 curl_4.3.3 png_0.1-7 e1071_1.7-8 ggsignif_0.6.2 reprex_2.0.2
## [92] bslib_0.4.0 DescTools_0.99.42 stringi_1.7.8 highr_0.9 lattice_0.20-45 Matrix_1.5-1 markdown_1.2
## [99] KMsurv_0.1-5 vctrs_0.5.0 pillar_1.8.1 lifecycle_1.0.3 jquerylib_0.1.4 data.table_1.14.2 bitops_1.0-7
## [106] lmom_2.8 R6_2.5.1 latticeExtra_0.6-30 qs_0.25.3 rio_0.5.27 gld_2.6.2 codetools_0.2-18
## [113] boot_1.3-28 MASS_7.3-58.1 assertthat_0.2.1 minpack.lm_1.2-1 withr_2.5.0 Deriv_4.1.3 mgcv_1.8-41
## [120] expm_0.999-6 hms_1.1.2 grid_4.1.0 rpart_4.1.16 class_7.3-19 rmarkdown_2.17 carData_3.0-4
## [127] googledrive_2.0.0 lubridate_1.8.0 base64enc_0.1-3 interp_1.1-2