R/DEsummaryPanel.R

In bulkAnalyseR: Interactive Shiny App for Bulk Sequencing Data

#' Generate the DE summary panel of the shiny app
#' @description These are the UI and server components of the Heatmap panel of the 
#' shiny app. It is generated by including 'DEsummary' in the panels.default argument
#' of \code{\link{generateShinyApp}}.
#' @inheritParams DEpanel
#' @inheritParams DEplotPanel
#' @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 DEsummaryPanel
NULL

#' @rdname DEsummaryPanel
#' @export
DEsummaryPanelUI <- function(id, metadata, show = TRUE){
  ns <- NS(id)
  
  if(show){
    tabPanel(
      'DE Summary',
      tags$h1("Gene heatmap"),
      shinyWidgets::dropdownButton(
        radioButtons(ns('heatmap.processing'), label = "Heatmap values",
                     choices = c('Expression','Log2 Expression','Z-score'), 
                     selected = 'Z-score'),
        shinyjqui::orderInput(ns('heatmap.annotations'), label = "Show annotations", items = colnames(metadata)),
        selectInput(ns("geneName"), "Additional genes to include:", multiple = TRUE, choices = character(0)),
        div("\nIf no genes are selected in the DE panel or here then the top 50 DE genes are chosen.\n"),
        div(style="margin-bottom:10px"),
        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('heatmap'), height = 800),
      tags$h1("Principal Component Analysis on DE genes"),
      shinyWidgets::dropdownButton(
        radioButtons(ns('pca.annotation'), label = "Group by",
                     choices = colnames(metadata), selected = colnames(metadata)[ncol(metadata)]),
        shinyWidgets::switchInput(
          inputId = ns("pca.useAllDE"),
          label = "Use all DE?",
          labelWidth = "80px",
          onLabel = 'All DE',
          offLabel = 'Only selected DE',
          value = TRUE,
          onStatus = FALSE
        ),
        checkboxInput(ns("pca.show.labels"), label = "Show sample labels", value = FALSE),
        checkboxInput(ns('pca.show.ellipses'), label = "Show ellipses around groups", value = TRUE),
        textInput(ns('plotPCAFileName'), 'File name for PCA plot download', value = 'PCAPlotDE.png'),
        downloadButton(ns('downloadPCAPlot'), 'Download PCA Plot'),
        
        status = "info",
        icon = icon("gear", verify_fa = FALSE), 
        tooltip = shinyWidgets::tooltipOptions(title = "Click to see inputs!")
      ),
      plotOutput(ns('pca')),
    )
  }else{
    NULL
  }
}

#' @rdname DEsummaryPanel
#' @export
DEsummaryPanelServer <- function(id, expression.matrix, metadata, DEresults, anno){
  
  # check whether inputs (other than id) are reactive or not
  stopifnot({
    is.reactive(DEresults)
    is.reactive(expression.matrix)
    is.reactive(metadata)
    !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)
    
    observe({
      items <- colnames(metadata())
      include.exclude <- apply(metadata(), 2, function(x){
        l <- length(unique(x))
        (l > 1) & (l < length(x))
      })
      if (sum(include.exclude == TRUE) != 0){
        items <- colnames(metadata())[include.exclude]
        items <- items[c(length(items), seq_len(length(items) - 1))]
      } else {items = colnames(metadata())[2:ncol(metadata())]}
      shinyjqui::updateOrderInput(session, "heatmap.annotations", items = items)
    })
    heatmap.plot <- reactive({
      selectedGenes = DEresults()$selectedGenes()
      if(length(selectedGenes)){
        selectedGeneNames <- anno$NAME[match(selectedGenes, anno$ENSEMBL)]
        geneSet <- c(selectedGeneNames, input[["geneName"]])
      }else{
        geneSet <- input[["geneName"]]
      }
      if (length(geneSet) == 0){
        geneSet <- anno$NAME[match(utils::head(DEresults()$DE()$DEtableSubset$gene_id, 50), anno$ENSEMBL)]
      }
      geneIDs <- anno$ENSEMBL[match(geneSet, anno$NAME)]
      subsetExpression <- expression.matrix()[geneIDs, , drop = FALSE]
      rownames(subsetExpression) <- geneSet
      meta <- lapply(metadata(), function(x)if(!is.factor(x)){factor(x, levels = unique(x))}else{x}) %>%
        as.data.frame() %>%
        dplyr::arrange(dplyr::across(input[['heatmap.annotations']]))
      myplot <- expression_heatmap(
        expression.matrix.subset = subsetExpression[, as.character(meta[, 1]), drop = FALSE],
        top.annotation.ids = match(input[['heatmap.annotations']], colnames(meta)),
        metadata = meta,
        type = input[["heatmap.processing"]],
        show.column.names = (nrow(meta) <= 20)
      )
      return(myplot)
    })
    output[['heatmap']] <- renderPlot(heatmap.plot(), height = 800)
    
    pca.plot <- reactive({
      results = DEresults()$DE()
      selectedGenes = DEresults()$selectedGenes()
      if (input[['pca.useAllDE']]){
        geneSet = results$DEtableSubset$gene_id
      }else if (length(selectedGenes) != 0){
        geneSet = selectedGenes
      }else{
        geneSet <- utils::head(results$DEtableSubset$gene_id, 50)
      }
      subsetExpression <- expression.matrix()[geneSet, , drop = FALSE]
      myplot <- plot_pca(
        expression.matrix = subsetExpression,
        metadata = metadata(),
        annotation.id = match(input[['pca.annotation']], colnames(metadata())),
        n.abundant = NULL,
        show.labels = input[['pca.show.labels']],
        show.ellipses = input[['pca.show.ellipses']]
      )
      myplot
    })
    output[['pca']] <- renderPlot(pca.plot())
    
    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 = 20)
          print(heatmap.plot())
          grDevices::dev.off()
        } else if (base::strsplit(input[['plotHeatmapFileName']], split="\\.")[[1]][-1] == 'svg'){
          grDevices::svg(file, width = 10, height = 20, pointsize = 20)
          print(heatmap.plot())
          grDevices::dev.off()
        } else {
          grDevices::png(file, width = 480, height = 1000, units = "px", 
                         pointsize = 12, bg = "white", res = NA)
          print(heatmap.plot())
          grDevices::dev.off()
        }
      }
    )
    
    output[['downloadPCAPlot']] <- downloadHandler(
      filename = function() { input[['plotPCAFileName']] },
      content = function(file) {
        ggsave(file, plot = pca.plot(), dpi = 300)
      }
    )
  })
}

DEsummaryPanelApp <- function(){
  shinyApp(
    ui = navbarPage("DE", tabPanel("", tabsetPanel(DEpanelUI('RNA'), DEsummaryPanelUI('RNA')))),
    server = function(input, output, session){
      DEresults <- DEpanelServer('RNA')
      DEsummaryPanelServer('RNA', DEresults)
    }
  )
}