Nothing
#' Generate the DE plot plot panel of the shiny app
#' @description These are the UI and server components of the DE plot panel of the
#' shiny app. It is generated by including 'DEplot' in the panels.default argument
#' of \code{\link{generateShinyApp}}.
#' @param DEresults differential expression results output from DEpanelServer;
#' a reactive list with slots 'DEtable' (all genes), 'DEtableSubset' (only DE genes),
#' 'lfcThreshold' and 'pvalThreshold'
#' @inheritParams DEpanel
#' @return The UI and Server components of the shiny module, that can be used
#' within the UI and Server definitions of a shiny app.
#' @name DEplotPanel
NULL
#' @rdname DEplotPanel
#' @export
DEplotPanelUI <- function(id, show = TRUE){
ns <- NS(id)
if(show){
tabPanel(
'Volcano and MA plots',
shinyWidgets::dropdownButton(
selectInput(ns('plotType'), 'Type of plot:', c('Volcano', 'MA')),
shinyWidgets::switchInput(
inputId = ns('autoLabel'),
label = "Auto labels",
labelWidth = "80px",
onLabel = 'On',
offLabel = 'Off',
value = FALSE,
onStatus = FALSE
),
shinyWidgets::switchInput(
inputId = ns("highlightSelected"),
label = "Highlight selected DE genes?",
labelWidth = "80px",
onLabel = 'No',
offLabel = 'Yes',
value = FALSE,
onStatus = FALSE
),
shinyWidgets::switchInput(
inputId = ns('allGenes'),
label = "Showing on click:",
labelWidth = "80px",
onLabel = 'All genes',
offLabel = 'Only DE genes',
value = FALSE,
onStatus = FALSE
),
conditionalPanel(
id = ns('conditionalVolcanoOption'),
ns=ns,
condition = "input[['plotType']] == 'Volcano'",
shinyWidgets::switchInput(
inputId = ns("capPVal"),
label = "Cap log10(pval)?",
labelWidth = "80px",
onLabel = 'No',
offLabel = 'Yes',
value = FALSE,
onStatus = FALSE
),
),
selectInput(ns("geneName"), "Other genes to highlight:", multiple = TRUE, choices = character(0)),
textInput(ns('plotFileName'), 'File name for plot download', value ='DEPlot.png'),
downloadButton(ns('download'), 'Download Plot'),
status = "info",
icon = icon("gear", verify_fa = FALSE),
tooltip = shinyWidgets::tooltipOptions(title = "Click to see inputs!")
),
plotOutput(ns('plot'), click = ns('plot_click')),
tableOutput(ns('data'))
)
}else{
NULL
}
}
#' @rdname DEplotPanel
#' @export
DEplotPanelServer <- function(id, DEresults, anno){
# check whether inputs (other than id) are reactive or not
stopifnot({
is.reactive(DEresults)
!is.reactive(anno)
})
moduleServer(id, function(input, output, session){
#Set up server-side search for gene names
updateSelectizeInput(session, "geneName", choices = anno$NAME, server = TRUE)
DEplot <- reactive({
results = DEresults()$DE()
selectedGenes = DEresults()$selectedGenes()
if(!(input[["highlightSelected"]]) & length(selectedGenes)){
selectedGeneNames <- anno$NAME[match(selectedGenes, anno$ENSEMBL)]
highlightGenes <- c(selectedGeneNames, input[["geneName"]])
}
else{
highlightGenes <- input[["geneName"]]
}
if(input[['plotType']] == 'Volcano'){
myplot <- volcano_plot(
genes.de.results = results$DEtable,
pval.threshold = results$pvalThreshold,
lfc.threshold = results$lfcThreshold,
raster = TRUE,
add.labels.auto = input[["autoLabel"]],
n.labels.auto = c(5, 5, 5),
add.labels.custom = length(highlightGenes) > 0,
genes.to.label = highlightGenes,
log10pval.cap = !(input[['capPVal']])
)
}
if (input[['plotType']] == 'MA'){
myplot <- ma_plot(
genes.de.results = results$DEtable,
pval.threshold = results$pvalThreshold,
lfc.threshold = results$lfcThreshold,
raster = TRUE,
add.labels.auto = input[["autoLabel"]],
n.labels.auto = c(5, 5, 5),
add.labels.custom = length(highlightGenes) > 0,
genes.to.label = highlightGenes
)
}
myplot
})
#Output MA/volcano plot
output[['plot']] <- renderPlot(DEplot())
#Define output table when you click on gene with all genes or only DE
output[['data']] <- renderTable({
req(input[['plot_click']])
results = DEresults()$DE()
if (input[['allGenes']]){
data <- results$DEtable
}else{
data <- results$DEtableSubset
}
data <- data %>% dplyr::mutate(`-log10pval` = -log10(.data$pvalAdj))
nearPoints(df = data, coordinfo = input[['plot_click']], threshold = 20, maxpoints = 10)
}, digits = 4)
output[['download']] <- downloadHandler(
filename = function() { input[['plotFileName']] },
content = function(file) {
ggsave(file, plot = DEplot(), dpi = 300)
}
)
})
}
DEplotPanelApp <- function(){
shinyApp(
ui = navbarPage("DE", tabPanel("", tabsetPanel(DEpanelUI('RNA'), DEplotPanelUI('RNA')))),
server = function(input, output, session){
DEresults <- DEpanelServer('RNA')
DEplotPanelServer('RNA', DEresults)
}
)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.