-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathVignette5-BioactivityExposureRatio.Rmd
508 lines (465 loc) · 23.2 KB
/
Vignette5-BioactivityExposureRatio.Rmd
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
---
title: "Honda et al. (unsubmitted): Impact of Bioavailability on Risk Prioritization"
author: "Greg Honda and John Wambaugh"
date: "August 21, 2023"
output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{Honda et al. (unsubmitted): Risk Prioritization}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
This vignette incorporates the Caco-2 data into estimates of oral
bioavailability and prioritizes chemical risk based on bioactivity:exposure
ratio.
All necessary files other than R packages should be available on GitHub at:
[https://github.com/USEPA/comptox-expocast-caco2](https://github.com/USEPA/comptox-expocast-caco2)
## Overall Manuscript Abstract
Performance of pharmacokinetic models developed using *in vitro-to-in vivo*
extrapolation (IVIVE) methods may be improved by refining assumptions regarding
fraction absorbed ($F_{abs}$) through the intestine, a component of oral
bioavailability ($F_{bio}$). Although *in vivo* measures of Fabs are often
unavailable for non-pharmaceuticals, *in vitro* measures of apparent
permeability ($P_{app}$) using the Caco-2 cell line have been highly correlated
with $F_{abs}$. We measured bidirectional $P_{app}$ for over 400
non-pharmaceutical chemicals using the Caco-2 assay. A random forest
quantitative structure-property relationship (QSPR) model was developed using
these and peer-reviewed pharmaceutical data. Both Caco-2 data ($R^2$=0.37) and
the QSPR model ($R^2$=0.29) were better at predicting human bioavailability
compared to *in vivo* rat data ($R^2$=0.23). After incorporation into a high
throughput toxicokinetics (HTTK) framework for IVIVE, the Caco-2 data were used
to estimate in vivo administered equivalent dose (AED) for bioactivity assessed
*in vitro*, The HTTK-predicted plasma steady state concentrations ($C_{ss}$)
for IVIVE were revised, with modest changes predicted for poorly absorbed
chemicals. Experimental data were evaluated for sources of measurement
uncertainty, which were then accounted for using the Monte Carlo method.
Revised AEDs were subsequently compared with exposure estimates to evaluate
effects on bioactivity:exposure ratios, a surrogate for risk. Only minor
changes in the margin between chemical exposure and predicted bioactive doses
were observed due to the preponderance of highly absorbed chemicals.
## Prepare for session
### Clear memory
```{r setup}
# Delete all objects from memory:
rm(list=ls())
```
### Set the figure size
```{r knitr_setup}
loc.wd <- "C:/Users/jwambaug/git/comptox-caco2/Honda_Caco2"
knitr::opts_chunk$set(echo = TRUE, fig.width=5, fig.height=4)
knitr::opts_knit$set(root.dir = loc.wd)
```
### Load the relevant libraries
```{r r_setup}
packages <- c("ggplot2","dplyr","httk",
"viridis","data.table","magrittr","readxl",
"gridExtra","grid","lattice",
"gtable","ggpubr","scales")
sapply(packages, require, character.only=TRUE, quietly=TRUE) #Note, the "character.only" argument is necessary her
```
### Load custom scripts for analysis
```{r load_useful_scripts}
source(paste0(loc.wd,"/r_scripts/Honda_caco2_utilities.R"))
#source('C:/Users/GHONDA/Documents/HTTKOralRoute/gh_ionization_functions.R')
#source("C:/Users/GHONDA/Documents/R homebrew/chemprop_connect/query_dsstox.measchemprop.R")
#source(paste0(loc.wd,"/r_scripts/rf_train.R"))
#source(paste0(loc.wd,"/r_scripts/Honda_caco2_fullmodel.R"))
```
### Plot Configuration
Here we set standard aspects of all plots, like font size
```{r BERplotsetup}
# make BER plot theme
gtheme <- theme(axis.title = element_text(size=12,color="black",face="bold"),
axis.text.y = element_text(size=10, color = "black",face="bold"),
legend.text = element_text(size = 10),
legend.title = element_text(size = 10),
legend.key.size = unit(10, "points"),
panel.background = element_rect(fill="white"),
axis.line = element_line(color="black"),
strip.background = element_blank(),
axis.ticks.y = element_line(color="black"),
legend.position = "top",
axis.line.x=element_line(color="black"),
axis.ticks.x=element_line(color="black"),
axis.text.x = element_text(size = 10,face="bold",color="black"),
plot.title = element_text(hjust=0,size=12,face="bold"))
legend.dt <- data.table(x = 1:3, y = 1:3,
leg.labl = c("AED","Exposure", "Overlap"),
leg.color = c("purple", "yellow", "orange")) %>%
.[, leg.labl := factor(leg.labl, levels = c("AED","Exposure", "Overlap"))]
g1leg <- ggplot(legend.dt)+
geom_point(aes(x = x, y = y, color = leg.labl))+
scale_color_manual(labels = c("AED","Exposure", "Overlap"),
values = c("purple","yellow","orange"))+
labs(color = "")+
theme_bw()+
gtheme+
theme(legend.position = "bottom")
gleg <- get_legend(g1leg)
```
### Function for labeling plot tick-marks on log-scale:
```{r label_logscale}
scientific_10 <- function(x) {
out <- gsub("1e", "10^", scientific_format()(x))
out <- gsub("\\+","",out)
out <- gsub("10\\^01","10",out)
out <- parse(text=gsub("10\\^00","1",out))
}
```
## BER plots
```{r calc_mc_css_options}
# collect httk chems for IVIVE
chem.dt <- as.data.table(chem.physical_and_invitro.data)
temp <- chem.dt[!is.na(DTXSID) &
!is.na(logP) &
!is.na(MP) &
!is.na(Human.Funbound.plasma) &
!is.na(Human.Clint),
.(DTXSID, CAS, Compound, logP, Human.Funbound.plasma, Human.Clint, Human.Caco2.Pab)
]
# Which chemicals have measure Caco2
measured.chems <- temp$DTXSID[!is.na(temp$Human.Caco2.Pab)]
length(measured.chems)
load_honda2023()
chem.dt <- as.data.table(chem.physical_and_invitro.data)
temp <- chem.dt[!is.na(DTXSID) &
!is.na(logP) &
!is.na(MP) &
!is.na(Human.Funbound.plasma) &
!is.na(Human.Clint),
.(DTXSID, CAS, Compound, logP, Human.Funbound.plasma, Human.Clint, Human.Caco2.Pab)
]
dim(temp)
measplusqspr.chems <- temp$DTXSID[!is.na(temp$Human.Caco2.Pab)]
length(measplusqspr.chems)
for(this.cas in temp[regexpr("<",Human.Clint) == -1 &
Human.Clint != "ND" &
Human.Funbound.plasma != "NF",CAS])
{
try(parameters <- parameterize_steadystate(chem.cas = this.cas,
suppress.messages=TRUE))
if (!(is(parameters,"try-error")))
temp[CAS == this.cas, adj.fuph := parameters$Funbound.plasma] %>%
.[CAS == this.cas, clinth := parameters$Clint]
}
use.dt <- temp[!is.na(adj.fuph) & !is.na(clinth), ]
# Restrict to chemicals with either measured or predicted Caco2:
use.dt <- use.dt[DTXSID %in% measplusqspr.chems,]
dim(use.dt)
```
### Calculate css for different IVIVE assumptions
```{r calc_css}
set.seed(6252019)
use.dt[, css_caco2 := .(list(suppressWarnings(try(calc_mc_css(chem.cas = CAS,
which.quantile = c(0.025,0.05,0.25,0.5,
0.75,0.95,0.975),
Caco2.options = list(overwrite.invivo = TRUE,
keepit100 = FALSE),
output.units = "uM",
suppress.messages=TRUE))))),.(CAS)]
set.seed(6252019)
use.dt[, css_fgutabs100 := .(list(suppressWarnings(try(calc_mc_css(chem.cas = CAS,
which.quantile = c(0.025,0.05,0.25,0.5,
0.75,0.95,0.975),
Caco2.options = list(overwrite.invivo = TRUE,
keepit100 = TRUE),
output.units = "uM",
suppress.messages=TRUE))))),.(CAS)] #%>%
save(use.dt, measured.chems, file = paste0(loc.wd, "/r_data/processed/AEDtable.RData"))
```
```{r ber_table}
# load Css values
load(file = paste0(loc.wd, "/r_data/processed/AEDtable.RData"))
# load ToxCast Summary file
load(file = paste0(loc.wd, "/r_data/BER/toxcast_summary_15AUG2019.RData"))
# load httk-seem3 data
load(file = paste0(loc.wd, "/r_data/BER/seem3_httk_chems_15AUG2019.RData"))
# Merge with Toxcast data and convert q5AC50 to OED (aka AED)
aed.dt <- toxcast.summary[use.dt, on = "CAS"]
aed_caco2 <- aed.dt[, lapply(unlist(css_caco2),
function(x) q5cnom/x),
.(CAS, DTXSID)][,c("gutabs", "IVIVE") :=
list("bold('Caco-2')~bolditalic('F'['bio'])", "bold('Nominal Conc.')")]
aed_fgutabs100 <- aed.dt[, lapply(unlist(css_fgutabs100),
function(x) q5cnom/x),
.(CAS, DTXSID)][,c("gutabs", "IVIVE") :=
list("bold('100 Percent')~bolditalic('F'['abs/gut'])", "bold('Nominal Conc.')")]
# aed_r3_mcaco2_honda1 <- aed.dt[, lapply(unlist(r1_mcaco2), function(x) q5cfree/x), .(CAS, DTXSID)][,c("gutabs", "IVIVE") :=
# list("bold('Caco-2')~bolditalic('F'['bio'])", "bold('Free Conc.')")]
# aed_r4_mfabs_honda1 <- aed.dt[, lapply(unlist(r2_mfabs), function(x) q5cfree/x), .(CAS, DTXSID)][,c("gutabs", "IVIVE") :=
# list("bolditalic('In Vivo')~bolditalic('F'['bio'])", "bold('Free Conc.')")]
aed.full <- rbind(aed_caco2,
aed_fgutabs100)#,
#aed_r3_mcaco2_honda1,
#aed_r4_mfabs_honda1)
setnames(aed.full, 3:9, c("q025", "q05", "q25", "q50", "q75", "q95", "q975"))
aed.full[, gutabs := factor(gutabs, levels = c(
"bold('100 Percent')~bolditalic('F'['abs/gut'])",
"bold('Caco-2')~bolditalic('F'['bio'])"))] %>%
.[, IVIVE := factor(IVIVE, levels = c(
"bold('Nominal Conc.')",
"bold('Free Conc.')"))]
# Make sure we have HTTK for these chemicals and they are in domain:
aed.full <- subset(aed.full,CAS%in%get_cheminfo())
aed.full2 <- seem.dt[,.(DTXSID = dsstox_substance_id,
seem3, seem3.l95,
seem3.u95)][aed.full, on = "DTXSID"]
aed.full2[, BER:=q95/seem3.u95]
aed.full2[BER<1, cross.ber.min:=q95]
aed.full2[BER<1, cross.ber.max:=seem3.u95]
aed.full2[gutabs == "bold('100 Percent')~bolditalic('F'['abs/gut'])" &
IVIVE == "bold('Nominal Conc.')", r100 := rank(
aed.full2[gutabs == "bold('100 Percent')~bolditalic('F'['abs/gut'])" &
IVIVE == "bold('Nominal Conc.')","BER"])]
aed.full2[gutabs == "bold('Caco-2')~bolditalic('F'['bio'])",r100:=
aed.full2[gutabs == "bold('100 Percent')~bolditalic('F'['abs/gut'])",
"r100"]
]
aed.full2[gutabs == "bold('Caco-2')~bolditalic('F'['bio'])" &
IVIVE == "bold('Nominal Conc.')", rcaco := rank(
aed.full2[gutabs == "bold('Caco-2')~bolditalic('F'['bio'])" &
IVIVE == "bold('Nominal Conc.')","BER"])]
aed.full2[gutabs == "bold('100 Percent')~bolditalic('F'['abs/gut'])" &
IVIVE == "bold('Nominal Conc.')" &
DTXSID %in% measured.chems, r100meas := rank(
aed.full2[gutabs == "bold('100 Percent')~bolditalic('F'['abs/gut'])" &
IVIVE == "bold('Nominal Conc.')" &
DTXSID %in% measured.chems,"BER"])]
aed.full2[gutabs == "bold('Caco-2')~bolditalic('F'['bio'])",r100meas:=
aed.full2[gutabs == "bold('100 Percent')~bolditalic('F'['abs/gut'])",
"r100meas"]
]
aed.full2[gutabs == "bold('Caco-2')~bolditalic('F'['bio'])" &
IVIVE == "bold('Nominal Conc.')" &
DTXSID %in% measured.chems, rcacomeas := rank(
aed.full2[gutabs == "bold('Caco-2')~bolditalic('F'['bio'])" &
IVIVE == "bold('Nominal Conc.')" &
DTXSID %in% measured.chems,"BER"])]
aed.full2[,
c("Fbio", "Fabs", "Fgut", "Fhep") :=
calc_fbio.oral(chem.cas=CAS,
suppress.messages=TRUE),by=CAS]
save(aed.full2,file=paste0(loc.wd, "/r_data/processed/BERtable.RData"))
```
### Bioactivty:Exposure Ratio Plots
```{r makehistogram}
load(file=paste0(loc.wd, "/r_data/processed/BERtable.RData"))
hist.table.fabs <- aed.full2[gutabs == "bold('100 Percent')~bolditalic('F'['abs/gut'])",
c("DTXSID","Fabs")]
hist.table.fabs$label <- "Fabs"
colnames(hist.table.fabs)[2] <- "Value"
hist.table.fgut <- aed.full2[gutabs == "bold('100 Percent')~bolditalic('F'['abs/gut'])",
c("DTXSID","Fgut")]
hist.table.fgut$label <- "Fgut"
colnames(hist.table.fgut)[2] <- "Value"
hist.table.ber <- aed.full2[gutabs == "bold('100 Percent')~bolditalic('F'['abs/gut'])",
c("DTXSID","BER")]
hist.table.ber$label <- "BER"
colnames(hist.table.ber)[2] <- "Value"
hist.table <- rbind(hist.table.fabs, hist.table.ber)
save(hist.table,file=paste0(loc.wd, "/r_data/processed/BER-histograms.RData"))
print(paste("We are assuming that systemic bioavailability of an oral dose is a function of three processes: first-pass hepatic metabolism (independent of gut permeability), gut absorption, and gut metabolism. HTTK already included first-pass hepatic metabolism either by modeling flow from the gut through the liver before it reaches systemic circulation or by multiplying the absorbed dose by Fhep. Therefore, shifts in the predictions of HTTK will be due to only gut absorption (no longer 100%) and gut metabolism (no longer zero).",
"For the chemicals where we can calculate BER the median value of Fabs is predicted to be",
signif(median(hist.table.fabs$Value),3),
"and the median value of Fgut is",
signif(median(hist.table.fgut$Value),3),
". This means for most chemicals we might expect Fbio to decrease only",
percent(signif(1 - signif(median(hist.table.fabs$Value),3)*
signif(median(hist.table.fgut$Value),3),2)),
". This reduction is less than one order of magnitude. Meanwhile the median BER is",
signif(median(hist.table.ber$Value,na.rm=TRUE),2),"or",
signif(log10(median(hist.table.ber$Value,na.rm=TRUE)),1),
"orders of magnitude.",
"For specific chemicals where Fabs is predicted to be low, the changes will be more pronounced.",
"Fabs is less than 50% for only",
sum(hist.table.fabs$Value<0.5),
"of chemicals where we can estimate BER."))
colnames(hist.table.ber)[2] <- "Value"
FigBERHistogram<-ggplot(hist.table, aes(x=Value, fill=label)) +
geom_histogram(alpha=0.25, position="identity") +
labs(x = expression(bold('F'['abs']*' and Bioactivity:Exposure Ratio')),
y = "Number of Chemicals") +
scale_x_log10(labels=scientific_10,limits=c(10^-3,10^7))+
scale_y_log10(labels=scientific_10)+
scale_fill_discrete(name="",labels=c(expression('BER','F'['abs'],'F'['gut'])))+
gtheme+
scale_colour_viridis_d()
print(FigBERHistogram)
ggsave(FigBERHistogram,
file = paste0(loc.wd, "/results_for_paper/Fig_BERhistogram.tiff"),
dpi = 600, height = 5, width = 5, compression = "lzw")
```
```{r makerankcomparison}
load(file=paste0(loc.wd, "/r_data/processed/BERtable.RData"))
rank.table <- aed.full2[gutabs == "bold('100 Percent')~bolditalic('F'['abs/gut'])",
c("DTXSID","r100")]
rank.table <- cbind(rank.table, aed.full2[gutabs != "bold('100 Percent')~bolditalic('F'['abs/gut'])",
"rcaco"])
save(rank.table,file=paste0(loc.wd, "/r_data/processed/ranks.RData"))
FigBERRankCompare<-ggplot(rank.table, aes(x=r100, y=rcaco)) +
geom_point(alpha=0.5, size=3) +
scale_colour_viridis_d()+
labs(y = expression(bold('BER Rank with F'['bio'])),
x = expression(bold('BER Rank with F'['abs']~'== F'['gut']~'== 1')))+
geom_abline(slope=1,intercept=0,linetype="dashed",color="blue")+
scale_x_log10() + scale_y_log10() +
gtheme
print(FigBERRankCompare)
ggsave(FigBERRankCompare,
file = paste0(loc.wd, "/results_for_paper/Fig_BERrankcompare.tiff"),
dpi = 600, height = 5, width = 5, compression = "lzw")
```
```{r calcmccsscheck}
load(file=paste0(loc.wd, "/r_data/processed/BERtable.RData"))
css.table <- aed.full2[gutabs == "bold('100 Percent')~bolditalic('F'['abs/gut'])",
c("DTXSID","q50","Fgut", "Fabs")]
css.table <- cbind(css.table, aed.full2[gutabs != "bold('100 Percent')~bolditalic('F'['abs/gut'])",
"q50"])
colnames(css.table)[5]<-"q50.2"
css.table[,"Fbio.eff"] <- css.table[,"q50"]/css.table[,"q50.2"]
css.table[,"Fgutchange"] <- css.table[,"Fgut"]*css.table[,"Fabs"]
save(css.table,file=paste0(loc.wd, "/r_data/ranks.RData"))
Figcsstest<-ggplot(css.table, aes(x=Fgutchange, y=Fbio.eff)) +
geom_point(alpha=0.5, size=3) +
scale_colour_viridis_d()+
labs(y = "Fabsgut.eff",
x = "Fabsgut")+
# scale_x_log10() + scale_y_log10() +
labs(y = expression(bold('Effective F'['gut']~'* F'['abs']~'from Monte Carlo')),
x = expression(bold('Actual F'['gut']~'* F'['abs'])))+
geom_abline(slope=1,intercept=0,color="blue",linetype="dashed")+
gtheme
print(Figcsstest)
ggsave(Figcsstest,
file = paste0(loc.wd, "/results_for_paper/Fig_CssTest.tiff"),
dpi = 600, height = 5, width = 5, compression = "lzw")
```
```{r extra_chems}
cat(paste(length(unique(subset(aed.full2,!is.na(BER))$DTXSID)) -
length(unique(subset(aed.full2,!is.na(BER) &
DTXSID %in% measured.chems)$DTXSID)),
"extra chemicals with BER thanks to the QSPR."))
```
```{r makeallchemBERfig}
load(file=paste0(loc.wd, "/r_data/processed/BERtable.RData"))
g1 <- ggplot(subset(aed.full2,
IVIVE=="bold('Nominal Conc.')"))+
facet_grid(rows= vars(gutabs), labeller = label_parsed) +
geom_point(aes(y = q95, x = r100), color = "purple") +
geom_point(aes(y = seem3.u95, x = r100), color = "yellow")+
geom_linerange(aes(ymin = cross.ber.min,
ymax = cross.ber.max,
x = r100), color = "orange")+
# geom_text(data = figtxt.dt,
# mapping = aes(x = x1, y = y1, label = labl1),
# hjust = 0, parse = FALSE) +
# geom_text(data = figtxt.dt,
## mapping = aes(x = x2, y = y2, label = labl2),
# hjust = 0, parse = TRUE)+
labs(x = "Bioactivity:Exposure Ratio",
y = expression(bold('log'['10']*'(mg/kgBW/day)')))+
theme_bw()+
xlim(1,500)+
scale_y_log10(limits=c(10^-8,10^2),labels=scientific_10)+
gtheme
hlay <- t(t(c(rep(1,8),2)))
g2 <- marrangeGrob(grobs = list(g1, gleg), nrow = 2, ncol = 1, top = NULL, layout_matrix = hlay)
print(g2)
ggsave(g2,
file = paste0(loc.wd,
"/results_for_paper/Fig_BERrankzoom.tiff"),
dpi = 600, height = 5, width = 7.5, compression = "lzw")
```
```{r makemeasurecacoBERfig}
load(file=paste0(loc.wd, "/r_data/processed/BERtable.RData"))
# load Css values
load(file = paste0(loc.wd, "/r_data/processed/AEDtable.RData"))
FigBERmeas <- ggplot(subset(aed.full2,DTXSID%in%measured.chems &
!is.na(q95) &
gutabs != "bold('100 Percent')~bolditalic('F'['abs/gut'])"))+
geom_linerange(aes(ymin = seem3.u95,
ymax = q95,
x = rcacomeas), color = "grey")+
geom_linerange(aes(ymin = cross.ber.min,
ymax = cross.ber.max,
x = rcacomeas), color = "orange")+
geom_point(aes(y = q95, x = rcacomeas), color = "purple") +
geom_point(aes(y = seem3.u95, x = rcacomeas), color = "yellow")+
labs(x = "Bioactivity:Exposure Ratio",
y = 'mg/kg BW/day')+
theme_bw()+
# xlim(1,500)+
scale_y_log10(limits=c(10^-8,10^2),labels=scientific_10)+
gtheme
hlay <- t(t(c(rep(1,8),2)))
FigBERleg <- marrangeGrob(grobs = list(FigBERmeas, gleg), nrow = 2, ncol = 1, top = NULL, layout_matrix = hlay)
print(FigBERleg)
ggsave(FigBERleg,
file = paste0(loc.wd,
"/results_for_paper/Fig_BERrankmeascaco2.tiff"),
dpi = 600, height = 5, width = 7.5, compression = "lzw")
```
```{r makemeasurecacoBERfig2}
load(file=paste0(loc.wd, "/r_data/processed/BERtable.RData"))
FigBERall <- ggplot(subset(aed.full2,
!is.na(q95) &
gutabs != "bold('100 Percent')~bolditalic('F'['abs/gut'])"))+
geom_linerange(aes(ymin = seem3.u95,
ymax = q95,
x = rcaco), color = "grey")+
geom_linerange(aes(ymin = cross.ber.min,
ymax = cross.ber.max,
x = rcaco), color = "orange")+
geom_point(aes(y = q95, x = rcaco), color = "purple") +
geom_point(aes(y = seem3.u95, x = rcaco), color = "yellow")+
labs(x = "Bioactivity:Exposure Ratio",
y = 'mg/kg BW/day')+
theme_bw()+
scale_y_log10(limits=c(10^-8,10^2),labels=scientific_10)+
gtheme
hlay <- t(t(c(rep(1,8),2)))
FigBERleg <- marrangeGrob(grobs = list(FigBERall, gleg), nrow = 2, ncol = 1, top = NULL, layout_matrix = hlay)
print(FigBERleg)
ggsave(FigBERleg,
file = paste0(loc.wd,
"/results_for_paper/Fig_BERrankallcaco2.tiff"),
dpi = 600, height = 5, width = 7.5, compression = "lzw")
```
```{r multipanelBER}
ggarrange(FigBERmeas, FigBERall,
labels = c("A", "B"),
ncol = 1, nrow = 2,
common.legend = TRUE, legend = "bottom")
ggsave(file = paste0(loc.wd, "/results_for_paper/Fig_BERTwoPanel.tiff"),
height = 6.8, width = 6.8, dpi=600, compression = "lzw")
ggarrange(FigBERmeas, FigBERall,
labels = c("A", "B"),
ncol = 1, nrow = 2,
common.legend = TRUE, legend = "bottom"+
theme_gray(base_size = 18))
dev.off()
```
### Identify the poorly absorbed chemicals:
```{r lowfabstable}
low.fabs <- subset(aed.full2,Fabs<0.5)
low.fabs.table <- subset(low.fabs,gutabs == "bold('100 Percent')~bolditalic('F'['abs/gut'])")
low.fabs.table<- low.fabs.table[,c("DTXSID","CAS","Fabs","Fgut","Fhep","Fbio","seem3.u95","q95","BER")]
low.fabs.table <- low.fabs.table[,q952:=
subset(low.fabs,gutabs !=
"bold('100 Percent')~bolditalic('F'['abs/gut'])")$q95]
low.fabs.table <- low.fabs.table[,BER2:=
subset(low.fabs,gutabs !=
"bold('100 Percent')~bolditalic('F'['abs/gut'])")$BER]
colnames(low.fabs.table)[colnames(low.fabs.table)=="seem3.u95"]<-"SEEM3"
colnames(low.fabs.table)[colnames(low.fabs.table)=="q95"]<-"ToxCast AED Fabs=Fgut=1"
colnames(low.fabs.table)[colnames(low.fabs.table)=="BER"]<-"BER Fabs=Fgut=1"
colnames(low.fabs.table)[colnames(low.fabs.table)=="q952"]<-"ToxCast AED Caco2"
colnames(low.fabs.table)[colnames(low.fabs.table)=="BER2"]<-"BER Caco2"
low.fabs.table <- as.data.frame(low.fabs.table)
for (i in 3:11) low.fabs.table[,i] <- signif(low.fabs.table[,i],3)
low.fabs.table <- low.fabs.table[order(low.fabs.table$Fbio),]
knitr::kable(low.fabs.table,
caption = "Chemicals with Low Caco2-Predicted Fabs (Poorly absorbed chemicals)",
floating.environment="sidewaystable")
write.csv(low.fabs.table,file=paste0(loc.wd,"/results_for_paper/Tablepoorlyabsorbedchemicals.csv"))
```