R/DEpanel.R

In bulkAnalyseR: Interactive Shiny App for Bulk Sequencing Data

#' Generate the DE panel of the shiny app
#' @description These are the UI and server components of the DE panel of the 
#' shiny app. It is generated by including 'DE' in the panels.default argument
#' of \code{\link{generateShinyApp}}.
#' @param id the input slot that will be used to access the value
#' @param show whether to show the panel or not; default is TRUE; there for
#' compatibility with specifying panels to show
#' @param anno annotation data frame containing a match between the row names
#' of the expression.matrix (usually ENSEMBL IDs) and the gene names that
#' should be rendered within the app and in output files; this object is
#' created by \code{\link{generateShinyApp}} using the org.db specified
#' @inheritParams generateShinyApp
#' @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 DEpanel
NULL

#' @rdname DEpanel
#' @export
DEpanelUI <- function(id, metadata, show = TRUE){
  ns <- NS(id)
  
  if(show){
    tabPanel(
      'Differential expression',
      shinyjs::useShinyjs(),
      sidebarLayout(
        
        # Sidebar panel for inputs ----
        sidebarPanel(
          
          selectInput(ns('condition'), 'Metadata column to use:', colnames(metadata)[-1], 
                      selected = colnames(metadata)[ncol(metadata)]),
          
          # Input: Selector variables to compare
          selectInput(ns('variable1'), 'Condition 1:', unique(metadata[[ncol(metadata)]])),
          selectInput(ns('variable2'), 'Condition 2:', unique(metadata[[ncol(metadata)]]),
                      selected = unique(metadata[[ncol(metadata)]])[2]),
          
          selectInput(ns('pipeline'), 'DE pipeline:', c("edgeR", "DESeq2")),
          
          #DE thresholds
          sliderInput(ns('lfcThreshold'), label = 'logFC threshold',
                      min = 0, value = 1, max = 5, step = 0.05),
          
          sliderInput(ns('pvalThreshold'), label = 'Adjusted p-value threshold',
                      min = 0, value = 0.05, max = 1, step = 0.005),
          
          #Only start DE when button is pressed
          actionButton(ns('goDE'), label = 'Start DE'),
          
          #download file name and button
          textInput(ns('fileName'),'File name for download', value ='DEset.csv', placeholder = 'DEset.csv'),
          downloadButton(ns('download'), 'Download Table'),
          hr(),
          tags$b("Gene selection"),
          div("\nSelect genes of interest by clicking on the corresponds rows in the table\n"),
          div(style="margin-bottom:10px"),
          actionButton(ns('resetSelection'), label = "Reset row selection"),
          div(style="margin-bottom:10px"),
          actionButton(ns('selectTop50'), label = "Select top 50 genes")
          
        ),
        
        #Main panel for displaying table of DE genes
        mainPanel(
          DT::dataTableOutput(ns('data'))
        )
      )
    )
  }else{
    NULL
  }
}

#' @rdname DEpanel
#' @export
DEpanelServer <- 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({
      updateSelectInput(session, 'variable1', choices = unique(metadata()[[input[["condition"]]]]))
      updateSelectInput(session, 'variable2', choices = unique(metadata()[[input[["condition"]]]]),
                        selected = unique(metadata()[[input[["condition"]]]])[2])
    })
    
    observe({
      condition.indices <- metadata()[[input[["condition"]]]] %in% c(input[['variable1']], input[['variable2']])
      if(any(summary(as.factor(metadata()[[input[["condition"]]]][condition.indices])) < 2)){
        choices <- "edgeR"
      }else{
        choices <- c("edgeR", "DESeq2")
      }
      updateSelectInput(session, 'pipeline', choices = choices)
    })
    
    DEresults <- reactive({
      shinyjs::disable("goDE")
      condition.indices <- metadata()[[input[["condition"]]]] %in% c(input[['variable1']], input[['variable2']])
      if(input[["pipeline"]] == "edgeR"){
        DEtable <- DEanalysis_edger(
          expression.matrix = expression.matrix()[, condition.indices],
          condition = metadata()[[input[["condition"]]]][condition.indices],
          var1 = input[['variable1']],
          var2 = input[['variable2']],
          anno = anno
        )
      }else if(input[["pipeline"]] == "DESeq2"){
        DEtable <- DEanalysis_deseq2(
          expression.matrix = expression.matrix()[, condition.indices],
          condition = metadata()[[input[["condition"]]]][condition.indices],
          var1 = input[['variable1']],
          var2 = input[['variable2']],
          anno = anno
        )
      }
      
      DEtableSubset <- DEtable %>%
        dplyr::filter(abs(.data$log2FC) > input[["lfcThreshold"]] & 
                        .data$pvalAdj < input[["pvalThreshold"]]) %>%
        dplyr::arrange(dplyr::desc(abs(.data$log2FC)))
      
      #the thresholds are returned here so that MA/volcano and table display 
      #don't use new thresholds without the button being used
      shinyjs::enable("goDE")
      return(list('DEtable' = DEtable,
                  "DEtableSubset" = DEtableSubset,
                  'lfcThreshold' = input[["lfcThreshold"]], 
                  'pvalThreshold' = input[["pvalThreshold"]]))
    }) %>%
      bindCache(utils::head(expression.matrix()), metadata(), input[["condition"]], 
                input[['variable1']], input[['variable2']], input[["pipeline"]], 
                input[["lfcThreshold"]], input[["pvalThreshold"]]) %>%
      bindEvent(input[["goDE"]])
    
    #Define output table (only DE genes)
    dataTable <- reactive({
      DEresults()$DEtableSubset %>% 
        DT::datatable() %>%
        DT::formatSignif(columns = c('log2exp', 'log2FC', 'pval', 'pvalAdj'), digits = 3)
    })
    
    output[['data']] <- DT::renderDataTable(dataTable())
    
    #DE data download
    output[['download']] <- downloadHandler(
      filename = function() {
        paste(input[['fileName']])
      },
      content = function(file) {
        utils::write.csv(x = DEresults()$DEtableSubset, file = file, row.names = FALSE)
      }
    )
    
    #Output selected genes
    selectedGenes <- reactive({
      DEresults()$DEtableSubset$gene_id[input$data_rows_selected]
    })
    
    proxy = DT::dataTableProxy('data')
    
    observe({proxy %>% DT::selectRows(NULL)}) %>%
      bindEvent(input[['resetSelection']])
    
    observe({proxy %>% DT::selectRows(selected = 1:50)}) %>%
      bindEvent(input[['selectTop50']])
    
    return(reactive(list('DE' = DEresults,
                         'selectedGenes' = reactive(selectedGenes())
    )))
    
    
  })
}

DEpanelApp <- function(){
  shinyApp(
    ui = fluidPage(DEpanelUI('RNA')),
    server = function(input, output, session){
      DEpanelServer('RNA')
    }
  )
}