R/DEplotPanel.R

In bulkAnalyseR: Interactive Shiny App for Bulk Sequencing Data

#' 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)
    }
  )
}