In Novartis/xgxr: Exploratory Graphics for Pharmacometrics

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

Overview

This document provides a template for exploring Single or Multiple Ascending Dose PK data.

Load packages and setting plot theme

#devtools::load_all()
library(xgxr)
library(gridExtra)
library(ggplot2)
library(dplyr)
library(tidyr)
library(knitr)
library(caTools)

#override masking
rename = dplyr::rename
select = dplyr::select
filter = dplyr::filter
count  = dplyr::count

# setting ggplot theme
xgx_theme_set()

Load the dataset and assign columns. Take subsets of data that are needed

This is the portion of code that would be adapted to the dataset of interest.

#units of dataset
  time_units_dataset = "hours"
  time_units_plot    = "days"
  dose_label         = "Dose (mg)"
  conc_label         = "Concentration (ng/ml)"  
  concnorm_label     = "Normalized Concentration (ng/ml)/mg"

#covariates in the dataset
  covariates = c("WEIGHTB","SEX")

#load dataset 
  data     = Multiple_Ascending_Dose %>%
    filter(CMT %in% c(1,2))

#make sure that the necessary columns are assigned
#five columns are required: TIME, NOMTIME, LIDV, CMT, DOSE, DOSEREG
  data = data %>%
    mutate(TIME    = TIME,   #TIME column name 
           NOMTIME = NOMTIME,#NOMINAL TIME column name
           EVID    = EVID   ,#EVENT ID, >=1 is dose, otherwise measurement
           CYCLE   = CYCLE,  #CYCLE of PK data
           CYCLELAB= paste("Day", PROFDAY), #CYCLE LABEL for faceting
           LIDV    = LIDV,   #DEPENDENT VARIABLE column name
           CENS    = CENS,   #CENSORING column name
           CMT     = CMT,    #COMPARTMENT column here (e.g. CMT or YTYPE)
           DOSE    = DOSE,   #DOSE column here (numeric value)
           DOSEREG = TRTACT) #DOSE REGIMEN column here

#convert DOSEREG to factor for proper ordering in the plotting
#add LIDVNORM dose normalized concentration for plotting
  data = data %>%
    arrange(DOSE) %>%
    mutate(LIDVNORM    = LIDV/DOSE,
           DOSEREG     = factor(DOSEREG, levels =     unique(DOSEREG)),
           DOSEREG_REV = factor(DOSEREG, levels = rev(unique(DOSEREG)))) #define order of treatment factor

#for plotting the PK data
  data_pk = filter(data,CMT==2)

#for plotting the rich PK data and comparing cycles  
#this dataset is optional and this code can be deleted if the user
#does not have rich PK data that they want to compare.
  data_pk_rich = data_pk %>%
    filter(PROFDAY %in% c(1,6)) #PROFDAY is the day of the PK profile

#load NCA
  NCA      = Multiple_Ascending_Dose_NCA

#make sure NCA dataset has the appropriate columns
#five columns are required: DOSE, DOSEREG, PARAM, VALUE, VALUE_NORM
  NCA = NCA %>%
    mutate(DOSE       = DOSE,       #DOSE column here (numeric value)
           DOSEREG    = TRTACT,     #DOSE REGIMEN column here
           PARAM      = PARAM,      #PARAM name of the NCA parameter
           VALUE      = VALUE,       #VALUE of the NCA parameter
           VALUE_NORM = VALUE/DOSE) #DOSE NORMALIZED value of NCA parameter  

# directories for saving figures and tables
dirs = list(
  parent_dir        = tempdir(),
  rscript_dir       = "./",
  rscript_name      = "PK_Multiple_Ascending_Dose.Rmd",
  results_dir       = "./",
  filename_prefix   = "MAD_PK_")

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

Summary of the data issues and the covariates

  check = xgx_check_data(data,covariates)

  kable(check$summary)
  kable(head(check$data_subset))
  kable(check$cts_covariates)
  kable(check$cat_covariates)

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?

Concentration over Time, colored by dose, mean +/- 95% CI

gg = ggplot(data = data_pk, aes(x = NOMTIME, y = LIDV, group=DOSE, color = DOSEREG_REV)) 
gg = gg + geom_point()
gg = gg + xgx_stat_ci()
gg = gg + xgx_scale_x_time_units(time_units_dataset, time_units_plot)
gg = gg + labs(y = conc_label, color = "Dose")
glin = gg
glin = xgx_save(width = 5, height = 5, dirs, "Summary_Lin", draft_flag)

gg = glin + xgx_scale_y_log10()
glog = gg
glog = xgx_save(width = 5, height = 5, dirs, "Summary_Log", draft_flag)

g2 = arrangeGrob(glin,glog,nrow = 1)
grid.arrange(g2)

Side-by-side comparison of first administered dose and steady state

For multiple dose studies, zoom in on key visits for a clearer picture of the profiles. Look for accumulation (if any) between first administered dose and steady state.

if (exists("data_pk_rich")) {
  gg = ggplot(data_pk_rich, aes(x = NOMTIME, y = LIDV, group= interaction(CYCLE,DOSE), color = DOSEREG_REV)) 
  gg = gg + facet_grid(~CYCLELAB, scales = "free_x")
  gg = gg + xgx_stat_ci()
  gg = gg + xgx_scale_x_time_units(time_units_dataset, time_units_plot)
  gg = gg + xgx_scale_y_log10()
  gg = gg + labs(y = conc_label, color = "Dose")
  gg = xgx_save(width = 6, height = 4, dirs, "Summary_Cycle", draft_flag)
  print(gg)
}

Concentration over Time, faceted by dose, mean +/- 95% CI, overlaid on gray spaghetti plots

gg = ggplot(data = data_pk, aes(x = NOMTIME, y = LIDV, group= interaction(ID,CYCLE))) 
gg = gg + geom_line(size = 1, color = rgb(0.5,0.5,0.5), alpha = 0.3) 
gg = gg + geom_point(aes(color=factor(CENS),shape=factor(CENS)),size = 2, alpha = 0.3) 
gg = gg + xgx_stat_ci(aes(group=NULL, color = NULL))
gg = gg + facet_grid(.~DOSEREG)
gg = gg + xgx_scale_x_time_units(time_units_dataset, time_units_plot)
gg = gg + xgx_scale_y_log10()
gg = gg + ylab(conc_label)
gg = gg + theme(legend.position="none") 
gg = gg + scale_shape_manual(values=c(1,8))
gg = gg + scale_color_manual(values=c("grey50","red"))
gg = xgx_save(width = 6, height = 4, dirs, "Summary_Spaghetti", draft_flag)
print(gg)

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? Dose 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 = data_pk, aes(x = TIME, y = LIDV, group = interaction(ID,CYCLE), color = factor(DOSEREG_REV), shape = factor(CENS)) )
gg = gg + geom_line(size = 1, alpha = 0.5) 
gg = gg + geom_point()
gg = gg + xgx_scale_x_time_units(time_units_dataset, time_units_plot)
gg = gg + xgx_scale_y_log10()
gg = gg + labs(y = conc_label, color = "Dose", shape = "Censoring")
gg = xgx_save(width = 4, height = 4, dirs, "Variability", draft_flag)
print(gg)

Side-by-side comparison of first administered dose and steady state

if(exists("data_pk_rich")) {
  gg = ggplot(data = data_pk_rich, aes(x = TIME, y = LIDV, group = interaction(ID,CYCLE), color = DOSEREG_REV, shape = factor(CENS)))
  gg = gg + geom_line(size = 1, alpha = 0.5) 
  gg = gg + geom_point()
  gg = gg + facet_grid(~CYCLELAB,scales = "free_x")
  gg = gg + xgx_scale_x_time_units(time_units_dataset, time_units_plot)
  gg = gg + xgx_scale_y_log10()
  gg = gg + labs(y = conc_label, color = "Dose", shape = "Censoring")
  gg = xgx_save(width=7,height=4,dirs,"Variability2",draft_flag)
  print(gg)
}

Concentration over Time, faceted by dose, lines grouped by individual

# gg = ggplot(data = data_pk, aes(x = TIME, y = LIDV,group = interaction(ID,CYCLE), color = factor(CENS), shape = factor(CENS)))
# gg = gg + geom_line(size = 1, alpha = 0.5) 
# gg = gg + geom_point()
# gg = gg + facet_grid(.~DOSEREG)
# gg = gg + xgx_scale_x_time_units(time_units_dataset, time_units_plot)
# gg = gg + xgx_scale_y_log10()
# gg = gg + ylab(conc_label)
# gg = gg + scale_shape_manual(values=c(1,8))
# gg = gg + scale_color_manual(values=c("grey50","red"))
# gg = gg + theme(legend.position="none") 
# xgx_save(width=7,height=4,dirs,"Variability3",draft_flag)

Assess the dose linearity of exposure

Dose Normalized Concentration over Time, colored by dose, mean +/- 95% CI

gg = ggplot(data = data_pk, aes(x = NOMTIME, y = LIDVNORM, group= DOSEREG_REV, color = DOSEREG_REV)) 
gg = gg + xgx_stat_ci()
gg = gg + xgx_scale_x_time_units(time_units_dataset, time_units_plot)
gg = gg + xgx_scale_y_log10()
gg = gg + labs(y = conc_label, color="Dose")
gg = xgx_save(width=4,height=4,dirs,"DoseNorm",draft_flag)
print(gg)

Side-by-side comparison of first administered dose and steady state

if (exists("data_pk_rich")) {
  gg = ggplot(data_pk_rich, aes(x=NOMTIME,y=LIDVNORM,group = interaction(DOSE,CYCLE),color=DOSEREG_REV))
  gg = gg + xgx_stat_ci()
  gg = gg + facet_grid(~CYCLELAB,scales = "free_x")
  gg = gg + xgx_scale_x_time_units(time_units_dataset, time_units_plot)
  gg = gg + xgx_scale_y_log10()
  gg = gg + labs(y = conc_label, color="Dose")
  gg = xgx_save(width=7,height=4,dirs,"DoseNorm2",draft_flag)
  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

gg = ggplot(data = data_pk, aes(x = TIME, y = LIDV)) 
gg = gg + geom_line() 
gg = gg + geom_point(aes(color=factor(CENS),shape=factor(CENS))) 
gg = gg + facet_wrap(~ID+DOSEREG)
gg = gg + xgx_scale_x_time_units(time_units_dataset, time_units_plot)
gg = gg + xgx_scale_y_log10()
gg = gg + ylab(conc_label)
gg = gg + theme(legend.position="none") 
gg = gg + scale_shape_manual(values=c(1,8))
gg = gg + scale_color_manual(values=c("black","red"))
gg = xgx_save(width = 8, height = 10, dirs, "Individual", draft_flag)
print(gg)

NCA

NCA of dose normalized AUC vs Dose

Observe the dose normalized AUC 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 CENS 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?

if (!exists("NCA")) {
  warning("For PK data exploration, it is highly recommended to perform an NCA")
} else {
  gg = ggplot(data = NCA, aes(x = DOSE, y = VALUE_NORM))
  gg = gg + geom_boxplot(aes(group = DOSE)) 
  gg = gg + geom_smooth(method = "loess", color = "black")
  gg = gg + facet_wrap(~PARAM, scales = "free_y") 
  gg = gg + xgx_scale_x_log10(breaks = unique(NCA$DOSE))
  gg = gg + xgx_scale_y_log10()
  gg = gg + labs(x = dose_label, y = concnorm_label)
  gg = xgx_save(width = 4, height = 5, dirs, "NCA_Normalized", draft_flag)
  print(gg)
}

Covariate Effects

if (!exists("NCA")) {
  warning("For covariate exploration, it is highly recommended to perform an NCA")
} else {
  NCA_cts = NCA[,c("PARAM","VALUE",check$cts_covariates$Covariate)] %>%
    gather(COV,COV_VALUE,-c(PARAM,VALUE))

  NCA_cat = NCA[,c("PARAM","VALUE",check$cat_covariates$Covariate)] %>%
    gather(COV,COV_VALUE,-c(PARAM,VALUE))

  if (nrow(check$cts_covariates)>=1) {
    gg = ggplot(data = NCA_cts, aes(x = COV_VALUE, y = VALUE))
    gg = gg + geom_point()
    gg = gg + geom_smooth(method = "loess", color = "black")
    gg = gg + facet_grid(PARAM~COV,switch = "y", scales = "free_y")
    gg = gg + xgx_scale_x_log10()
    gg = gg + xgx_scale_y_log10()
    gg = gg + labs(x = "NCA Parameter Value", y = "Covariate Value")
    gg = xgx_save(width = 6, height = 6, dirs, "NCA_CtsCov", draft_flag)
    print(gg)
  }

  if (nrow(check$cat_covariates)>=1) {
    gg = ggplot(data = NCA_cat, aes(x = COV_VALUE, y = VALUE))
    gg = gg + geom_boxplot()
    gg = gg + facet_grid(PARAM~COV,switch = "y", scales = "free_y")
    gg = gg + xgx_scale_y_log10()
    gg = gg + labs(x = "NCA Parameter Value", y = "Covariate Value")
    gg = xgx_save(width = 6, height = 6, dirs, "NCA_CatCov", draft_flag)
    print(gg)
  }
}

Novartis/xgxr documentation built on Oct. 20, 2023, 4:35 a.m.