Browse code

add the awesome select_region function

Zuguang Gu authored on 01/09/2015 22:09:36
Showing 29 changed files

1 1
Binary files a/.DS_Store and b/.DS_Store differ
... ...
@@ -1,7 +1,7 @@
1 1
 Package: ComplexHeatmap
2 2
 Type: Package
3 3
 Title: Making Complex Heatmaps
4
-Version: 1.3.3
4
+Version: 1.4.0
5 5
 Date: 2015-8-25
6 6
 Author: Zuguang Gu
7 7
 Maintainer: Zuguang Gu <z.gu@dkfz.de>
... ...
@@ -1,5 +1,6 @@
1 1
 export(column_anno_histogram)
2 2
 export(anno_boxplot)
3
+exportMethods(column_order)
3 4
 export(ColorMapping)
4 5
 export(HeatmapAnnotation)
5 6
 export(column_anno_boxplot)
... ...
@@ -27,6 +28,7 @@ exportClasses(AdditiveUnit)
27 28
 export(AdditiveUnit)
28 29
 export(max_text_height)
29 30
 exportMethods(annotation_legend_size)
31
+exportMethods(row_order)
30 32
 export(AdditiveUnit)
31 33
 exportMethods(draw_heatmap_list)
32 34
 export(row_anno_density)
... ...
@@ -35,6 +37,7 @@ export(decorate_heatmap_body)
35 37
 exportMethods(draw_heatmap_legend)
36 38
 exportMethods(add_heatmap)
37 39
 export(anno_barplot)
40
+exportMethods(row_dend)
38 41
 export(row_anno_boxplot)
39 42
 export(max_text_width)
40 43
 export(decorate_row_title)
... ...
@@ -61,12 +64,14 @@ export(column_anno_density)
61 64
 exportClasses(Heatmap)
62 65
 export(Heatmap)
63 66
 exportMethods(draw_annotation_legend)
67
+exportMethods(column_dend)
64 68
 exportMethods(set_component_height)
65 69
 export(HeatmapList)
66 70
 exportMethods(draw_annotation)
67 71
 exportMethods(make_column_cluster)
68 72
 export(SingleAnnotation)
69 73
 export(row_anno_histogram)
74
+export(select_region)
70 75
 exportMethods(get_color_mapping_list)
71 76
 exportMethods(make_row_cluster)
72 77
 exportMethods(component_width)
... ...
@@ -1,3 +1,13 @@
1
+CHANGES in VERSION 1.3.4
2
+
3
+* returned value for `draw` method has been changes
4
+* add `row_order`, `column_order`, `row_dend` and `column_dend`
5
+  to extract orders and dendrograms after heatmap clustering
6
+* add `select_region` to interactively select sub region in the heatmap
7
+  and retrieve row/column index in the selected sub region.
8
+
9
+====================================
10
+
1 11
 CHANGES in VERSION 1.3.3
2 12
 
3 13
 * set `row_reorder` and `column_reorder` to FALSE by default in `Heatmap()`
... ...
@@ -7,6 +7,8 @@ setGeneric('set_component_height', function(object, ...) standardGeneric('set_co
7 7
 
8 8
 setGeneric('draw_heatmap_body', function(object, ...) standardGeneric('draw_heatmap_body'))
9 9
 
10
+setGeneric('column_order', function(object, ...) standardGeneric('column_order'))
11
+
10 12
 setGeneric('draw_hclust', function(object, ...) standardGeneric('draw_hclust'))
11 13
 
12 14
 setGeneric('draw_annotation_legend', function(object, ...) standardGeneric('draw_annotation_legend'))
... ...
@@ -25,10 +27,10 @@ setGeneric('prepare', function(object, ...) standardGeneric('prepare'))
25 27
 
26 28
 setGeneric('draw_annotation', function(object, ...) standardGeneric('draw_annotation'))
27 29
 
28
-setGeneric('draw_dimnames', function(object, ...) standardGeneric('draw_dimnames'))
29
-
30 30
 setGeneric('get_color_mapping_param_list', function(object, ...) standardGeneric('get_color_mapping_param_list'))
31 31
 
32
+setGeneric('draw_dimnames', function(object, ...) standardGeneric('draw_dimnames'))
33
+
32 34
 setGeneric('color_mapping_legend', function(object, ...) standardGeneric('color_mapping_legend'))
33 35
 
34 36
 setGeneric('draw', function(object, ...) standardGeneric('draw'))
... ...
@@ -41,6 +43,12 @@ setGeneric('make_column_cluster', function(object, ...) standardGeneric('make_co
41 43
 
42 44
 setGeneric('component_width', function(object, ...) standardGeneric('component_width'))
43 45
 
46
+setGeneric('column_dend', function(object, ...) standardGeneric('column_dend'))
47
+
44 48
 setGeneric('get_color_mapping_list', function(object, ...) standardGeneric('get_color_mapping_list'))
45 49
 
50
+setGeneric('row_order', function(object, ...) standardGeneric('row_order'))
51
+
46 52
 setGeneric('draw_heatmap_list', function(object, ...) standardGeneric('draw_heatmap_list'))
53
+
54
+setGeneric('row_dend', function(object, ...) standardGeneric('row_dend'))
... ...
@@ -160,7 +160,7 @@ Heatmap = setClass("Heatmap",
160 160
 # -column_order order of column. It makes it easy to adjust column order for both matrix and column annotations.
161 161
 # -row_names_side should the row names be put on the left or right of the heatmap?
162 162
 # -show_row_names whether show row names.
163
-# -row_reorder apply reordering on rows. The value can be a logical value or a vector which contains weight 
163
+# -row_hclust_reorder apply reordering on rows. The value can be a logical value or a vector which contains weight 
164 164
 #               which is used to reorder rows
165 165
 # -row_names_max_width maximum width of row names viewport. Because some times row names can be very long, it is not reasonable
166 166
 #                      to show them all.
... ...
@@ -168,7 +168,7 @@ Heatmap = setClass("Heatmap",
168 168
 # -column_names_side should the column names be put on the top or bottom of the heatmap?
169 169
 # -column_names_max_height maximum height of column names viewport.
170 170
 # -show_column_names whether show column names.
171
-# -column_reorder apply reordering on columns. The value can be a logical value or a vector which contains weight 
171
+# -column_hclust_reorder apply reordering on columns. The value can be a logical value or a vector which contains weight 
172 172
 #               which is used to reorder columns
173 173
 # -column_names_gp graphic parameters for drawing text.
174 174
 # -top_annotation a `HeatmapAnnotation` object which contains a list of annotations.
... ...
@@ -216,12 +216,12 @@ Heatmap = function(matrix, col, name, na_col = "grey", color_space = "LAB",
216 216
     cluster_rows = TRUE, clustering_distance_rows = "euclidean",
217 217
     clustering_method_rows = "complete", row_hclust_side = c("left", "right"),
218 218
     row_hclust_width = unit(10, "mm"), show_row_hclust = TRUE, 
219
-    row_reorder = FALSE,
219
+    row_hclust_reorder = FALSE,
220 220
     row_hclust_gp = gpar(), cluster_columns = TRUE, 
221 221
     clustering_distance_columns = "euclidean", clustering_method_columns = "complete",
222 222
     column_hclust_side = c("top", "bottom"), column_hclust_height = unit(10, "mm"), 
223 223
     show_column_hclust = TRUE, column_hclust_gp = gpar(), 
224
-    column_reorder = FALSE,
224
+    column_hclust_reorder = FALSE,
225 225
     row_order = NULL, column_order = NULL,
226 226
     row_names_side = c("right", "left"), show_row_names = TRUE, 
227 227
     row_names_max_width = unit(4, "cm"), row_names_gp = gpar(fontsize = 12), 
... ...
@@ -323,14 +323,14 @@ Heatmap = function(matrix, col, name, na_col = "grey", color_space = "LAB",
323 323
             cluster_rows = FALSE
324 324
             show_row_hclust = FALSE
325 325
         }
326
-        row_reorder = FALSE
326
+        row_hclust_reorder = FALSE
327 327
         if("clustering_distance_columns" %in% called_args) {
328 328
         } else if(inherits(cluster_columns, c("dendrogram", "hclust"))) {
329 329
         } else {
330 330
             cluster_columns = FALSE
331 331
             show_column_hclust = FALSE
332 332
         }
333
-        column_reorder = FALSE
333
+        column_hclust_reorder = FALSE
334 334
         km = 1
335 335
     }
336 336
     .Object@matrix = matrix
... ...
@@ -461,7 +461,7 @@ Heatmap = function(matrix, col, name, na_col = "grey", color_space = "LAB",
461 461
     .Object@row_hclust_param$width = row_hclust_width + unit(1, "mm")  # append the gap
462 462
     .Object@row_hclust_param$show = show_row_hclust
463 463
     .Object@row_hclust_param$gp = check_gp(row_hclust_gp)
464
-    .Object@row_hclust_param$reorder = row_reorder
464
+    .Object@row_hclust_param$reorder = row_hclust_reorder
465 465
     .Object@row_order_list = list() # default order
466 466
     if(is.null(row_order)) {
467 467
         .Object@row_order = seq_len(nrow(matrix))
... ...
@@ -495,7 +495,7 @@ Heatmap = function(matrix, col, name, na_col = "grey", color_space = "LAB",
495 495
     .Object@column_hclust_param$height = column_hclust_height + unit(1, "mm")  # append the gap
496 496
     .Object@column_hclust_param$show = show_column_hclust
497 497
     .Object@column_hclust_param$gp = check_gp(column_hclust_gp)
498
-    .Object@column_hclust_param$reorder = column_reorder
498
+    .Object@column_hclust_param$reorder = column_hclust_reorder
499 499
     if(is.null(column_order)) {
500 500
         .Object@column_order = seq_len(ncol(matrix))
501 501
     } else {
... ...
@@ -81,7 +81,8 @@ HeatmapList = setClass("HeatmapList",
81 81
             layout_annotation_legend_bottom_height = unit(0, "mm"),
82 82
             
83 83
             layout_index = matrix(nrow = 0, ncol = 2),
84
-            graphic_fun_list = list()
84
+            graphic_fun_list = list(),
85
+            initialized = FALSE
85 86
         )
86 87
     ),
87 88
     contains = "AdditiveUnit"
... ...
@@ -210,6 +211,10 @@ setMethod(f = "make_layout",
210 211
     row_hclust_side = c("original", "left", "right"),
211 212
     row_sub_title_side = c("original", "left", "right")) {
212 213
 
214
+    if(object@layout$initialized) {
215
+        return(object)
216
+    }
217
+
213 218
     n = length(object@ht_list)
214 219
     i_main = main_heatmap[1]
215 220
 
... ...
@@ -542,6 +547,8 @@ setMethod(f = "make_layout",
542 547
         }
543 548
     }
544 549
 
550
+    object@layout$initialized = TRUE
551
+
545 552
     return(object)
546 553
 })
547 554
 
... ...
@@ -607,23 +614,14 @@ setMethod(f = "draw",
607 614
 
608 615
     upViewport()
609 616
 
610
-    # return a list of orders
611
-    n = length(object@ht_list)
612
-    dend_list = vector("list", n)
613
-    names(dend_list) = sapply(object@ht_list, function(ht) ht@name)
617
+    .LAST_HT_LIST$object = object
614 618
 
615
-    for(i in seq_len(n)) {
616
-        dend_list[[i]] = list(row = NULL, column = NULL)
617
-        if(inherits(object@ht_list[[i]], "HeatmapAnnotation")) {
618
-        } else {
619
-            dend_list[[i]]$column = object@ht_list[[i]]@column_hclust
620
-            dend_list[[i]]$row = object@ht_list[[i]]@row_hclust_list
621
-        }
622
-    }
623 619
 
624
-    return(invisible(dend_list))
620
+    return(invisible(object))
625 621
 })
626 622
 
623
+.LAST_HT_LIST = new.env()
624
+
627 625
 # == title
628 626
 # Width of each heatmap list component
629 627
 #
... ...
@@ -28,6 +28,8 @@ decorate_heatmap_body = function(heatmap, code = {}, slice = 1) {
28 28
 	seekViewport(vp_name)
29 29
 	e = new.env(parent = parent.frame())
30 30
 	eval(substitute(code), envir = e)
31
+
32
+	seekViewport("global")
31 33
 }
32 34
 
33 35
 # == title
... ...
@@ -66,6 +68,8 @@ decorate_hclust = function(heatmap, code, slice = 1, which = c("column", "row"))
66 68
 	seekViewport(vp_name)
67 69
 	e = new.env(parent = parent.frame())
68 70
 	eval(substitute(code), envir = e)
71
+
72
+	seekViewport("global")
69 73
 }
70 74
 
71 75
 # == title
... ...
@@ -135,6 +139,7 @@ decorate_dimnames = function(heatmap, code, slice = 1, which = c("column", "row"
135 139
 	seekViewport(vp_name)
136 140
 	e = new.env(parent = parent.frame())
137 141
 	eval(substitute(code), envir = e)
142
+	seekViewport("global")
138 143
 }
139 144
 
140 145
 # == title
... ...
@@ -200,6 +205,7 @@ decorate_title = function(heatmap, code, slice = 1, which = c("column", "row"))
200 205
 	seekViewport(vp_name)
201 206
 	e = new.env(parent = parent.frame())
202 207
 	eval(substitute(code), envir = e)
208
+	seekViewport("global")
203 209
 }
204 210
 
205 211
 # == title
... ...
@@ -279,5 +285,6 @@ decorate_annotation = function(annotation, code, slice = NULL) {
279 285
 
280 286
 	e = new.env(parent = parent.frame())
281 287
 	eval(substitute(code), envir = e)
288
+	seekViewport("global")
282 289
 }
283 290
 
284 291
new file mode 100644
... ...
@@ -0,0 +1,194 @@
1
+
2
+# == title
3
+# Get row order from a heatmap list
4
+#
5
+# == param
6
+# -object a `HeatmapList-class` object
7
+#
8
+# == value
9
+# A list contains row orders which correspond to the original matrix
10
+#
11
+setMethod(f = "row_order",
12
+	signature = "HeatmapList",
13
+	definition = function(object) {
14
+
15
+	object = make_layout(object)
16
+
17
+	n = length(object@ht_list)
18
+	for(i in seq_len(n)) {
19
+        if(inherits(object@ht_list[[i]], "Heatmap")) {
20
+        	lt = object@ht_list[[i]]@row_order_list
21
+        	names(lt) = object@ht_list[[i]]@row_title
22
+        	return(lt)
23
+        }
24
+    }
25
+
26
+    return(NULL)
27
+	
28
+})
29
+
30
+# == title
31
+# Get row order from a heatmap
32
+#
33
+# == param
34
+# -object a `Heatmap-class` object
35
+#
36
+# == value
37
+# A list contains row orders which correspond to the original matrix
38
+#
39
+setMethod(f = "row_order",
40
+	signature = "Heatmap",
41
+	definition = function(object) {
42
+
43
+	object = prepare(object)
44
+
45
+	lt = object@row_order_list
46
+	names(lt) = object@row_title
47
+	return(lt)
48
+	
49
+})
50
+
51
+# == title
52
+# Get column order from a heatmap list
53
+#
54
+# == param
55
+# -object a `HeatmapList-class` object
56
+#
57
+# == value
58
+# A list contains column orders which correspond every matrix
59
+#
60
+setMethod(f = "column_order",
61
+	signature = "HeatmapList",
62
+	definition = function(object) {
63
+
64
+	object = make_layout(object)
65
+
66
+    n = length(object@ht_list)
67
+    order_list = vector("list", n)
68
+    names(order_list) = sapply(object@ht_list, function(ht) ht@name)
69
+
70
+    for(i in seq_len(n)) {
71
+        if(inherits(object@ht_list[[i]], "HeatmapAnnotation")) {
72
+        } else {
73
+            order_list[[i]] = object@ht_list[[i]]@column_order
74
+        }
75
+    }
76
+
77
+    return(order_list)
78
+
79
+})
80
+
81
+# == title
82
+# Get column order from a heatmap list
83
+#
84
+# == param
85
+# -object a `Heatmap-class` object
86
+#
87
+# == value
88
+# A vector containing column orders
89
+#
90
+setMethod(f = "column_order",
91
+	signature = "Heatmap",
92
+	definition = function(object) {
93
+
94
+	object = prepare(object)
95
+
96
+	return(object@column_order)
97
+	
98
+})
99
+
100
+# == title
101
+# Get row dendrograms from a heatmap list
102
+#
103
+# == param
104
+# -object a `HeatmapList-class` object
105
+# 
106
+# == value
107
+# A list of dendrograms for which each dendrogram corresponds to a row slice
108
+#
109
+setMethod(f = "row_dend",
110
+	signature = "HeatmapList",
111
+	definition = function(object) {
112
+
113
+	object = make_layout(object)
114
+
115
+	n = length(object@ht_list)
116
+    for(i in seq_len(n)) {
117
+        if(inherits(object@ht_list[[i]], "Heatmap")) {
118
+        	lt = object@ht_list[[i]]@row_hclust_list
119
+        	names(lt) = object@ht_list[[i]]@row_title
120
+        	return(lt)
121
+        }
122
+    }
123
+
124
+    return(NULL)
125
+})
126
+
127
+# == title
128
+# Get row dendrograms from a heatmap
129
+#
130
+# == param
131
+# -object a `HeatmapList` object
132
+# 
133
+# == value
134
+# A list of dendrograms for which each dendrogram corresponds to a row slice
135
+#
136
+setMethod(f = "row_dend",
137
+	signature = "Heatmap",
138
+	definition = function(object) {
139
+
140
+	object = prepare(object)
141
+
142
+	lt = object@row_hclust_list
143
+	names(lt) = object@row_title
144
+	return(lt)
145
+})
146
+
147
+# == title
148
+# Get column dendrograms from a heatmap list
149
+#
150
+# == param
151
+# -object a `HeatmapList-class` object
152
+# 
153
+# == value
154
+# A list of dendrograms for which dendrogram corresponds to each matrix
155
+#
156
+setMethod(f = "column_dend",
157
+	signature = "HeatmapList",
158
+	definition = function(object) {
159
+
160
+	object = make_layout(object)
161
+
162
+	# return a list of orders
163
+    n = length(object@ht_list)
164
+    dend_list = vector("list", n)
165
+    names(dend_list) = sapply(object@ht_list, function(ht) ht@name)
166
+
167
+    for(i in seq_len(n)) {
168
+        if(inherits(object@ht_list[[i]], "HeatmapAnnotation")) {
169
+        } else {
170
+            dend_list[[i]] = object@ht_list[[i]]@column_hclust
171
+        }
172
+    }
173
+
174
+    return(dend_list)
175
+})
176
+
177
+# == title
178
+# Get column dendrograms from a heatmap
179
+#
180
+# == param
181
+# -object a `Heatmap-class` object
182
+# 
183
+# == value
184
+# A dendrogram object
185
+#
186
+setMethod(f = "column_dend",
187
+	signature = "Heatmap",
188
+	definition = function(object) {
189
+
190
+	object = prepare(object)
191
+
192
+	return(object@column_hclust)
193
+})
194
+
... ...
@@ -17,6 +17,7 @@
17 17
 # -row_barplot_width width of barplot annotation on rows. It should be a `grid::unit` object
18 18
 # -show_column_barplot whether show barplot annotation on columns
19 19
 # -column_barplot_height height of barplot annotatioin on columns. it should be a `grid::unit` object.
20
+# -remove_empty_columns if there is no alteration in that sample, whether remove it on the heatmap
20 21
 # -... pass to `Heatmap`
21 22
 #
22 23
 # == details
... ...
@@ -35,6 +36,7 @@ oncoPrint = function(mat, get_type = function(x) x,
35 36
 	pct_gp = gpar(), axis_gp = gpar(fontsize = 8), 
36 37
 	show_row_barplot = TRUE, row_barplot_width = unit(2, "cm"),
37 38
 	show_column_barplot = TRUE, column_barplot_height = unit(2, "cm"),
39
+	remove_empty_columns = TRUE,
38 40
 	...) {
39 41
 	
40 42
 	# convert mat to mat_list
... ...
@@ -77,8 +79,10 @@ oncoPrint = function(mat, get_type = function(x) x,
77 79
 		arr[, , i] = mat_list[[i]]
78 80
 	}
79 81
 
80
-	l = rowSums(apply(arr, c(2, 3), sum)) > 0
81
-	arr = arr[, l, , drop = FALSE]
82
+	if(remove_empty_columns) {
83
+		l = rowSums(apply(arr, c(2, 3), sum)) > 0
84
+		arr = arr[, l, , drop = FALSE]
85
+	}
82 86
 
83 87
 	# validate alter_fun_list
84 88
 	if(is.null(alter_fun_list$background)) alter_fun_list$background = function(x, y, w, h) grid.rect(x, y, w, h, gp = gpar(fill = "#CCCCCC", col = NA))
85 89
new file mode 100644
... ...
@@ -0,0 +1,152 @@
1
+
2
+# == title
3
+# Select a region in the heatmap
4
+#
5
+# == param
6
+# -mark whether show the rectangular selected region
7
+#
8
+# == details
9
+# Users can use mouse to click two positions on the heatmap, the function
10
+# will return the row index and column index for the selected region in the selected matrix.
11
+# 
12
+select_region = function(mark = FALSE) {
13
+
14
+	if(!interactive()) {
15
+		stop("`select()` can only be used under interactive mode.")
16
+	}
17
+
18
+	x = dev.cur()
19
+	if(! (names(x) %in% c("quartz", "X11", "windows", "JavaGD", "CairoX11", "CairoWin")) ) {
20
+		stop("Can not detect any interactive graphic device.")
21
+	}
22
+
23
+	seekViewport("main_heatmap_list")
24
+
25
+	cat("Click two positions on the heatmap:\n")
26
+	pos1 = grid.locator(unit = "mm")
27
+	cat("  x:", sprintf("%.1f", pos1$x), "mm, y:", sprintf("%.1f", pos1$y), "mm\n")
28
+	pos2 = grid.locator(unit = "mm")
29
+	cat("  x:", sprintf("%.1f", pos2$x), "mm, y:", sprintf("%.1f", pos2$y), "mm\n")
30
+
31
+	# pos1 is always at bottom left
32
+	# pos2 is always at top right
33
+	if(compare_width(pos1$x, pos2$x) > 0) {
34
+		tmp = pos2$x
35
+		pos2$x = pos1$x
36
+		pos1$x = tmp
37
+	}
38
+
39
+	if(compare_height(pos1$y, pos2$y) > 0) {
40
+		tmp = pos2$y
41
+		pos2$y = pos1$y
42
+		pos1$y = tmp
43
+	}
44
+
45
+	for(i in seq_along(.LAST_HT_LIST$object@ht_list)) {
46
+		if(inherits(.LAST_HT_LIST$object@ht_list[[i]], "Heatmap")) {
47
+			ht = .LAST_HT_LIST$object@ht_list[[i]]
48
+			ht_name = ht@name
49
+			
50
+			seekViewport(qq("heatmap_@{ht_name}", code.pattern = "@\\{CODE\\}"))
51
+			vp = current.viewport()
52
+
53
+			pos1_cp = list()
54
+			pos2_cp = list()
55
+
56
+			# relative to current heatmap body
57
+			pos1_cp$x = pos1$x - convertWidth(vp$x, "mm") - sum(component_width(ht, 1:3))
58
+			pos1_cp$y = pos1$y - convertHeight(vp$y, "mm") - sum(component_height(ht, 6:9))
59
+			pos2_cp$x = pos2$x - convertWidth(vp$x, "mm") - sum(component_width(ht, 1:3))
60
+			pos2_cp$y = pos2$y - convertHeight(vp$y, "mm") - sum(component_height(ht, 6:9))
61
+
62
+			pos1_cp$x = convertWidth(pos1_cp$x, "mm")
63
+			pos1_cp$y = convertHeight(pos1_cp$y, "mm")
64
+			pos2_cp$x = convertWidth(pos2_cp$x, "mm")
65
+			pos2_cp$y = convertHeight(pos2_cp$y, "mm")
66
+
67
+			for(i in seq_along(ht@row_order_list)) {
68
+				
69
+				pos1_cp2 = list()
70
+				pos2_cp2 = list()
71
+
72
+				seekViewport(qq("@{ht_name}_heatmap_body_@{i}"))
73
+				vp2 = current.viewport()
74
+				pos1_cp2$x = pos1_cp$x
75
+				pos1_cp2$y = pos1_cp$y - (vp2$y - vp2$height)
76
+				pos2_cp2$x = pos2_cp$x
77
+				pos2_cp2$y = pos2_cp$y - (vp2$y - vp2$height)
78
+
79
+				pos1_cp2$x = convertWidth(pos1_cp2$x, "mm")
80
+				pos1_cp2$y = convertHeight(pos1_cp2$y, "mm")
81
+				pos2_cp2$x = convertWidth(pos2_cp2$x, "mm")
82
+				pos2_cp2$y = convertHeight(pos2_cp2$y, "mm")
83
+			
84
+				# test whether two clicks are in one heatmap body
85
+				if(compare_width(pos1_cp2$x) < 0 || compare_height(pos1_cp2$y) < 0 ||
86
+				   compare_width(pos2_cp2$x) < 0 || compare_height(pos2_cp2$y) < 0 ||
87
+				   compare_width(pos1_cp2$x, vp2$width) > 0 || compare_width(pos2_cp2$x, vp2$width) > 0 ||
88
+				   compare_height(pos1_cp2$y, vp2$height) > 0 || compare_height(pos2_cp2$y, vp2$height) > 0) {
89
+					
90
+				} else {
91
+					# extract row index and column index
92
+					# be careful with row slices
93
+					ht_width = convertWidth(vp2$width, "mm")
94
+					ht_height = convertHeight(vp2$height, "mm")
95
+
96
+					res = list()
97
+
98
+					nc = length(ht@column_order)
99
+
100
+					x1 = ceiling(as.numeric(pos1_cp2$x) / as.numeric(ht_width) * nc)
101
+					x2 = ceiling(as.numeric(pos2_cp2$x) / as.numeric(ht_width) * nc)
102
+
103
+					res$column_order = ht@column_order[x1:x2]
104
+
105
+					nr = length(ht@row_order_list[[i]])
106
+
107
+					y1 = 1 +nr - ceiling(as.numeric(pos1_cp2$y) / as.numeric(ht_height) * nr)
108
+					y2 = 1 + nr - ceiling(as.numeric(pos2_cp2$y) / as.numeric(ht_height) * nr)
109
+
110
+					res$row_order = ht@row_order_list[[i]][y2:y1]
111
+
112
+					if(mark) {
113
+						grid.rect( (pos1_cp2$x + pos2_cp2$x)*0.5, (pos1_cp2$y + pos2_cp2$y)*0.5,
114
+							       abs_unit(pos2_cp2$x - pos1_cp2$x), abs_unit(pos2_cp2$y - pos1_cp2$y) )
115
+					}
116
+
117
+					return(res)
118
+				}
119
+			}
120
+		} else {
121
+			stop("Do not click into row annotation regions.\n")
122
+		}
123
+	}
124
+
125
+	cat("\nTwo clicks should be in one same heatmap (or slice) region.\n\n")
126
+	select_region()
127
+
128
+}
129
+
130
+compare_width = function(u1, u2 = unit(0, "mm")) {
131
+
132
+	u1 = convertWidth(u1, "mm", valueOnly = TRUE)
133
+	u2 = convertWidth(u2, "mm", valueOnly = TRUE)
134
+
135
+	ifelse(u1 > u2, 1, ifelse(u1 < u2, -1, 0))
136
+}
137
+
138
+
139
+compare_height = function(u1, u2 = unit(0, "mm")) {
140
+
141
+	u1 = convertHeight(u1, "mm", valueOnly = TRUE)
142
+	u2 = convertHeight(u2, "mm", valueOnly = TRUE)
143
+
144
+	ifelse(u1 > u2, 1, ifelse(u1 < u2, -1, 0))
145
+}
146
+
147
+abs_unit = function(u) {
148
+	if(compare_unit(u) < 0) u = -1*u
149
+	return(u)
150
+}
151
+
152
+
... ...
@@ -39,6 +39,7 @@ increase_color_mapping_index = function() {
39 39
     INDEX_ENV$I_COLOR_MAPPING = INDEX_ENV$I_COLOR_MAPPING + 1
40 40
 }
41 41
 
42
+
42 43
 # default colors for matrix or annotations
43 44
 # this function should be improved later
44 45
 default_col = function(x, main_matrix = FALSE) {
... ...
@@ -17,12 +17,12 @@ Heatmap(matrix, col, name, na_col = "grey", color_space = "LAB",
17 17
     cluster_rows = TRUE, clustering_distance_rows = "euclidean",
18 18
     clustering_method_rows = "complete", row_hclust_side = c("left", "right"),
19 19
     row_hclust_width = unit(10, "mm"), show_row_hclust = TRUE,
20
-    row_reorder = FALSE,
20
+    row_hclust_reorder = FALSE,
21 21
     row_hclust_gp = gpar(), cluster_columns = TRUE,
22 22
     clustering_distance_columns = "euclidean", clustering_method_columns = "complete",
23 23
     column_hclust_side = c("top", "bottom"), column_hclust_height = unit(10, "mm"),
24 24
     show_column_hclust = TRUE, column_hclust_gp = gpar(),
25
-    column_reorder = FALSE,
25
+    column_hclust_reorder = FALSE,
26 26
     row_order = NULL, column_order = NULL,
27 27
     row_names_side = c("right", "left"), show_row_names = TRUE,
28 28
     row_names_max_width = unit(4, "cm"), row_names_gp = gpar(fontsize = 12),
... ...
@@ -73,13 +73,13 @@ Heatmap(matrix, col, name, na_col = "grey", color_space = "LAB",
73 73
   \item{column_order}{order of column. It makes it easy to adjust column order for both matrix and column annotations.}
74 74
   \item{row_names_side}{should the row names be put on the left or right of the heatmap?}
75 75
   \item{show_row_names}{whether show row names.}
76
-  \item{row_reorder}{apply reordering on rows. The value can be a logical value or a vector which contains weight which is used to reorder rows}
76
+  \item{row_hclust_reorder}{apply reordering on rows. The value can be a logical value or a vector which contains weight which is used to reorder rows}
77 77
   \item{row_names_max_width}{maximum width of row names viewport. Because some times row names can be very long, it is not reasonableto show them all.}
78 78
   \item{row_names_gp}{graphic parameters for drawing text.}
79 79
   \item{column_names_side}{should the column names be put on the top or bottom of the heatmap?}
80 80
   \item{column_names_max_height}{maximum height of column names viewport.}
81 81
   \item{show_column_names}{whether show column names.}
82
-  \item{column_reorder}{apply reordering on columns. The value can be a logical value or a vector which contains weight which is used to reorder columns}
82
+  \item{column_hclust_reorder}{apply reordering on columns. The value can be a logical value or a vector which contains weight which is used to reorder columns}
83 83
   \item{column_names_gp}{graphic parameters for drawing text.}
84 84
   \item{top_annotation}{a \code{\link{HeatmapAnnotation}} object which contains a list of annotations.}
85 85
   \item{top_annotation_height}{total height of the column annotations on the top.}
86 86
new file mode 100644
... ...
@@ -0,0 +1,19 @@
1
+\name{column_dend-Heatmap-method}
2
+\alias{column_dend,Heatmap-method}
3
+\title{
4
+Get column dendrograms from a heatmap
5
+}
6
+\description{
7
+Get column dendrograms from a heatmap
8
+}
9
+\usage{
10
+\S4method{column_dend}{Heatmap}(object)
11
+}
12
+\arguments{
13
+
14
+  \item{object}{a \code{\link{Heatmap-class}} object}
15
+
16
+}
17
+\value{
18
+A dendrogram object
19
+}
0 20
new file mode 100644
... ...
@@ -0,0 +1,19 @@
1
+\name{column_dend-HeatmapList-method}
2
+\alias{column_dend,HeatmapList-method}
3
+\title{
4
+Get column dendrograms from a heatmap list
5
+}
6
+\description{
7
+Get column dendrograms from a heatmap list
8
+}
9
+\usage{
10
+\S4method{column_dend}{HeatmapList}(object)
11
+}
12
+\arguments{
13
+
14
+  \item{object}{a \code{\link{HeatmapList-class}} object}
15
+
16
+}
17
+\value{
18
+A list of dendrograms for which dendrogram corresponds to each matrix
19
+}
0 20
new file mode 100644
... ...
@@ -0,0 +1,22 @@
1
+\name{column_dend-dispatch}
2
+\alias{column_dend}
3
+\title{
4
+Method dispatch page for column_dend
5
+}
6
+\description{
7
+Method dispatch page for \code{column_dend}.
8
+}
9
+\section{Dispatch}{
10
+\code{column_dend} can be dispatched on following classes:
11
+
12
+\itemize{
13
+\item \code{\link{column_dend,HeatmapList-method}}, \code{\link{HeatmapList-class}} class method
14
+\item \code{\link{column_dend,Heatmap-method}}, \code{\link{Heatmap-class}} class method
15
+}
16
+}
17
+\examples{
18
+# no example
19
+NULL
20
+
21
+
22
+}
0 23
new file mode 100644
... ...
@@ -0,0 +1,19 @@
1
+\name{column_order-Heatmap-method}
2
+\alias{column_order,Heatmap-method}
3
+\title{
4
+Get column order from a heatmap list
5
+}
6
+\description{
7
+Get column order from a heatmap list
8
+}
9
+\usage{
10
+\S4method{column_order}{Heatmap}(object)
11
+}
12
+\arguments{
13
+
14
+  \item{object}{a \code{\link{Heatmap-class}} object}
15
+
16
+}
17
+\value{
18
+A vector containing column orders
19
+}
0 20
new file mode 100644
... ...
@@ -0,0 +1,19 @@
1
+\name{column_order-HeatmapList-method}
2
+\alias{column_order,HeatmapList-method}
3
+\title{
4
+Get column order from a heatmap list
5
+}
6
+\description{
7
+Get column order from a heatmap list
8
+}
9
+\usage{
10
+\S4method{column_order}{HeatmapList}(object)
11
+}
12
+\arguments{
13
+
14
+  \item{object}{a \code{\link{HeatmapList-class}} object}
15
+
16
+}
17
+\value{
18
+A list contains column orders which correspond every matrix
19
+}
0 20
new file mode 100644
... ...
@@ -0,0 +1,22 @@
1
+\name{column_order-dispatch}
2
+\alias{column_order}
3
+\title{
4
+Method dispatch page for column_order
5
+}
6
+\description{
7
+Method dispatch page for \code{column_order}.
8
+}
9
+\section{Dispatch}{
10
+\code{column_order} can be dispatched on following classes:
11
+
12
+\itemize{
13
+\item \code{\link{column_order,HeatmapList-method}}, \code{\link{HeatmapList-class}} class method
14
+\item \code{\link{column_order,Heatmap-method}}, \code{\link{Heatmap-class}} class method
15
+}
16
+}
17
+\examples{
18
+# no example
19
+NULL
20
+
21
+
22
+}
... ...
@@ -12,6 +12,7 @@ oncoPrint(mat, get_type = function(x) x,
12 12
     pct_gp = gpar(), axis_gp = gpar(fontsize = 8),
13 13
     show_row_barplot = TRUE, row_barplot_width = unit(2, "cm"),
14 14
     show_column_barplot = TRUE, column_barplot_height = unit(2, "cm"),
15
+    remove_empty_columns = TRUE,
15 16
     ...)
16 17
 }
17 18
 \arguments{
... ...
@@ -27,6 +28,7 @@ oncoPrint(mat, get_type = function(x) x,
27 28
   \item{row_barplot_width}{width of barplot annotation on rows. It should be a \code{\link[grid]{unit}} object}
28 29
   \item{show_column_barplot}{whether show barplot annotation on columns}
29 30
   \item{column_barplot_height}{height of barplot annotatioin on columns. it should be a \code{\link[grid]{unit}} object.}
31
+  \item{remove_empty_columns}{if there is no alteration in that sample, whether remove it on the heatmap}
30 32
   \item{...}{pass to \code{\link{Heatmap}}}
31 33
 
32 34
 }
33 35
new file mode 100644
... ...
@@ -0,0 +1,19 @@
1
+\name{row_dend-Heatmap-method}
2
+\alias{row_dend,Heatmap-method}
3
+\title{
4
+Get row dendrograms from a heatmap
5
+}
6
+\description{
7
+Get row dendrograms from a heatmap
8
+}
9
+\usage{
10
+\S4method{row_dend}{Heatmap}(object)
11
+}
12
+\arguments{
13
+
14
+  \item{object}{a \code{\link{HeatmapList}} object}
15
+
16
+}
17
+\value{
18
+A list of dendrograms for which each dendrogram corresponds to a row slice
19
+}
0 20
new file mode 100644
... ...
@@ -0,0 +1,19 @@
1
+\name{row_dend-HeatmapList-method}
2
+\alias{row_dend,HeatmapList-method}
3
+\title{
4
+Get row dendrograms from a heatmap list
5
+}
6
+\description{
7
+Get row dendrograms from a heatmap list
8
+}
9
+\usage{
10
+\S4method{row_dend}{HeatmapList}(object)
11
+}
12
+\arguments{
13
+
14
+  \item{object}{a \code{\link{HeatmapList-class}} object}
15
+
16
+}
17
+\value{
18
+A list of dendrograms for which each dendrogram corresponds to a row slice
19
+}
0 20
new file mode 100644
... ...
@@ -0,0 +1,22 @@
1
+\name{row_dend-dispatch}
2
+\alias{row_dend}
3
+\title{
4
+Method dispatch page for row_dend
5
+}
6
+\description{
7
+Method dispatch page for \code{row_dend}.
8
+}
9
+\section{Dispatch}{
10
+\code{row_dend} can be dispatched on following classes:
11
+
12
+\itemize{
13
+\item \code{\link{row_dend,HeatmapList-method}}, \code{\link{HeatmapList-class}} class method
14
+\item \code{\link{row_dend,Heatmap-method}}, \code{\link{Heatmap-class}} class method
15
+}
16
+}
17
+\examples{
18
+# no example
19
+NULL
20
+
21
+
22
+}
0 23
new file mode 100644
... ...
@@ -0,0 +1,19 @@
1
+\name{row_order-Heatmap-method}
2
+\alias{row_order,Heatmap-method}
3
+\title{
4
+Get row order from a heatmap
5
+}
6
+\description{
7
+Get row order from a heatmap
8
+}
9
+\usage{
10
+\S4method{row_order}{Heatmap}(object)
11
+}
12
+\arguments{
13
+
14
+  \item{object}{a \code{\link{Heatmap-class}} object}
15
+
16
+}
17
+\value{
18
+A list contains row orders which correspond to the original matrix
19
+}
0 20
new file mode 100644
... ...
@@ -0,0 +1,19 @@
1
+\name{row_order-HeatmapList-method}
2
+\alias{row_order,HeatmapList-method}
3
+\title{
4
+Get row order from a heatmap list
5
+}
6
+\description{
7
+Get row order from a heatmap list
8
+}
9
+\usage{
10
+\S4method{row_order}{HeatmapList}(object)
11
+}
12
+\arguments{
13
+
14
+  \item{object}{a \code{\link{HeatmapList-class}} object}
15
+
16
+}
17
+\value{
18
+A list contains row orders which correspond to the original matrix
19
+}
0 20
new file mode 100644
... ...
@@ -0,0 +1,22 @@
1
+\name{row_order-dispatch}
2
+\alias{row_order}
3
+\title{
4
+Method dispatch page for row_order
5
+}
6
+\description{
7
+Method dispatch page for \code{row_order}.
8
+}
9
+\section{Dispatch}{
10
+\code{row_order} can be dispatched on following classes:
11
+
12
+\itemize{
13
+\item \code{\link{row_order,HeatmapList-method}}, \code{\link{HeatmapList-class}} class method
14
+\item \code{\link{row_order,Heatmap-method}}, \code{\link{Heatmap-class}} class method
15
+}
16
+}
17
+\examples{
18
+# no example
19
+NULL
20
+
21
+
22
+}
0 23
new file mode 100644
... ...
@@ -0,0 +1,20 @@
1
+\name{select_region}
2
+\alias{select_region}
3
+\title{
4
+Select a region in the heatmap
5
+}
6
+\description{
7
+Select a region in the heatmap
8
+}
9
+\usage{
10
+select_region(mark = FALSE)
11
+}
12
+\arguments{
13
+
14
+  \item{mark}{whether show the rectangular selected region}
15
+
16
+}
17
+\details{
18
+Users can use mouse to click two positions on the heatmap, the function
19
+will return the row index and column index for the selected region in the selected matrix.
20
+}
... ...
@@ -293,27 +293,29 @@ Heatmap(mat, name = "foo", cluster_rows = as.dendrogram(diana(mat)),
293 293
    cluster_columns = as.dendrogram(agnes(t(mat))))
294 294
 ```
295 295
 
296
-By default, dendrograms on row and on column are reordered to let features with larger different
297
-separated more from each other (to behave same as the native `heatmap()`). 
298
-You can first generate a dendrogram and apply other reordering
299
-method. But remember you need to set `row_reorder` to `FALSE` to turn off the default reordering.
296
+In the native `heatmap()` function, dendrograms on row and on column are reordered to let features with larger different
297
+separated more from each other, but according to my experience, the default reordering can not always give nice visualization.
298
+So the reordering for the dendrograms are turned off for `Heatmap()` function. 
299
+
300
+Besides the default reordering method, you can first generate a dendrogram and apply other reordering
301
+method and then send the reordered dendrogram to `cluster_rows` argument. 
300 302
 
301 303
 Compare following three plots:
302 304
 
303 305
 ```{r cluster_dendsort, fig.width = 14}
304 306
 pushViewport(viewport(layout = grid.layout(nr = 1, nc = 3)))
305 307
 pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 1))
306
-draw(Heatmap(mat, name = "foo", row_reorder = FALSE, column_title = "no reordering"), newpage = FALSE)
308
+draw(Heatmap(mat, name = "foo", row_hclust_reorder = FALSE, column_title = "no reordering"), newpage = FALSE)
307 309
 upViewport()
308 310
 
309 311
 pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 2))
310
-draw(Heatmap(mat, name = "foo", column_title = "default reordering"), newpage = FALSE)
312
+draw(Heatmap(mat, name = "foo", row_hclust_reorder = TRUE, column_title = "default reordering"), newpage = FALSE)
311 313
 upViewport()
312 314
 
313 315
 library(dendsort)
314 316
 dend = dendsort(hclust(dist(mat)))
315 317
 pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 3))
316
-draw(Heatmap(mat, name = "foo", cluster_rows = dend, row_reorder = FALSE, 
318
+draw(Heatmap(mat, name = "foo", cluster_rows = dend, row_hclust_reorder = FALSE, 
317 319
     column_title = "reordering by dendsort"), newpage = FALSE)
318 320
 upViewport(2)
319 321
 ```
... ...
@@ -70,7 +70,7 @@ From left to right, heatmaps are:
70 70
 8. overlapping between DMRs and enhancers (Color shows how much the DMR is covered by the enhancers).
71 71
 
72 72
 
73
-```{r, echo = FALSE, fig.width = 10, fig.height = 8}
73
+```{r, fig.width = 10, fig.height = 8}
74 74
 library(circlize)
75 75
 library(RColorBrewer)
76 76
 
... ...
@@ -151,7 +151,8 @@ for colors for continous values.
151 151
 
152 152
 ```{r}
153 153
 Heatmap(mat, col = topo.colors(50), row_hclust_width = unit(2, "cm"), 
154
-    column_hclust_height = unit(2, "cm"))
154
+    column_hclust_height = unit(2, "cm"), row_hclust_reorder = TRUE,
155
+    column_hclust_reorder = TRUE)
155 156
 ```
156 157
 
157 158
 ## The measles vaccine heatmap