In jwr-git/mrpipeline: Implements a Ready-for-Use Mendelian Randomisation Pipeline
knitr::opts_chunk$set(echo = F)
# Subset correct results for reporting
results <- params$report$results
results <- results[results$id.exposure == id.exposure, ]
cresults <- params$report$cresults
cresults <- cresults[cresults$id1 == id.exposure, ]
sensitivity <- params$report$sresults
sensitivity <- sensitivity[sensitivity$id.exposure == id.exposure, ]
plots <- params$report$plots
plots <- plots[plots$id1 == id.exposure, ]
# raw.plots have the same indices as plots
# therefore raw.plots can be subset the same as plots
if (nrow(plots[plots$id1 == id.exposure, ]) > 0) {
raw.plots <- report$raw.plots
raw.plots <- raw.plots[as.integer(rownames(plots[plots$id1 == id.exposure, ]))]
}
if (nrow(plots)) {
# Now the df need re-indexed
rownames(plots) <- 1:nrow(plots)
}
Back to Main Page
Harmonised SNPs
This table shows the SNPs included in the instrument after harmonisation with the outcome dataset(s).
if (length(dat) < 1 || nrow(dat) < 1) {
cat("No results generated.")
} else {
sketch = htmltools::withTags(table(
class = 'display',
thead(
tr(
th(rowspan = 2, 'SNP'),
th(colspan = 7, 'Exposure'),
th(colspan = 1, ''),
th(colspan = 7, 'Outcome')
),
tr(
lapply(c('Name', 'Eff', 'Alt', 'EAF', 'Beta', 'SE', 'P', 'F.Stat.',
'Name', 'Eff', 'Alt', 'EAF', 'Beta', 'SE', 'P','Inc.MR'),
th)
)
)
))
dat[dat$id.exposure == params$id.exposure, ] %>%
dplyr::select(!tidyselect::any_of(
c("remove",
"palindromic",
"ambiguous",
"id.outcome",
"id.exposure",
"originalname.outcome",
"outcome.deprecated",
"mr_keep.outcome",
"data_source.outcome",
"proxy.outcome",
"target_snp.outcome",
"proxy_snp.outcome",
"target_a1.outcome",
"target_a2.outcome",
"proxy_a1.outcome",
"proxy_a2.outcome",
"trait.exposure",
"pve.exposure",
"rsid",
"id",
"data_source.exposure",
"action",
"ogdb_eid",
"ogdb_oid",
"chr",
"pos",
"samplesize.exposure",
"samplesize.outcome",
"ncase.exposure",
"ncontrol.exposure",
"pval_origin.exposure",
"maf.exposure",
"pval",
"mr_keep",
"chr.exposure",
"pos.exposure"
))) %>%
dplyr::rename(Eff.e = effect_allele.exposure,
Alt.e = other_allele.exposure,
Eff.o = effect_allele.outcome,
Alt.o = other_allele.outcome,
B.e = beta.exposure,
B.o = beta.outcome,
EAF.e = eaf.exposure,
EAF.o = eaf.outcome,
SE.e = se.exposure,
SE.o = se.outcome,
P.e = pval.exposure,
P.o = pval.outcome,
Exposure = exposure,
Outcome = outcome,
Inc.MR = mr_keep.exposure,
F.Stat = f.stat.exposure) %>%
dplyr::relocate(SNP,
Exposure, Eff.e, Alt.e, EAF.e, B.e, SE.e, P.e,
F.Stat,
Outcome, Eff.o, Alt.o, EAF.o, B.o, SE.o, P.o,
Inc.MR) %>%
DT::datatable(rownames = F,
container = sketch,
caption = "Details for SNPs which were included in the MR analysis by passing the QC and cleaning stages.",
extensions = c("Buttons"),
options = list(order = list(7, "desc"),
dom = "BDfrtip",
buttons = list('copy',
list(extend = 'collection',
buttons = c('csv', 'excel'),
text = 'Download')))) %>%
DT::formatSignif(columns = c("P.e", "P.o"), digits = 3) %>%
DT::formatRound(columns = c("F.Stat"), digits = 0)
}
r if (nrow(params$dat) <= nrow(unique(dat$outcome))) { "\\begin{comment}" }
Diagnostic Plots
The following plots show how the exposure and outcome SNPs relate to one another. These graphs can therefore offer an qualitative inspection of the data when instruments consist of multiple SNPs.
Z score plot
A plot of Z score (beta / SE) against P value for each exposure SNP which can help detect potentially problematic SNPs. The shape of the graph should be parabolic, roughly of the form $y=x^{2}$, with potentially problematic SNPs lying outside of that curve. A curve of best fit is also provided as a rough aid if there are enough SNPs.
plotly::ggplotly(mrpipeline::interactive_z_plot(params$dat))
Scatter plots {.tabset}
Scatter plots of the SNP-exposure and SNP-outcome effects to potentially detect problematic SNPs.
plotlist <- htmltools::tagList() # Work around for print and plotly::ggplotly not working nicely together
j <- 0
for (i in unique(dat$id.outcome)) {
j <- j + 1
p <- mrpipeline::interactive_scatter_plot(params$dat, params$id.exposure, i)
if (!is.null(p)) {
cat(" \n### ", unique(dat[dat$id.outcome == i,]$outcome), " \n")
plotlist[[j]] <- as.widget(plotly::ggplotly(p))
print(htmltools::tagList(plotlist[[j]]))
cat(" \n")
} else {
cat("No plot generated.")
}
}
r if (nrow(params$dat) <= nrow(unique(dat$outcome))) { "\\end{comment}" }
MR Results
Results for the main MR analyses (Wald ratio (WR) and inverse variance weighted (IVW)) are given here. The WR method is performed on all constituent SNPs for each instrument, whilst the IVW method is performed on those instruments which consist of multiple SNPs.
Steiger filtering results are also given, including the approximated variance explained (r2.exposure, r2.outcome), direction of effect (true when direction is from exposure to outcome, false vice versa), P value and a flag which simplifies the interpretation of the Steiger results:
- True, when direction is correctly orientated and P value < 0.05.
- False, when direction is incorrectly orientated and P value < 0.05.
- Unknown, when P value >= 0.05.
steiger <- params$report$steigerresults
steiger <- steiger[steiger$id.exposure == params$id.exposure,]
results %>%
dplyr::left_join(steiger) %>%
dplyr::rename(Exposure.ID = id.exposure,
Outcome.ID = id.outcome,
Outcome = outcome,
Exposure = exposure,
Method = method,
SNPs = nsnp,
P.value = pval,
OR = or,
Lower.95ci = or_lci95,
Upper.95ci = or_uci95,
r2.exposure = snp_r2.exposure,
r2.outcome = snp_r2.outcome,
Direction = correct_causal_direction,
Steiger.P = steiger_pval,
Steiger.Flag = flag) %>%
dplyr::select(-Exposure.ID, -Outcome.ID) %>%
dplyr::relocate(Outcome, .after = Exposure) %>%
DT::datatable(rownames = F,
filter = 'top',
extensions = 'Buttons',
caption = "MR results for this exposure on all outcomes",
options = list(order = list(5, "desc"),
dom = 'Bfrtip',
buttons = list('copy',
list(extend = 'collection',
buttons = c('csv', 'excel'),
text = 'Download')))) %>%
DT::formatSignif(columns = c("P.value",
"OR",
"Lower.95ci",
"Upper.95ci",
"r2.exposure",
"r2.outcome",
"Steiger.P"),
digits = 3)
Results Plots {.tabset}
Plots shown here include scatter and forest plots of results, if they are generated (some may require many SNPs).
Forest Plot {.tabset}
Forest plot showing the MR results for each outcome.
#if (exists("raw.plots") & "forest" %in% plots$type) {
# grid.newpage()
# grid.draw(raw.plots[[as.integer(rownames(plots[plots$type == "forest", ]))]][[1]])
#}
Volcano Plot {.tabset}
Volcano plot of the individual SNP Wald ratios.
#raw.plots[as.integer(rownames(plots[plots$type == "volcano", ]))]
mrpipeline::interactive_volcano_plot(dat[dat$id.exposure == id.exposure,])
grid.newpage()
PheWAS-like Plot {.tabset}
#if (exists("raw.plots") & "phewas" %in% plots$type) {
# raw.plots[as.integer(rownames(plots[plots$type == "phewas", ]))]
#}
Colocalisation
Colocalisaton uses the coloc.abf function from the coloc R package. This section should be expanded to include conditional analyses and/or pwcoco, or other colocalisation methods.
r if (!length(cresults) || nrow(cresults) < 1 || !length(cresults[cresults["nsnps"] > 50, ])) { "\\begin{comment}" }
if (length(plots[plots$type == "regional", ]) > 0) {
for (idx in as.integer(rownames(plots[plots$type == "regional", ])))
{
if (all(is.na(raw.plots[[idx]]))) {
next
}
grid.newpage()
grid.draw(raw.plots[[idx]])
}
}
for (i in 1:nrow(cresults)) {
tryCatch({
cresults[i, "plot"] <- sprintf("<a class='ItemsTooltip' target='_blank'><img class='imgTooltip' src='%s'/>Region</a>", knitr::image_uri(knitr::fig_chunk('regional-plot', 'png', i)))
},
error = function(e) {
cresults[i, "plot"] <- "No plot"
})
}
cresults <- cresults[cresults["nsnps"] > 50, ]
if (length(cresults) && nrow(cresults) > 0) {
cresults %>%
dplyr::rename(Exposure = name1,
Outcome = name2,
SNPs = nsnps,
ChrPos = chrpos,
Plot = plot) %>%
dplyr::select(-id1, -id2) %>%
dplyr::relocate(Plot, .after = Outcome) %>%
DT::datatable(rownames = F,
escape = F,
filter = 'top',
extensions = c("Buttons"),
options = list(order = list(7, "desc"),
dom = "Bfrtip",
buttons = list('copy',
list(extend = 'collection',
buttons = c('csv', 'excel'),
text = 'Download')))) %>%
DT::formatPercentage(c("H0", "H1", "H2", "H3", "H4"), 2)
} else {
cat("No colocalisation results were generated.")
}
r if (!length(cresults) || nrow(cresults) < 1 || !length(cresults[cresults["nsnps"] > 50, ])) { "\\end{comment}" }
Drug Target Profile
This section contains evidence for the given target for each of the outcomes given. Evidence is collected from:
Literature Evidence
#brks <- seq(from = 0, to = 1, by = 0.1)
#clrs <- round(seq(180, 40, length.out = length(brks) + 1), 0) %>%
# {paste0("rgb(", ., ",", ., ",180)")}
#
#to_table <-params$report$otresults[params$report$otresults$id1 == params$id.exposure, ] %>%
# dplyr::select(-id1, -id2) %>%
# dplyr::relocate(name2, .after = name1) %>%
# dplyr::rename(Exposure = name1,
# Outcome = name2,
# Overall.Score = overall.ot,
# Literature = literature.ot,
# RNA.Expression = rna_expression.ot,
# Genetic.Assoc = genetic_assoc.ot,
# Somatic.Mutations = somatic_mute.ot,
# Known.Drugs = known_drug.ot,
# Animal.Model = animal_model.ot,
# Affected.Pathways = affected_pathway.ot)
#
#to_table %>%
# DT::datatable(rownames = F,
# escape = F,
# filter = 'top',
# extensions = c("Buttons"),
# options = list(order = list(2, "desc"),
# dom = "Bfrtip",
# buttons = list('copy',
# list(extend = 'collection',
# buttons = c('csv', 'excel'),
# text = 'Download')))) %>%
# DT::formatSignif(columns = c("Overall.Score",
# "Literature",
# "RNA.Expression",
# "Genetic.Assoc",
# "Somatic.Mutations",
# "Known.Drugs",
# "Animal.Model",
# "Affected.Pathways"),
# digits = 3) #%>%
# #DT::formatStyle(names(to_table), backgroundColor = DT::styleInterval(brks, clrs))
if (!any(is.null(params$report$epidbresults)) & nrow(params$report$epidbresults) > 0) {
to_table <- params$report$epidbresults[params$report$epidbresults$id1 == params$id.exposure, ]
to_table$pubmed_id <- lapply(to_table$pubmed_id, function(x) paste(lapply(unlist(x), function(y) pmid_to_link(y, hyperlink = T)), collapse = ", "))
#to_table$pubmed_id <- gsub(",", ", ", to_table$pubmed_id)
to_table %>%
dplyr::select(-id1, -id2, -lt.id, -lt.type, -literature_count) %>%
dplyr::relocate(c("gene.name", "st.predicate", "lt.name", "pubmed_id")) %>%
dplyr::rename(Gene = gene.name,
PMIDs = pubmed_id,
Outcome = lt.name,
Predicate = st.predicate) %>%
DT::datatable(rownames = F,
escape = F,
filter = 'top',
extensions = c("Buttons"),
options = list(order = list(0, "asc"),
dom = "Bfrtip",
buttons = list ('copy',
list(extend = 'collection',
buttons = c('csv', 'excel'),
text = 'Download'))))
}
r if (all(is.na(params$report$dgidbresults))) { "\\begin{comment}" }
Drug-Genome Interaction DB
colourise <- function(type) {
if (params$report$dgidbresults[params$report$dgidbresults$id == params$id.exposure, ][type] == T) {
clr <- "green;font-weight:bold"
} else {
clr <- "lightgrey"
}
ttip <- ""
if (type == "Druggable.Genome") {
ttip <- paste0('This target is', if (params$report$dgidbresults[params$report$dgidbresults$id == params$id.exposure, ]$Druggable.Genome == F) { ' not' }, ' considered to be part of the Druggable Genome. This is defined as genes, or gene products, which have either known or predicted interactions with drugs. Sources for this category usually come from published databases which are publicly available for searching, for example, ["The druggable genome and support for target identification and validation in drug development"](http://www.ncbi.nlm.nih.gov/pubmed/28356508) by Finan, et al. and ["The druggable genome"](http://www.ncbi.nlm.nih.gov/pubmed/12209152) by Hopkins, et al.')
} else if (type == "Clinically.Actionable") {
ttip <- paste0('This target is', if (params$report$dgidbresults[params$report$dgidbresults$id == params$id.exposure, ]$Clinically.Actionable == F) { ' not' }, ' considered to be Clinically Actionable. Genes which are clinically actionable are those genes, or their products, which inform on clinical decisions and are used by clinicians to guide interventions. Sources for this category come from published works which detail diagnostic panels, for example, in the case of ["High-throughput detection of actionable genomic alterations in clinical tumor samples by targeted, massively parallel sequencing"](https://pubmed.ncbi.nlm.nih.gov/22585170/) by Wagle, et al. which details genes which can guide clinical interventions for cancer.')
} else if (type == "Drug.Resistant") {
ttip <- paste0('This target is', if (params$report$dgidbresults[params$report$dgidbresults$id == params$id.exposure, ]$Drug.Resistant == F) { ' not' }, ' considered to be resistant against drugs. The main source of this category comes from the EBI [Gene Ontology](https://www.ebi.ac.uk/QuickGO/term/GO:0042493) "response to drug" category. Caution should be given to naive interpretation of this category if more than one class of drugs may be used to target that gene -- for example, the gene of interest may be resistant to one class of drug but not another.')
}
tippy::tippy(sprintf("<span style='color: %s;'>| %s </span>", clr, type), tooltip = ttip, allowHTML = T)
}
r colourise("Druggable.Genome") r colourise("Clinically.Actionable") r colourise("Drug.Resistant")
The Drug-Genome Interaction DB (DGIdB) collates evidence relevant to drug discovery efforts, for example, by categorising targets with ontology such as "part of the druggable genome", with the aim of improving and aiding drug discovery efforts. This section provides details on the three main ontologies.
#to_table <- params$report$dgidbdrugs[params$report$dgidbdrugs$id == params$id.exposure, ]
#to_table$PMIDs <- lapply(to_table$PMIDs, function(x) paste(lapply(unlist(x), function(y) pmid_to_link(y, hyperlink = T)), #collapse = ", "))
#to_table %>%
# dplyr::select(-id) %>%
# dplyr::rename(Trait = trait) %>%
# DT::datatable(rownames = F,
# escape = T,
# filter = 'top',
# extensions = c("Buttons"),
# options = list(dom = "Bfrtip",
# buttons = list ('copy',
# list(extend = 'collection',
# buttons = c('csv', 'excel'),
# text = 'Download'))))
r if (all(is.na(params$report$dgidbresults))) { "\\end{comment}" }
#params$report$mouseresults %>%
# DT::datatable(rownames = F,
# escape = T,
# filter = 'top',
# extensions = c("Buttons"),
# options = list(dom = "Bfrtip",
# buttons = list ('copy',
# list(extend = 'collection',
# buttons = c('csv', 'excel'),
# text = 'Download'))))
jwr-git/mrpipeline documentation built on Oct. 2, 2022, 3:41 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
knitr::opts_chunk$set(echo = F) # Subset correct results for reporting results <- params$report$results results <- results[results$id.exposure == id.exposure, ] cresults <- params$report$cresults cresults <- cresults[cresults$id1 == id.exposure, ] sensitivity <- params$report$sresults sensitivity <- sensitivity[sensitivity$id.exposure == id.exposure, ] plots <- params$report$plots plots <- plots[plots$id1 == id.exposure, ] # raw.plots have the same indices as plots # therefore raw.plots can be subset the same as plots if (nrow(plots[plots$id1 == id.exposure, ]) > 0) { raw.plots <- report$raw.plots raw.plots <- raw.plots[as.integer(rownames(plots[plots$id1 == id.exposure, ]))] } if (nrow(plots)) { # Now the df need re-indexed rownames(plots) <- 1:nrow(plots) }
Back to Main Page
Harmonised SNPs
This table shows the SNPs included in the instrument after harmonisation with the outcome dataset(s).
if (length(dat) < 1 || nrow(dat) < 1) { cat("No results generated.") } else { sketch = htmltools::withTags(table( class = 'display', thead( tr( th(rowspan = 2, 'SNP'), th(colspan = 7, 'Exposure'), th(colspan = 1, ''), th(colspan = 7, 'Outcome') ), tr( lapply(c('Name', 'Eff', 'Alt', 'EAF', 'Beta', 'SE', 'P', 'F.Stat.', 'Name', 'Eff', 'Alt', 'EAF', 'Beta', 'SE', 'P','Inc.MR'), th) ) ) )) dat[dat$id.exposure == params$id.exposure, ] %>% dplyr::select(!tidyselect::any_of( c("remove", "palindromic", "ambiguous", "id.outcome", "id.exposure", "originalname.outcome", "outcome.deprecated", "mr_keep.outcome", "data_source.outcome", "proxy.outcome", "target_snp.outcome", "proxy_snp.outcome", "target_a1.outcome", "target_a2.outcome", "proxy_a1.outcome", "proxy_a2.outcome", "trait.exposure", "pve.exposure", "rsid", "id", "data_source.exposure", "action", "ogdb_eid", "ogdb_oid", "chr", "pos", "samplesize.exposure", "samplesize.outcome", "ncase.exposure", "ncontrol.exposure", "pval_origin.exposure", "maf.exposure", "pval", "mr_keep", "chr.exposure", "pos.exposure" ))) %>% dplyr::rename(Eff.e = effect_allele.exposure, Alt.e = other_allele.exposure, Eff.o = effect_allele.outcome, Alt.o = other_allele.outcome, B.e = beta.exposure, B.o = beta.outcome, EAF.e = eaf.exposure, EAF.o = eaf.outcome, SE.e = se.exposure, SE.o = se.outcome, P.e = pval.exposure, P.o = pval.outcome, Exposure = exposure, Outcome = outcome, Inc.MR = mr_keep.exposure, F.Stat = f.stat.exposure) %>% dplyr::relocate(SNP, Exposure, Eff.e, Alt.e, EAF.e, B.e, SE.e, P.e, F.Stat, Outcome, Eff.o, Alt.o, EAF.o, B.o, SE.o, P.o, Inc.MR) %>% DT::datatable(rownames = F, container = sketch, caption = "Details for SNPs which were included in the MR analysis by passing the QC and cleaning stages.", extensions = c("Buttons"), options = list(order = list(7, "desc"), dom = "BDfrtip", buttons = list('copy', list(extend = 'collection', buttons = c('csv', 'excel'), text = 'Download')))) %>% DT::formatSignif(columns = c("P.e", "P.o"), digits = 3) %>% DT::formatRound(columns = c("F.Stat"), digits = 0) }
r if (nrow(params$dat) <= nrow(unique(dat$outcome))) { "\\begin{comment}" }
Diagnostic Plots
The following plots show how the exposure and outcome SNPs relate to one another. These graphs can therefore offer an qualitative inspection of the data when instruments consist of multiple SNPs.
Z score plot
A plot of Z score (beta / SE) against P value for each exposure SNP which can help detect potentially problematic SNPs. The shape of the graph should be parabolic, roughly of the form $y=x^{2}$, with potentially problematic SNPs lying outside of that curve. A curve of best fit is also provided as a rough aid if there are enough SNPs.
plotly::ggplotly(mrpipeline::interactive_z_plot(params$dat))
Scatter plots {.tabset}
Scatter plots of the SNP-exposure and SNP-outcome effects to potentially detect problematic SNPs.
plotlist <- htmltools::tagList() # Work around for print and plotly::ggplotly not working nicely together j <- 0 for (i in unique(dat$id.outcome)) { j <- j + 1 p <- mrpipeline::interactive_scatter_plot(params$dat, params$id.exposure, i) if (!is.null(p)) { cat(" \n### ", unique(dat[dat$id.outcome == i,]$outcome), " \n") plotlist[[j]] <- as.widget(plotly::ggplotly(p)) print(htmltools::tagList(plotlist[[j]])) cat(" \n") } else { cat("No plot generated.") } }
r if (nrow(params$dat) <= nrow(unique(dat$outcome))) { "\\end{comment}" }
MR Results
Results for the main MR analyses (Wald ratio (WR) and inverse variance weighted (IVW)) are given here. The WR method is performed on all constituent SNPs for each instrument, whilst the IVW method is performed on those instruments which consist of multiple SNPs.
Steiger filtering results are also given, including the approximated variance explained (r2.exposure, r2.outcome), direction of effect (true when direction is from exposure to outcome, false vice versa), P value and a flag which simplifies the interpretation of the Steiger results:
- True, when direction is correctly orientated and P value < 0.05.
- False, when direction is incorrectly orientated and P value < 0.05.
- Unknown, when P value >= 0.05.
steiger <- params$report$steigerresults steiger <- steiger[steiger$id.exposure == params$id.exposure,] results %>% dplyr::left_join(steiger) %>% dplyr::rename(Exposure.ID = id.exposure, Outcome.ID = id.outcome, Outcome = outcome, Exposure = exposure, Method = method, SNPs = nsnp, P.value = pval, OR = or, Lower.95ci = or_lci95, Upper.95ci = or_uci95, r2.exposure = snp_r2.exposure, r2.outcome = snp_r2.outcome, Direction = correct_causal_direction, Steiger.P = steiger_pval, Steiger.Flag = flag) %>% dplyr::select(-Exposure.ID, -Outcome.ID) %>% dplyr::relocate(Outcome, .after = Exposure) %>% DT::datatable(rownames = F, filter = 'top', extensions = 'Buttons', caption = "MR results for this exposure on all outcomes", options = list(order = list(5, "desc"), dom = 'Bfrtip', buttons = list('copy', list(extend = 'collection', buttons = c('csv', 'excel'), text = 'Download')))) %>% DT::formatSignif(columns = c("P.value", "OR", "Lower.95ci", "Upper.95ci", "r2.exposure", "r2.outcome", "Steiger.P"), digits = 3)
Results Plots {.tabset}
Plots shown here include scatter and forest plots of results, if they are generated (some may require many SNPs).
Forest Plot {.tabset}
Forest plot showing the MR results for each outcome.
#if (exists("raw.plots") & "forest" %in% plots$type) { # grid.newpage() # grid.draw(raw.plots[[as.integer(rownames(plots[plots$type == "forest", ]))]][[1]]) #}
Volcano Plot {.tabset}
Volcano plot of the individual SNP Wald ratios.
#raw.plots[as.integer(rownames(plots[plots$type == "volcano", ]))] mrpipeline::interactive_volcano_plot(dat[dat$id.exposure == id.exposure,]) grid.newpage()
PheWAS-like Plot {.tabset}
#if (exists("raw.plots") & "phewas" %in% plots$type) { # raw.plots[as.integer(rownames(plots[plots$type == "phewas", ]))] #}
Colocalisation
Colocalisaton uses the coloc.abf function from the coloc R package. This section should be expanded to include conditional analyses and/or pwcoco, or other colocalisation methods.
r if (!length(cresults) || nrow(cresults) < 1 || !length(cresults[cresults["nsnps"] > 50, ])) { "\\begin{comment}" }
if (length(plots[plots$type == "regional", ]) > 0) { for (idx in as.integer(rownames(plots[plots$type == "regional", ]))) { if (all(is.na(raw.plots[[idx]]))) { next } grid.newpage() grid.draw(raw.plots[[idx]]) } }
for (i in 1:nrow(cresults)) { tryCatch({ cresults[i, "plot"] <- sprintf("<a class='ItemsTooltip' target='_blank'><img class='imgTooltip' src='%s'/>Region</a>", knitr::image_uri(knitr::fig_chunk('regional-plot', 'png', i))) }, error = function(e) { cresults[i, "plot"] <- "No plot" }) } cresults <- cresults[cresults["nsnps"] > 50, ] if (length(cresults) && nrow(cresults) > 0) { cresults %>% dplyr::rename(Exposure = name1, Outcome = name2, SNPs = nsnps, ChrPos = chrpos, Plot = plot) %>% dplyr::select(-id1, -id2) %>% dplyr::relocate(Plot, .after = Outcome) %>% DT::datatable(rownames = F, escape = F, filter = 'top', extensions = c("Buttons"), options = list(order = list(7, "desc"), dom = "Bfrtip", buttons = list('copy', list(extend = 'collection', buttons = c('csv', 'excel'), text = 'Download')))) %>% DT::formatPercentage(c("H0", "H1", "H2", "H3", "H4"), 2) } else { cat("No colocalisation results were generated.") }
r if (!length(cresults) || nrow(cresults) < 1 || !length(cresults[cresults["nsnps"] > 50, ])) { "\\end{comment}" }
Drug Target Profile
This section contains evidence for the given target for each of the outcomes given. Evidence is collected from:
Literature Evidence
#brks <- seq(from = 0, to = 1, by = 0.1) #clrs <- round(seq(180, 40, length.out = length(brks) + 1), 0) %>% # {paste0("rgb(", ., ",", ., ",180)")} # #to_table <-params$report$otresults[params$report$otresults$id1 == params$id.exposure, ] %>% # dplyr::select(-id1, -id2) %>% # dplyr::relocate(name2, .after = name1) %>% # dplyr::rename(Exposure = name1, # Outcome = name2, # Overall.Score = overall.ot, # Literature = literature.ot, # RNA.Expression = rna_expression.ot, # Genetic.Assoc = genetic_assoc.ot, # Somatic.Mutations = somatic_mute.ot, # Known.Drugs = known_drug.ot, # Animal.Model = animal_model.ot, # Affected.Pathways = affected_pathway.ot) # #to_table %>% # DT::datatable(rownames = F, # escape = F, # filter = 'top', # extensions = c("Buttons"), # options = list(order = list(2, "desc"), # dom = "Bfrtip", # buttons = list('copy', # list(extend = 'collection', # buttons = c('csv', 'excel'), # text = 'Download')))) %>% # DT::formatSignif(columns = c("Overall.Score", # "Literature", # "RNA.Expression", # "Genetic.Assoc", # "Somatic.Mutations", # "Known.Drugs", # "Animal.Model", # "Affected.Pathways"), # digits = 3) #%>% # #DT::formatStyle(names(to_table), backgroundColor = DT::styleInterval(brks, clrs))
if (!any(is.null(params$report$epidbresults)) & nrow(params$report$epidbresults) > 0) { to_table <- params$report$epidbresults[params$report$epidbresults$id1 == params$id.exposure, ] to_table$pubmed_id <- lapply(to_table$pubmed_id, function(x) paste(lapply(unlist(x), function(y) pmid_to_link(y, hyperlink = T)), collapse = ", ")) #to_table$pubmed_id <- gsub(",", ", ", to_table$pubmed_id) to_table %>% dplyr::select(-id1, -id2, -lt.id, -lt.type, -literature_count) %>% dplyr::relocate(c("gene.name", "st.predicate", "lt.name", "pubmed_id")) %>% dplyr::rename(Gene = gene.name, PMIDs = pubmed_id, Outcome = lt.name, Predicate = st.predicate) %>% DT::datatable(rownames = F, escape = F, filter = 'top', extensions = c("Buttons"), options = list(order = list(0, "asc"), dom = "Bfrtip", buttons = list ('copy', list(extend = 'collection', buttons = c('csv', 'excel'), text = 'Download')))) }
r if (all(is.na(params$report$dgidbresults))) { "\\begin{comment}" }
Drug-Genome Interaction DB
colourise <- function(type) { if (params$report$dgidbresults[params$report$dgidbresults$id == params$id.exposure, ][type] == T) { clr <- "green;font-weight:bold" } else { clr <- "lightgrey" } ttip <- "" if (type == "Druggable.Genome") { ttip <- paste0('This target is', if (params$report$dgidbresults[params$report$dgidbresults$id == params$id.exposure, ]$Druggable.Genome == F) { ' not' }, ' considered to be part of the Druggable Genome. This is defined as genes, or gene products, which have either known or predicted interactions with drugs. Sources for this category usually come from published databases which are publicly available for searching, for example, ["The druggable genome and support for target identification and validation in drug development"](http://www.ncbi.nlm.nih.gov/pubmed/28356508) by Finan, et al. and ["The druggable genome"](http://www.ncbi.nlm.nih.gov/pubmed/12209152) by Hopkins, et al.') } else if (type == "Clinically.Actionable") { ttip <- paste0('This target is', if (params$report$dgidbresults[params$report$dgidbresults$id == params$id.exposure, ]$Clinically.Actionable == F) { ' not' }, ' considered to be Clinically Actionable. Genes which are clinically actionable are those genes, or their products, which inform on clinical decisions and are used by clinicians to guide interventions. Sources for this category come from published works which detail diagnostic panels, for example, in the case of ["High-throughput detection of actionable genomic alterations in clinical tumor samples by targeted, massively parallel sequencing"](https://pubmed.ncbi.nlm.nih.gov/22585170/) by Wagle, et al. which details genes which can guide clinical interventions for cancer.') } else if (type == "Drug.Resistant") { ttip <- paste0('This target is', if (params$report$dgidbresults[params$report$dgidbresults$id == params$id.exposure, ]$Drug.Resistant == F) { ' not' }, ' considered to be resistant against drugs. The main source of this category comes from the EBI [Gene Ontology](https://www.ebi.ac.uk/QuickGO/term/GO:0042493) "response to drug" category. Caution should be given to naive interpretation of this category if more than one class of drugs may be used to target that gene -- for example, the gene of interest may be resistant to one class of drug but not another.') } tippy::tippy(sprintf("<span style='color: %s;'>| %s </span>", clr, type), tooltip = ttip, allowHTML = T) }
r colourise("Druggable.Genome") r colourise("Clinically.Actionable") r colourise("Drug.Resistant")
The Drug-Genome Interaction DB (DGIdB) collates evidence relevant to drug discovery efforts, for example, by categorising targets with ontology such as "part of the druggable genome", with the aim of improving and aiding drug discovery efforts. This section provides details on the three main ontologies.
#to_table <- params$report$dgidbdrugs[params$report$dgidbdrugs$id == params$id.exposure, ] #to_table$PMIDs <- lapply(to_table$PMIDs, function(x) paste(lapply(unlist(x), function(y) pmid_to_link(y, hyperlink = T)), #collapse = ", ")) #to_table %>% # dplyr::select(-id) %>% # dplyr::rename(Trait = trait) %>% # DT::datatable(rownames = F, # escape = T, # filter = 'top', # extensions = c("Buttons"), # options = list(dom = "Bfrtip", # buttons = list ('copy', # list(extend = 'collection', # buttons = c('csv', 'excel'), # text = 'Download'))))
r if (all(is.na(params$report$dgidbresults))) { "\\end{comment}" }
#params$report$mouseresults %>% # DT::datatable(rownames = F, # escape = T, # filter = 'top', # extensions = c("Buttons"), # options = list(dom = "Bfrtip", # buttons = list ('copy', # list(extend = 'collection', # buttons = c('csv', 'excel'), # text = 'Download'))))
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.