Browse code

adjust color order on barplot

Zuguang Gu authored on 25/10/2018 19:37:48
Showing8 changed files

... ...
@@ -42,7 +42,8 @@
42 42
 # draw(anno, test = "anno_empty")
43 43
 # anno = anno_empty(border = FALSE)
44 44
 # draw(anno, test = "anno_empty without border")
45
-anno_empty = function(which = c("column", "row"), border = TRUE, width = NULL, height = NULL) {
45
+anno_empty = function(which = c("column", "row"), border = TRUE, zoom = FALSE,
46
+	width = NULL, height = NULL) {
46 47
 	
47 48
 	if(is.null(.ENV$current_annotation_which)) {
48 49
 		which = match.arg(which)[1]
... ...
@@ -52,6 +53,7 @@ anno_empty = function(which = c("column", "row"), border = TRUE, width = NULL, h
52 53
 
53 54
 	anno_size = anno_width_and_height(which, width, height, unit(1, "cm"))
54 55
 	
56
+	
55 57
 	fun = function(index) {
56 58
 		if(border) grid.rect()
57 59
 	}
... ...
@@ -61,13 +63,14 @@ anno_empty = function(which = c("column", "row"), border = TRUE, width = NULL, h
61 63
 		n = NA,
62 64
 		fun_name = "anno_empty",
63 65
 		which = which,
64
-		var_import = list(border),
66
+		var_import = list(border, zoom),
65 67
 		subset_rule = list(),
66 68
 		subsetable = TRUE,
67 69
 		height = anno_size$height,
68 70
 		width = anno_size$width,
69 71
 		show_name = FALSE
70 72
 	)
73
+	
71 74
 	return(anno) 
72 75
 }
73 76
 
... ...
@@ -156,6 +156,7 @@ Heatmap = setClass("Heatmap",
156 156
 # -gap Gap between row slices if the heatmap is split by rows. The value should be a `grid::unit` object.
157 157
 # -row_gap Same as ``gap``.
158 158
 # -column_gap Gap between column slices.
159
+# -show_parent_dend_line When heatmap is split, whether to add a dashed line to mark parent dendrogram and children dendrograms?
159 160
 # -width Width of the heatmap body.
160 161
 # -height Height of the heatmap body.
161 162
 # -heatmap_width Width of the whole heatmap (including heatmap components)
... ...
@@ -543,17 +544,25 @@ Heatmap = function(matrix, col, name,
543 544
     if(missing(cluster_rows) && !missing(row_order)) {
544 545
         cluster_rows = FALSE
545 546
     }
546
-    if(inherits(cluster_rows, "dendrogram") || inherits(cluster_rows, "hclust")) {
547
+    if(is.logical(cluster_rows)) {
548
+        if(!cluster_rows) {
549
+            row_dend_width = unit(0, "mm")
550
+            show_row_dend = FALSE
551
+        }
552
+        .Object@row_dend_param$cluster = cluster_rows
553
+    } else if(inherits(cluster_rows, "dendrogram") || inherits(cluster_rows, "hclust")) {
547 554
         .Object@row_dend_param$obj = cluster_rows
548 555
         .Object@row_dend_param$cluster = TRUE
549 556
     } else if(inherits(cluster_rows, "function")) {
550 557
         .Object@row_dend_param$fun = cluster_rows
551 558
         .Object@row_dend_param$cluster = TRUE
552 559
     } else {
553
-        .Object@row_dend_param$cluster = cluster_rows
554
-        if(!cluster_rows) {
555
-            row_dend_width = unit(0, "mm")
556
-            show_row_dend = FALSE
560
+        oe = try(cluster_rows <- as.dendrogram(cluster_rows), silent = TRUE)
561
+        if(!inherits(oe, "try-error")) {
562
+            .Object@row_dend_param$obj = cluster_rows
563
+            .Object@row_dend_param$cluster = TRUE
564
+        } else {
565
+            stop_wrap("`cluster_rows` should be a logical value, a clustering function or a clustering object.")
557 566
         }
558 567
     }
559 568
     if(!show_row_dend) {
... ...
@@ -580,17 +589,25 @@ Heatmap = function(matrix, col, name,
580 589
     if(missing(cluster_columns) && !missing(column_order)) {
581 590
         cluster_columns = FALSE
582 591
     }
583
-    if(inherits(cluster_columns, "dendrogram") || inherits(cluster_columns, "hclust")) {
592
+    if(is.logical(cluster_columns)) {
593
+        if(!cluster_columns) {
594
+            column_dend_height = unit(0, "mm")
595
+            show_column_dend = FALSE
596
+        }
597
+        .Object@column_dend_param$cluster = cluster_columns
598
+    } else if(inherits(cluster_columns, "dendrogram") || inherits(cluster_columns, "hclust")) {
584 599
         .Object@column_dend_param$obj = cluster_columns
585 600
         .Object@column_dend_param$cluster = TRUE
586 601
     } else if(inherits(cluster_columns, "function")) {
587 602
         .Object@column_dend_param$fun = cluster_columns
588 603
         .Object@column_dend_param$cluster = TRUE
589 604
     } else {
590
-        .Object@column_dend_param$cluster = cluster_columns
591
-        if(!cluster_columns) {
592
-            column_dend_height = unit(0, "mm")
593
-            show_column_dend = FALSE
605
+        oe = try(cluster_columns <- as.dendrogram(cluster_columns), silent = TRUE)
606
+        if(!inherits(oe, "try-error")) {
607
+            .Object@column_dend_param$obj = cluster_columns
608
+            .Object@column_dend_param$cluster = TRUE
609
+        } else {
610
+            stop_wrap("`cluster_columns` should be a logical value, a clustering function or a clustering object.")
594 611
         }
595 612
     }
596 613
     if(!show_column_dend) {
... ...
@@ -348,8 +348,22 @@ HeatmapAnnotation = function(...,
348 348
 		}
349 349
 	}
350 350
 
351
+
351 352
 	n_total_anno = length(anno_list)
352 353
 
354
+	## check whether anno_list contains zoomed anno_empty
355
+	if(n_total_anno > 1) {
356
+		for(i in seq_len(n_total_anno)) {
357
+			anno = anno_list[[i]]@fun
358
+			if(identical(anno@fun_name, "anno_empty")) {
359
+				if(anno@var_env$zoom) {
360
+					stop_wrap("You set `zoom = TRUE` in `anno_empty()` for the empty annotation. The HeatmapAnnotation object only allows to contain one single annotation if it is a zoomed empty annotation.")
361
+				}
362
+			}
363
+		}
364
+	}
365
+
366
+
353 367
 	if(is.null(gap)) gap = unit(0, "mm")
354 368
 
355 369
 	# the nth gap does not really matter
... ...
@@ -559,6 +573,7 @@ setMethod(f = "draw",
559 573
 	n_anno = length(object@anno_list)
560 574
 	anno_size = object@anno_size
561 575
 	gap = object@gap
576
+	vp_param = list(...)
562 577
 
563 578
 	if(is.character(test)) {
564 579
         test2 = TRUE
... ...
@@ -572,7 +587,7 @@ setMethod(f = "draw",
572 587
     	if(which == "column") pushViewport(viewport(width = unit(1, "npc") - unit(3, "cm"), height = object@height))
573 588
     	if(which == "row") pushViewport(viewport(height = unit(1, "npc") - unit(3, "cm"), width = object@width))
574 589
     } else {
575
-		pushViewport(viewport(...))
590
+		pushViewport(do.call(viewport, vp_param))
576 591
 	}
577 592
 
578 593
 	if(missing(index)) {
... ...
@@ -1215,3 +1230,15 @@ setMethod(f = "re_size",
1215 1230
 	return(object)
1216 1231
 })
1217 1232
 
1233
+
1234
+has_zoomed_anno_empty = function(ha) {
1235
+	if(length(ha@anno_list) == 1) {
1236
+		anno = ha@anno_list[[1]]@fun
1237
+		if(identical(anno@fun_name, "anno_empty")) {
1238
+			if(anno@var_env$zoom) {
1239
+				return(TRUE)
1240
+			}
1241
+		}
1242
+	}
1243
+	return(FALSE)
1244
+}
... ...
@@ -192,6 +192,8 @@ oncoPrint = function(mat,
192 192
 		}
193 193
 
194 194
 		alter_fun = alter_fun[unique(c("background", intersect(names(alter_fun), all_type)))]
195
+		all_type = setdiff(names(alter_fun), "background")
196
+		arr = arr[, , all_type, drop = FALSE]
195 197
 
196 198
 		if(is.null(alter_fun_is_vectorized)) {
197 199
 			alter_fun_is_vectorized = guess_alter_fun_is_vectorized(alter_fun)
... ...
@@ -30,7 +30,7 @@ Heatmap(matrix, col, name,
30 30
     row_dend_side = c("left", "right"),
31 31
     row_dend_width = unit(10, "mm"),
32 32
     show_row_dend = TRUE,
33
-    row_dend_reorder = TRUE,
33
+    row_dend_reorder = is.logical(cluster_rows) || is.function(cluster_rows),
34 34
     row_dend_gp = gpar(),
35 35
     cluster_columns = TRUE,
36 36
     clustering_distance_columns = "euclidean",
... ...
@@ -39,7 +39,7 @@ Heatmap(matrix, col, name,
39 39
     column_dend_height = unit(10, "mm"),
40 40
     show_column_dend = TRUE,
41 41
     column_dend_gp = gpar(),
42
-    column_dend_reorder = TRUE,
42
+    column_dend_reorder = is.logical(cluster_columns) || is.function(cluster_columns),
43 43
     
44 44
     row_order = NULL,
45 45
     column_order = NULL,
... ...
@@ -71,6 +71,7 @@ Heatmap(matrix, col, name,
71 71
     gap = unit(1, "mm"),
72 72
     row_gap = unit(1, "mm"),
73 73
     column_gap = unit(1, "mm"),
74
+    show_parent_dend_line = ht_opt$show_parent_dend_line,
74 75
     
75 76
     heatmap_width = unit(1, "npc"),
76 77
     width = NULL,
... ...
@@ -149,6 +150,7 @@ Heatmap(matrix, col, name,
149 150
   \item{gap}{Gap between row slices if the heatmap is split by rows. The value should be a \code{\link[grid]{unit}} object.}
150 151
   \item{row_gap}{Same as \code{gap}.}
151 152
   \item{column_gap}{Gap between column slices.}
153
+  \item{show_parent_dend_line}{When heatmap is split, whether to add a dashed line to mark parent dendrogram and children dendrograms?}
152 154
   \item{width}{Width of the heatmap body.}
153 155
   \item{height}{Height of the heatmap body.}
154 156
   \item{heatmap_width}{Width of the whole heatmap (including heatmap components)}
... ...
@@ -56,7 +56,7 @@ HeatmapAnnotation(...,
56 56
 
57 57
 }
58 58
 \details{
59
-For arguments \code{border}, \code{annotation_name_offset}, \code{annotation_name_side}, \code{annotation_name_rot},
59
+For arguments \code{show_legend}, \code{border}, \code{annotation_name_offset}, \code{annotation_name_side}, \code{annotation_name_rot},
60 60
 \code{show_annotation_name}, they can be set as named vectors to modify values for some of the annotations,
61 61
 e.g. assuming you have an annotation with name \code{foo}, you can specify \code{border = c(foo = TRUE)} in \code{\link{HeatmapAnnotation}}.
62 62
 
... ...
@@ -84,7 +84,8 @@ Draw a list of heatmaps
84 84
     heatmap_border = NULL,
85 85
     annotation_border = NULL,
86 86
     fastcluster = NULL,
87
-    anno_simple_size = NULL)
87
+    anno_simple_size = NULL,
88
+    show_parent_dend_line = NULL)
88 89
 }
89 90
 \arguments{
90 91
 
... ...
@@ -157,6 +158,7 @@ Draw a list of heatmaps
157 158
   \item{annotation_border}{this set the value in \code{\link{ht_opt}} and reset back after the plot is done}
158 159
   \item{fastcluster}{this set the value in \code{\link{ht_opt}} and reset back after the plot is done}
159 160
   \item{anno_simple_size}{this set the value in \code{\link{ht_opt}} and reset back after the plot is done}
161
+  \item{show_parent_dend_line}{this set the value in \code{\link{ht_opt}} and reset back after the plot is done}
160 162
 
161 163
 }
162 164
 \details{
... ...
@@ -65,6 +65,7 @@ Other parameters:
65 65
 
66 66
 \describe{
67 67
   \item{fast_hclust}{whether use \code{\link[fastcluster]{hclust}} to speed up clustering?}
68
+  \item{show_parent_dend_line}{when heatmap is split, whether to add a dashed line to mark parent dendrogram and children dendrograms?}
68 69
 }
69 70
 
70 71
 You can get or set option values by the traditional way (like \code{\link[base]{options}}) or by \code{$} operator: