This vignette includes the code to create the global sensitivity analysis plots included in the HTTK-Pop paper.
First, read in the global sensitivity analysis data. Do this for all four combinations of the poormetab
and fup.censored.dist
conditions.
model <- '3compartmentss'
css.method <- 'analytic'
#All combinations of poormetab and fup.censored.dist
pmfc <- expand.grid(poormetab=c(TRUE, FALSE),
fup.censored.dist=c(TRUE, FALSE),
fuptofub=TRUE)
#Initialize list of data.tables
dt.list <- vector(mode="list", length=nrow(pmfc))
for (i in 1:nrow(pmfc)){
dt.list[[i]] <- readRDS(paste0('data/',
'sens_glenisaacs_nhanes_',
'allchems_',
'allgroups_',
model,
'_',
css.method,
'_fup_censor_',
pmfc[i, 'fup.censored.dist'],
'_poormetab_',
pmfc[i, 'poormetab'],
ifelse(pmfc[i, 'fuptofub'], "_FuptoFub", ""),
'.Rdata'))
dt.list[[i]][, poormetab:=pmfc[i, 'poormetab']]
dt.list[[i]][, fup.censored.dist:=pmfc[i, 'fup.censored.dist']]
dt.list[[i]][, fuptofub:=pmfc[i, 'fuptofub']]
}
dat <- rbindlist(dt.list)
rm(dt.list)
setnames(dat, c('chemcas', 'rn'),
c('CAS', 'param'))
Next, add measured values of Funbound.plasma
and CLint
to the data table. Get these measured values from httk
.
cheminfo.dt <- as.data.table(httk::get_cheminfo(model='3compartmentss',
info=c('CAS','Compound',
'Funbound.plasma'),
exclude.fup.zero=FALSE))
setnames(cheminfo.dt,
'Human.Funbound.plasma',
'Funbound.plasma'
)
cheminfo.dt[, Clint:=sapply(CAS,
function(x) parameterize_steadystate(chem.cas=x,
species='Human')$Clint)]
dat <- merge(dat,
cheminfo.dt[, .(CAS,
Compound,
Funbound.plasma,
Clint)],
by='CAS')
setnames(dat, 'Clint', 'CLint')
dat[param=='Clint', param:='CLint']
dat[param=='Funbound.plasma', param:='Fub']
dat[, param:=factor(param,
levels=c('CLint',
'Fub',
'phys.par'))]
Next, set up a few things to prepare for plotting. First, change the factor levels for poormetab
and fup.censored.dist
to be more informative than just TRUE and FALSE.
#change poormetab factor levels to be informative
dat[, poormetab:=factor(poormetab,
levels=c(FALSE, TRUE),
labels=c('excluded',
'included'))]
#change fup.censored.dist factor levels to be informative
dat[, fup.censored.dist:=factor(fup.censored.dist,
levels=c(FALSE, TRUE),
labels=c('<lod=lod/2',
'<lod censored'))]
#change fup.censored.dist name is be more informative
setnames(dat, 'fup.censored.dist', 'Fub')
And set up a labeller function to more informatively label the plots by parameter.
my_labeller_fun <- function(DF){
if (variable=='param'){
return(paste('i =', value))
}else{
return(paste(variable,value))
}
}
Next, since we’re going to plot measured CLint on a log scale, we need to handle the case where measured CLint was 0. It’s a bit kludgy, but we’ll just plot CLint = 0 as CLint = 1e-8, so that those points will actually show up on the log-scale plot.
dat[CLint==0, CLint:=1e-8] #plot them as 1e-8 but label them as zero
#Hack the log-scaled x-axis so that CLint==0 points have some buffer space for display
CLint.breaks <- c(1e-8, 1e-6, 1e-4, 1e-2, 1e0, 1e2, 1e4)
#Label the CLint breaks
CLint.labels <- c(expression(0^{paste(' ')}), expression(10^{-6}),
expression(10^{-4}),
expression(10^{-2}), expression(10^0),
expression(10^2), expression(10^4))
And define the colormap to use for the sensitivity values. I chose a multi-hue sequential palette from ColorBrewer, because the variations in hue make it easier to see where sensitivity index values fall into certain bins, and the yellow-green-blue palette shows up well against a gray plot background.
Finally, let’s actually make the plots.
for (ecg in c('Total',
'Age.6.11',
'Age.12.19',
'Age.20.65',
'Age.GT65',
'BMIgt30',
'BMIle30',
'Males',
'Females',
'ReproAgeFemale')){
for (fpb in c(TRUE)){
dt.tmp <- dat[param %in% c('CLint',
'Fub',
'phys.par') &
ExpoCast.group==ecg &
fuptofub==fpb, ]
setorder(dt.tmp,Si)
p<-ggplot(data=dt.tmp) +
geom_point(aes(x=CLint,
y=Funbound.plasma,
color=Si,
fill=Si,
order=Si),
shape=21)+
scale_color_gradientn(colours=ylgnbu,
guide='colourbar',
limits=c(0,1), #specify limits, breaks, and labels to get the colorbar tick marks where I want them
breaks=c(0,0.25,0.5,0.75,1),
labels=as.character(c(0,0.25,0.5,0.75,1)),
oob=squish,
name='First-order \nCss sensitivity \nto param i')+ #there may be some very small negative indexes; just treat them as zero
scale_fill_gradientn(colours=ylgnbu,
guide=FALSE, #don't plot separate colorbar for fill
na.value=NA, #don't fill points for NAs
limits=c(0,1), #specify limits, breaks, and labels to get the colorbar tick marks where I want them
breaks=c(0,0.25,0.5,0.75,1),
labels=as.character(c(0,0.25,0.5,0.75,1)),
oob=squish)+
scale_x_continuous(trans='log10', #use the hack to get CLint==0 points to not be clipped
breaks=CLint.breaks,
labels=CLint.labels) +
scale_y_continuous(limits=c(0,1),
oob=squish) + #Funbound.plasma shouldn't be >1 -- if it is, just pretend it's 1
# facet_grid(poormetab*Fub~param,
# labeller=my_labeller_fun)+
facet_grid(poormetab*Fub~param,
labeller=labeller(poormetab=function(x) paste("CLint: PM ", x),
Fub = label_both,
param=function(x) paste("i = ", x))) +
labs(x='Measured CLint (uL/min/million cells)',
y='Measured Fub',
title=ecg) +
theme(legend.title=element_text(size=12), #bump up the legend text size
legend.text=element_text(size=12),
strip.background=element_blank())
ggsave(filename=paste0('pdf_figures/',
paste('Si',
'httkpop',
'group',
ecg,
'model',
model,
"FuptoFub",
fpb,
sep='_'),
'.pdf'),
plot=p,
height=8.5,
width=11)
print(p)
}
}
We’d also like to plot the sensitivity analysis results for independent Monte Carlo – both showing the same data as for correlated Monte Carlo (sensitivity to the physiological parameters as a group), and showing sensitivity to each of the physiological parameters independently.
So first, we read in the independent MC data.
#Initialize list of data.tables
dt.list <- vector(mode="list", length=nrow(pmfc))
for (i in 1:nrow(pmfc)){
dt.list[[i]] <- readRDS(paste0('data/',
'sens_glenisaacs_nhanes_',
'allchems_',
'indepMC_',
model,
'_',
css.method,
'_fup_censor_',
pmfc[i, 'fup.censored.dist'],
'_poormetab_',
pmfc[i, 'poormetab'],
ifelse(pmfc[i, 'fuptofub'], "_FuptoFub", ""),
'.Rdata'))
dt.list[[i]][, poormetab:=pmfc[i, 'poormetab']]
dt.list[[i]][, fup.censored.dist:=pmfc[i, 'fup.censored.dist']]
dt.list[[i]][, fuptofub:=pmfc[i, 'fuptofub']]
}
dat_indep <- rbindlist(dt.list)
setnames(dat_indep, c('chemcas', 'rn'),
c('CAS', 'param'))
dat_indep <- merge(dat_indep,
cheminfo.dt[, .(CAS,
Compound,
Funbound.plasma,
Clint)],
by='CAS')
setnames(dat_indep, 'Clint', 'CLint')
dat_indep[param=='Clint', param:='CLint']
dat_indep[param=='Funbound.plasma', param:='Fub']
dat_indep[, param:=factor(param,
levels=c('CLint',
'Fub',
'phys.par',
unique(param)[!(unique(param) %in%
c('CLint',
'Fub',
'phys.par'))]))]
#change poormetab factor levels to be informative
dat_indep[, poormetab:=factor(poormetab,
levels=c(FALSE, TRUE),
labels=c('excluded',
'included'))]
#change fup.censored.dist factor levels to be informative
dat_indep[, fup.censored.dist:=factor(fup.censored.dist,
levels=c(FALSE, TRUE),
labels=c('<lod=lod/2',
'<lod censored'))]
#change fup.censored.dist name is be more informative
setnames(dat_indep, 'fup.censored.dist', 'Fub')
dat_indep[CLint==0, CLint:=1e-8] #plot them as 1e-8 but label them as zero
Now do the plotting.
for (fpb in c(TRUE)){
dt.tmp <- dat_indep[param %in% c('CLint',
'Fub',
'phys.par') &
fuptofub==fpb, ]
setorder(dt.tmp, Si)
p<-ggplot(data=dt.tmp) +
geom_point(aes(x=CLint,
y=Funbound.plasma,
color=Si,
fill=Si,
order=Si),
shape=21)+
scale_color_gradientn(colours=ylgnbu,
guide='colourbar',
limits=c(0,1), #specify limits, breaks, and labels to get the colorbar tick marks where I want them
breaks=c(0,0.25,0.5,0.75,1),
labels=as.character(c(0,0.25,0.5,0.75,1)),
oob=squish,
name='First-order \nCss sensitivity \nto param i')+ #there may be some very small negative indexes; just treat them as zero
scale_fill_gradientn(colours=ylgnbu,
guide=FALSE, #don't plot separate colorbar for fill
na.value=NA, #don't fill points for NAs
limits=c(0,1), #specify limits, breaks, and labels to get the colorbar tick marks where I want them
breaks=c(0,0.25,0.5,0.75,1),
labels=as.character(c(0,0.25,0.5,0.75,1)),
oob=squish)+
scale_x_continuous(trans='log10', #use the hack to get CLint==0 points to not be clipped
breaks=CLint.breaks,
labels=CLint.labels) +
scale_y_continuous(limits=c(0,1),
oob=squish) + #Funbound.plasma shouldn't be >1 -- if it is, just pretend it's 1
# facet_grid(poormetab*Fub~param,
# labeller=my_labeller_fun)+
facet_grid(poormetab*Fub~param,
labeller=labeller(poormetab=function(x) paste("CLint: PM ", x),
Fub = label_both,
param=function(x) paste("i = ", x))) +
labs(x='Measured CLint (uL/min/million cells)',
y='Measured Fub',
title='Independent MC') +
theme(legend.title=element_text(size=12), #bump up the legend text size
legend.text=element_text(size=12),
strip.background=element_blank())
ggsave(filename=paste0('pdf_figures/',
paste('Si',
'indepMC',
'model',
model,
"FuptoFub",
fpb,
sep='_'),
'.pdf'),
plot=p,
height=8.5,
width=11)
print(p)
}
And plot each physiological parameter independently.
for (fpb in c(TRUE)){
dt.tmp <- dat_indep[param %in% c('million.cells.per.gliver',
'Qgfrc',
'Qtotal.liverc',
'Vliverc') &
fuptofub==fpb, ]
setorder(dt.tmp, Si)
p<-ggplot(data=dt.tmp) +
geom_point(aes(x=CLint,
y=Funbound.plasma,
color=Si,
fill=Si,
order=Si),
shape=21)+
scale_color_gradientn(colours=ylgnbu,
guide='colourbar',
limits=c(0,1), #specify limits, breaks, and labels to get the colorbar tick marks where I want them
breaks=c(0,0.25,0.5,0.75,1),
labels=as.character(c(0,0.25,0.5,0.75,1)),
oob=squish,
name='First-order \nCss sensitivity \nto param i')+ #there may be some very small negative indexes; just treat them as zero
scale_fill_gradientn(colours=ylgnbu,
guide=FALSE, #don't plot separate colorbar for fill
na.value=NA, #don't fill points for NAs
limits=c(0,1), #specify limits, breaks, and labels to get the colorbar tick marks where I want them
breaks=c(0,0.25,0.5,0.75,1),
labels=as.character(c(0,0.25,0.5,0.75,1)),
oob=squish)+
scale_x_continuous(trans='log10', #use the hack to get CLint==0 points to not be clipped
breaks=CLint.breaks,
labels=CLint.labels) +
scale_y_continuous(limits=c(0,1),
oob=squish) + #Funbound.plasma shouldn't be >1 -- if it is, just pretend it's 1
# facet_grid(poormetab*Fub~param,
# labeller=my_labeller_fun)+
facet_grid(poormetab*Fub~param,
labeller=labeller(poormetab=function(x) paste("CLint: PM ", x),
Fub = label_both,
param=function(x) paste("i = ", x))) +
labs(x='Measured CLint (uL/min/million cells)',
y='Measured Fub',
title='Independent MC') +
theme(legend.title=element_text(size=12), #bump up the legend text size
legend.text=element_text(size=12),
strip.background=element_blank())
ggsave(filename=paste0('pdf_figures/',
paste('Si',
'indepMC',
'physparams',
'model',
model,
"FuptoFub",
fpb,
sep='_'),
'.pdf'),
plot=p,
height=8.5,
width=11)
print(p)
}