Restored previous gene annotation heatmap commit

Author: emouts

R/DEsummaryFuns.R

@@ -6,7 +6,7 @@
 #' rows correspond to genes and columns correspond to samples
 #' @param top.annotation.ids a vector of column indices denoting which columns
 #' of the metadata should become heatmap annotations
-#' @param show.columns.names whether to show the column names below the heatmap;
+#' @param show.column.names whether to show the column names below the heatmap;
 #' default is TRUE
 #' @return The heatmap as detailed in the ComplexHeatmap package.
 #' @export
@@ -25,12 +25,14 @@ expression_heatmap <- function(
   expression.matrix.subset,
   top.annotation.ids = NULL,
   metadata,
-  type = c('Z-score', 'Log2 Expression', 'Expression')
+  type = c('Z-score', 'Log2 Expression', 'Expression'),
+  show.column.names = TRUE
 ){
   heatmat <- as.matrix(expression.matrix.subset)
 
   type <- type[1]
   heatmat <- rescale_matrix(heatmat, type)
+  if(!show.column.names){colnames(heatmat <- NULL)}
 
   if(!is.null(top.annotation.ids)){
     qual.col.pals = dplyr::filter(RColorBrewer::brewer.pal.info, .data$category == 'qual')

R/DEsummaryPanel.R

@@ -28,8 +28,8 @@ DEsummaryPanelUI <- function(id, metadata){
         onStatus = FALSE
       ),
       checkboxInput(ns("pca.show.labels"), label = "Show sample labels", value = FALSE),
-      checkboxInput(ns('pca.show.ellipses'),label = "Show ellipses around groups",value=TRUE),
-      textInput(ns('plotPCAFileName'), 'File name for PCA plot download', value ='PCAPlotDE.png'),
+      checkboxInput(ns('pca.show.ellipses'), label = "Show ellipses around groups", value = TRUE),
+      textInput(ns('plotPCAFileName'), 'File name for PCA plot download', value = 'PCAPlotDE.png'),
       downloadButton(ns('downloadPCAPlot'), 'Download PCA Plot'),
 
       status = "info",
@@ -42,8 +42,7 @@ DEsummaryPanelUI <- function(id, metadata){
       radioButtons(ns('heatmap.processing'), label = "Heatmap values",
                    choices = c('Expression','Log2 Expression','Z-score'), 
                    selected = 'Z-score'),
-      shinyjqui::orderInput(ns('heatmap.annotations'), label = "Show annotations",
-                            items = colnames(metadata)[c(ncol(metadata), seq_len(ncol(metadata) - 1))][-2]),
+      shinyjqui::orderInput(ns('heatmap.annotations'), label = "Show annotations", items = colnames(metadata)),
       selectInput(ns("geneName"), "Additional genes to include:", multiple = TRUE, choices = character(0)),
       div("\nIf no genes are selected in the DE panel or here then the top 50 DE genes are chosen.\n"),
       div(style="margin-bottom:10px"),
@@ -55,7 +54,7 @@ DEsummaryPanelUI <- function(id, metadata){
       icon = icon("gear", verify_fa = FALSE), 
       tooltip = shinyWidgets::tooltipOptions(title = "Click to see inputs!")
     ),
-    plotOutput(ns('heatmap'),height=400),
+    plotOutput(ns('heatmap'), height = 400),
   )
 }
 
@@ -99,6 +98,16 @@ DEsummaryPanelServer <- function(id, expression.matrix, metadata, DEresults, ann
     })
     output[['pca']] <- renderPlot(pca.plot())
 
+    observe({
+      items <- colnames(metadata())
+      include.exclude <- apply(metadata(), 2, function(x){
+        l <- length(unique(x))
+        (l > 1) & (l < length(x))
+      })
+      items <- colnames(metadata())[include.exclude]
+      items <- items[c(length(items), seq_len(length(items) - 1))]
+      shinyjqui::updateOrderInput(session, "heatmap.annotations", items = items)
+    })
     heatmap.plot <- reactive({
       selectedGenes = DEresults()$selectedGenes()
       if(length(selectedGenes)){
@@ -122,7 +131,8 @@ DEsummaryPanelServer <- function(id, expression.matrix, metadata, DEresults, ann
         expression.matrix.subset = subsetExpression[, meta[, 1]],
         top.annotation.ids = match(input[['heatmap.annotations']], colnames(meta)),
         metadata = meta,
-        type = input[["heatmap.processing"]]
+        type = input[["heatmap.processing"]],
+        show.column.names = (nrow(meta) <= 20)
       )
       return(myplot)
     }) %>%