R/GRNCustomPanel.R

In bulkAnalyseR: Interactive Shiny App for Bulk Sequencing Data

#' Generate the GRN custom integration panel of the shiny app
#' @description These are the UI and server components of the GRN custom integration 
#' panel of the shiny app. It is generated by including at least 1 row in the 
#' custom.integration parameter of \code{\link{generateShinyApp}}.
#' @inheritParams GRNpanel
#' @param comparison.table Table linking rows of expression.matrix to custom information, 
#' for example miRNAs or transcription factors.
#' @param title Name for custom panel instance
#' @param DEresults differential expression results output from DEpanelServer;
#' a reactive list with slots 'DEtable' (all genes), 'DEtableSubset' (only DE genes), 
#' 'lfcThreshold' and 'pvalThreshold'
#' @param seed Random seed to create reproducible GRNs
#' @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 GRNCustomPanel
NULL
#' @rdname GRNCustomPanel
#' @export
GRNCustomPanelUI <- function(id, title = 'GRN with custom integration', show = TRUE){
  ns <- NS(id)
  if (show){
  tabPanel(
    title,
    sidebarLayout(
      
      sidebarPanel(
        selectInput(ns("targetGenes"), "Target genes:", multiple = TRUE, choices = character(0)),
        actionButton(ns('goGRN'), label = 'Start GRN inference'),
        
        numericInput(ns("plotConnections"), "Connections to plot:", 5, 0, 100),
        shinyWidgets::switchInput(
          inputId = ns("showAllAnnotations"),
          label = "Show all annotations?",
          labelWidth = "80px",
          onLabel = 'All matching terms',
          offLabel = 'Only selected terms',
          value = FALSE,
          onStatus = FALSE
        ),
        selectInput(ns("annotationCategory"), "Annotation category", choices=character(), multiple=TRUE),
        selectizeInput(ns("annotationsShown"), "Annotations", choices=character(), multiple=TRUE),
        textInput(ns('plotFileName'), 'File name for plot download', value ='GRNplot.html'),
        downloadButton(ns('download'), 'Download Plot'),
      ),
      
      mainPanel(
        visNetwork::visNetworkOutput(ns('plot')),
      )
    )
  )
  }
}

#' @rdname GRNCustomPanel
#' @export
GRNCustomPanelServer <- function(id, expression.matrix, anno, comparison.table, DEresults = NULL, seed = 13){
  
  stopifnot({
    !is.null(DEresults) & is.reactive(expression.matrix) & is.reactive(comparison.table)
    !is.reactive(anno)
  })
  
  moduleServer(id, function(input, output, session){
    
    observe(updateSelectizeInput(
      session, 
      "targetGenes",
      choices = if (is.null(DEresults)) {anno$NAME} else {DEresults()$DE()$DEtableSubset$gene_name}, 
      server = TRUE
    ))
    
    observe(updateSelectInput(
      session, 
      "annotationCategory",
      choices = if (is.null(DEresults)) {unique(comparison.table$Category)} else {unique(comparison.table()$Category)}
    ))
    
    observe(updateSelectizeInput(
      session, 
      "annotationsShown",
      choices = if (is.null(DEresults)) {unique(dplyr::filter(comparison.table, .data$Category %in% input[["annotationCategory"]])$Comparison_Name)
        } else {unique(dplyr::filter(comparison.table(), .data$Category %in% input[["annotationCategory"]])$Comparison_Name)}, 
      server = TRUE
    )) %>%
      bindEvent(input[["annotationCategory"]])
    
    
    GRNresults <- reactive({
      if (!is.null(DEresults)) {
        expression.matrix <- expression.matrix()[DEresults()$DE()$DEtableSubset$gene_id,]
        target.genes <- DEresults()$DE()$DEtableSubset$gene_id[match(input[["targetGenes"]], DEresults()$DE()$DEtableSubset$gene_name)]
      } else {
        target.genes <- anno$ENSEMBL[match(input[["targetGenes"]],anno$NAME)]
      }
      set.seed(seed)
      GENIE3::GENIE3(expression.matrix, targets = target.genes)
    }) %>%
      bindEvent(input[["goGRN"]])
    
    GRNplot <- reactive({
      
      if (!is.null(DEresults)) {
        expression.matrix <- expression.matrix()[DEresults()$DE()$DEtableSubset$gene_id,]
        comparison.table <- comparison.table()
      }
      
      weightMat <- GRNresults()
      color_regulator_reference <- '#D2E5FF'
      color_target_reference <- '#E0E0E0'
      color_regulator_nonreference <- '#ACE9B4'
      
      edges <- GENIE3::getLinkList(weightMat, input[["plotConnections"]]) %>%
        dplyr::rename(from = .data$regulatoryGene, to = .data$targetGene, value = .data$weight) %>%
        dplyr::mutate(from = as.character(.data$from), to = as.character(.data$to))
      nodes <- tibble::tibble(
        id = c(colnames(weightMat), edges$from),
        label = anno$NAME[match(id, anno$ENSEMBL)],
        group = c(rep("target", ncol(weightMat)), rep("regulator", nrow(edges))),
        color = c(rep(color_target_reference, ncol(weightMat)), rep(color_regulator_reference, nrow(edges)))
      ) %>%
        dplyr::distinct(id, .keep_all = TRUE)
      comparison.table.subset = comparison.table[comparison.table$Reference_ID %in% nodes$id,]
      if (!input[["showAllAnnotations"]]){
        comparison.table.subset <- dplyr::filter(comparison.table.subset, 
                                                 (.data$Category %in% input[["annotationCategory"]]) & 
                                                   (.data$Comparison_Name %in% input[["annotationsShown"]]))
      }
      if (nrow(comparison.table.subset)!=0){
        
        edges.comparison <- data.frame('from' = comparison.table$Reference_ID,
                                       'to' = comparison.table$Comparison_ID,
                                       'value' = (1/nrow(comparison.table))*sum(edges$value))
        nodes.comparison <- dplyr::as_tibble(data.frame('id' = comparison.table.subset$Comparison_ID,
                                                        'label' = comparison.table.subset$Comparison_Name,
                                                        'group' = 'table2',
                                                        'color' = color_regulator_nonreference))
        nodes.comparison <- unique(nodes.comparison)
        edges.comparison <- unique(edges.comparison)
        nodes <- rbind(nodes,nodes.comparison)
        edges <- rbind(edges,edges.comparison)
      }
      
      visNetwork::visNetwork(nodes, edges)
    })
    
    output[['plot']] <- visNetwork::renderVisNetwork(GRNplot())
    
    output[['download']] <- downloadHandler(
      filename = function() {input[['plotFileName']]},
      content = function(file) {
        GRNplot() %>% visNetwork::visSave(file)
      }
    )
    
  })
}