#' Shiny triad plot module
#'
#' Shiny module for triad plots, with interfaces \code{shinyTriadUI} and \code{shinyTriadOutput}.
#'
#' @param id identifier for shiny reactive
#' @param med_par,patterns,geno_max,peak_mar,med_ls,mediate_obj,phe_mx,cov_df,K_chr,probs_obj,chr_id,sdp reactive arguments
#'
#' @author Brian S Yandell, \email{brian.yandell@@wisc.edu}
#' @keywords utilities
#'
#' @return No return value; called for side effects.
#'
#' @export
#' @importFrom dplyr filter
#' @importFrom qtl2 scan1
#' @importFrom ggplot2 autoplot
#' @importFrom qtl2mediate mediation_triad_qtl2
#' @importFrom qtl2pattern sdp_to_pattern
#' @importFrom shiny moduleServer NS reactive req isTruthy
#' radioButtons selectInput sliderInput updateSliderInput
#' dataTableOutput plotOutput uiOutput
#' renderDataTable renderPlot renderUI
#' fluidRow column strong tagList
#' withProgress setProgress
#' downloadButton downloadHandler
#' @importFrom plotly renderPlotly plotlyOutput
#' @importFrom utils write.csv
#' @importFrom grDevices dev.off pdf
#
shinyTriad <- function(id, med_par, patterns, geno_max, peak_mar, med_ls,
mediate_obj, phe_mx, cov_df, K_chr, probs_obj, chr_id, sdp) {
shiny::moduleServer(id, function(input, output, session) {
ns <- session$ns
## Select triad for plots.
output$triad <- shiny::renderUI({
triad <- shiny::req(mediate_obj())$best$triad
choices <- levels(triad)
choices <- choices[choices %in% unique(triad)]
shiny::selectInput(ns("triad"), NULL,
choices = choices, input$triad)
})
medID <- reactive({
ifelse("symbol" %in% names(shiny::req(mediate_obj())$best), "symbol", "longname")
})
## Select mediator for plots.
output$med_name <- shiny::renderUI({
shiny::req(mediate_obj(), input$triad, medID())
choices <- dplyr::filter(mediate_obj()$best, .data$triad == input$triad)[[medID()]]
shiny::selectInput(ns("med_name"), NULL,
choices = choices, input$med_name)
})
scat_dat <- reactive({
shiny::req(phe_mx(), med_ls(), cov_df(), probs_obj(), chr_id(),
input$med_name, med_par$pos_Mbp, sdp())
qtl2mediate::mediation_triad_qtl2(
target = phe_mx(),
mediator = med_ls()[[1]][, input$med_name, drop = FALSE],
annotation = med_ls()[[2]],
covar_tar = cov_df(),
covar_med = med_ls()$covar,
genoprobs = probs_obj()$probs,
map = probs_obj()$map,
chr = chr_id(),
pos = med_par$pos_Mbp,
kinship = K_chr()[[1]],
sdp = sdp())
})
## Select plot format.
output$med_plot <- shiny::renderUI({
shiny::selectInput(ns("med_plot"), NULL,
choices = c("by_mediator",
"by_target",
"driver_offset",
"driver"),
input$med_plot)
})
## Triad plot
output$scatPlot <- shiny::renderPlot({
if(!shiny::isTruthy(patterns())) {
return(plot_null("first run\nAllele Patterns"))
}
if(!shiny::isTruthy(scat_dat())) {
plot_null("too much\nmissing data\nin mediators\nreduce window width")
} else {
shiny::req(input$med_plot, input$med_name, phe_mx())
shiny::withProgress(message = 'Triad Plot ...', value = 0, {
shiny::setProgress(1)
ggplot2::autoplot(scat_dat(), type = input$med_plot,
dname = peak_mar(),
mname = input$med_name,
tname = colnames(phe_mx()),
fitlines = "sdp",
centerline = NULL)
})
}
})
## Downloads.
output$downloadData <- shiny::downloadHandler(
filename = function() {
file.path(paste0("scatter.csv")) },
content = function(file) {
shiny::req(mediate_obj())
utils::write.csv(mediate_obj()$best, file)
}
)
output$downloadPlot <- shiny::downloadHandler(
filename = function() {
file.path(paste0("scatter.pdf")) },
content = function(file) {
shiny::req(phe_mx(), scat_dat(), input$med_plot)
grDevices::pdf(file, width=9,height=9)
for(types in c("by_mediator",
"by_target",
"driver_offset",
"driver")) {
print(ggplot2::autoplot(scat_dat(), type = types,
dname = peak_mar(),
mname = input$med_name,
tname = colnames(phe_mx()),
centerline = NULL))
}
grDevices::dev.off()
})
med_ls
})
}
shinyTriadUI <- function(id) {
ns <- shiny::NS(id)
shiny::tagList(
shiny::uiOutput(ns("triad")),
shiny::uiOutput(ns("med_name")),
shiny::uiOutput(ns("med_plot")),
shiny::fluidRow(
shiny::column(6, shiny::downloadButton(ns("downloadData"), "CSV")),
shiny::column(6, shiny::downloadButton(ns("downloadPlot"), "Plots"))))
}
shinyTriadOutput <- function(id) {
ns <- shiny::NS(id)
shiny::plotOutput(ns("scatPlot"))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.