Nothing
#' Generate the expression patterns panel of the shiny app
#' @description These are the UI and server components of the expression patterns
#' panel of the shiny app. It is generated by including 'Patterns' in the
#' panels.default argument of \code{\link{generateShinyApp}}.
#' @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 patternPanel
NULL
#' @rdname patternPanel
#' @export
patternPanelUI <- function(id, metadata, show = TRUE){
ns <- NS(id)
if(show){
tabPanel(
'Expression patterns',
shinyjs::useShinyjs(),
sidebarLayout(
sidebarPanel(
selectInput(ns('condition'), 'Metadata column to use:', colnames(metadata)[-1],
selected = colnames(metadata)[ncol(metadata)]),
shinyjqui::orderInput(ns('series'), label = "Series of states to use",
items = NULL, placeholder = "Drag states here...",
connect = ns("states")),
shinyjqui::orderInput(ns('states'), label = "Unused states",
items = unique(metadata[[ncol(metadata)]]),
connect = ns("series")),
selectInput(ns("nSD"), "Number of standard deviations from the mean to use for interval overlap:",
c(1:10), selected = 2),
div(style="margin-bottom:20px"),
shinyjs::disabled(actionButton(ns('goPatterns'), label = 'Calculate expression patterns')),
div(style="margin-bottom:20px"),
selectInput(ns('pattern'), 'Pattern to plot', choices = NULL),
textInput(ns('tableFileName'), 'File name for download',
value ='patternExpression.csv', placeholder = 'patternExpression.csv'),
downloadButton(ns('downloadTable'), 'Download grouped expression table'),
radioButtons(ns('downloadValues'), label = "Download values",
choices = c('Expression', 'Log2 Expression', 'Mean Scaled', 'Z-score'),
selected = 'Expression'),
),
mainPanel(
shinyWidgets::dropdownButton(
radioButtons(ns('line.processing'), label = "Heatmap values",
choices = c('Expression', 'Log2 Expression', 'Mean Scaled'),
selected = 'Mean Scaled'),
textInput(ns('plotLineFileName'), 'File name for line plot download', value ='LinePlot.png'),
downloadButton(ns('downloadLinePlot'), 'Download Line Plot'),
status = "info",
icon = icon("gear", verify_fa = FALSE),
tooltip = shinyWidgets::tooltipOptions(title = "Click to see inputs!")
),
plotOutput(ns('plot_line')),
shinyWidgets::dropdownButton(
radioButtons(ns('heatmap.processing'), label = "Heatmap values",
choices = c('Expression', 'Log2 Expression', 'Z-score'),
selected = 'Z-score'),
textInput(ns('plotHeatmapFileName'), 'File name for heatmap plot download', value ='HeatmapPlot.png'),
downloadButton(ns('downloadHeatmapPlot'), 'Download Heatmap Plot'),
status = "info",
icon = icon("gear", verify_fa = FALSE),
tooltip = shinyWidgets::tooltipOptions(title = "Click to see inputs!")
),
plotOutput(ns('plot_heatmap')),
)
)
)
}else{
NULL
}
}
#' @rdname patternPanel
#' @export
patternPanelServer <- function(id, expression.matrix, metadata, anno){
# check whether inputs (other than id) are reactive or not
stopifnot({
is.reactive(expression.matrix)
is.reactive(metadata)
!is.reactive(anno)
})
moduleServer(id, function(input, output, session){
observe({
shinyjqui::updateOrderInput(session, "series", items = character(0))
shinyjqui::updateOrderInput(session, "states",
items = as.character(unique(metadata()[[input[["condition"]]]])))
})
observe({
if(length(input[["series"]]) >= 2){
shinyjs::enable("goPatterns")
}else{
shinyjs::disable("goPatterns")
}
}) %>%
bindEvent(input[["series"]])
patterns.list <- reactive({
shinyjs::disable("goPatterns")
subset.idxs <- metadata()[[input[["condition"]]]] %in% input[["series"]]
mat <- expression.matrix()[, subset.idxs]
condition <- metadata()[subset.idxs, input[["condition"]]]
condition <- factor(condition, levels = input[["series"]])
tbl <- calculate_condition_mean_sd_per_gene(mat, condition)
patterns <- make_pattern_matrix(tbl, n_sd = as.numeric(input[["nSD"]]))[, "pattern"]
shinyjs::enable("goPatterns")
list("tbl" = tbl, "patterns" = patterns)
}) %>%
bindCache(utils::head(expression.matrix()), metadata(), input[["condition"]],
input[["series"]], input[["nSD"]]) %>%
bindEvent(input[["goPatterns"]])
observe({
pats <- unique(patterns.list()$patterns)
updateSelectInput(
session, "pattern",
choices = setdiff(pats, paste0(rep("S", nchar(pats[1])), collapse = ""))
)
})
output[['downloadTable']] <- downloadHandler(
filename = function() {
paste(input[['tableFileName']])
},
content = function(file) {
mat <- make_heatmap_matrix(patterns.list()$tbl) %>%
rescale_matrix(type = input[["downloadValues"]])
gene_id <- NULL
df <- cbind(
tibble::tibble(gene_id = names(patterns.list()$patterns),
gene_name = anno$NAME[match(gene_id, anno$ENSEMBL)],
pattern = patterns.list()$patterns),
tibble::as_tibble(mat)
)
utils::write.csv(x = df, file = file, row.names = FALSE)
}
)
line.plot <- reactive({
genes <- names(patterns.list()$patterns)[patterns.list()$patterns == input[["pattern"]]]
genes <- anno$NAME[match(genes, anno$ENSEMBL)]
tbl <- patterns.list()$tbl
tbl$gene <- anno$NAME[match(tbl$gene, anno$ENSEMBL)]
myplot <- plot_line_pattern(
tbl = tbl,
genes = genes,
type = input[['line.processing']],
show.legend = ifelse(length(genes) <= 10, TRUE, FALSE)
)
return(myplot)
})
heatmap.plot <- reactive({
genes <- names(patterns.list()$patterns)[patterns.list()$patterns == input[["pattern"]]]
heatmat <- make_heatmap_matrix(patterns.list()$tbl, genes)
rownames(heatmat) <- anno$NAME[match(rownames(heatmat), anno$ENSEMBL)]
if(nrow(heatmat) > 50) rownames(heatmat) <- NULL
myplot <- expression_heatmap(
expression.matrix.subset = heatmat,
top.annotation.ids = NULL,
metadata = metadata(),
type = input[["heatmap.processing"]]
)
return(myplot)
})
output[['plot_line']] <- renderPlot(line.plot())
output[['downloadLinePlot']] <- downloadHandler(
filename = function() { input[['plotLineFileName']] },
content = function(file) {
ggsave(file, plot = line.plot(), dpi = 300)
}
)
output[['plot_heatmap']] <- renderPlot(heatmap.plot(), height = 800)
output[['downloadHeatmapPlot']] <- downloadHandler(
filename = function() { input[['plotHeatmapFileName']] },
content = function(file) {
if (base::strsplit(input[['plotHeatmapFileName']], split="\\.")[[1]][-1] == 'pdf'){
grDevices::pdf(file, width = 10, height = 20, pointsize = 12)
print(heatmap.plot())
grDevices::dev.off()
} else if (base::strsplit(input[['plotHeatmapFileName']], split="\\.")[[1]][-1] == 'svg'){
grDevices::svg(file, width = 10, height = 20, pointsize = 12)
print(heatmap.plot())
grDevices::dev.off()
} else {
grDevices::png(file, width = 480, height = 1000,
units = "px", pointsize = 12)
print(heatmap.plot())
grDevices::dev.off()
}
}
)
})
}
# patternPanelApp <- function(){
# shinyApp(
# ui = navbarPage("Expression patterns",
# tabPanel("", tabsetPanel(patternPanelUI('Patterns', metadata)))),
# server = function(input, output, session){
# patternPanelServer("Patterns", reactiveVal(expression.matrix), reactiveVal(metadata), NULL) ###
# }
# )
# }
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.