enrichmentPanel.R

#' Generate the enrichment panel of the shiny app
#' @description These are the UI and server components of the enrichment panel of the 
#' shiny app. It is generated by including 'Enrichment' in the panels.default argument
#' of \code{\link{generateShinyApp}}.
#' @inheritParams generateShinyApp
#' @inheritParams DEplotPanel
#' @param seed the random seed to be set for the jitter plot, to avoid
#' seemingly different plots for the same inputs
#' @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 enrichmentPanel
NULL

#' @rdname enrichmentPanel
#' @export
enrichmentPanelUI <- function(id, show = TRUE){
  ns <- NS(id)
  
  if(show){
    tabPanel(
      'Enrichment',
      shinyjs::useShinyjs(),
      sidebarLayout(
        # Sidebar panel for inputs ----
        sidebarPanel(
          checkboxGroupInput(ns('gprofilerSources'), 'Select data sources', 
                             choices = c('GO:BP', 'GO:MF', 'GO:CC', 'KEGG', 'REAC', 
                                         'TF', 'MIRNA', 'CORUM', 'HP', 'HPA', 'WP'), 
                             selected = c('GO:BP', 'GO:MF', 'GO:CC', 'KEGG', 'REAC', 'TF', 'MIRNA')),
          actionButton(ns('goEnrichment'), label = 'Start enrichment analysis'),
          textInput(ns('fileName'), 'File name for data download', value ='EnrichmentSet.csv'),
          downloadButton(ns('downloadTable'), 'Download Data'),
          textInput(ns('plotFileName'), 'File name for plot download', value ='EnrichmentPlot.png'),
          downloadButton(ns('downloadPlot'), 'Download Plot'),
        ),
        mainPanel(
          textOutput(ns('enriched_terms')),
          plotOutput(ns('plot'), click = ns('plot_click')),
          tableOutput(ns('data'))
        )
      )
    )
  }else{
    NULL
  }
}

#' @rdname enrichmentPanel
#' @export
enrichmentPanelServer <- function(id, DEresults, organism, seed = 13){
  # check whether inputs (other than id) are reactive or not
  stopifnot({
    is.reactive(DEresults)
    !is.reactive(organism)
  })
  
  moduleServer(id, function(input, output, session){
    
    #Run enrichment
    getenrichmentData <- reactive({
      shinyjs::disable("goEnrichment")
      inputdata = DEresults()$DE()
      if (length(inputdata$DEtableSubset$gene_id)>0){
        gostres <- gprofiler2::gost(query = inputdata$DEtableSubset$gene_id,
                                    organism = organism,
                                    correction_method = 'fdr',
                                    custom_bg = inputdata$DEtable$gene_id,
                                    sources = input[['gprofilerSources']],
                                    evcodes = TRUE)
        if(!is.null(gostres$result)){
          gostres$result <- gostres$result %>%
            dplyr::mutate(parents = sapply(.data$parents, toString),
                          intersection_names = sapply(.data$intersection, function(x){
                            ensids <- strsplit(x, split = ",")[[1]]
                            names <- inputdata$DEtable$gene_name[match(ensids, inputdata$DEtable$gene_id)]
                            paste(names, collapse = ",")
                          }))
        }
        shinyjs::enable("goEnrichment")
        return(gostres$result)
      } else {
        return(NULL)
      }
    }) %>%
      bindCache(DEresults()$DE()$DEtableSubset$gene_id, input[['gprofilerSources']]) %>%
      bindEvent(input[["goEnrichment"]])
    
    returnableResult <- reactive({
      term_id <- term_name <- intersection <- intersection_names <- source <- NULL
      gostres <- getenrichmentData() 
      if(!is.null(gostres)){
        gostres <- gostres %>% 
          dplyr::select(c(term_id, term_name, intersection, intersection_names, source)) %>% 
          dplyr::filter(source %in% c('TF', 'MIRNA')) %>% 
          dplyr::mutate(term_name = dplyr::case_when(source=='TF' ~ stringr::str_extract(term_name, "Factor[:punct:] .*[:punct:] motif") %>% substr(9,nchar(.)-7))) %>%
          dplyr::mutate('term_id' = term_name) %>%
          tidyr::separate_rows(c('intersection', 'intersection_names'), sep=',', convert = TRUE) %>%
          dplyr::select(c('intersection', 'intersection_names', 'term_id', 'term_name', 'source'))
        colnames(gostres) <- c('Reference_ID', 'Reference_Name', 'Comparison_ID', 'Comparison_Name', 'Category')
      }
      return(gostres)
    })
    
    source <- p_value <- `-log10(pVal)` <- NULL
    
    #Jitter plot and save coordinates
    getenrichmentPlot <- reactive({
      set.seed(seed)
      jitter.plot <- ggplot(getenrichmentData()) + 
        geom_jitter(aes(x = source, y = p_value, colour = source))
      jitter.build <- ggplot_build(jitter.plot)
      x <- jitter.build$data[[1]]$x
      df <- getenrichmentData()
      if(!is.null(df)){
        df$jitter <- x
        df$`-log10(pVal)` <- -log10(df$p_value)
      }
      return(df)
    })
    
    #Plot enrichment data
    plotenrichmentPlot <- reactive({
      plotdata <- getenrichmentPlot()
      if(is.null(plotdata)) {
        return(list('numterms'='No enriched terms found','plot'=NULL))
      } else {
        myplot <- ggplot(plotdata) + 
          geom_point(aes(x = jitter, y = `-log10(pVal)`, colour = source)) + 
          theme_bw()+ 
          scale_x_continuous(breaks = seq(1, length(unique(plotdata$source)), 1), 
                             labels = unique(plotdata$source)) + 
          xlab("")
        return(list('numterms'=paste0(nrow(plotdata),' enriched terms found'),
                    'plot'=myplot))
      }
    })
    output[['enriched_terms']] <- renderText(plotenrichmentPlot()$numterms)
    output[['plot']] <- renderPlot(plotenrichmentPlot()$plot)
    
    
    #Define clicking on enrichment data table
    output[['data']] <- renderTable({
      req(input[['plot_click']])
      nearPoints(
        df = getenrichmentPlot()[, c('term_name', 'source', 'term_id', '-log10(pVal)',
                                     'intersection_size', 'jitter')], 
        coordinfo = input[['plot_click']], 
        maxpoints = 5
      )
    })
    
    #Download enrichment
    output[['downloadTable']] <- downloadHandler(
      filename = function(){
        paste(input[['fileName']])
      },
      content = function(file){
        utils::write.csv(x = getenrichmentData(), file, row.names = FALSE)
      }
    )
    
    output[['downloadPlot']] <- downloadHandler(
      filename = function() { input[['plotFileName']] },
      content = function(file) {
        ggsave(file, plot = plotenrichmentPlot()$plot, dpi = 300)
      }
    )
    return(returnableResult)
    
  })
}

# enrichmentPanelApp <- function(){
#   shinyApp(
#     ui = fluidPage(enrichmentPanelUI('RNA')),
#     server = function(input, output, session){
#       enrichmentPanelServer('RNA', reactive(gene.df[,'gene_id', drop = FALSE]))
#     }
#   )
# }