R/GRNCisPanel.R

In bulkAnalyseR: Interactive Shiny App for Bulk Sequencing Data

#' Generate the GRN cis integration panel of the shiny app
#' @description These are the UI and server components of the GRN cis integration 
#' panel of the shiny app. It is generated by including at least 1 row in the 
#' cis.integration parameter of \code{\link{generateShinyApp}}.
#' @inheritParams GRNpanel
#' @param coord.table.reference Table of coordinates corresponding to rows of 
#' expression.matrix
#' @param coord.table.comparison Table of coordinates to compare against coord.table.reference
#' @param reference.table.name Name for reference expression matrix and coordinate table
#' @param comparison.table.name Name for comparison coordinate table
#' @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 GRNCisPanel
NULL
#' @rdname GRNCisPanel
#' @export
GRNCisPanelUI <- function(id, reference.table.name, comparison.table.name){
  ns <- NS(id)
  
  tabPanel(
    paste0('GRN with cis integration - ',reference.table.name,' vs ',comparison.table.name),
    sidebarLayout(
      
      sidebarPanel(
        selectInput(ns("targetGenes"), "Targets:", multiple = TRUE, choices = character(0)),
        actionButton(ns('goGRN'), label = 'Start GRN inference'),
        
        numericInput(ns("maxDistance"), "Maximum distance for cis-regulatory elements:", 5000, 0, 1000000,100),
        numericInput(ns("plotConnections"), "Connections to plot:", 5, 0, 100),
        selectInput(ns("direction"), "Direction (compared to reference table):", multiple = FALSE, choices = c('Symmetric','Upstream','Downstream')),
        textInput(ns('plotFileName'), 'File name for plot download', value ='GRNCisPlot.html'),
        downloadButton(ns('download'), 'Download Plot'),
      ),
      
      mainPanel(
        visNetwork::visNetworkOutput(ns('plot')),
      )
    )
  )
}

#' @rdname GRNCisPanel
#' @export
GRNCisPanelServer <- function(id, expression.matrix, anno, coord.table.reference, coord.table.comparison, seed = 13){
  
  stopifnot({
    !is.reactive(expression.matrix)
    !is.reactive(anno)
    !is.reactive(coord.table.reference)
    !is.reactive(coord.table.comparison)
  })
  
  moduleServer(id, function(input, output, session){
    
    updateSelectizeInput(session, "targetGenes", choices = anno$NAME, server = TRUE)
    
    GRNresults <- reactive({
      target.genes <- anno$ENSEMBL[match(input[["targetGenes"]], anno$NAME)]
      set.seed(seed)
      GENIE3::GENIE3(expression.matrix, targets = target.genes)
    }) %>%
      bindEvent(input[["goGRN"]])
    
    GRNplot <- reactive({
      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))
      edges$color <- '#848484'
      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)
      rownames(coord.table.reference) <- coord.table.reference$ID
      node.locations <- coord.table.reference[nodes$id,]
      ref.comp.merge <- merge(node.locations,coord.table.comparison,by='Chrom')
      ref.comp.merge <- ref.comp.merge[ref.comp.merge$Stop.y >= (ref.comp.merge$Start.x - input[['maxDistance']]) & 
                                         ref.comp.merge$Start.y <= (ref.comp.merge$Stop.x + input[['maxDistance']]),]
      ref.comp.merge$Midpoint.x <- (ref.comp.merge$Start.x + ref.comp.merge$Stop.x) / 2
      ref.comp.merge$Midpoint.y <- (ref.comp.merge$Start.y + ref.comp.merge$Stop.y) / 2
      ref.comp.merge$Direction <- ifelse(( (ref.comp.merge$Strand.x == '+' & (ref.comp.merge$Midpoint.y < ref.comp.merge$Midpoint.x)) |
                                          (ref.comp.merge$Strand.x == '-' & (ref.comp.merge$Midpoint.y > ref.comp.merge$Midpoint.x)) ), 
                                         'Upstream' , 
                                         'Downstream')
      ref.comp.merge$Distance <- 1/abs(ref.comp.merge$Midpoint.y - ref.comp.merge$Midpoint.x)
      if (input[['direction']] == 'Upstream'){ ref.comp.merge=ref.comp.merge[ref.comp.merge$Direction == 'Upstream',] }
      if (input[['direction']] == 'Downstream'){ ref.comp.merge=ref.comp.merge[ref.comp.merge$Direction == 'Downstream',] }
      
      if (nrow(ref.comp.merge) != 0){
        edges.comparison <- data.frame('from' = ref.comp.merge$ID.x, 'to' = ref.comp.merge$ID.y, 'value' = ref.comp.merge$Distance)
        edges.comparison$value <- (edges.comparison$value/sum(edges.comparison$value))*sum(edges$value)
        edges.comparison$color <- ifelse(ref.comp.merge$Direction == 'Upstream','#000080','#8B0000')
        nodes.comparison <- dplyr::as_tibble(data.frame('id' = ref.comp.merge$ID.y,label = ref.comp.merge$Name.y,'group' = 'table2','color' = color_regulator_nonreference))
        nodes.comparison <- unique(nodes.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)
      }
    )
    
  })
}