PK - Multiple Ascending Dose
Overview
This document contains exploratory plots for multiple 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). 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).
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)
library(reshape)
#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")
# Define order for factors
my.data$TRTACT <- factor(my.data$TRTACT, levels = unique(my.data$TRTACT[order(my.data$DOSE)]))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
data_to_plot <- my.data[my.data$CMT==2,]
data_to_plot$TRTACT <- factor(data_to_plot$TRTACT, levels = rev(levels(data_to_plot$TRTACT)))
gg <- ggplot(data = data_to_plot, aes(x = NOMTIME/24, y = LIDV, group= interaction(DOSE,CYCLE), color = TRTACT))
gg <- gg + theme_bw(base_size = 12)
gg <- gg + stat_summary(geom = "errorbar", width = 0.1, size = 1,
fun.data = function(y){
y <- stats::na.omit(y)
data.frame(
y = mean(y),
ymin = mean(y)-qt(0.975,length(y))*sqrt(stats::var(y)/length(y)),
ymax = mean(y)+qt(0.975,length(y))*sqrt(stats::var(y)/length(y)))
}) +
stat_summary(geom = "point", size = 2, fun.y = mean) +
stat_summary(geom = "line", size = 1, fun.y = mean)
gg <- gg + scale_y_log10() + annotation_logticks(base = 10, sides = "l", color = rgb(0.5,0.5,0.5))
gg <- gg + scale_x_continuous(breaks = seq(0,max(my.data$TIME/24)+1,1))
gg <- gg + xlab("Time (days)") + ylab("Concentration (ng/mL)")
gg <- gg + guides(color= guide_legend(title="Dose"))
gg + AnnotateStatus(draft.flag, log.y=TRUE)
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.
data_to_plot <- my.data[my.data$CMT==2,]
data_to_plot$TRTACT <- factor(data_to_plot$TRTACT, levels = rev(levels(data_to_plot$TRTACT)))
data_to_plot$DAY_label <- paste("Day", data_to_plot$PROFDAY)
gg <- ggplot(data = data_to_plot[data_to_plot$PROFDAY%in%c(1,6),], aes(x = PROFTIME, y = LIDV, group= interaction(CYCLE,DOSE), color = TRTACT))
gg <- gg + theme_bw(base_size = 12)
gg <- gg + stat_summary(geom = "errorbar", width = 0.5, size = 1,
fun.data = function(y){
y <- stats::na.omit(y)
data.frame(
y = mean(y),
ymin = mean(y)-qt(0.975,length(y))*sqrt(stats::var(y)/length(y)),
ymax = mean(y)+qt(0.975,length(y))*sqrt(stats::var(y)/length(y)))
}) +
stat_summary(geom = "point", size = 2, fun.y = mean) +
stat_summary(geom = "line", size = 1, fun.y = mean)
gg <- gg + scale_y_log10() + annotation_logticks(base = 10, sides = "l", color = rgb(0.5,0.5,0.5))
gg <- gg + scale_x_continuous(breaks = seq(0,max(data_to_plot$PROFTIME)+1,6))
gg <- gg + xlab("Time after dose (hours)") + ylab("Concentration (ng/mL)")
gg <- gg + guides(color= guide_legend(title="Dose"))
gg <- gg + facet_grid(~DAY_label)
gg + AnnotateStatus(draft.flag, log.y=TRUE)
Concentration over Time, faceted by dose, mean +/- 95% CI, overlaid on gray spaghetti plots
data_to_plot <- my.data[my.data$CMT==2&my.data$DOSE!=0,]
gg <- ggplot(data = data_to_plot, aes(x = TIME/24, y = LIDV,
group= interaction(CYCLE,DOSE)))
gg <- gg + theme_bw(base_size = 12)
gg <- gg + geom_line(aes(group = interaction(ID,CYCLE)), size = 1, color = rgb(0.5,0.5,0.5), alpha = 0.3)
gg <- gg + geom_point(data = data_to_plot[data_to_plot$CENS==0,],
aes(group = interaction(ID,CYCLE)), size = 2, color = rgb(0.5,0.5,0.5), alpha = 0.3)
gg <- gg + geom_point(data = data_to_plot[data_to_plot$CENS==1,],
aes(group = interaction(ID,CYCLE)), size = 2, color = "red", alpha = 0.3, shape = 8)
gg <- gg + stat_summary(aes(x=NOMTIME/24),geom = "errorbar", width = 0.1, size = 1,
fun.data = function(y){
y <- stats::na.omit(y)
data.frame(
y = mean(y),
ymin = mean(y)-qt(0.975,length(y))*sqrt(stats::var(y)/length(y)),
ymax = mean(y)+qt(0.975,length(y))*sqrt(stats::var(y)/length(y)))
}) +
stat_summary(aes(x=NOMTIME/24),geom = "point", size = 2, fun.y = mean) +
stat_summary(aes(x=NOMTIME/24),geom = "line", size = 1, fun.y = mean)
gg <- gg + scale_y_log10() + annotation_logticks(base = 10, sides = "l", color = rgb(0.5,0.5,0.5))
gg <- gg + scale_x_continuous(breaks = seq(0,max(my.data$TIME/24)+1,1))
gg <- gg + xlab("Time (days)") + ylab("Concentration (ng/mL)")
gg <- gg + theme(legend.position="none") + facet_grid(.~TRTACT)
gg + AnnotateStatus(draft.flag, log.y=TRUE)
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
data_to_plot <- my.data[my.data$CMT==2,]
data_to_plot$TRTACT <- factor(data_to_plot$TRTACT, levels = rev(levels(data_to_plot$TRTACT)))
gg <- ggplot(data = data_to_plot, aes(x = TIME/24, y = LIDV)) + theme_bw(base_size = 12)
gg <- gg + geom_line(aes(group = interaction(ID,CYCLE), color = TRTACT), size = 1, alpha = 0.5)
gg <- gg + geom_point(data = data_to_plot[data_to_plot$CENS==0,],aes(color = factor(TRTACT)), size = 2, alpha = 0.5)
gg <- gg + geom_point(data = data_to_plot[data_to_plot$CENS==1,],color="red",shape=8, size = 2, alpha = 0.5)
gg <- gg + scale_y_log10() + annotation_logticks(base = 10, sides = "l", color = rgb(0.5,0.5,0.5))
gg <- gg + scale_x_continuous(breaks = seq(0,max(data_to_plot$TIME/24)+1,1))
gg <- gg + xlab("Time (days)") + ylab("Concentration (ng/mL)")
gg <- gg + guides(color= guide_legend(title=element_blank()))
gg + AnnotateStatus(draft.flag, log.y=TRUE)
Side-by-side comparison of first administered dose and steady state
data_to_plot <- my.data[my.data$CMT==2&my.data$PROFDAY%in%c(1,6),]
data_to_plot$TRTACT <- factor(data_to_plot$TRTACT, levels = rev(levels(data_to_plot$TRTACT)))
data_to_plot$DAY_label <- paste("Day", data_to_plot$PROFDAY)
gg <- ggplot(data = data_to_plot[data_to_plot$PROFTIME<=24,], aes(x = PROFTIME, y = LIDV)) + theme_bw(base_size = 12)
gg <- gg + geom_line(aes(group = interaction(ID,CYCLE), color = TRTACT), size = 1, alpha = 0.5)
gg <- gg + geom_point(data = data_to_plot[data_to_plot$CENS==0&data_to_plot$PROFTIME<=24,],
aes(color = factor(TRTACT)), size = 2, alpha = 0.5)
gg <- gg + geom_point(data = data_to_plot[data_to_plot$CENS==1&data_to_plot$PROFTIME<=24,],
color="red",shape=8, size = 2, alpha = 0.5)
gg <- gg + scale_y_log10() + annotation_logticks(base = 10, sides = "l", color = rgb(0.5,0.5,0.5))
gg <- gg + scale_x_continuous(breaks = seq(0,max(data_to_plot$PROFTIME)+1,6))
gg <- gg + xlab("Time after dose (hours)") + ylab("Concentration (ng/mL)")
gg <- gg + guides(color= guide_legend(title=element_blank()))
gg <- gg + facet_grid(~DAY_label)
gg + AnnotateStatus(draft.flag, log.y=TRUE)
Concentration over Time, faceted by dose, lines grouped by individual
data_to_plot <- my.data[my.data$CMT==2&my.data$DOSE!=0,]
gg <- ggplot(data = data_to_plot, aes(x = TIME/24, y = LIDV)) + theme_bw(base_size = 12)
gg <- gg + geom_line(aes(group = interaction(ID,CYCLE)), size = 1, alpha = 0.5)
gg <- gg + geom_point(data = data_to_plot[data_to_plot$CENS==0,],size = 2, alpha = 0.5)
gg <- gg + geom_point(data = data_to_plot[data_to_plot$CENS==1,],size = 2, alpha = 0.5, color="red", shape = 8)
gg <- gg + scale_y_log10() + annotation_logticks(base = 10, sides = "l", color = rgb(0.5,0.5,0.5))
gg <- gg + scale_x_continuous(breaks = seq(0,max(my.data$TIME/24)+1,1))
gg <- gg + xlab("Time (days)") + ylab("Concentration (ng/mL)")
gg <- gg + theme(legend.position="none") + facet_grid(.~TRTACT)
gg + AnnotateStatus(draft.flag, log.y=TRUE)
Assess the dose linearity of exposure
Dose Normalized Concentration over Time, colored by dose, mean +/- 95% CI
data_to_plot <- my.data[my.data$CMT==2,]
data_to_plot$TRTACT <- factor(data_to_plot$TRTACT, levels = rev(levels(data_to_plot$TRTACT)))
gg <- ggplot(data = data_to_plot,
aes(x = NOMTIME/24, y = LIDV/as.numeric(as.character(DOSE)),
group= TRTACT, color = TRTACT))
gg <- gg + theme_bw(base_size = 12)
gg <- gg + stat_summary(geom = "errorbar", width = 0.1, size = 1,
fun.data = function(y){
y <- stats::na.omit(y)
data.frame(
y = mean(y),
ymin = mean(y)-qt(0.975,length(y))*sqrt(stats::var(y)/length(y)),
ymax = mean(y)+qt(0.975,length(y))*sqrt(stats::var(y)/length(y)))
}, alpha = 0.5) +
stat_summary(geom = "point", size = 2, fun.y = mean, alpha = 0.5) +
stat_summary(geom = "line", size = 1, fun.y = mean, alpha = 0.5, aes(group = interaction(TRTACT,CYCLE)))
gg <- gg + scale_y_log10() + annotation_logticks(base = 10, sides = "l", color = rgb(0.5,0.5,0.5))
gg <- gg + scale_x_continuous(breaks = seq(0,max(my.data$TIME/24)+1,1))
gg <- gg + xlab("Time (days)") + ylab("Dose Normalized Concentration (ng/mL)/mg")
gg <- gg + guides(color= guide_legend(title="Dose"))
gg + AnnotateStatus(draft.flag, log.y=TRUE)
Side-by-side comparison of first administered dose and steady state
data_to_plot <- my.data[my.data$CMT==2,]
data_to_plot$TRTACT <- factor(data_to_plot$TRTACT, levels = rev(levels(data_to_plot$TRTACT)))
data_to_plot$DAY_label <- paste("Day", data_to_plot$PROFDAY)
gg <- ggplot(data = data_to_plot[data_to_plot$PROFDAY%in%c(1,6)&data_to_plot$PROFTIME<=24,],
aes(x = PROFTIME, y = LIDV/as.numeric(as.character(DOSE)),
group= DOSE, color = TRTACT))
gg <- gg + theme_bw(base_size = 12)
gg <- gg + stat_summary(geom = "errorbar", width = 0.5, size = 1,
fun.data = function(y){
y <- stats::na.omit(y)
data.frame(
y = mean(y),
ymin = mean(y)-qt(0.975,length(y))*sqrt(stats::var(y)/length(y)),
ymax = mean(y)+qt(0.975,length(y))*sqrt(stats::var(y)/length(y)))
}, alpha = 0.5) +
stat_summary(geom = "point", size = 2, fun.y = mean, alpha = 0.5) +
stat_summary(geom = "line", size = 1, fun.y = mean, alpha = 0.5, aes(group = interaction(DOSE,CYCLE)))
gg <- gg + scale_y_log10() + annotation_logticks(base = 10, sides = "l", color = rgb(0.5,0.5,0.5))
gg <- gg + scale_x_continuous(breaks = seq(0,max(data_to_plot$PROFTIME)+1,6))
gg <- gg + xlab("Time after dose (hours)") + ylab("Dose Normalized Concentration (ng/mL)/mg")
gg <- gg + guides(color= guide_legend(title="Dose"))
gg <- gg + facet_grid(~DAY_label)
gg + AnnotateStatus(draft.flag, log.y=TRUE)
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?
AUC_0_24 <- my.data[my.data$CMT==2&my.data$NOMTIME>0&my.data$NOMTIME<=24,]
AUC_0_24 <- data.frame(stack(sapply(split(AUC_0_24,AUC_0_24$ID),function(df) trapz(df$TIME,df$LIDV))))
names(AUC_0_24) <- c("AUC","ID")
AUC_0_24$PROFDAY = 1
AUCtau <- my.data[my.data$CMT==2&my.data$NOMTIME>120&my.data$NOMTIME<=144,]
AUCtau <- data.frame(stack(sapply(split(AUCtau,AUCtau$ID),function(df) trapz(df$TIME,df$LIDV))))
names(AUCtau) <- c("AUC","ID")
AUCtau$PROFDAY = 6
AUC <- rbind(AUC_0_24, AUCtau)
AUC$ID <- as.numeric(as.character(AUC$ID))
AUC <- AUC[order(AUC$ID,AUC$PROFDAY),]
AUC$DAY_label <- paste("Day", AUC$PROFDAY)
AUC <- merge(AUC, unique(my.data[c("ID","DOSE","TRTACT")]), by = "ID")
gg <- ggplot(data = AUC, aes(x = DOSE, y = AUC/DOSE))
gg <- gg + geom_boxplot(aes(group = DOSE)) + geom_smooth(method = "lm", color = "black")
gg <- gg + scale_x_continuous(breaks=unique(AUC$DOSE))
gg <- gg + facet_grid(.~DAY_label) + ylab("Dose normalized AUCtau (h.(ng/mL)/mg)") + xlab("Dose (mg)")
gg + AnnotateStatus(draft.flag)
For multiple ascending dose studies, plot the ratio between the steady state AUC and the AUC from the first cycle. Is there any accumulation?
AUC2 <- cast(AUC, ID~PROFDAY, value = "AUC")
AUC2 <- merge(AUC2, unique(my.data[c("ID","DOSE","TRTACT")]), by = "ID")
AUC2$Ratio <- AUC2[,"6"]/AUC2[,"1"]
gg <- ggplot(data = AUC2, aes(x = DOSE, y = Ratio))
gg <- gg + geom_boxplot(aes(group = DOSE)) + geom_smooth(method = "lm",span=1, color = "black")
gg <- gg + geom_hline(yintercept = 1, linetype="dashed")
gg <- gg + scale_y_log10(breaks=c(0.5,1,2)) + coord_cartesian(ylim = c(0.5, 3))
gg <- gg + annotation_logticks(base = 10, sides = "l", color = rgb(0.5,0.5,0.5))
gg <- gg + scale_x_continuous(breaks=unique(AUC2$DOSE))
gg <- gg + ylab("Fold Accumulation in AUCtau") + xlab("Dose (mg)")
gg + AnnotateStatus(draft.flag, log.y=TRUE)
NCA of dose normalized Cmax vs Dose
Cmax_0_24 <- my.data[my.data$CMT==2&my.data$NOMTIME>0&my.data$NOMTIME<=24,]
Cmax_0_24 <- data.frame(stack(sapply(split(Cmax_0_24,Cmax_0_24$ID),function(df) max(df$LIDV))))
names(Cmax_0_24) <- c("Cmax","ID")
Cmax_0_24$PROFDAY = 1
Cmaxtau <- my.data[my.data$CMT==2&my.data$NOMTIME>120&my.data$NOMTIME<=144,]
Cmaxtau <- data.frame(stack(sapply(split(Cmaxtau,Cmaxtau$ID),function(df) max(df$LIDV))))
names(Cmaxtau) <- c("Cmax","ID")
Cmaxtau$PROFDAY = 6
Cmax <- rbind(Cmax_0_24, Cmaxtau)
Cmax$ID <- as.numeric(as.character(Cmax$ID))
Cmax <- Cmax[order(Cmax$ID,Cmax$PROFDAY),]
Cmax$DAY_label <- paste("Day", Cmax$PROFDAY)
Cmax <- merge(Cmax, unique(my.data[c("ID","DOSE","TRTACT")]), by = "ID")
gg <- ggplot(data = Cmax, aes(x = DOSE, y = Cmax/DOSE))
gg <- gg + geom_boxplot(aes(group = DOSE)) + geom_smooth(method = "lm",color = "black")
gg <- gg + scale_x_continuous(breaks=unique(Cmax$DOSE))
gg <- gg + facet_grid(.~DAY_label) + ylab("Dose normalized Cmax ((ng/mL)/mg)") + xlab("Dose (mg)")
gg + AnnotateStatus(draft.flag)
For multiple ascending dose studies, plot the ratio between the steady state Cmax and the Cmax from the first cycle. Is there any accumulation?
Cmax2 <- cast(Cmax, ID~PROFDAY, value = "Cmax")
Cmax2 <- merge(Cmax2, unique(my.data[c("ID","DOSE","TRTACT")]), by = "ID")
Cmax2$Ratio <- Cmax2[,"6"]/Cmax2[,"1"]
gg <- ggplot(data = Cmax2, aes(x = DOSE, y = Ratio))
gg <- gg + geom_boxplot(aes(group = DOSE)) + geom_smooth(method = "lm", color = "black")
gg <- gg + geom_hline(yintercept = 1, linetype="dashed")
gg <- gg + scale_y_log10(breaks=c(0.5,1,2)) + coord_cartesian(ylim = c(0.25, 4))+ annotation_logticks(base = 10, sides = "l", color = rgb(0.5,0.5,0.5))
gg <- gg + scale_x_continuous(breaks=unique(Cmax2$DOSE))
gg <- gg + ylab("Fold Accumulation in Cmax") + xlab("Dose (mg)")
gg + AnnotateStatus(draft.flag, log.y=TRUE)
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
data_to_plot <- my.data[my.data$CMT==2&my.data$DOSE!=0,]
# In order to plot grayed out spaghetti plots by dose with individuals highlighted,
# a new dataset needs to be defined that groups the individuals by dose
data_to_plot2 <- NULL
for(id in unique(data_to_plot$ID)){
# for each ID, select out all subjects in the same dose group, and set ID2 to ID
if(is.null(data_to_plot2)){
data_to_plot2 <- data.frame(data_to_plot[data_to_plot$DOSE==data_to_plot[data_to_plot$ID==id,]$DOSE,], ID2 = id)
}else{
data_to_plot2 <- rbind(data_to_plot2,
data.frame(data_to_plot[data_to_plot$DOSE==data_to_plot[data_to_plot$ID==id,]$DOSE,], ID2 = id))
}
}
# switch ID and ID2, data_to_plot2 can now be used for the greyed out spaghetti plots
temp <- data_to_plot2$ID
data_to_plot2$ID = data_to_plot2$ID2
data_to_plot2$ID2 <- temp
gg <- ggplot() + theme_bw(base_size = 12) + AnnotateStatus(draft.flag, log.y=TRUE, fontsize=4, color=rgb(0.5,0.5,1))
# use data_to_plot2 for the grey spaghetti plots
gg <- gg + geom_line(data = data_to_plot2,
aes(x = TIME/24, y = LIDV, group = interaction(ID2,CYCLE)),
size = 1, color = rgb(0.5,0.5,0.5), alpha = 0.3)
gg <- gg + geom_point(data = data_to_plot2,
aes(x = TIME/24, y = LIDV, group = interaction(ID2,CYCLE)),
size = 1, color = rgb(0.5,0.5,0.5), alpha = 0.3)
# use data_to_plot for the highlighted individuals
gg <- gg + geom_line(data = data_to_plot,
aes(x = TIME/24, y = LIDV,group = CYCLE), size = 1)
gg <- gg + geom_point(data = data_to_plot[data_to_plot$CENS==0,],
aes(x = TIME/24, y = LIDV,group = CYCLE), size = 1)
gg <- gg + geom_point(data = data_to_plot[data_to_plot$CENS==1,],
aes(x = TIME/24, y = LIDV,group = CYCLE), size = 1, color="red", shape=8)
gg <- gg + scale_y_log10() + annotation_logticks(base = 10, sides = "l", color = rgb(0.5,0.5,0.5))
gg <- gg + scale_x_continuous(breaks = seq(0,max(my.data$TIME/24)+1,7))
gg <- gg + xlab("Time (days)") + ylab("Concentration (ng/mL)")
gg <- gg + theme( legend.position="none")
gg <- gg + facet_wrap(~ID+TRTACT,ncol = length(unique(data_to_plot$ID))/length(unique(data_to_plot$DOSE)))
gg
Explore covariate effects on PK
Concentration over Time, colored by categorical covariate, mean +/- 95% CI
data_to_plot <- my.data[my.data$CMT==2&my.data$DOSE!=0,]
gg <- ggplot(data = data_to_plot, aes(x = NOMTIME/24, y = LIDV, color = SEX))
gg <- gg + theme_bw(base_size = 12)
gg <- gg + stat_summary(geom = "errorbar", width = 0.5, size = 1,
fun.data = function(y){
y <- stats::na.omit(y)
data.frame(
y = mean(y),
ymin = mean(y)-qt(0.975,length(y))*sqrt(stats::var(y)/length(y)),
ymax = mean(y)+qt(0.975,length(y))*sqrt(stats::var(y)/length(y)))
}) +
stat_summary(geom = "point", size = 2, fun.y = mean) +
stat_summary(geom = "line", size = 1, fun.y = mean)
gg <- gg + scale_y_log10() + annotation_logticks(base = 10, sides = "l", color = rgb(0.5,0.5,0.5))
gg <- gg + scale_x_continuous(breaks = seq(0,9))
gg <- gg + xlab("Time after first dose (days)") + ylab("Concentration (ng/mL)")
gg + facet_grid(.~DOSE)
Dose Normalized Concentration over Time, colored by categorical covariate, mean +/- 95% CI
data_to_plot <- my.data[my.data$CMT==2,]
gg <- ggplot(data = data_to_plot,
aes(x = NOMTIME/24, y = LIDV/as.numeric(as.character(DOSE)),
color = SEX))
gg <- gg + theme_bw(base_size = 12)
gg <- gg + stat_summary(geom = "errorbar", width = 0.1, size = 1,
fun.data = function(y){
y <- stats::na.omit(y)
data.frame(
y = mean(y),
ymin = mean(y)-qt(0.975,length(y))*sqrt(stats::var(y)/length(y)),
ymax = mean(y)+qt(0.975,length(y))*sqrt(stats::var(y)/length(y)))
}) +
stat_summary(geom = "point", size = 2, fun.y = mean) +
stat_summary(geom = "line", size = 1, fun.y = mean)
gg <- gg + scale_y_log10() + annotation_logticks(base = 10, sides = "l", color = rgb(0.5,0.5,0.5))
gg <- gg + scale_x_continuous(breaks = seq(0,9))
gg <- gg + xlab("Time (days)") + ylab("Dose Normalized Concentration (ng/mL)/mg")
gg
AUClast <- my.data[my.data$CMT==2&!is.na(my.data$LIDV)&my.data$PROFDAY>6,]
AUClast <- data.frame(stack(sapply(split(AUClast,AUClast$ID),function(df) trapz(df$TIME,df$LIDV))))
names(AUClast) <- c("AUC","ID")
AUClast$ID <- as.numeric(as.character(AUClast$ID))
AUClast <- AUClast[order(AUClast$ID),]
AUClast <- merge(AUClast, unique(my.data[c("ID","DOSE","TRTACT","SEX")]), by = "ID")
gg <- ggplot(data = AUClast, aes(x = SEX, y = AUC/DOSE))
gg <- gg + geom_boxplot(aes(group = SEX))# + geom_smooth(method = "lm",color = "black")
gg + ylab("Dose normalized AUClast (h.(ng/mL)/mg)") + xlab("Sex")
data_to_plot <- my.data[my.data$CMT==2,]
gg <- ggplot(data = data_to_plot,
aes(x = NOMTIME/24, y = LIDV/as.numeric(as.character(DOSE)),
color = WEIGHTB>70))
gg <- gg + theme_bw(base_size = 12)
gg <- gg + stat_summary(geom = "errorbar", width = 0.1, size = 1,
fun.data = function(y){
y <- stats::na.omit(y)
data.frame(
y = mean(y),
ymin = mean(y)-qt(0.975,length(y))*sqrt(stats::var(y)/length(y)),
ymax = mean(y)+qt(0.975,length(y))*sqrt(stats::var(y)/length(y)))
}) +
stat_summary(geom = "point", size = 2, fun.y = mean) +
stat_summary(geom = "line", size = 1, fun.y = mean)
gg <- gg + scale_y_log10() + annotation_logticks(base = 10, sides = "l", color = rgb(0.5,0.5,0.5))
gg <- gg + scale_x_continuous(breaks = seq(0,9))
gg <- gg + xlab("Time (hours)") + ylab("Dose Normalized Concentration (ng/mL)/mg")
gg
AUClast <- my.data[my.data$CMT==2&!is.na(my.data$LIDV),]
AUClast <- data.frame(stack(sapply(split(AUClast,AUClast$ID),function(df) trapz(df$TIME,df$LIDV))))
names(AUClast) <- c("AUC","ID")
AUClast$ID <- as.numeric(as.character(AUClast$ID))
AUClast <- AUClast[order(AUClast$ID),]
AUClast <- merge(AUClast, unique(my.data[c("ID","DOSE","TRTACT","WEIGHTB","SEX")]), by = "ID")
gg <- ggplot(data = AUClast, aes(x = WEIGHTB, y = AUC/DOSE))
gg <- gg + geom_point() + geom_smooth(method="lm")
gg + ylab("Dose normalized AUClast (h.(ng/mL)/mg)") + xlab("Bodyweight (kg)")
gg <- ggplot(data = AUClast, aes(x = WEIGHTB, y = AUC/DOSE, color = SEX))
gg <- gg + geom_point() + geom_smooth(method="lm")
gg + ylab("Dose normalized AUClast (h.(ng/mL)/mg)") + xlab("Bodyweight (kg)")
AUClast$WT0bins <- cut(AUClast$WEIGHTB, c(50,70,90,110))
gg <- ggplot(data = AUClast, aes(x = WT0bins, y = AUC/DOSE))
gg <- gg + geom_boxplot(aes(group = WT0bins))# + geom_smooth(method = "lm",color = "black")
gg + ylab("Dose normalized AUClast (h.(ng/mL)/mg)") + xlab("Bodyweight (kg)")
AUClast$WT0bins <- cut(AUClast$WEIGHTB, c(50,70,90,110))
gg <- ggplot(data = AUClast, aes(x = WT0bins, y = AUC/DOSE))
gg <- gg + geom_boxplot(aes( fill=SEX))# + geom_smooth(method = "lm",color = "black")
gg + ylab("Dose normalized AUClast (h.(ng/mL)/mg)") + xlab("Bodyweight (kg)")
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] reshape_0.8.7 lubridate_1.7.1 survival_2.41-3 DT_0.2
## [5] RxODE_0.6-1 bindrcpp_0.2 haven_1.1.0 readr_1.1.1
## [9] readxl_1.0.0 xtable_1.8-2 tidyr_0.7.2 caTools_1.17.1
## [13] zoo_1.8-0 dplyr_0.7.4 ggplot2_2.2.1 gridExtra_2.3
##
## loaded via a namespace (and not attached):
## [1] purrr_0.2.4 reshape2_1.4.3 splines_3.4.3
## [4] lattice_0.20-35 colorspace_1.3-2 htmltools_0.3.6
## [7] yaml_2.1.16 rlang_0.1.6 pillar_1.0.1
## [10] glue_1.2.0 RColorBrewer_1.1-2 binom_1.1-1
## [13] bindr_0.1 plyr_1.8.4 stringr_1.2.0
## [16] munsell_0.4.3 gtable_0.2.0 cellranger_1.1.0
## [19] htmlwidgets_0.9 codetools_0.2-15 evaluate_0.10.1
## [22] memoise_1.1.0 labeling_0.3 knitr_1.18
## [25] forcats_0.2.0 rex_1.1.2 markdown_0.8
## [28] Rcpp_0.12.14 scales_0.5.0 backports_1.1.2
## [31] jsonlite_1.5 hms_0.4.0 digest_0.6.13
## [34] stringi_1.1.3 rprojroot_1.3-1 tools_3.4.3
## [37] bitops_1.0-6 magrittr_1.5 lazyeval_0.2.1
## [40] tibble_1.4.1 pkgconfig_2.0.1 Matrix_1.2-12
## [43] rsconnect_0.8.5 assertthat_0.2.0 rmarkdown_1.8
## [46] R6_2.2.2 compiler_3.4.3