1. ComplexHeatmap
  2. Commit 81f0e1ff09cdb6ac6fd6588e0cbde403b48cad08
Browse code

add documentations

jokergoo authored on 14/02/2015 23:56:05
Showing 42 changed files
DESCRIPTION
History View file @ 81f0e1f
1 1 
new file mode 100644
... ... 
@@ -0,0 +1,18 @@
1 
+Package: mheatmap
2 
+Type: Package
3 
+Title: plot multiple heatmaps
4 
+Version: 0.99.0
5 
+Date: 2014-10-6
6 
+Author: Zuguang Gu
7 
+Maintainer: Zuguang Gu <z.gu@dkfz.de>
8 
+Depends: R (>= 3.1.0), methods, grid
9 
+Imports: circlize (>= 0.2.3), GetoptLong, RColorBrewer
10 
+Suggests: testthat (>= 0.3), knitr
11 
+VignetteBuilder: knitr
12 
+Description: plot multiple heatmaps
13 
+biocViews: Software, Visualization, Sequencing
14 
+URL: https://github.com/jokergoo/mheatmap
15 
+License: GPL (>= 2)
16 
+Packaged: 2014-10-6 00:00:00 UTC; Administrator
17 
+Repository: Bioconductor
18 
+Date/Publication: 2014-10-6 00:00:00
NAMESPACE
History View file @ 81f0e1f
0 19 
new file mode 100644
... ... 
@@ -0,0 +1,34 @@
1 
+exportMethods(draw_annotation_legend)
2 
+exportMethods(component_height)
3 
+exportClasses(ColorMapping)
4 
+exportMethods(draw_hclust)
5 
+exportMethods(make_layout)
6 
+exportMethods(draw_annotation)
7 
+exportMethods(draw_dimnames)
8 
+exportClasses(Heatmap)
9 
+exportMethods(annotation_legend_size)
10 
+export("+.Heatmap")
11 
+exportClasses(HeatmapList)
12 
+exportMethods(legend)
13 
+exportMethods(component_width)
14 
+exportMethods(draw_heatmap_list)
15 
+export(dist2)
16 
+exportMethods(map)
17 
+exportMethods(draw_title)
18 
+exportMethods(draw)
19 
+exportMethods(draw_heatmap_legend)
20 
+exportMethods(draw_heatmap_body)
21 
+exportMethods(add_heatmap)
22 
+exportMethods(initialize)
23 
+exportMethods(heatmap_legend_size)
24 
+export("+.HeatmapList")
25 
+
26 
+import(grid)
27 
+import(methods)
28 
+importFrom("RColorBrewer", brewer.pal)
29 
+importFrom("circlize", colorRamp2)
30 
+importFrom("circlize", rand_color)
31 
+importFrom("GetoptLong", qq)
32 
+importFrom("GetoptLong", qqcat)
33 
+importFrom("GetoptLong", qq.options)
34 
+
R/00generic_methods.R
History View file @ 81f0e1f
0 35 
new file mode 100644
... ... 
@@ -0,0 +1,49 @@
1 
+
2 
+set_generic_functions = function(fname) {
3 
+
4 
+	op = qq.options(READ.ONLY = FALSE)
5 
+    on.exit(qq.options(op))
6 
+    qq.options(code.pattern = "@\\{CODE\\}")
7 
+
8 
+	for(f in unique(fname)) {
9 
+
10 
+		eval(parse(text = qq("
11 
+if(!isGeneric('@{f}')) {
12 
+    if(is.function('@{f}')) {
13 
+        fun = @{f}
14 
+    } else {
15 
+        fun = function(object, ...) standardGeneric('@{f}', ...)
16 
+    }
17 
+    setGeneric('@{f}', fun)
18 
+}
19 
+")))
20 
+	}
21 
+}
22 
+
23 
+set_generic_functions(c(
24 
+	"map",
25 
+	"legend",
26 
+
27 
+	"add_heatmap",
28 
+	"draw_heatmap_body",
29 
+	"draw_hclust",
30 
+	"draw_dimnames",
31 
+	"draw_title",
32 
+	"draw_annotation",
33 
+	"component_width",
34 
+	"component_height",
35 
+	"set_component_height",
36 
+	"draw",
37 
+
38 
+	"add_heatmap",
39 
+	"make_layout",
40 
+	"draw",
41 
+	"component_width",
42 
+	"component_height",
43 
+	"draw_heatmap_list",
44 
+	"draw_title",
45 
+	"draw_heatmap_legend",
46 
+	"draw_annotation_legend",
47 
+	"heatmap_legend_size",
48 
+	"annotation_legend_size"
49 
+))
R/colorMapping-class.R
History View file @ 81f0e1f
... ... 
@@ -1,13 +1,34 @@
1 1
2 2 
 #####################################
3 
-# class to map values to colors
3 
+# class and methods to map values to colors
4 4 
 #
5 
-# 1. map values to colors, both discrete and continuous
6 
-# 2. generate a legend which corresponds to color mapping
7 
-# 3. return the size of the legend
8 5
9 
-ColorMapping = setRefClass("ColorMapping",
10 
-	fields = list(
6 
+# == title
7 
+# class to map values to colors
8 
+#
9 
+# == details
10 
+# The `ColorMapping` class can handle color mapping with both discrete values and continuous values.
11 
+#
12 
+# == constructor
13 
+#
14 
+#     ColorMapping(name, colors = NULL, levels = NULL,
15 
+#         col_fun = NULL, breaks = NULL)
16 
+#
17 
+# -name name for this color mapping
18 
+# -colors discrete colors
19 
+# -levels levels that correspond to ``colors``
20 
+# -col_fun color mapping function that maps continuous values to colors
21 
+# -breaks breaks for the continuous color mapping
22 
+#
23 
+# ``colors`` and ``levels`` are for discrete color mapping, ``col_fun`` and
24 
+# ``breaks`` are for continuous color mapping. If ``col_fun`` is generated from
25 
+# `circlize::colorRamp2`, ``breaks`` does not need to be specified.
26 
+#
27 
+# == author
28 
+# Zuguang Gu <z.gu@dkfz.de>
29 
+#
30 
+ColorMapping = setClass("ColorMapping",
31 
+	slots = list(
11 32 
 		colors  = "character", # a list of colors
12 33 
 		levels  = "character", # levels which colors correspond to
13 34 
 		col_fun = "function", # function to map values to colors
... ... 
@@ -16,8 +37,19 @@ ColorMapping = setRefClass("ColorMapping",
16 37 
 	)
17 38 
 )
18 39
19 
-# constructor
20 
-suppressWarnings(ColorMapping$methods(initialize = function(name, colors = NULL, levels = NULL,
40 
+# == title
41 
+# initialize
42 
+#
43 
+# == param
44 
+# -name name
45 
+# -colors colors
46 
+# -levels levels
47 
+# -col_fun color function
48 
+# -breaks breaks
49 
+#
50 
+setMethod(f = "initialize",
51 
+	signature = "ColorMapping",
52 
+	definition = function(.Object, name, colors = NULL, levels = NULL,
21 53 
 	col_fun = NULL, breaks = NULL) {
22 54
23 55 
 	if(is.null(name)) {
... ... 
@@ -33,10 +65,15 @@ suppressWarnings(ColorMapping$methods(initialize = function(name, colors = NULL,
33 65 
 		if(length(colors) != length(levels)) {
34 66 
 			stop("length of colors and length of levels should be the same.\n")
35 67 
 		}
36 
-		.self$colors = colors
37 
-		.self$levels = levels
38 
-		names(.self$colors) = levels
39 
-		.self$type = "discrete"
68 
+		.Object@colors = colors
69 
+		if(is.numeric(levels)) {
70 
+			.Object@levels = as.character(levels)
71 
+			attr(.Object@levels, "numeric") = TRUE
72 
+		} else {
73 
+			.Object@levels = levels
74 
+		}
75 
+		names(.Object@colors) = levels
76 
+		.Object@type = "discrete"
40 77 
 	} else if(!is.null(col_fun)) {
41 78 
 		if(is.null(breaks)) {
42 79 
 			breaks = attr(col_fun, "breaks")
... ... 
@@ -45,52 +82,72 @@ suppressWarnings(ColorMapping$methods(initialize = function(name, colors = NULL,
45 82 
 			}
46 83 
 		}
47 84 
 		le = grid.pretty(range(breaks))
48 
-		.self$colors = col_fun(le)
49 
-		.self$levels = as.character(le)
50 
-		.self$col_fun = col_fun
51 
-		.self$type = "continuous"
85 
+		.Object@colors = col_fun(le)
86 
+		.Object@levels = as.character(le)
87 
+		.Object@col_fun = col_fun
88 
+		.Object@type = "continuous"
52 89 
 	} else {
53 90 
 		stop("initialization failed. Either specify `colors` + `levels` or `col_fun` + `breaks` (optional)\n")
54 91 
 	}
55 92
56 
-	.self$name = name
93 
+	.Object@name = name
57 94
58 
-	return(invisible(.self))
59 
-}))
95 
+	return(.Object)
96 
+})
60 97
61 
-ColorMapping$methods(show = function(x) {
62 
-	if(.self$type == "discrete") {
98 
+setMethod(f = "show",
99 
+	signature = "ColorMapping",
100 
+	definition = function(object) {
101 
+	if(object@type == "discrete") {
63 102 
 		cat("Discrete color mapping:\n")
64 103 
 		cat("levels:\n")
65 
-		print(.self$levels)
104 
+		print(object@levels)
66 105 
 		cat("\n")
67 106 
 		cat("colors:\n")
68 
-		col = .self$colors; names(col) = NULL
107 
+		col = object@colors; names(col) = NULL
69 108 
 		print(col)
70 109 
 		cat("\n")
71 
-	} else if(.self$type == "continuous") {
110 
+	} else if(object@type == "continuous") {
72 111 
 		cat("Continuous color mapping:\n")
73 112 
 		cat("breaks:\n")
74 
-		print(.self$levels)
113 
+		print(object@levels)
75 114 
 		cat("\n")
76 115 
 		cat("colors:\n")
77 
-		col = .self$colors; names(col) = NULL
116 
+		col = object@colors; names(col) = NULL
78 117 
 		print(col)
79 118 
 		cat("\n")
80 119 
 	}
81 120 
 })
82 121
83 
-# map values to colors and keep the attributes (in case it is a matrix)
84 
-ColorMapping$methods(map = function(x) {
122 
+# == title
123 
+# map values to colors
124 
+#
125 
+# == param
126 
+# -object a `ColorMapping` object
127 
+# -x input values
128 
+#
129 
+# == details
130 
+# It maps a vector of values to a vector of colors
131 
+#
132 
+# == value
133 
+# a vector of colors
134 
+#
135 
+# == author
136 
+# Zuguang Gu <z.gu@dkfz.de>
137 
+#
138 
+setMethod(f = "map",
139 
+	signature = "ColorMapping",
140 
+	definition = function(object, x) {
85 141 
 	original_attr = attributes(x)
86 
-	if(.self$type == "discrete") {
87 
-		if(any(! x %in% .self$levels)) {
88 
-			msg = paste0("Cannot map some of the levels:\n", paste(setdiff(x, .self$levels), sep = ", ", collapse = ", "))
142 
+	if(object@type == "discrete") {
143 
+		if(is.numeric(x)) x = as.character(x)
144 
+		if(any(! x %in% object@levels)) {
145 
+			msg = paste0("Cannot map some of the levels:\n", paste(setdiff(x, object@levels), sep = ", ", collapse = ", "))
89 146 
 			stop(msg)
90 147 
 		}
91 
-		x = .self$colors[x]
148 
+		x = object@colors[x]
92 149 
 	} else {
93 
-		x = .self$col_fun(x)
150 
+		x = object@col_fun(x)
94 151 
 	}
95 152
96 153 
 	# keep original attributes, such as dimension
... ... 
@@ -98,36 +155,59 @@ ColorMapping$methods(map = function(x) {
98 155 
 	return(x)
99 156 
 })
100 157
101 
-# add legend to the plot, or just return the size of the legend
102 
-ColorMapping$methods(legend = function(..., plot = TRUE, legend_grid_height = unit(3, "mm"),
103 
-	legend_grid_width = unit(5, "mm"), legend_title_gp = gpar(fontsize = 12),
158 
+
159 
+# == title
160 
+# generate legend based on color mapping
161 
+#
162 
+# == param
163 
+# -object a `ColorMapping` object
164 
+# -... pass to `grid::viewport`
165 
+# -plot whether to plot or just return the size of the legend grob
166 
+# -legend_grid_height height of each legend grid
167 
+# -legend_grid_width width of each legend grid
168 
+# -legend_title_gp graphic parameter for legend title
169 
+# -legend_label_gp graphic parameter for legend label
170 
+#
171 
+# == details
172 
+# This function adds legend to the plot, or just returns the size of the legend.
173 
+#
174 
+# == value
175 
+# A `grid::unit` object with length two.
176 
+#
177 
+# == author
178 
+# Zuguang Gu <z.gu@dkfz.de>
179 
+#
180 
+setMethod(f = "legend",
181 
+	signature = "ColorMapping",
182 
+	definition = function(object, ..., plot = TRUE, legend_grid_height = unit(3, "mm"),
183 
+	legend_grid_width = unit(5, "mm"), legend_title_gp = gpar(fontsize = 10),
104 184 
 	legend_label_gp = gpar(fontsize = 10)) {
105 185
106 186 
 	# add title
107 
-	legend_title_grob = textGrob(.self$name, unit(0, "npc"), unit(1, "npc"), just = c("left", "top"),
187 
+	legend_title_grob = textGrob(object@name, unit(0, "npc"), unit(1, "npc"), just = c("left", "top"),
108 188 
 		gp = legend_title_gp)
109 189 
 	legend_title_height = grobHeight(legend_title_grob)
110 190 
 	legend_title_width = grobWidth(legend_title_grob)
111 191
112 
-	nlevel = length(.self$levels)
192 
+	nlevel = length(object@levels)
113 193 
 	x = unit(rep(0, nlevel), "npc")
114 
-	y = unit(1, "npc") - 1.5*legend_title_height - (0:(nlevel-1))*(legend_grid_height + unit(1, "mm"))
194 
+	y = 1.5*legend_title_height + (0:(nlevel-1))*(legend_grid_height + unit(1, "mm"))
115 195
116 
-	legend_label_max_width = max(do.call("unit.c", lapply(.self$levels, function(x) {
196 
+	legend_label_max_width = max(do.call("unit.c", lapply(object@levels, function(x) {
117 197 
 			grobWidth(textGrob(x, gp = legend_label_gp))
118 198 
 		})))
119 199 
 	vp_width = max(unit.c(legend_title_width,
120 
-				   legend_grid_width + unit(2, "mm") + legend_label_max_width ))
200 
+				   legend_grid_width + unit(1, "mm") + legend_label_max_width ))
121 201 
 	vp_height = legend_title_height*1.5 + nlevel*(legend_grid_height + unit(1, "mm"))
122 202
123 203 
 	if(plot) {
124 
-		pushViewport(viewport(..., width = vp_width, height = vp_height, name = paste0("legend_", .self$name)))
204 
+		pushViewport(viewport(..., width = vp_width, height = vp_height, name = paste0("legend_", object@name)))
125 205
126 
-		grid.text(.self$name, unit(0, "npc"), unit(1, "npc"), just = c("left", "top"),
206 
+		grid.text(object@name, unit(0, "npc"), unit(1, "npc"), just = c("left", "top"),
127 207 
 			gp = legend_title_gp)
128 208 
 		grid.rect(x, y,	width = legend_grid_width, height = legend_grid_height, just = c("left", "top"),
129 
-			gp = gpar(col = NA, fill = .self$colors))
130 
-		grid.text(.self$levels, x + legend_grid_width + unit(2, "mm"), y - legend_grid_height*0.5,
209 
+			gp = gpar(col = NA, fill = object@colors))
210 
+		grid.text(object@levels, x + legend_grid_width + unit(1, "mm"), y - legend_grid_height*0.5,
131 211 
 			just = c("left", "center"), gp = legend_label_gp)
132 212 
 		upViewport()
133 213 
 	}
R/draw_s4.R
History View file @ 81f0e1f
134 214 
deleted file mode 100644
... ... 
@@ -1,19 +0,0 @@
1 
-setGeneric("draw", function(x, ...) {
2 
-	standardGeneric("draw")
3 
-})
4 
-
5 
-setMethod("draw",
6 
-	c(x = "Heatmap"),
7 
-	function(x, ...) {
8 
-		ht_list = new("HeatmapList")
9 
-    	ht_list$add_heatmap(x)
10 
-		ht_list$draw(...)
11 
-	}
12 
-)
13 
-
14 
-setMethod("draw",
15 
-	c(x = "HeatmapList"),
16 
-	function(x, ...) {
17 
-		x$draw(...)
18 
-	}
19 
-)
R/heatmap-class.R
History View file @ 81f0e1f
... ... 
@@ -2,709 +2,975 @@
2 2 
 ###############################
3 3 
 # class for single heatmap
4 4 
 #
5 
-# this class would be a private class. The plotting of heatmap
6 
-# is really taken care by HeatmapList class.
7 
-#
8 
-# the draw method only plots the heatmap body, cluster, annotation and dimnames
9 
-#
5 
+
10 6
11 7 
 # the layout of the heatmap is 7 x 9
12 
-Heatmap = setRefClass("Heatmap",
13 
-    fields = list(
14 
-    	name = "character",
15 
-    	matrix = "matrix",  # original order
16 
-    	row_hclust = "ANY",
17 
-    	column_hclust = "ANY",
18 
-    	column_anno = "ANY", # annotation data frame, order of columns are same as matrix
19 
-    	column_anno_color_mapping = "list", # a list of ColorMapping class objects
20 
-    	matrix_color_mapping = "ANY",
21 
-
22 
-    	layout = "list",
23 
-    	gp_list = "list"
8 
+
9 
+# == title
10 
+# class for single heatmap
11 
+#
12 
+# == details
13 
+# The components for a heamtap is
14 
+#
15 
+#          +------+
16 
+#          +------+
17 
+#          +------+
18 
+#          +------+
19 
+#    +-+-+-+------+-+-+-+
20 
+#    | | | |      | | | |
21 
+#    +-+-+-+------+-+-+-+
22 
+#          +------+
23 
+#          +------+
24 
+#          +------+
25 
+#          +------+
26 
+#
27 
+Heatmap = setClass("Heatmap",
28 
+    slots = list(
29 
+        name = "character",
30 
+        matrix = "matrix",  # original order
31 
+        row_hclust = "ANY",
32 
+        column_hclust = "ANY",
33 
+        column_anno = "ANY", # annotation data frame, order of columns are same as matrix
34 
+        column_anno_color_mapping = "list", # a list of ColorMapping objects
35 
+        matrix_color_mapping = "ANY",
36 
+
37 
+        layout = "environment",
38 
+        gp_list = "list"
24 39 
     )
25 40 
 )
26 41
42 
+# default colors for matrix or annotations
43 
+# this function should be improved later
27 44 
 default_col = function(x, main_matrix = FALSE) {
28 45
29 
-	if(length(unique(x)) == 1) {
30 
-		x = as.character(x)
31 
-	}
32 
-
33 
-	if(is.character(x)) {  # discrete
34 
-		levels = unique(x)
35 
-		colors = rand_color(length(levels))
36 
-		names(colors) = levels
37 
-		return(colors)
38 
-	} else if(is.numeric(x)) {
39 
-		if(main_matrix) {
40 
-			col_fun = colorRamp2(seq(min(x), max(x), length.out = 11),
41 
-				rev(brewer.pal(11, "RdYlBu")))
42 
-		} else {
43 
-			col_fun = colorRamp2(range(min(x), max(x)), c("white", rand_color(1)))
44 
-		}
45 
-		return(col_fun)
46 
-	}
46 
+    if(is.factor(x)) {
47 
+        x = as.character(x)
48 
+    }
49 
+
50 
+    if(length(unique(x)) == 1) {
51 
+        x = as.character(x)
52 
+    }
53 
+
54 
+    attributes(x) = NULL
55 
+
56 
+    if(is.character(x)) {  # discrete
57 
+        levels = unique(x)
58 
+        colors = rand_color(length(levels))
59 
+        names(colors) = levels
60 
+        return(colors)
61 
+    } else if(is.numeric(x)) {
62 
+        if(main_matrix) {
63 
+            col_fun = colorRamp2(seq(min(x), max(x), length.out = 11),
64 
+                rev(brewer.pal(11, "RdYlBu")))
65 
+        } else {
66 
+            col_fun = colorRamp2(range(min(x), max(x)), c("white", rand_color(1)))
67 
+        }
68 
+        return(col_fun)
69 
+    }
47 70 
 }
48 71
49 
-# matrix can be a numeric matrix or a character matrix
50 
-Heatmap$methods(initialize = function(matrix, col, name, rect_gp = gpar(col = NA),
51 
-	row_title = character(0), row_title_side = c("left", "right"), row_title_gp = gpar(fontsize = 14),
52 
-	column_title = character(0), column_title_side = c("top", "bottom"), column_title_gp = gpar(fontsize = 14),
53 
-	cluster_rows = TRUE, clustering_distance_rows = "euclidean", clustering_method_rows = "complete",
54 
-	row_hclust_side = c("left", "right"), row_hclust_width = unit(10, "mm"), show_row_hclust = TRUE, row_hclust_gp = gpar(),
55 
-	cluster_columns = TRUE, clustering_distance_columns = "euclidean", clustering_method_columns = "complete",
56 
-	column_hclust_side = c("top", "bottom"), column_hclust_height = unit(10, "mm"), show_column_hclust = TRUE, column_hclust_gp = gpar(),
57 
-	rownames_side = c("right", "left"), show_rownames = TRUE, rownames_gp = gpar(fontsize = 12),
58 
-	colnames_side = c("bottom", "top"), show_colnames = TRUE, colnames_gp = gpar(fontsize = 12),
59 
-	annotation = NULL, annotation_color = NULL, annotation_side = c("top", "bottom"),
60 
-	annotation_height = if(is.null(annotation)) unit(0, "null") else ncol(annotation)*unit(4, "mm"), annotation_gp = gpar()
61 
-	) {
62 
-
63 
-	.self$gp_list = list(rect_gp = rect_gp,
64 
-		             row_title_gp = row_title_gp,
65 
-		             column_title_gp = column_title_gp,
66 
-		             row_hclust_gp = rownames_gp,
67 
-		             column_hclust_gp = column_hclust_gp,
68 
-		             rownames_gp = rownames_gp,
69 
-		             colnames_gp = colnames_gp,
70 
-		             annotation_gp = annotation_gp)
71 
-
72 
-	if(missing(col)) {
73 
-		col = default_col(matrix, main_matrix = TRUE)
74 
-	}
75 
-
76 
-	if(missing(name)) {
77 
-		name = paste0("matrix", get_n_heatmap() + 1)
78 
-		increase_n_heatmap()
79 
-	}
80 
-
81 
-	if(is.function(col)) {
82 
-		.self$matrix_color_mapping = ColorMapping(col_fun = col, name = name)
83 
-	} else {
84 
-		.self$matrix_color_mapping = ColorMapping(colors = col, name = name)
85 
-	}
86 
-	.self$name = name
87 
-
88 
-	if(cluster_rows) {
89 
-		.self$row_hclust = hclust(get_dist(matrix, clustering_distance_rows), method = clustering_method_rows)
90 
-		row_order = row_hclust$order
91 
-	} else {
92 
-		row_hclust_width = unit(0, "null")
93 
-		.self$row_hclust = NULL
94 
-		row_order = seq_len(nrow(matrix))
95 
-	}
96 
-
97 
-	if(cluster_columns) {
98 
-		.self$column_hclust = hclust(get_dist(t(matrix), clustering_distance_columns), method = clustering_method_columns)
99 
-		column_order = column_hclust$order
100 
-	} else {
101 
-		column_hclust_height = unit(0, "null")
102 
-		.self$column_hclust = NULL
103 
-		column_order = seq_len(ncol(matrix))
104 
-	}
105 
-
106 
-	.self$matrix = matrix[row_order, column_order, drop = FALSE]
107 
-
108 
-	if(is.null(annotation)) {
109 
-		# don't need to consider annotation_color
110 
-	} else if(is.data.frame(annotation)) {
111 
-		# if there is rownames
112 
-		if(is.null(rownames(annotation))) {
113 
-			.self$column_anno = annotation[col_order, , drop = FALSE]
114 
-		} else {
115 
-			.self$column_anno = annotation[colnames(matrix), , drop = FALSE]
116 
-		}
117 
-
118 
-		if(is.null(colnames(annotation))) {
119 
-			stop("`annotation` should have colnames.")
120 
-		}
121 
-
122 
-		if(is.null(annotation_color)) {
123 
-			annotation_color = lapply(annotation, default_col)
124 
-		}
125 
-
126 
-		if(is.null(names(annotation_color))) {
127 
-			stop("`annotation_color` should have names to map to `annotation`.")
128 
-		}
129 
-
130 
-		if(!setequal(colnames(annotation), names(annotation_color))) {
131 
-			stop("You should provide colors for all annotations.")
132 
-		} else {
133 
-			annotation_color = annotation_color[colnames(annotation)]
134 
-			annotation_name = names(annotation_color)
135 
-			column_anno_color_mapping = list()
136 
-			for(i in seq_along(annotation_color)) {
137 
-				if(is.atomic(annotation_color[[i]])) {
138 
-					.self$column_anno_color_mapping[[i]] = ColorMapping(name = annotation_name[i],
139 
-						                                     colors = annotation_color[[i]])
140 
-				} else if(is.function(annotation_color[[i]])) {
141 
-					.self$column_anno_color_mapping[[i]] = ColorMapping(name = annotation_name[i],
142 
-						                                          col_fun = annotation_color[[i]])
143 
-				}
144 
-			}
145 
-		}
146 
-	} else {
147 
-		stop("`annotation` should be a data frame.")
148 
-	}
149 
-
150 
-	# settings for positin of each component
151 
-	.self$layout = list(
152 
-		layout_column_title_top_height = NULL,
153 
-    	layout_column_hclust_top_height = NULL,
154 
-    	layout_column_anno_top_height = NULL,
155 
-    	layout_colnames_top_height = NULL,
156 
-    	layout_column_title_bottom_height = NULL,
157 
-    	layout_column_hclust_bottom_height = NULL,
158 
-    	layout_column_anno_bottom_height = NULL,
159 
-    	layout_colnames_bottom_height = NULL,
160 
-
161 
-    	layout_row_title_left_width = NULL,
162 
-    	layout_row_hclust_left_width = NULL,
163 
-    	layout_rownames_left_width = NULL,
164 
-    	layout_row_hclust_right_width = NULL,
165 
-    	layout_rownames_right_width = NULL,
166 
-    	layout_row_title_right_width = NULL,
167 
-
168 
-    	layout_index = matrix(nrow = 0, ncol = 2),
169 
-    	graphic_fun_list = list()
170 
-    )
72 
+# == title
73 
+# constructor of `Heatmap` class
74 
+#
75 
+# == param
76 
+# -matrix matrix
77 
+# -col color
78 
+# -name name
79 
+# -rect_gp graphic parameters for drawing rectangles
80 
+# -row_title title on rows
81 
+# -row_title_side side
82 
+# -row_title_gp gp
83 
+# -column_title foo
84 
+# -column_title_side foo
85 
+# -column_title_gp foo
86 
+# -cluster_rows foo
87 
+# -clustering_distance_rows foo
88 
+# -clustering_method_rows foo
89 
+# -row_hclust_side foo
90 
+# -row_hclust_width foo
91 
+# -show_row_hclust foo
92 
+# -row_hclust_gp foo
93 
+# -cluster_columns foo
94 
+# -column_hclust_height foo
95 
+# -show_column_hclust foo
96 
+# -column_hclust_side foo
97 
+# -column_hclust_height foo
98 
+# -show_column_hclust foo
99 
+# -column_hclust_gp foo
100 
+# -rownames_side foo
101 
+# -show_rownames foo
102 
+# -rownames_gp foo
103 
+# -colnames_side foo
104 
+# -show_colnames foo
105 
+# -colnames_gp foo
106 
+# -annotation foo
107 
+# -annotation_color foo
108 
+# -annotation_side foo
109 
+# -annotation_height foo
110 
+# -annotation_gp foo
111 
+#
112 
+# == value
113 
+# a `Heatmap` object
114 
+#
115 
+# == author
116 
+# Zuguang Gu <z.gu@dkfz.de>
117 
+#
118 
+setMethod(f = "initialize",
119 
+    signature = "Heatmap",
120 
+    definition = function(.Object, matrix, col, name, rect_gp = gpar(col = NA),
121 
+    row_title = character(0), row_title_side = c("left", "right"), row_title_gp = gpar(fontsize = 14),
122 
+    column_title = character(0), column_title_side = c("top", "bottom"), column_title_gp = gpar(fontsize = 14),
123 
+    cluster_rows = TRUE, clustering_distance_rows = "euclidean", clustering_method_rows = "complete",
124 
+    row_hclust_side = c("left", "right"), row_hclust_width = unit(10, "mm"), show_row_hclust = TRUE, row_hclust_gp = gpar(),
125 
+    cluster_columns = TRUE, clustering_distance_columns = "euclidean", clustering_method_columns = "complete",
126 
+    column_hclust_side = c("top", "bottom"), column_hclust_height = unit(10, "mm"), show_column_hclust = TRUE, column_hclust_gp = gpar(),
127 
+    rownames_side = c("right", "left"), show_rownames = TRUE, rownames_gp = gpar(fontsize = 12),
128 
+    colnames_side = c("bottom", "top"), show_colnames = TRUE, colnames_gp = gpar(fontsize = 12),
129 
+    annotation = NULL, annotation_color = NULL, annotation_side = c("top", "bottom"),
130 
+    annotation_height = if(is.null(annotation)) unit(0, "null") else ncol(annotation)*unit(4, "mm"), annotation_gp = gpar(col = NA)
131 
+    ) {
132 
+
133 
+    .Object@gp_list = list(rect_gp = rect_gp,
134 
+                     row_title_gp = row_title_gp,
135 
+                     column_title_gp = column_title_gp,
136 
+                     row_hclust_gp = rownames_gp,
137 
+                     column_hclust_gp = column_hclust_gp,
138 
+                     rownames_gp = rownames_gp,
139 
+                     colnames_gp = colnames_gp,
140 
+                     colnames_annotation_gp = annotation_gp)
141 
+
142 
+    if(!is.matrix(matrix)) {
143 
+    	matrix = matrix(matrix, ncol = 1)
144 
+    }
145 
+
146 
+    if(missing(col)) {
147 
+        col = default_col(matrix, main_matrix = TRUE)
148 
+    }
171 149
172 
-	.self$layout$layout_index = rbind(c(5, 4))
173 
-	.self$layout$graphic_fun_list = list(function() .self$draw_heatmap_body())
174 
-
175 
-	############################################
176 
-	## title on top or bottom
177 
-	column_title_side = match.arg(column_title_side)[1]
178 
-	if(length(column_title) == 0) {
179 
-		column_title = character(0)
180 
-	} else if(is.na(column_title)) {
181 
-		column_title = character(0)
182 
-	} else if(column_title == "") {
183 
-		column_title = character(0)
184 
-	}
150 
+    if(missing(name)) {
151 
+        name = paste0("matrix", get_heatmap_index() + 1)
152 
+        increase_heatmap_index()
153 
+    }
154 
+
155 
+    if(is.function(col)) {
156 
+        .Object@matrix_color_mapping = ColorMapping(col_fun = col, name = name)
157 
+    } else {
158 
+        .Object@matrix_color_mapping = ColorMapping(colors = col, name = name)
159 
+    }
160 
+    .Object@name = name
161 
+
162 
+    if(cluster_rows) {
163 
+        .Object@row_hclust = hclust(get_dist(matrix, clustering_distance_rows), method = clustering_method_rows)
164 
+        row_order = .Object@row_hclust$order
165 
+    } else {
166 
+        row_hclust_width = unit(0, "null")
167 
+        .Object@row_hclust = NULL
168 
+        row_order = seq_len(nrow(matrix))
169 
+    }
170 
+
171 
+    if(cluster_columns) {
172 
+        .Object@column_hclust = hclust(get_dist(t(matrix), clustering_distance_columns), method = clustering_method_columns)
173 
+        column_order = .Object@column_hclust$order
174 
+    } else {
175 
+        column_hclust_height = unit(0, "null")
176 
+        .Object@column_hclust = NULL
177 
+        column_order = seq_len(ncol(matrix))
178 
+    }
179 
+
180 
+    .Object@matrix = matrix[row_order, column_order, drop = FALSE]
181 
+
182 
+    if(is.null(annotation)) {
183 
+        # don't need to consider annotation_color
184 
+    } else if(is.data.frame(annotation)) {
185 
+
186 
+        for(i in seq_len(ncol(annotation))) {
187 
+            if(is.factor(annotation[[i]])) {
188 
+                annotation[[i]] = as.character(annotation[[i]])
189 
+            }
190 
+        }
191 
+
192 
+        # if there is rownames
193 
+        if(is.null(rownames(annotation))) {
194 
+            .Object@column_anno = annotation[column_order, , drop = FALSE]
195 
+        } else {
196 
+            .Object@column_anno = annotation[colnames(matrix), , drop = FALSE]
197 
+        }
198 
+
199 
+        if(is.null(colnames(annotation))) {
200 
+            stop("`annotation` should have colnames.")
201 
+        }
202 
+
203 
+        if(is.null(annotation_color)) {
204 
+            annotation_color = lapply(annotation, default_col)
205 
+        }
206 
+
207 
+        if(is.null(names(annotation_color))) {
208 
+            stop("`annotation_color` should have names to map to `annotation`.")
209 
+        }
210 
+
211 
+        if(!setequal(colnames(annotation), names(annotation_color))) {
212 
+            stop("You should provide colors for all annotations.")
213 
+        } else {
214 
+            annotation_color = annotation_color[colnames(annotation)]
215 
+            annotation_name = names(annotation_color)
216 
+            .Object@column_anno_color_mapping = list()
217 
+
218 
+            for(i in seq_along(annotation_color)) {
219 
+                if(is.atomic(annotation_color[[i]])) {
220 
+                    .Object@column_anno_color_mapping[[i]] = ColorMapping(name = annotation_name[i],
221 
+                                                             colors = annotation_color[[i]])
222 
+                } else if(is.function(annotation_color[[i]])) {
223 
+                    .Object@column_anno_color_mapping[[i]] = ColorMapping(name = annotation_name[i],
224 
+                                                                  col_fun = annotation_color[[i]])
225 
+                }
226 
+            }
227 
+        }
228 
+    } else {
229 
+        stop("`annotation` should be a data frame.")
230 
+    }
231 
+
232 
+    # settings for positin of each component
233 
+    .Object@layout = as.environment(list(
234 
+        layout_column_title_top_height = NULL,
235 
+        layout_column_hclust_top_height = NULL,
236 
+        layout_column_anno_top_height = NULL,
237 
+        layout_colnames_top_height = NULL,
238 
+        layout_column_title_bottom_height = NULL,
239 
+        layout_column_hclust_bottom_height = NULL,
240 
+        layout_column_anno_bottom_height = NULL,
241 
+        layout_colnames_bottom_height = NULL,
242 
+
243 
+        layout_row_title_left_width = NULL,
244 
+        layout_row_hclust_left_width = NULL,
245 
+        layout_rownames_left_width = NULL,
246 
+        layout_row_hclust_right_width = NULL,
247 
+        layout_rownames_right_width = NULL,
248 
+        layout_row_title_right_width = NULL,
249 
+
250 
+        layout_index = matrix(nrow = 0, ncol = 2),
251 
+        graphic_fun_list = list()
252 
+    ))
253 
+
254 
+    .Object@layout$layout_index = rbind(c(5, 4))
255 
+    .Object@layout$graphic_fun_list = list(function(object) draw_heatmap_body(object))
256 
+
257 
+    ############################################
258 
+    ## title on top or bottom
259 
+    column_title_side = match.arg(column_title_side)[1]
260 
+    if(length(column_title) == 0) {
261 
+        column_title = character(0)
262 
+    } else if(is.na(column_title)) {
263 
+        column_title = character(0)
264 
+    } else if(column_title == "") {
265 
+        column_title = character(0)
266 
+    }
185 267 
     if(length(column_title) > 0) {
186 
-    	column_title = column_title
187 
-    	if(column_title_side == "top") {
188 
-    		.self$layout$layout_column_title_top_height = grobHeight(textGrob(column_title, gp = column_title_gp))*2
189 
-    		.self$layout$layout_column_title_bottom_height = unit(0, "null")
190 
-    		.self$layout$layout_index = rbind(layout$layout_index, c(1, 4))
191 
-    	} else {
192 
-    		.self$layout$layout_column_title_bottom_height = grobHeight(textGrob(column_title, gp = column_title_gp))*2
193 
-    		.self$layout$layout_column_title_top_height = unit(0, "null")
194 
-    		.self$layout$layout_index = rbind(layout$layout_index, c(9, 4))
195 
-    	}
196 
-    	.self$layout$graphic_fun_list = c(layout$graphic_fun_list, function() .self$draw_title(column_title, which = "column", side = column_title_side))
268 
+        column_title = column_title
269 
+        if(column_title_side == "top") {
270 
+            .Object@layout$layout_column_title_top_height = grobHeight(textGrob(column_title, gp = column_title_gp))*2
271 
+            .Object@layout$layout_column_title_bottom_height = unit(0, "null")
272 
+            .Object@layout$layout_index = rbind(.Object@layout$layout_index, c(1, 4))
273 
+        } else {
274 
+            .Object@layout$layout_column_title_bottom_height = grobHeight(textGrob(column_title, gp = column_title_gp))*2
275 
+            .Object@layout$layout_column_title_top_height = unit(0, "null")
276 
+            .Object@layout$layout_index = rbind(.Object@layout$layout_index, c(9, 4))
277 
+        }
278 
+        .Object@layout$graphic_fun_list = c(.Object@layout$graphic_fun_list, function(object) draw_title(object, column_title, which = "column", side = column_title_side))
197 279 
     } else {
198 
-    	.self$layout$layout_column_title_top_height = unit(0, "null")
199 
-    	.self$layout$layout_column_title_bottom_height = unit(0, "null")
280 
+        .Object@layout$layout_column_title_top_height = unit(0, "null")
281 
+        .Object@layout$layout_column_title_bottom_height = unit(0, "null")
200 282 
     }
201 283
202 284 
     ############################################
203 
-	## title on left or right
204 
-	row_title_side = match.arg(row_title_side)[1]
205 
-	if(length(row_title) == 0) {
206 
-		row_title = character(0)
207 
-	} else if(is.na(row_title)) {
208 
-		row_title = character(0)
209 
-	} else if(row_title == "") {
210 
-		row_title = character(0)
211 
-	}
285 
+    ## title on left or right
286 
+    row_title_side = match.arg(row_title_side)[1]
287 
+    if(length(row_title) == 0) {
288 
+        row_title = character(0)
289 
+    } else if(is.na(row_title)) {
290 
+        row_title = character(0)
291 
+    } else if(row_title == "") {
292 
+        row_title = character(0)
293 
+    }
212 294 
     if(length(row_title) > 0) {
213 
-    	row_title = row_title
214 
-    	if(row_title_side == "left") {
215 
-    		.self$layout$layout_row_title_left_width = grobHeight(textGrob(row_title, gp = row_title_gp))*2
216 
-    		.self$layout$layout_row_title_right_width = unit(0, "null")
217 
-    		.self$layout$layout_index = rbind(layout$layout_index, c(5, 1))
218 
-    	} else {
219 
-    		.self$layout$layout_row_title_right_width = grobHeight(textGrob(row_title, gp = row_title_gp))*2
220 
-    		.self$layout$layout_row_title_left_width = unit(0, "null")
221 
-    		.self$layout$layout_index = rbind(layout$layout_index, c(5, 7))
222 
-    	}
223 
-    	.self$layout$graphic_fun_list = c(layout$graphic_fun_list, function() .self$draw_title(row_title, which = "row", side = row_title_side))
295 
+        row_title = row_title
296 
+        if(row_title_side == "left") {
297 
+            .Object@layout$layout_row_title_left_width = grobHeight(textGrob(row_title, gp = row_title_gp))*2
298 
+            .Object@layout$layout_row_title_right_width = unit(0, "null")
299 
+            .Object@layout$layout_index = rbind(.Object@layout$layout_index, c(5, 1))
300 
+        } else {
301 
+            .Object@layout$layout_row_title_right_width = grobHeight(textGrob(row_title, gp = row_title_gp))*2
302 
+            .Object@layout$layout_row_title_left_width = unit(0, "null")
303 
+            .Object@layout$layout_index = rbind(.Object@layout$layout_index, c(5, 7))
304 
+        }
305 
+        .Object@layout$graphic_fun_list = c(.Object@layout$graphic_fun_list, function(object) draw_title(object, row_title, which = "row", side = row_title_side))
224 306 
     } else {
225 
-    	.self$layout$layout_row_title_left_width = unit(0, "null")
226 
-    	.self$layout$layout_row_title_right_width = unit(0, "null")
307 
+        .Object@layout$layout_row_title_left_width = unit(0, "null")
308 
+        .Object@layout$layout_row_title_right_width = unit(0, "null")
227 309 
     }
228 310
229 311 
     ##########################################
230 312 
     ## hclust on left or right
231 313 
     row_hclust_side = match.arg(row_hclust_side)[1]
232 314 
     if(show_row_hclust) {
233 
-    	if(row_hclust_side == "left") {
234 
-    		.self$layout$layout_row_hclust_left_width = row_hclust_width
235 
-    		.self$layout$layout_row_hclust_right_width = unit(0, "null")
236 
-    		.self$layout$layout_index = rbind(layout$layout_index, c(5, 2))
237 
-    	} else {
238 
-    		.self$layout$layout_row_hclust_right_width = row_hclust_width
239 
-    		.self$layout$layout_row_hclust_left_width = unit(0, "null")
240 
-    		.self$layout$layout_index = rbind(layout$layout_index, c(5, 6))
241 
-    	}
242 
-    	.self$layout$graphic_fun_list = c(layout$graphic_fun_list, function() .self$draw_hclust(which = "row", side = row_hclust_side))
315 
+        if(row_hclust_side == "left") {
316 
+            .Object@layout$layout_row_hclust_left_width = row_hclust_width
317 
+            .Object@layout$layout_row_hclust_right_width = unit(0, "null")
318 
+            .Object@layout$layout_index = rbind(.Object@layout$layout_index, c(5, 2))
319 
+        } else {
320 
+            .Object@layout$layout_row_hclust_right_width = row_hclust_width
321 
+            .Object@layout$layout_row_hclust_left_width = unit(0, "null")
322 
+            .Object@layout$layout_index = rbind(.Object@layout$layout_index, c(5, 6))
323 
+        }
324 
+        .Object@layout$graphic_fun_list = c(.Object@layout$graphic_fun_list, function(object) draw_hclust(object, which = "row", side = row_hclust_side))
243 325 
     } else {
244 
-    	.self$layout$layout_row_hclust_right_width = unit(0, "null")
245 
-    	.self$layout$layout_row_hclust_left_width = unit(0, "null")
326 
+        .Object@layout$layout_row_hclust_right_width = unit(0, "null")
327 
+        .Object@layout$layout_row_hclust_left_width = unit(0, "null")
246 328 
     }
247 329
248 330 
     ##########################################
249 331 
     ## hclust on top or bottom
250 332 
     column_hclust_side = match.arg(column_hclust_side)[1]
251 333 
     if(show_column_hclust) {
252 
-    	if(column_hclust_side == "top") {
253 
-			.self$layout$layout_column_hclust_top_height = column_hclust_height
254 
-    		.self$layout$layout_column_hclust_bottom_height = unit(0, "null")
255 
-    		.self$layout$layout_index = rbind(layout$layout_index, c(2, 4))
256 
-    	} else {
257 
-    		.self$layout$layout_column_hclust_bottom_height = column_hclust_height
258 
-    		.self$layout$layout_column_hclust_top_height = unit(0, "null")
259 
-    		.self$layout$layout_index = rbind(layout$layout_index, c(8, 4))
260 
-    	}
261 
-    	.self$layout$graphic_fun_list = c(layout$graphic_fun_list, function() .self$draw_hclust(which = "column", side = column_hclust_side))
334 
+        if(column_hclust_side == "top") {
335 
+            .Object@layout$layout_column_hclust_top_height = column_hclust_height
336 
+            .Object@layout$layout_column_hclust_bottom_height = unit(0, "null")
337 
+            .Object@layout$layout_index = rbind(.Object@layout$layout_index, c(2, 4))
338 
+        } else {
339 
+            .Object@layout$layout_column_hclust_bottom_height = column_hclust_height
340 
+            .Object@layout$layout_column_hclust_top_height = unit(0, "null")
341 
+            .Object@layout$layout_index = rbind(.Object@layout$layout_index, c(8, 4))
342 
+        }
343 
+        .Object@layout$graphic_fun_list = c(.Object@layout$graphic_fun_list, function(object) draw_hclust(object, which = "column", side = column_hclust_side))
262 344 
     } else {
263 
-    	.self$layout$layout_column_hclust_top_height = unit(0, "null")
264 
-    	.self$layout$layout_column_hclust_bottom_height = unit(0, "null")
345 
+        .Object@layout$layout_column_hclust_top_height = unit(0, "null")
346 
+        .Object@layout$layout_column_hclust_bottom_height = unit(0, "null")
265 347 
     }
266 348
267 349 
     #######################################
268 350 
     ## rownames on left or right
269 351 
     rownames_side = match.arg(rownames_side)[1]
270 352 
     if(is.null(rownames(matrix))) {
271 
-    	show_rownames = FALSE
353 
+        show_rownames = FALSE
272 354 
     }
273 355 
     if(show_rownames) {
274 
-    	rownames_width = max(do.call("unit.c", lapply(rownames(matrix), function(x) {
275 
-			grobWidth(textGrob(x, gp = rownames_gp))
276 
-		}))) + unit(2, "mm")
277 
-		if(rownames_side == "left") {
278 
-			.self$layout$layout_rownames_left_width = rownames_width
279 
-			.self$layout$layout_rownames_right_width = unit(0, "null")
280 
-			.self$layout$layout_index = rbind(layout$layout_index, c(5, 3))
281 
-		} else {
282 
-			.self$layout$layout_rownames_right_width = rownames_width
283 
-			.self$layout$layout_rownames_left_width = unit(0, "null")
284 
-			.self$layout$layout_index = rbind(layout$layout_index, c(5, 5))
285 
-		}
286 
-		.self$layout$graphic_fun_list = c(layout$graphic_fun_list, function() .self$draw_dimnames(which = "row", side = rownames_side))
356 
+        rownames_width = max(do.call("unit.c", lapply(rownames(matrix), function(x) {
357 
+            grobWidth(textGrob(x, gp = rownames_gp))
358 
+        }))) + unit(2, "mm")
359 
+        if(rownames_side == "left") {
360 
+            .Object@layout$layout_rownames_left_width = rownames_width
361 
+            .Object@layout$layout_rownames_right_width = unit(0, "null")
362 
+            .Object@layout$layout_index = rbind(.Object@layout$layout_index, c(5, 3))
363 
+        } else {
364 
+            .Object@layout$layout_rownames_right_width = rownames_width
365 
+            .Object@layout$layout_rownames_left_width = unit(0, "null")
366 
+            .Object@layout$layout_index = rbind(.Object@layout$layout_index, c(5, 5))
367 
+        }
368 
+        .Object@layout$graphic_fun_list = c(.Object@layout$graphic_fun_list, function(object) draw_dimnames(object, which = "row", side = rownames_side))
287 369 
     } else {
288 
-    	.self$layout$layout_rownames_left_width = unit(0, "null")
289 
-    	.self$layout$layout_rownames_right_width = unit(0, "null")
370 
+        .Object@layout$layout_rownames_left_width = unit(0, "null")
371 
+        .Object@layout$layout_rownames_right_width = unit(0, "null")
290 372 
     }
291 373
292 374 
     #########################################
293 375 
     ## colnames on top or bottom
294 376 
     colnames_side = match.arg(colnames_side)[1]
295 377 
     if(is.null(colnames(matrix))) {
296 
-    	show_colnames = FALSE
378 
+        show_colnames = FALSE
297 379 
     }
298 380 
     if(show_colnames) {
299 
-    	colnames_height = max(do.call("unit.c", lapply(colnames(matrix), function(x) {
300 
-			grobWidth(textGrob(x, gp = colnames_gp))
301 
-		}))) + unit(2, "mm")
302 
-		if(colnames_side == "top") {
303 
-			.self$layout$layout_colnames_top_height = colnames_height
304 
-			.self$layout$layout_colnames_bottom_height = unit(0, "null")
305 
-			.self$layout$layout_index = rbind(layout$layout_index, c(4, 4))
306 
-		} else {
307 
-			.self$layout$layout_colnames_bottom_height = colnames_height
308 
-			.self$layout$layout_colnames_top_height = unit(0, "null")
309 
-			.self$layout$layout_index = rbind(layout$layout_index, c(6, 4))
310 
-		}
311 
-		.self$layout$graphic_fun_list = c(layout$graphic_fun_list, function() .self$draw_dimnames(which = "column", side = colnames_side))
381 
+        colnames_height = max(do.call("unit.c", lapply(colnames(matrix), function(x) {
382 
+            grobWidth(textGrob(x, gp = colnames_gp))
383 
+        }))) + unit(2, "mm")
384 
+        if(colnames_side == "top") {
385 
+            .Object@layout$layout_colnames_top_height = colnames_height
386 
+            .Object@layout$layout_colnames_bottom_height = unit(0, "null")
387 
+            .Object@layout$layout_index = rbind(.Object@layout$layout_index, c(4, 4))
388 
+        } else {
389 
+            .Object@layout$layout_colnames_bottom_height = colnames_height
390 
+            .Object@layout$layout_colnames_top_height = unit(0, "null")
391 
+            .Object@layout$layout_index = rbind(.Object@layout$layout_index, c(6, 4))
392 
+        }
393 
+        .Object@layout$graphic_fun_list = c(.Object@layout$graphic_fun_list, function(object) draw_dimnames(object, which = "column", side = colnames_side))
312 394 
     } else {
313 
-    	.self$layout$layout_colnames_top_height = unit(0, "null")
314 
-    	.self$layout$layout_colnames_bottom_height = unit(0, "null")
395 
+        .Object@layout$layout_colnames_top_height = unit(0, "null")
396 
+        .Object@layout$layout_colnames_bottom_height = unit(0, "null")
315 397 
     }
316 398
317 399 
     ##########################################
318 400 
     ## annotation on top or bottom
319 
-	column_anno_side = match.arg(annotation_side)[1]
320 
-	if(is.null(annotation)) {
321 
-		.self$layout$layout_column_anno_top_height = unit(0, "null")
322 
-		.self$layout$layout_column_anno_bottom_height = unit(0, "null")
323 
-	} else {
324 
-		if(column_anno_side == "top") {
325 
-			.self$layout$layout_column_anno_top_height = annotation_height
326 
-			.self$layout$layout_column_anno_bottom_height = unit(0, "null")
327 
-			.self$layout$layout_index = rbind(layout$layout_index, c(3, 4))
328 
-		} else {
329 
-			.self$layout$layout_column_anno_bottom_height = annotation_height
330 
-			.self$layout$layout_column_anno_top_height = unit(0, "null")
331 
-			.self$layout$layout_index = rbind(layout$layout_index, c(7, 4))
332 
-		}
333 
-		.self$layout$graphic_fun_list = c(layout$graphic_fun_list, function() .self$draw_annotation())
334 
-	}
335 
-
336 
-	return(invisible(.self))
401 
+    column_anno_side = match.arg(annotation_side)[1]
402 
+    if(is.null(annotation)) {
403 
+        .Object@layout$layout_column_anno_top_height = unit(0, "null")
404 
+        .Object@layout$layout_column_anno_bottom_height = unit(0, "null")
405 
+    } else {
406 
+        if(column_anno_side == "top") {
407 
+            .Object@layout$layout_column_anno_top_height = annotation_height
408 
+            .Object@layout$layout_column_anno_bottom_height = unit(0, "null")
409 
+            .Object@layout$layout_index = rbind(.Object@layout$layout_index, c(3, 4))
410 
+        } else {
411 
+            .Object@layout$layout_column_anno_bottom_height = annotation_height
412 
+            .Object@layout$layout_column_anno_top_height = unit(0, "null")
413 
+            .Object@layout$layout_index = rbind(.Object@layout$layout_index, c(7, 4))
414 
+        }
415 
+        .Object@layout$graphic_fun_list = c(.Object@layout$graphic_fun_list, function(object) draw_annotation(object))
416 
+    }
417 
+
418 
+    return(.Object)
337 419 
 })
338 420
339 421 
 # show method is in fact a plot method
340 
-Heatmap$methods(show = function() {
341 
-	cat("A Heatmap class instance:\n")
342 
-	cat("name:", .self$name, "\n")
343 
-	cat("dim:", nrow(.self$matrix), "x", ncol(.self$matrix), "\n")
422 
+setMethod(f = "show",
423 
+    signature = "Heatmap",
424 
+    definition = function(object) {
425 
+
426 
+    cat("A Heatmap object:\n")
427 
+    cat("name:", object@name, "\n")
428 
+    cat("dim:", nrow(object@matrix), "x", ncol(object@matrix), "\n")
429 
+
344 430 
 })
345 431
346 
-Heatmap$methods(add_heatmap = function(ht) {
347 
-	ht_list = new("HeatmapList")
348 
-	ht_list$add_heatmap(.self)
349 
-	ht_list$add_heatmap(ht)
432 
+# == title
433 
+# add two heatmaps as a heatmap list
434 
+#
435 
+# == param
436 
+# -object a `Heatmap` object
437 
+# -ht a `Heatmap` object
438 
+#
439 
+# == value
440 
+# a `HeatmapList` object
441 
+#
442 
+# == author
443 
+# Zuguang Gu <z.gu@dkfz.de>
444 
+#
445 
+setMethod(f = "add_heatmap",
446 
+    signature = "Heatmap",
447 
+    definition = function(object, ht) {
448 
+
449 
+    ht_list = new("HeatmapList")
450 
+    ht_list = add_heatmap(ht_list, object)
451 
+    ht_list = add_heatmap(ht_list, ht)
452 
+    return(ht_list)
453 
+
350 454 
 })
351 455
352 
-# add the heatmap body
353 
-# 100% covered the viewport
354 
-Heatmap$methods(draw_heatmap_body = function(gp = .self$gp_list$rect_gp) {
355 
-	pushViewport(viewport(name = paste(.self$name, "heatmap_body", sep = "-")))
356 
-	col_matrix = .self$matrix_color_mapping$map(.self$matrix)
357 
-
358 
-	nc = ncol(.self$matrix)
359 
-	nr = nrow(.self$matrix)
360 
-	x = (seq_len(nc) - 0.5) / nc
361 
-	y = (rev(seq_len(nr)) - 0.5) / nr
362 
-	expand_index = expand.grid(seq_len(nr), seq_len(nc))
363 
-	grid.rect(x[expand_index[[2]]], y[expand_index[[1]]], width = 1/nc, height = 1/nr, gp = do.call("gpar", c(list(fill = col_matrix), gp)))
364 
-	upViewport()
456 
+# == title
457 
+# plot the heatmap body
458 
+#
459 
+# == param
460 
+# -object a `Heatmap` object
461 
+# -gp graphic parameters for drawing rectangles
462 
+#
463 
+# == details
464 
+# the heatmap body 100% covers the viewport
465 
+#
466 
+# == value
467 
+# this function returns no value
468 
+#
469 
+# == author
470 
+# Zuguang Gu <z.gu@dkfz.de>
471 
+#
472 
+setMethod(f = "draw_heatmap_body",
473 
+    signature = "Heatmap",
474 
+    definition = function(object, gp = object@gp_list$rect_gp) {
475 
+
476 
+    pushViewport(viewport(name = paste(object@name, "heatmap_body", sep = "-")))
477 
+    col_matrix = map(object@matrix_color_mapping, object@matrix)
478 
+
479 
+    nc = ncol(object@matrix)
480 
+    nr = nrow(object@matrix)
481 
+    x = (seq_len(nc) - 0.5) / nc
482 
+    y = (rev(seq_len(nr)) - 0.5) / nr
483 
+    expand_index = expand.grid(seq_len(nr), seq_len(nc))
484 
+    grid.rect(x[expand_index[[2]]], y[expand_index[[1]]], width = 1/nc, height = 1/nr, gp = do.call("gpar", c(list(fill = col_matrix), gp)))
485 
+    upViewport()
486 
+
365 487 
 })
366 488
367 
-# 100% percent to covert the whole viewport
368 
-Heatmap$methods(draw_hclust = function(which = c("row", "column"),
369 
-	side = ifelse(which == "row", "left", "top"), gp = NULL) {
370 
-
371 
-	which = match.arg(which)[1]
372 
-
373 
-	side = side[1]
374 
-	if(which == "row" && side %in% c("top", "bottom")) {
375 
-		stop("`side` can only be set to 'left' or 'right' if `which` is 'row'.")
376 
-	}
377 
-
378 
-	if(which == "column" && side %in% c("left", "right")) {
379 
-		stop("`side` can only be set to 'top' or 'bottom' if `which` is 'column'.")
380 
-	}
381 
-
382 
-	hc = switch(which,
383 
-		"row" = .self$row_hclust,
384 
-		"column" = .self$column_hclust)
385 
-
386 
-	if(is.null(gp)) {
387 
-		gp = switch(which,
388 
-			"row" = .self$gp_list$row_hclust_gp,
389 
-			"column" = .self$gp_list$column_hclust_gp)
390 
-	}
391 
-
392 
-	if(is.null(hc)) {
393 
-		return(invisible(NULL))
394 
-	}
395 
-
396 
-	h = hc$height / max(hc$height)
397 
-	m = hc$merge
398 
-	o = hc$order
399 
-	n = length(o)
400 
-
401 
-	m[m > 0] = n + m[m > 0]
402 
-	m[m < 0] = abs(m[m < 0])
403 
-
404 
-	dist = matrix(0, nrow = 2 * n - 1, ncol = 2, dimnames = list(NULL, c("x", "y")))
405 
-	dist[1:n, 1] = 1 / n / 2 + (1 / n) * (match(1:n, o) - 1)
406 
-
407 
-	for(i in 1:nrow(m)){
408 
-		dist[n + i, 1] = (dist[m[i, 1], 1] + dist[m[i, 2], 1]) / 2
409 
-		dist[n + i, 2] = h[i]
410 
-	}
411 
-
412 
-	draw_connection = function(x1, x2, y1, y2, y, horizontal = FALSE, gp = gpar()){
413 
-
414 
-		if(horizontal) {
415 
-			grid.lines(y = c(x1, x1), x = c(y1, y), gp = gp)
416 
-			grid.lines(y = c(x2, x2), x = c(y2, y), gp = gp)
417 
-			grid.lines(y = c(x1, x2), x = c(y, y), gp = gp)
418 
-		} else {
419 
-			grid.lines(x = c(x1, x1), y = c(y1, y), gp = gp)
420 
-			grid.lines(x = c(x2, x2), y = c(y2, y), gp = gp)
421 
-			grid.lines(x = c(x1, x2), y = c(y, y), gp = gp)
422 
-		}
423 
-	}
424 
-
425 
-	if(which == "row" && side == "right") {
426 
-		#dist[, 1] = 1 - dist[, 1]
427 
-	} else if(which == "row" && side == "left") {
428 
-		#dist[, 1] = 1 - dist[, 1]
429 
-		dist[, 2] = 1 - dist[, 2]
430 
-		h = 1 - h
431 
-	} else if(which == "column" && side == "bottom") {
432 
-		dist[, 2] = 1 - dist[, 2]
433 
-		h = 1 - h
434 
-	}
435 
-
436 
-	if(which == "row") {
437 
-		pushViewport(viewport(name = paste(.self$name, "hclust_row", sep = "-") ))
438 
-		for(i in 1:nrow(m)){
439 
-			draw_connection(dist[m[i, 1], 1], dist[m[i, 2], 1], dist[m[i, 1], 2], dist[m[i, 2], 2], h[i], horizontal = TRUE, gp = gp)
440 
-		}
441 
-	} else {
442 
-		pushViewport(viewport(name = paste(.self$name, "hclust_col", sep = "-") ))
443 
-		for(i in 1:nrow(m)){
444 
-			draw_connection(dist[m[i, 1], 1], dist[m[i, 2], 1], dist[m[i, 1], 2], dist[m[i, 2], 2], h[i], horizontal = FALSE, gp = gp)
445 
-		}
446 
-	}
447 
-
448 
-	upViewport()
489 
+# == title
490 
+# plot the dendrogram on rows or columns
491 
+#
492 
+# == param
493 
+# -object a `Heatmap` object
494 
+# -which the dendrogram should be plotted on rows or columns
495 
+# -side side of the dendrogram
496 
+# -gp graphic parameters for drawing lines
497 
+#
498 
+# == details
499 
+# the dendrogram 100% covers the viewport
500 
+#
501 
+# == value
502 
+# this function returns no value
503 
+#
504 
+# == author
505 
+# Zuguang Gu <z.gu@dkfz.de>
506 
+#
507 
+setMethod(f = "draw_hclust",
508 
+    signature = "Heatmap",
509 
+    definition = function(object, which = c("row", "column"),
510 
+    side = ifelse(which == "row", "left", "top"), gp = NULL) {
511 
+
512 
+    which = match.arg(which)[1]
513 
+
514 
+    side = side[1]
515 
+    if(which == "row" && side %in% c("top", "bottom")) {
516 
+        stop("`side` can only be set to 'left' or 'right' if `which` is 'row'.")
517 
+    }
518 
+
519 
+    if(which == "column" && side %in% c("left", "right")) {
520 
+        stop("`side` can only be set to 'top' or 'bottom' if `which` is 'column'.")
521 
+    }
522 
+
523 
+    hc = switch(which,
524 
+        "row" = object@row_hclust,
525 
+        "column" = object@column_hclust)
526 
+
527 
+    if(is.null(gp)) {
528 
+        gp = switch(which,
529 
+            "row" = object@gp_list$row_hclust_gp,
530 
+            "column" = object@gp_list$column_hclust_gp)
531 
+    }
532 
+
533 
+    if(is.null(hc)) {
534 
+        return(invisible(NULL))
535 
+    }
536 
+
537 
+    h = hc$height / max(hc$height)
538 
+    m = hc$merge
539 
+    o = hc$order
540 
+    n = length(o)
541 
+
542 
+    m[m > 0] = n + m[m > 0]
543 
+    m[m < 0] = abs(m[m < 0])
544 
+
545 
+    dist = matrix(0, nrow = 2 * n - 1, ncol = 2, dimnames = list(NULL, c("x", "y")))
546 
+    dist[1:n, 1] = 1 / n / 2 + (1 / n) * (match(1:n, o) - 1)
547 
+
548 
+    for(i in 1:nrow(m)){
549 
+        dist[n + i, 1] = (dist[m[i, 1], 1] + dist[m[i, 2], 1]) / 2
550 
+        dist[n + i, 2] = h[i]
551 
+    }
552 
+
553 
+    draw_connection = function(x1, x2, y1, y2, y, horizontal = FALSE, gp = gpar()){
554 
+
555 
+        if(horizontal) {
556 
+            grid.lines(y = c(x1, x1), x = c(y1, y), gp = gp)
557 
+            grid.lines(y = c(x2, x2), x = c(y2, y), gp = gp)
558 
+            grid.lines(y = c(x1, x2), x = c(y, y), gp = gp)
559 
+        } else {
560 
+            grid.lines(x = c(x1, x1), y = c(y1, y), gp = gp)
561 
+            grid.lines(x = c(x2, x2), y = c(y2, y), gp = gp)
562 
+            grid.lines(x = c(x1, x2), y = c(y, y), gp = gp)
563 
+        }
564 
+    }
565 
+
566 
+    if(which == "row" && side == "right") {
567 
+        #dist[, 1] = 1 - dist[, 1]
568 
+    } else if(which == "row" && side == "left") {
569 
+        #dist[, 1] = 1 - dist[, 1]
570 
+        dist[, 2] = 1 - dist[, 2]
571 
+        h = 1 - h
572 
+    } else if(which == "column" && side == "bottom") {
573 
+        dist[, 2] = 1 - dist[, 2]
574 
+        h = 1 - h
575 
+    }
576 
+
577 
+    if(which == "row") {
578 
+        pushViewport(viewport(name = paste(object@name, "hclust_row", sep = "-") ))
579 
+        for(i in 1:nrow(m)){
580 
+            draw_connection(dist[m[i, 1], 1], dist[m[i, 2], 1], dist[m[i, 1], 2], dist[m[i, 2], 2], h[i], horizontal = TRUE, gp = gp)
581 
+        }
582 
+    } else {
583 
+        pushViewport(viewport(name = paste(object@name, "hclust_col", sep = "-") ))
584 
+        for(i in 1:nrow(m)){
585 
+            draw_connection(dist[m[i, 1], 1], dist[m[i, 2], 1], dist[m[i, 1], 2], dist[m[i, 2], 2], h[i], horizontal = FALSE, gp = gp)
586 
+        }
587 
+    }
588 
+
589 
+    upViewport()
449 590 
 })
450 591
451 
-# width is fixed
452 
-Heatmap$methods(draw_dimnames = function(which = c("row", "column"),
453 
-	side = ifelse(which == "row", "right", "bottom"), gp = NULL) {
454 
-
455 
-	which = match.arg(which)[1]
456 
-
457 
-	side = side[1]
458 
-	if(which == "row" && side %in% c("bottom", "top")) {
459 
-		stop("`side` can only be set to 'left' or 'right' if `which` is 'row'.")
460 
-	}
461 
-
462 
-	if(which == "column" && side %in% c("left", "right")) {
463 
-		stop("`side` can only be set to 'top' or 'bottom' if `which` is 'column'.")
464 
-	}
465 
-
466 
-	nm = switch(which,
467 
-		"row" = rownames(.self$matrix),
468 
-		"column" = colnames(.self$matrix))
469 
-
470 
-	if(is.null(gp)) {
471 
-		gp = switch(which,
472 
-			"row" = .self$gp_list$row_hclust_gp,
473 
-			"column" = .self$gp_list$column_hclust_gp)
474 
-	}
475 
-
476 
-	if(is.null(nm)) {
477 
-		return(invisible(NULL))
478 
-	}
479 
-
480 
-	n = length(nm)
481 
-
482 
-	if(which == "row") {
483 
-		pushViewport(viewport(name = paste(.self$name, "rownames", sep = "-") ))
484 
-		if(side == "left") {
485 
-			x = unit(1, "npc") - unit(2, "mm")
486 
-			just = c("right", "center")
487 
-		} else {