Use unique heatmap name, and other feature updates

R/visualization.R

@@ -1776,8 +1776,9 @@ netVisual_diffInteraction <- function(object, comparison = c(1,2), measure = c("
 #' @param color.use the character vector defining the color of each cell group
 #' @param color.heatmap A vector of two colors corresponding to max/min values, or a color name in brewer.pal only when the data in the heatmap do not contain negative values
 #' @param title.name the name of the title
-#' @param width width of heatmap
-#' @param height height of heatmap
+#' @param legend.title the title of the heatmap legend
+#' @param width width of the heatmap bidy, should be a fixed `unit` object
+#' @param height height of the heatmap body, should be a fixed `unit` object
 #' @param font.size fontsize in heatmap
 #' @param font.size.title font size of the title
 #' @param cluster.rows whether cluster rows
@@ -1792,9 +1793,11 @@ netVisual_diffInteraction <- function(object, comparison = c(1,2), measure = c("
 #' @importFrom ComplexHeatmap Heatmap HeatmapAnnotation anno_barplot rowAnnotation
 #' @return  an object of ComplexHeatmap
 #' @export
-netVisual_heatmap <- function(object, comparison = c(1,2), measure = c("count", "weight"), signaling = NULL, slot.name = c("netP", "net"), color.use = NULL, color.heatmap = c("#2166ac","#b2182b"),
-                              title.name = NULL, width = NULL, height = NULL, font.size = 8, font.size.title = 10, cluster.rows = FALSE, cluster.cols = FALSE,
-                              sources.use = NULL, targets.use = NULL, remove.isolate = FALSE, row.show = NULL, col.show = NULL){
+netVisual_heatmap <- function(object, comparison = c(1,2), measure = c("count", "weight"), signaling = NULL,
+                              slot.name = c("netP", "net"), color.use = NULL, color.heatmap = c("#2166ac","#b2182b"),
+                              title.name = NULL, legend.title = NULL, width = NULL, height = NULL, font.size = 8, font.size.title = 10,
+                              cluster.rows = FALSE, cluster.cols = FALSE, sources.use = NULL, targets.use = NULL,
+                              remove.isolate = FALSE, row.show = NULL, col.show = NULL){
   # obj1 <- object.list[[comparison[1]]]
   # obj2 <- object.list[[comparison[2]]]
   if (!is.null(measure)) {
@@ -1816,15 +1819,15 @@ netVisual_heatmap <- function(object, comparison = c(1,2), measure = c("count",
         title.name = "Differential interaction strength"
       }
     }
-    legend.name = "Relative values"
+    if(is.null(legend.title)) legend.title <- "Relative values"
   } else {
     message("Do heatmap based on a single object \n")
     if (!is.null(signaling)) {
       net.diff <- slot(object, slot.name)$prob[,,signaling]
       if (is.null(title.name)) {
         title.name = paste0(signaling, " signaling network")
       }
-      legend.name <- "Communication Prob."
+      if(is.null(legend.title)) legend.title <- "Communication Prob."
     } else if (!is.null(measure)) {
       net.diff <- object@net[[measure]]
       if (measure == "count") {
@@ -1836,7 +1839,7 @@ netVisual_heatmap <- function(object, comparison = c(1,2), measure = c("count",
           title.name = "Interaction strength"
         }
       }
-      legend.name <- title.name
+      if(is.null(legend.title)) legend.title <- title.name
     }
   }
 
@@ -1916,24 +1919,31 @@ netVisual_heatmap <- function(object, comparison = c(1,2), measure = c("count",
                                       show_legend = FALSE, show_annotation_name = FALSE,
                                       simple_anno_size = grid::unit(0.2, "cm"))
 
-  ha1 = rowAnnotation(Strength = anno_barplot(rowSums(abs(mat)), border = FALSE,gp = gpar(fill = color.use, col=color.use)), show_annotation_name = FALSE)
-  ha2 = HeatmapAnnotation(Strength = anno_barplot(colSums(abs(mat)), border = FALSE,gp = gpar(fill = color.use, col=color.use)), show_annotation_name = FALSE)
+  ha1 = rowAnnotation(Strength = anno_barplot(rowSums(abs(mat)), border = FALSE, gp = gpar(fill = color.use, col=color.use)), 
+ 		      show_annotation_name = FALSE)
+  ha2 = HeatmapAnnotation(Strength = anno_barplot(colSums(abs(mat)), border = FALSE,gp = gpar(fill = color.use, col=color.use)), 
+ 			  show_annotation_name = FALSE)
 
   if (sum(abs(mat) > 0) == 1) {
     color.heatmap.use = c("white", color.heatmap.use)
   } else {
     mat[mat == 0] <- NA
   }
-  ht1 = Heatmap(mat, col = color.heatmap.use, na_col = "white", name = legend.name,
+
+  ht.name <- paste0(abbreviate(legend.title), sample(.Machine$integer.max, 1))
+
+  ht1 = Heatmap(mat, col = color.heatmap.use, na_col = "white", name = ht.name,
                 bottom_annotation = col_annotation, left_annotation =row_annotation, top_annotation = ha2, right_annotation = ha1,
-                cluster_rows = cluster.rows,cluster_columns = cluster.rows,
-                row_names_side = "left",row_names_rot = 0,row_names_gp = gpar(fontsize = font.size),column_names_gp = gpar(fontsize = font.size),
-               # width = unit(width, "cm"), height = unit(height, "cm"),
-                column_title = title.name,column_title_gp = gpar(fontsize = font.size.title),column_names_rot = 90,
-                row_title = "Sources (Sender)",row_title_gp = gpar(fontsize = font.size.title),row_title_rot = 90,
-                heatmap_legend_param = list(title_gp = gpar(fontsize = 8, fontface = "plain"),title_position = "leftcenter-rot",
-                                            border = NA, #at = colorbar.break,
-                                            legend_height = unit(20, "mm"),labels_gp = gpar(fontsize = 8),grid_width = unit(2, "mm"))
+                cluster_rows = cluster.rows, cluster_columns = cluster.rows,
+                row_names_side = "left", row_names_rot = 0, column_names_rot = 90, row_title_rot = 90,  
+                row_names_gp = gpar(fontsize = font.size), column_names_gp = gpar(fontsize = font.size),
+                row_title = "Sources (Sender)", row_title_gp = gpar(fontsize = font.size.title),
+                column_title = title.name, column_title_gp = gpar(fontsize = font.size.title),
+                width = width, height = height,
+                heatmap_legend_param = list(title = legend.title, title_gp = gpar(fontsize = font.size, fontface = "plain"),  
+                                            title_position = "leftcenter-rot", border = NA, #at = colorbar.break,
+                                            legend_height = unit(20, "mm"), labels_gp = gpar(fontsize = font.size),  
+                                            grid_width = unit(2, "mm"))
   )
   #  draw(ht1)
   return(ht1)