R/GRNTransPanel.R

In bulkAnalyseR: Interactive Shiny App for Bulk Sequencing Data

#' Generate the GRN trans integration panel of the shiny app
#' @description These are the UI and server components of the GRN trans integration 
#' panel of the shiny app. It is generated by including at least 1 row in the 
#' trans.integration parameter of \code{\link{generateShinyApp}}.
#' @inheritParams GRNpanel
#' @param expression.matrix.comparison Additional expression matrix to integrate. 
#' Column names must match column names from expression.matrix.
#' @param anno.comparison annotation data frame containing a match between the row names
#' of the comparison expression matrix and the names that
#' should be rendered within the app and in output files. 
#' The structure matches the anno table created in 
#' \code{\link{generateShinyApp}} using the org.db specified
#' @param tablenames,reference.table.name,comparison.table.name Names for reference and comparison expression tables.
#' @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 GRNTransPanel
NULL
#' @rdname GRNTransPanel
#' @export
GRNTransPanelUI <- function(id, reference.table.name, comparison.table.name){
  ns <- NS(id)
  
  tabPanel(
    paste0('GRN with trans integration - ',reference.table.name,' vs ',comparison.table.name),
    sidebarLayout(
      
      sidebarPanel(
        selectInput(ns("choices"), 'Table to choose target genes from:',
                    multiple=FALSE, choices=character(0)),
        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),
        textInput(ns('plotFileName'), 'File name for plot download', value ='GRNTransPlot.html'),
        downloadButton(ns('download'), 'Download Plot'),
      ),
      
      mainPanel(
        visNetwork::visNetworkOutput(ns('plot')),
      )
    )
  )
}

#' @rdname GRNTransPanel
#' @export
GRNTransPanelServer <- function(id, expression.matrix, anno, anno.comparison, 
                                expression.matrix.comparison, tablenames, seed = 13){
  
  stopifnot({
    !is.reactive(expression.matrix)
    !is.reactive(expression.matrix.comparison)
    !is.reactive(anno)
    !is.reactive(anno.comparison)
    !is.reactive(tablenames)
    !is.reactive(seed)
  })
  moduleServer(id, function(input, output, session){
    reference.table <- rbind(anno, anno.comparison)
    
    updateSelectInput(session, "choices", choices = tablenames)
    
    observe({
      if(input[["choices"]] == tablenames[1]){
        updateSelectizeInput(session, "targetGenes", choices = anno$NAME, server = TRUE)
      }else if(input[["choices"]] == tablenames[2]){
        updateSelectizeInput(session, "targetGenes", choices = anno.comparison$NAME, server = TRUE)
      }
    }) %>%
      bindEvent(input[["choices"]])
    
    reference.anno <- reactive({
      if (input[['choices']] == tablenames[1]) {reference.anno <- anno} else {reference.anno <- anno.comparison}
    }) %>%
      bindEvent(input[["goGRN"]])
    
    GRNresults <- reactive({
      target.genes.names <- intersect(input[['targetGenes']],reference.anno()$NAME)
      target.genes <- reference.anno()$ENSEMBL[match(target.genes.names,reference.anno()$NAME)]
      total.expression.matrix <- rbind(expression.matrix,expression.matrix.comparison)
      set.seed(seed)
      GENIE3::GENIE3(total.expression.matrix, targets = target.genes)
    }) %>%
      bindEvent(input[["goGRN"]])
    
    
    GRNplot <- reactive({
      reference.table <- rbind(anno,anno.comparison)
      weightMat <- GRNresults()
      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 = reference.table$NAME[match(id, reference.table$ENSEMBL)],
        group = c(rep("target", ncol(weightMat)), rep("regulator", nrow(edges)))
      ) %>%
        dplyr::distinct(id, .keep_all = TRUE)
      nodes$group <- paste0(nodes$group, ifelse(nodes$id %in% reference.anno()$ENSEMBL, 'reference', 'nonreference'))
      
      color_regulator_reference <- list("background" = '#D2E5FF')
      color_target_reference <- list("background" = '#E0E0E0')
      color_regulator_nonreference <- list("background" = '#ACE9B4')
      colors.list <- list(color_regulator_reference, color_target_reference, color_regulator_nonreference)
      
      nodes$color=''
      for(i in seq_len(nrow(nodes))){
        nodes$color[i] <- colors.list[[match(
          nodes$group[i], c("regulatorreference", "targetreference", "regulatornonreference")
        )]]
      }
      
      visNetwork::visNetwork(nodes, edges)
    })
    
    output[['plot']] <- visNetwork::renderVisNetwork(GRNplot())
    
    output[['download']] <- downloadHandler(
      filename = function() {input[['plotFileName']]},
      content = function(file) {
        GRNplot() %>% visNetwork::visSave(file)
      }
    )
    
  })
}