1. ComplexHeatmap
  2. Commit d7a3c7afc61d865e658160e5a153c0ae12e7dfb3
Browse code

some changes

Zuguang Gu authored on 12/08/2018 20:47:19
Showing 17 changed files
R/00_S4_generic_methods.R
History View file @ d7a3c7a
... ... 
@@ -25,7 +25,7 @@ setGeneric('prepare', function(object, ...) standardGeneric('prepare'))
25 25
26 26 
 setGeneric('draw_annotation', function(object, ...) standardGeneric('draw_annotation'))
27 27
28 
-setGeneric('get_color_mapping_param_list', function(object, ...) standardGeneric('get_color_mapping_param_list'))
28 
+setGeneric('get_legend_param_list', function(object, ...) standardGeneric('get_legend_param_list'))
29 29
30 30 
 setGeneric('draw_dimnames', function(object, ...) standardGeneric('draw_dimnames'))
31 31
... ... 
@@ -55,4 +55,5 @@ setGeneric('row_dend', function(object, ...) standardGeneric('row_dend'))
55 55
56 56 
 setGeneric('copy_all', function(object, ...) standardGeneric('copy_all'))
57 57 
 setGeneric('resize', function(object, ...) standardGeneric('resize'))
58 
+setGeneric('adjust_heatmap_list', function(object, ...) standardGeneric('adjust_heatmap_list'))
58 59
R/AnnotationFunction-class.R
History View file @ d7a3c7a
... ... 
@@ -223,10 +223,10 @@ setMethod(f = "show",
223 223 
 	cat("  items:", ifelse(object@n == 0, "unknown", object@n), "\n")
224 224 
 	cat("  width:", as.character(object@width), "\n")
225 225 
 	cat("  height:", as.character(object@height), "\n")
226 
-	var_imported = names(anno@var_env)
226 
+	var_imported = names(object@var_env)
227 227 
 	if(length(var_imported)) {
228 228 
 		cat("  imported variable:", paste(var_imported, collapse = ", "), "\n")
229 
-		var_subsetable = names(anno@subset_rule)
229 
+		var_subsetable = names(object@subset_rule)
230 230 
 		if(length(var_subsetable)) {
231 231 
 			cat("  subsetable variable:", paste(var_subsetable, collapse = ", "), "\n")
232 232 
 		}
... ... 
@@ -442,19 +442,19 @@ anno_image = function(image, which = c("column", "row"), border = TRUE,
442 442 
 			if(!requireNamespace("png")) {
443 443 
 				stop("Need png package to read png images.")
444 444 
 			}
445 
-			image_list[[i]] = getFromNamespace("readPNG", ns = "png")(image[i])
445 
+			image_list[[i]] = png::readPNG(image[i])
446 446 
 			image_class[i] = "raster"
447 447 
 		} else if(image_type[i] %in% c("jpeg", "jpg")) {
448 448 
 			if(!requireNamespace("jpeg")) {
449 449 
 				stop("Need jpeg package to read jpeg/jpg images.")
450 450 
 			}
451 
-			image_list[[i]] = getFromNamespace("readJPEG", ns = "jpeg")(image[i])
451 
+			image_list[[i]] = jpeg::readJPEG(image[i])
452 452 
 			image_class[i] = "raster"
453 453 
 		} else if(image_type[i] == "tiff") {
454 454 
 			if(!requireNamespace("tiff")) {
455 455 
 				stop("Need tiff package to read tiff images.")
456 456 
 			}
457 
-			image_list[[i]] = getFromNamespace("readTIFF", ns = "tiff")(image[i])
457 
+			image_list[[i]] = tiff::readTIFF(image[i])
458 458 
 			image_class[i] = "raster"
459 459 
 		} else if(image_type[i] %in% c("pdf", "eps")) {
460 460 
 			if(!requireNamespace("grImport")) {
... ... 
@@ -462,7 +462,7 @@ anno_image = function(image, which = c("column", "row"), border = TRUE,
462 462 
 			}
463 463 
 			temp_file = tempfile()
464 464 
 			getFromNamespace("PostScriptTrace", ns = "grImport")(image[[i]], temp_file)
465 
-			image_list[[i]] = getFromNamespace("readPicture", ns = "grImport")(temp_file)
465 
+			image_list[[i]] = grImport::readPicture(temp_file)
466 466 
 			file.remove(temp_file)
467 467 
 			image_class[i] = "grImport::Picture"
468 468 
 		} else if(image_type[i] == "svg") {
... ... 
@@ -473,8 +473,8 @@ anno_image = function(image, which = c("column", "row"), border = TRUE,
473 473 
 				stop("Need rsvg package to convert svg images.")
474 474 
 			}
475 475 
 			temp_file = tempfile()
476 
-			getFromNamespace("rsvg_svg", ns = "rsvg")(image[i], temp_file)
477 
-			image_list[[i]] = getFromNamespace("readPicture", ns = "grImport2")(temp_file)
476 
+			rsvg::rsvg_svg(image[i], temp_file)
477 
+			image_list[[i]] = grImport2::readPicture(temp_file)
478 478 
 			file.remove(temp_file)
479 479 
 			image_class[i] = "grImport2::Picture"
480 480 
 		}
... ... 
@@ -781,6 +781,147 @@ update_anno_extend = function(anno, axis_grob, axis_param) {
781 781 
 	return(extended)
782 782 
 }
783 783
784 
+anno_lines = function(x, which = c("column", "row"), border = TRUE, gp = gpar(),
785 
+	add_points = TRUE, pch = 16, size = unit(2, "mm"), pt_gp = gpar(), ylim = NULL,
786 
+	extend = 0.05, axis = TRUE, axis_param = default_axis_param(which),
787 
+	width = NULL, height = NULL) {
788 
+
789 
+	if(is.null(.ENV$current_annotation_which)) {
790 
+		which = match.arg(which)[1]
791 
+	} else {
792 
+		which = .ENV$current_annotation_which
793 
+	}
794 
+
795 
+	if(is.data.frame(x)) x = as.matrix(x)
796 
+	if(is.matrix(x)) {
797 
+		if(ncol(x) == 1) {
798 
+			x = x[, 1]
799 
+		}
800 
+	}
801 
+	input_is_matrix = is.matrix(x)
802 
+
803 
+	anno_size = anno_width_and_height(which, width, height, unit(1, "cm"))
804 
+
805 
+	if(is.matrix(x)) {
806 
+		n = nrow(x)
807 
+		nr = n
808 
+		nc = ncol(x)
809 
+	} else {
810 
+		n = length(x)
811 
+		nr = n
812 
+		nc = 1
813 
+	}
814 
+
815 
+	if(is.atomic(x)) {
816 
+		gp = recycle_gp(gp, 1)
817 
+		pt_gp = recycle_gp(pt_gp, n)
818 
+		if(length(pch) == 1) pch = rep(pch, n)
819 
+		if(length(size) == 1) size = rep(size, n)
820 
+	} else if(input_is_matrix) {
821 
+		gp = recycle_gp(gp, nc)
822 
+		pt_gp = recycle_gp(pt_gp, nc)
823 
+		if(length(pch) == 1) pch = rep(pch, nc)
824 
+		if(length(size) == 1) size = rep(size, nc)
825 
+	}
826 
+
827 
+	if(is.null(ylim)) {
828 
+		data_scale = range(x, na.rm = TRUE)
829 
+	} else {
830 
+		data_scale = ylim
831 
+	}
832 
+	data_scale = data_scale + c(-extend, extend)*(data_scale[2] - data_scale[1])
833 
+
834 
+	value = x
835 
+
836 
+	axis_param = validate_axis_param(axis_param, which)
837 
+	axis_grob = if(axis) construct_axis_grob(axis_param, which, data_scale) else NULL
838 
+
839 
+	row_fun = function(index) {
840 
+		n = length(index)
841 
+
842 
+		pushViewport(viewport(xscale = data_scale, yscale = c(0.5, n+0.5)))
843 
+		if(is.matrix(value)) {
844 
+			for(i in seq_len(ncol(value))) {
845 
+				grid.lines(value[index, i], n - seq_along(index) + 1, gp = subset_gp(gp, i),
846 
+					default.units = "native")
847 
+				if(add_points) {
848 
+					grid.points(value[index, i], n - seq_along(index) + 1, gp = subset_gp(pt_gp, i),
849 
+						default.units = "native", pch = pch[i], size = size[i])
850 
+				}
851 
+			}
852 
+		} else {
853 
+			grid.lines(value[index, i], n - seq_along(index) + 1, gp = gp,
854 
+				default.units = "native")
855 
+			if(add_points) {
856 
+				grid.points(value[index], n - seq_along(index) + 1, gp = gp, default.units = "native",
857 
+					pch = pch[index], size = size[index])
858 
+			}
859 
+		}
860 
+		if(axis) grid.draw(axis_grob)
861 
+		if(border) grid.rect(gp = gpar(fill = "transparent"))
862 
+		popViewport()
863 
+	}
864 
+
865 
+	column_fun = function(index) {
866 
+		n = length(index)
867 
+
868 
+		pushViewport(viewport(yscale = data_scale, xscale = c(0.5, n+0.5)))
869 
+		if(is.matrix(value)) {
870 
+			for(i in seq_len(ncol(value))) {
871 
+				grid.lines(seq_along(index), value[index, i], gp = subset_gp(gp, i),
872 
+					default.units = "native")
873 
+				if(add_points) {
874 
+					grid.points(seq_along(index), value[index, i], gp = subset_gp(pt_gp, i),
875 
+						default.units = "native", pch = pch[i], size = size[i])
876 
+				}
877 
+			}
878 
+		} else {
879 
+			grid.lines(seq_along(index), value[index], gp = gp, default.units = "native")
880 
+			if(add_points) {
881 
+				grid.points(seq_along(index), value[index], gp = pt_gp, default.units = "native",
882 
+					pch = pch[index], size = size[index])
883 
+			}
884 
+		}
885 
+		if(axis) grid.draw(axis_grob)
886 
+		if(border) grid.rect(gp = gpar(fill = "transparent"))
887 
+		popViewport()
888 
+	}
889 
+
890 
+	if(which == "row") {
891 
+		fun = row_fun
892 
+	} else if(which == "column") {
893 
+		fun = column_fun
894 
+	}
895 
+
896 
+	anno = AnnotationFunction(
897 
+		fun = fun,
898 
+		fun_name = "anno_points",
899 
+		which = which,
900 
+		width = anno_size$width,
901 
+		height = anno_size$height,
902 
+		n = n,
903 
+		data_scale = data_scale,
904 
+		var_import = list(value, gp, border, pch, size, pt_gp, axis, axis_param, axis_grob, data_scale, add_points)
905 
+	)
906 
+
907 
+	anno@subset_rule$gp = subset_vector
908 
+	if(input_is_matrix) {
909 
+		anno@subset_rule$value = subset_matrix_by_row
910 
+	} else {
911 
+		anno@subset_rule$value = subset_vector
912 
+		anno@subset_rule$gp = subset_gp
913 
+		anno@subset_rule$pt_gp = subset_gp
914 
+		anno@subset_rule$size = subset_vector
915 
+		anno@subset_rule$pch = subset_vector
916 
+	}
917 
+
918 
+	anno@subsetable = TRUE
919 
+
920 
+	anno@extended = update_anno_extend(anno, axis_grob, axis_param)
921 
+
922 
+	return(anno)
923 
+}
924 
+
784 925 
 # == title
785 926 
 # Using barplot as annotation
786 927 
 #
... ... 
@@ -1526,7 +1667,7 @@ anno_text = function(x, which = c("column", "row"), gp = gpar(),
1526 1667 
 		unit(ifelse(which == "column", 1, 0), "npc")
1527 1668 
 	}
1528 1669
1529 
-	rot = rot[1]
1670 
+	rot = rot[1] %% 360
1530 1671 
 	just = just[1]
1531 1672 
 	if(!missing(offset)) {
1532 1673 
 		warning("`offset` is deprecated, use `location` instead.")
R/ColorMapping-class.R
History View file @ d7a3c7a
... ... 
@@ -307,7 +307,7 @@ setMethod(f = "color_mapping_legend",
307 307 
 	if(plot) {
308 308 
 		pushViewport(viewport(..., width = grobWidth(gf), height = grobHeight(gf), name = paste0("legend_", object@name)))
309 309 
 		grid.draw(gf)
310 
-		upViewport()
310 
+		popViewport()
311 311 
 	}
312 312
313 313 
 	#size = unit.c(vp_width, vp_height)
R/Heatmap-class.R
History View file @ d7a3c7a
... ... 
@@ -71,24 +71,23 @@ Heatmap = setClass("Heatmap",
71 71 
         matrix = "matrix",  # one or more matrix which are spliced by rows
72 72 
         matrix_param = "list",
73 73 
         matrix_color_mapping = "ANY",
74 
-        matrix_color_mapping_param = "ANY",
74 
+        matrix_legend_param = "ANY",
75 75
76 76 
         row_title = "ANY",
77 
-        row_title_rot = "numeric",
78 
-        row_title_just = "numeric",
79 77 
         row_title_param = "list",
80 78 
         column_title = "ANY",
81 79 
         column_title_param = "list",
82 
-        column_title_rot = "numeric",
83 
-        column_title_just = "numeric",
84 80
85 81 
         row_dend_list = "list", # one or more row clusters
82 
+        row_dend_slice = "ANY",
86 83 
         row_dend_param = "list", # parameters for row cluster
87 84 
         row_order_list = "list",
88 85 
         row_order = "numeric",
89 86
90 
-        column_dend = "ANY",
87 
+        column_dend_list = "list",
88 
+        column_dend_slice = "ANY",
91 89 
         column_dend_param = "list", # parameters for column cluster
90 
+        column_order_list = "list",
92 91 
         column_order = "numeric",
93 92
94 93 
         row_names_param = "list",
... ... 
@@ -96,7 +95,6 @@ Heatmap = setClass("Heatmap",
96 95
97 96 
         top_annotation = "ANY", # NULL or a `HeatmapAnnotation` object
98 97 
         top_annotation_param = "list",
99 
-
100 98 
         bottom_annotation = "ANY",
101 99 
         bottom_annotation_param = "list",
102 100
... ... 
@@ -231,7 +229,9 @@ Heatmap = function(matrix, col, name,
231 229 
     na_col = "grey",
232 230 
     color_space = "LAB",
233 231 
     rect_gp = gpar(col = NA),
232 
+    border = NA,
234 233 
     cell_fun = NULL,
234 
+
235 235 
     row_title = character(0),
236 236 
     row_title_side = c("left", "right"),
237 237 
     row_title_gp = gpar(fontsize = 14),
... ... 
@@ -240,6 +240,7 @@ Heatmap = function(matrix, col, name,
240 240 
     column_title_side = c("top", "bottom"),
241 241 
     column_title_gp = gpar(fontsize = 14),
242 242 
     column_title_rot = 0,
243 
+
243 244 
     cluster_rows = TRUE,
244 245 
     clustering_distance_rows = "euclidean",
245 246 
     clustering_method_rows = "complete",
... ... 
@@ -248,11 +249,6 @@ Heatmap = function(matrix, col, name,
248 249 
     show_row_dend = TRUE,
249 250 
     row_dend_reorder = TRUE,
250 251 
     row_dend_gp = gpar(),
251 
-    row_hclust_side = row_dend_side,
252 
-    row_hclust_width = row_dend_width,
253 
-    show_row_hclust = show_row_dend,
254 
-    row_hclust_reorder = row_dend_reorder,
255 
-    row_hclust_gp = row_dend_gp,
256 252 
     cluster_columns = TRUE,
257 253 
     clustering_distance_columns = "euclidean",
258 254 
     clustering_method_columns = "complete",
... ... 
@@ -261,89 +257,95 @@ Heatmap = function(matrix, col, name,
261 257 
     show_column_dend = TRUE,
262 258 
     column_dend_gp = gpar(),
263 259 
     column_dend_reorder = TRUE,
264 
-    column_hclust_side = column_dend_side,
265 
-    column_hclust_height = column_dend_height,
266 
-    show_column_hclust = show_column_dend,
267 
-    column_hclust_gp = column_dend_gp,
268 
-    column_hclust_reorder = column_dend_reorder,
260 
+
269 261 
     row_order = NULL,
270 262 
     column_order = NULL,
263 
+
264 
+    row_labels = rownames(matrix),
271 265 
     row_names_side = c("right", "left"),
272 266 
     show_row_names = TRUE,
273 
-    row_names_max_width = default_row_names_max_width(),
267 
+    row_names_max_width = unit(6, "cm"),
274 268 
     row_names_gp = gpar(fontsize = 12),
269 
+    row_names_rot = 0,
270 
+    column_labels = colnames(matrix),
275 271 
     column_names_side = c("bottom", "top"),
276 272 
     show_column_names = TRUE,
277 
-    column_names_max_height = default_column_names_max_height(),
273 
+    column_names_max_height = unit(6, "cm"),
278 274 
     column_names_gp = gpar(fontsize = 12),
275 
+    column_names_rot = 90,
276 
+
279 277 
     top_annotation = new("HeatmapAnnotation"),
280 278 
     top_annotation_height = top_annotation@size,
281 279 
     bottom_annotation = new("HeatmapAnnotation"),
282 280 
     bottom_annotation_height = bottom_annotation@size,
281 
+
283 282 
     km = 1,
284 
-    km_title = "cluster%i",
285 283 
     split = NULL,
284 
+    row_km = km,
285 
+    row_split = split,
286 286 
     column_km = 1,
287 
-    column_km_title = "cluster%i",
288 287 
     column_split = NULL,
289 288 
     gap = unit(1, "mm"),
290 
-    column_gap = unit(2, "mm"),
291 
-    combined_name_fun = function(x) paste(x, collapse = "/"),
292 
-    width = NULL,
289 
+    row_gap = unit(1, "mm"),
290 
+    column_gap = unit(1, "mm"),
291 
+
292 
+    width = unit(1, "npc"),
293 
+    heatmap_body_width = NULL,
294 
+    height = unit(1, "npc"),
295 
+    heatmap_body_height = NULL,
296 
+
293 297 
     show_heatmap_legend = TRUE,
294 298 
     heatmap_legend_param = list(title = name),
295 
-    use_raster = FALSE,
299 
+
300 
+    use_raster = nrow(matrix) > 5000,
296 301 
     raster_device = c("png", "jpeg", "tiff", "CairoPNG", "CairoJPEG", "CairoTIFF"),
297 302 
     raster_quality = 2,
298 303 
     raster_device_param = list()) {
299 304
305 
+    verbose = ht_global_opt("verbose")
306 
+
307 
+    if(!dev.interactive()) {
308 
+        pdf(file = NULL)
309 
+        on.exit(dev.off())
310 
+    }
311 
+
312 
+    .Object = new("Heatmap")
313 
+    if(missing(name)) {
314 
+        name = paste0("matrix_", get_heatmap_index() + 1)
315 
+        increase_heatmap_index()
316 
+    }
317 
+    .Object@name = name
318 
+
300 319 
     # re-define some of the argument values according to global settings
301 320 
     called_args = names(as.list(match.call())[-1])
302 
-    e = environment()
303 321 
     for(opt_name in c("row_names_gp", "column_names_gp", "row_title_gp", "column_title_gp")) {
304 322 
         opt_name2 = paste0("heatmap_", opt_name)
305 323 
         if(! opt_name %in% called_args) { # if this argument is not called
306 324 
             if(!is.null(ht_global_opt(opt_name2))) {
307 
-                assign(opt_name, ht_global_opt(opt_name2), envir = e)
325 
+                if(verbose) qqcat("re-assign @{opt_name} with `ht_global_opt('@{opt_name2}'')`\n")
326 
+                assign(opt_name, ht_global_opt(opt_name2))
308 327 
             }
309 328 
         }
310 329 
     }
311 330
312 
-    for(ca in called_args) {
313 
-        if(ca %in% c("row_hclust_side", "row_hclust_width", "show_row_hclust", "row_hclust_reorder", "row_hclust_gp",
314 
-                     "column_hclust_side", "column_hclust_height", "show_column_hclust", "column_hclust_gp", "column_hclust_reorder")) {
315 
-            ca_new = gsub("hclust", "dend", ca)
316 
-            if(!ca_new %in% called_args) {
317 
-                assign(ca_new, get(ca))
318 
-            }
319 
-            warning(paste0("'", ca, "' is deprecated in the future, use '", ca_new, "' instead."))
320 
-        }
321 
-    }
322 
-
323 331 
     if("heatmap_legend_param" %in% called_args) {
324 332 
         for(opt_name in setdiff(c("title_gp", "title_position", "labels_gp", "grid_width", "grid_height", "grid_border"), names(heatmap_legend_param))) {
325 333 
             opt_name2 = paste0("heatmap_legend_", opt_name)
326 334 
             if(!is.null(ht_global_opt(opt_name2)))
335 
+                if(verbose) qqcat("re-assign heatmap_legend_param$@{opt_name} with `ht_global_opt('@{opt_name2}'')`\n")
327 336 
                 heatmap_legend_param[[opt_name]] = ht_global_opt(opt_name2)
328 337 
         }
329 338 
     } else {
330 339 
         for(opt_name in c("title_gp", "title_position", "labels_gp", "grid_width", "grid_height", "grid_border")) {
331 340 
             opt_name2 = paste0("heatmap_legend_", opt_name)
332 341 
             if(!is.null(ht_global_opt(opt_name2)))
342 
+                if(verbose) qqcat("re-assign heatmap_legend_param$@{opt_name} with `ht_global_opt('@{opt_name2}'')`\n")
333 343 
                 heatmap_legend_param[[opt_name]] = ht_global_opt(opt_name2)
334 344 
         }
335 345 
     }
336 346
337 
-    .Object = new("Heatmap")
338 
-
339 
-    .Object@heatmap_param$width = width
340 
-    .Object@heatmap_param$show_heatmap_legend = show_heatmap_legend
341 
-    .Object@heatmap_param$use_raster = use_raster
342 
-    .Object@heatmap_param$raster_device = match.arg(raster_device)[1]
343 
-    .Object@heatmap_param$raster_quality = raster_quality
344 
-    .Object@heatmap_param$raster_device_param = raster_device_param
345 
-
346 347 
     if(is.data.frame(matrix)) {
348 
+        if(verbose) qqcat("convert data frame to matrix\n")
347 349 
         matrix = as.matrix(matrix)
348 350 
     }
349 351 
     if(!is.matrix(matrix)) {
... ... 
@@ -352,20 +354,22 @@ Heatmap = function(matrix, col, name,
352 354 
             matrix = matrix(matrix, ncol = 1)
353 355 
             if(!is.null(rn)) rownames(matrix) = rn
354 356 
             if(!missing(name)) colnames(matrix) = name
357 
+            if(verbose) qqcat("convert simple vector to one-column matrix\n")
355 358 
         } else {
356 359 
             stop("If data is not a matrix, it should be a simple vector.")
357 360 
         }
358 361 
     }
359 362
360 
-    if(is.null(width)) {
361 
-        .Object@heatmap_param$width = ncol(matrix)
362 
-    }
363 
-
364 363 
     if(ncol(matrix) == 0) {
365 364 
         .Object@heatmap_param$show_heatmap_legend = FALSE
366 
-        .Object@heatmap_param$width = unit(0, "mm")
367 365 
     }
368 366
367 
+    ### normalize km/split and row_km/row_split
368 
+    if(missing(row_km)) row_km = km
369 
+    if(missing(row_split)) row_split = split
370 
+    if(missing(row_gap)) row_gap = gap
371 
+
372 
+    ####### zero and one column matrix ########
369 373 
     if(ncol(matrix) == 0 || nrow(matrix) == 0) {
370 374 
         if(!inherits(cluster_columns, c("dendrogram", "hclust"))) {
371 375 
             cluster_columns = FALSE
... ... 
@@ -375,21 +379,27 @@ Heatmap = function(matrix, col, name,
375 379 
             cluster_rows = FALSE
376 380 
             show_row_dend = FALSE
377 381 
         }
378 
-        km = 1
382 
+        row_km = 1
383 
+        column_km = 1
384 
+        if(verbose) qqcat("zero row/column matrix, set cluster_columns/rows to FALSE\n")
379 385 
     }
380 386 
     if(ncol(matrix) == 1) {
381 387 
         if(!inherits(cluster_columns, c("dendrogram", "hclust"))) {
382 388 
             cluster_columns = FALSE
383 389 
             show_column_dend = FALSE
384 390 
         }
391 
+        column_km = 1
392 
+        if(verbose) qqcat("one-column matrix, set cluster_columns to FALSE\n")
385 393 
     }
386 394 
     if(nrow(matrix) == 1) {
387 395 
         if(!inherits(cluster_rows, c("dendrogram", "hclust"))) {
388 396 
             cluster_rows = FALSE
389 397 
             show_row_dend = FALSE
390 398 
         }
391 
-        km = 1
399 
+        row_km = 1
400 
+        if(verbose) qqcat("one-row matrix, set cluster_rows to FALSE\n")
392 401 
     }
402 
+
393 403 
     if(is.character(matrix)) {
394 404 
         called_args = names(match.call()[-1])
395 405 
         if("clustering_distance_rows" %in% called_args) {
... ... 
@@ -399,6 +409,7 @@ Heatmap = function(matrix, col, name,
399 409 
             show_row_dend = FALSE
400 410 
         }
401 411 
         row_dend_reorder = FALSE
412 
+
402 413 
         if("clustering_distance_columns" %in% called_args) {
403 414 
         } else if(inherits(cluster_columns, c("dendrogram", "hclust"))) {
404 415 
         } else {
... ... 
@@ -406,32 +417,34 @@ Heatmap = function(matrix, col, name,
406 417 
             show_column_dend = FALSE
407 418 
         }
408 419 
         column_dend_reorder = FALSE
409 
-        km = 1
420 
+        row_km = 1
421 
+        column_km = 1
422 
+        if(verbose) qqcat("matrix is character. Do not cluster unless distance method is provided.\n")
410 423 
     }
411 424 
     .Object@matrix = matrix
412 425
413 
-    .Object@matrix_param$km = km
414 
-    .Object@matrix_param$km_title = km_title
415 
-    .Object@matrix_param$gap = gap
416 
-    if(!is.null(split)) {
426 
+    .Object@matrix_param$row_km = row_km
427 
+    .Object@matrix_param$row_gap = row_gap
428 
+    .Object@matrix_param$column_km = column_km
429 
+    .Object@matrix_param$column_gap = column_gap
430 
+
431 
+    ### check row_split and column_split ###
432 
+    if(!is.null(row_split)) {
417 433 
         if(inherits(cluster_rows, c("dendrogram", "hclust"))) {
418 
-            .Object@matrix_param$split = split
434 
+            .Object@matrix_param$row_split = row_split
419 435 
         } else {
420 
-            if(identical(cluster_rows, TRUE) && is.numeric(split) && length(split) == 1) {
436 
+            if(identical(cluster_rows, TRUE) && is.numeric(row_split) && length(row_split) == 1) {
421 437
422 438 
             } else {
423 
-                if(!is.data.frame(split)) split = data.frame(split)
424 
-                if(nrow(split) != nrow(matrix)) {
425 
-                    stop("Length or number of rows of `split` should be same as rows in `matrix`.")
439 
+                if(!is.data.frame(row_split)) row_split = data.frame(row_split)
440 
+                if(nrow(row_split) != nrow(matrix)) {
441 
+                    stop("Length or number of rows of `row_split` should be same as rows in `matrix`.")
426 442 
                 }
427 443 
             }
428 444 
         }
429 445 
     }
430 
-    .Object@matrix_param$split = split
446 
+    .Object@matrix_param$row_split = row_split
431 447
432 
-
433 
-    .Object@matrix_param$column_km = column_km
434 
-    .Object@matrix_param$column_gap = column_gap
435 448 
     if(!is.null(column_split)) {
436 449 
         if(inherits(cluster_columns, c("dendrogram", "hclust"))) {
437 450 
             .Object@matrix_param$column_split = column_split
... ... 
@@ -440,7 +453,7 @@ Heatmap = function(matrix, col, name,
440 453
441 454 
             } else {
442 455 
                 if(!is.data.frame(column_split)) column_split = data.frame(column_split)
443 
-                if(nrow(column_split) != nrow(matrix)) {
456 
+                if(nrow(column_split) != ncol(matrix)) {
444 457 
                     stop("Length or number of columns of `column_split` should be same as columns in `matrix`.")
445 458 
                 }
446 459 
             }
... ... 
@@ -448,100 +461,132 @@ Heatmap = function(matrix, col, name,
448 461 
     }
449 462 
     .Object@matrix_param$column_split = column_split
450 463
451 
-    .Object@matrix_param$gp =check_gp(rect_gp)
464 
+
465 
+    ### parameters for heatmap body ###
466 
+    .Object@matrix_param$gp = check_gp(rect_gp)
467 
+    if(identical(border, TRUE)) border = "black"
468 
+    .Object@matrix_param$border = border
452 469 
     .Object@matrix_param$cell_fun = cell_fun
453 470
454 
-    if(missing(name)) {
455 
-        name = paste0("matrix_", get_heatmap_index() + 1)
456 
-        increase_heatmap_index()
471 
+    if(!missing(heatmap_body_width)) {
472 
+        if(is_abs_unit(heatmap_body_width)) {
473 
+            width = unit(1, "npc") # since width is a relative unit and all components are absolute, it will be refit
474 
+        }
457 475 
     }
458 
-    .Object@name = name
459 
-
460 
-    # if(ncol(matrix) == 1 && is.null(colnames(matrix))) {
461 
-    #     colnames(matrix) = name
462 
-    #     .Object@matrix = matrix
463 
-    # }
476 
+    if(!missing(heatmap_body_height)) {
477 
+        if(is_abs_unit(heatmap_body_height)) {
478 
+            height = unit(1, "npc")
479 
+        }
480 
+    }
481 
+    if(is.null(heatmap_body_width)) {
482 
+        heatmap_body_width = unit(ncol(matrix), "null")
483 
+    }
484 
+    if(is.null(heatmap_body_height)) {
485 
+        heatmap_body_height = unit(nrow(matrix), "null")
486 
+    }
487 
+    .Object@matrix_param$width = heatmap_body_width
488 
+    .Object@matrix_param$height = heatmap_body_height
489 
+
464 490
465 
-    # color for main matrix
491 
+    ### color for main matrix #########
466 492 
     if(ncol(matrix) > 0 && nrow(matrix) > 0) {
467 493 
         if(missing(col)) {
468 494 
             col = default_col(matrix, main_matrix = TRUE)
495 
+            if(verbose) qqcat("color is not specified, use randomly generated colors\n")
469 496 
         }
470 497 
         if(is.function(col)) {
471 498 
             .Object@matrix_color_mapping = ColorMapping(col_fun = col, name = name, na_col = na_col)
499 
+            if(verbose) qqcat("input color is a color mapping function\n")
472 500 
         } else {
473 501 
             if(is.null(names(col))) {
474 502 
                 if(length(col) == length(unique(as.vector(matrix)))) {
475 503 
                     names(col) = sort(unique(as.vector(matrix)))
476 504 
                     .Object@matrix_color_mapping = ColorMapping(colors = col, name = name, na_col = na_col)
505 
+                    if(verbose) qqcat("input color is a vector with no names, treat it as discrete color mapping\n")
477 506 
                 } else if(is.numeric(matrix)) {
478 507 
                     col = colorRamp2(seq(min(matrix, na.rm = TRUE), max(matrix, na.rm = TRUE), length = length(col)),
479 508 
                                      col, space = color_space)
480 509 
                     .Object@matrix_color_mapping = ColorMapping(col_fun = col, name = name, na_col = na_col)
510 
+                    if(verbose) qqcat("input color is a vector with no names, treat it as continuous color mapping\n")
481 511 
                 } else {
482 512 
                     stop("`col` should have names to map to values in `mat`.")
483 513 
                 }
484 514 
             } else {
485 515 
                 col = col[intersect(c(names(col), "_NA_"), as.character(matrix))]
486 516 
                 .Object@matrix_color_mapping = ColorMapping(colors = col, name = name, na_col = na_col)
517 
+                if(verbose) qqcat("input color is a named vector\n")
487 518 
             }
488 519 
         }
489 
-        .Object@matrix_color_mapping_param = heatmap_legend_param
520 
+        .Object@matrix_legend_param = heatmap_legend_param
490 521 
     }
491 522
523 
+    ##### titles, should also consider titles after row splitting #####
492 524 
     if(length(row_title) == 0) {
493 
-        row_title = character(0)
494 525 
     } else if(!inherits(row_title, c("expression", "call"))) {
495 
-            if(is.na(row_title)) {
526 
+        if(is.na(row_title)) {
496 527 
             row_title = character(0)
497 528 
         } else if(row_title == "") {
498 529 
             row_title = character(0)
499 530 
         }
500 531 
     }
501 532 
     .Object@row_title = row_title
502 
-    .Object@row_title_rot = row_title_rot %% 360
533 
+    .Object@row_title_param$rot = row_title_rot %% 360
503 534 
     .Object@row_title_param$side = match.arg(row_title_side)[1]
504 535 
     .Object@row_title_param$gp = check_gp(row_title_gp)  # if the number of settings is same as number of row-splits, gp will be adjusted by `make_row_dend`
505 
-    .Object@row_title_param$combined_name_fun = combined_name_fun
506 
-    .Object@row_title_just = get_text_just(rot = row_title_rot, side = .Object@row_title_param$side)
536 
+    .Object@row_title_param$just = get_text_just(rot = row_title_rot, side = .Object@row_title_param$side)
507 537
508 538 
     if(length(column_title) == 0) {
509 
-        column_title = character(0)
510 539 
     } else if(!inherits(column_title, c("expression", "call"))) {
511 
-            if(is.na(column_title)) {
540 
+        if(is.na(column_title)) {
512 541 
             column_title = character(0)
513 542 
         } else if(column_title == "") {
514 543 
             column_title = character(0)
515 544 
         }
516 545 
     }
517 546 
     .Object@column_title = column_title
518 
-    .Object@column_title_rot = column_title_rot %% 360
547 
+    .Object@column_title_param$rot = column_title_rot %% 360
519 548 
     .Object@column_title_param$side = match.arg(column_title_side)[1]
520 549 
     .Object@column_title_param$gp = check_gp(column_title_gp)
521 
-    .Object@column_title_just = get_text_just(rot = column_title_rot, side = .Object@column_title_param$side)
550 
+    .Object@column_title_param$just = get_text_just(rot = column_title_rot, side = .Object@column_title_param$side)
522 551
552 
+    ### row labels/column labels ###
523 553 
     if(is.null(rownames(matrix))) {
524 554 
         show_row_names = FALSE
525 555 
     }
556 
+    .Object@row_names_param$labels = row_labels
526 557 
     .Object@row_names_param$side = match.arg(row_names_side)[1]
527 558 
     .Object@row_names_param$show = show_row_names
528 559 
     .Object@row_names_param$gp = check_gp(row_names_gp)
529 
-    default_row_names_max_width = function() {
530 
-        min(unit.c(unit(6, "cm")), max_text_width(rownames(matrix), gp = .Object@row_names_param$gp))
531 
-    }
560 
+    .Object@row_names_param$rot = row_names_rot
532 561 
     .Object@row_names_param$max_width = row_names_max_width + unit(2, "mm")
562 
+    # we use anno_text to draw row/column names because it already takes care of text rotation
563 
+    if(length(row_labels)) {
564 
+        row_names_anno = anno_text(row_labels, which = "row", gp = row_names_gp, rot = row_names_rot,
565 
+            location = ifelse(.Object@row_names_param$side == "left", 1, 0),
566 
+            just = ifelse(.Object@row_names_param$side == "left", "right", "left"))
567 
+        .Object@row_names_param$anno = row_names_anno
568 
+    }
533 569
534 570 
     if(is.null(colnames(matrix))) {
535 571 
         show_column_names = FALSE
536 572 
     }
573 
+    .Object@column_names_param$labels = column_labels
537 574 
     .Object@column_names_param$side = match.arg(column_names_side)[1]
538 575 
     .Object@column_names_param$show = show_column_names
539 576 
     .Object@column_names_param$gp = check_gp(column_names_gp)
540 
-    default_column_names_max_height = function() {
541 
-        min(unit.c(unit(6, "cm")), max_text_width(colnames(matrix), gp = .Object@column_names_param$gp))
542 
-    }
577 
+    .Object@column_names_param$rot = column_names_rot
543 578 
     .Object@column_names_param$max_height = column_names_max_height + unit(2, "mm")
579 
+    if(length(column_labels)) {
580 
+        column_names_anno = anno_text(column_labels, which = "column", gp = column_names_gp, rot = column_names_rot,
581 
+            location = ifelse(.Object@column_names_param$side == "top", 0, 1),
582 
+            just = ifelse(.Object@column_names_param$side == "top", "left", "right"))
583 
+        .Object@column_names_param$anno = column_names_anno
584 
+    }
544 585
586 
+    #### dendrograms ########
587 
+    if(missing(cluster_rows) && !missing(row_order)) {
588 
+        cluster_rows = FALSE
589 
+    }
545 590 
     if(inherits(cluster_rows, "dendrogram") || inherits(cluster_rows, "hclust")) {
546 591 
         .Object@row_dend_param$obj = cluster_rows
547 592 
         .Object@row_dend_param$cluster = TRUE
... ... 
@@ -576,6 +621,9 @@ Heatmap = function(matrix, col, name,
576 621 
         .Object@row_order = row_order
577 622 
     }
578 623
624 
+    if(missing(cluster_columns) && !missing(column_order)) {
625 
+        cluster_columns = FALSE
626 
+    }
579 627 
     if(inherits(cluster_columns, "dendrogram") || inherits(cluster_columns, "hclust")) {
580 628 
         .Object@column_dend_param$obj = cluster_columns
581 629 
         .Object@column_dend_param$cluster = TRUE
... ... 
@@ -592,7 +640,7 @@ Heatmap = function(matrix, col, name,
592 640 
     if(!show_column_dend) {
593 641 
         column_dend_height = unit(0, "mm")
594 642 
     }
595 
-    .Object@column_dend = NULL
643 
+    .Object@column_dend_list = list()
596 644 
     .Object@column_dend_param$distance = clustering_distance_columns
597 645 
     .Object@column_dend_param$method = clustering_method_columns
598 646 
     .Object@column_dend_param$side = match.arg(column_dend_side)[1]
... ... 
@@ -609,6 +657,7 @@ Heatmap = function(matrix, col, name,
609 657 
         .Object@column_order = column_order
610 658 
     }
611 659
660 
+    ######### annotations #############
612 661 
     .Object@top_annotation = top_annotation # a `HeatmapAnnotation` object
613 662 
     if(is.null(top_annotation)) {
614 663 
         .Object@top_annotation_param$height = unit(0, "mm")
... ... 
@@ -638,117 +687,41 @@ Heatmap = function(matrix, col, name,
638 687 
     }
639 688
640 689 
     .Object@layout = list(
641 
-        layout_column_title_top_height = unit(0, "mm"),
642 
-        layout_column_dend_top_height = unit(0, "mm"),
643 
-        layout_column_anno_top_height = unit(0, "mm"),
644 
-        layout_column_names_top_height = unit(0, "mm"),
645 
-        layout_column_title_bottom_height = unit(0, "mm"),
646 
-        layout_column_dend_bottom_height = unit(0, "mm"),
647 
-        layout_column_anno_bottom_height = unit(0, "mm"),
648 
-        layout_column_names_bottom_height = unit(0, "mm"),
649 
-
650 
-        layout_row_title_left_width = unit(0, "mm"),
651 
-        layout_row_dend_left_width = unit(0, "mm"),
652 
-        layout_row_names_left_width = unit(0, "mm"),
653 
-        layout_row_dend_right_width = unit(0, "mm"),
654 
-        layout_row_names_right_width = unit(0, "mm"),
655 
-        layout_row_title_right_width = unit(0, "mm"),
656 
-
657 
-        layout_heatmap_width = width, # for the layout of heatmap list
658 
-
659 
-        layout_index = matrix(nrow = 0, ncol = 2),
690 
+        layout_size = list(
691 
+            column_title_top_height = unit(0, "mm"),
692 
+            column_dend_top_height = unit(0, "mm"),
693 
+            column_anno_top_height = unit(0, "mm"),
694 
+            column_names_top_height = unit(0, "mm"),
695 
+            column_title_bottom_height = unit(0, "mm"),
696 
+            column_dend_bottom_height = unit(0, "mm"),
697 
+            column_anno_bottom_height = unit(0, "mm"),
698 
+            column_names_bottom_height = unit(0, "mm"),
699 
+
700 
+            row_title_left_width = unit(0, "mm"),
701 
+            row_dend_left_width = unit(0, "mm"),
702 
+            row_names_left_width = unit(0, "mm"),
703 
+            row_dend_right_width = unit(0, "mm"),
704 
+            row_names_right_width = unit(0, "mm"),
705 
+            row_title_right_width = unit(0, "mm")
706 
+        ),
707 
+
708 
+        layout_index = data.frame(),
660 709 
         graphic_fun_list = list()
661 710 
     )
662 711
712 
+    .Object@heatmap_param$width = width
713 
+    .Object@heatmap_param$height = height
714 
+    .Object@heatmap_param$show_heatmap_legend = show_heatmap_legend
715 
+    .Object@heatmap_param$use_raster = use_raster
716 
+    .Object@heatmap_param$raster_device = match.arg(raster_device)[1]
717 
+    .Object@heatmap_param$raster_quality = raster_quality
718 
+    .Object@heatmap_param$raster_device_param = raster_device_param
719 
+    .Object@heatmap_param$verbose = verbose
720 
+
663 721 
     return(.Object)
664 722
665 723 
 }
666 724
667 
-# == title
668 
-# Make cluster on columns
669 
-#
670 
-# == param
671 
-# -object a `Heatmap-class` object.
672 
-#
673 
-# == details
674 
-# The function will fill or adjust ``column_dend`` and ``column_order`` slots.
675 
-#
676 
-# This function is only for internal use.
677 
-#
678 
-# == value
679 
-# A `Heatmap-class` object.
680 
-#
681 
-# == author
682 
-# Zuguang Gu <z.gu@dkfz.de>
683 
-#
684 
-setMethod(f = "make_column_cluster",
685 
-    signature = "Heatmap",
686 
-    definition = function(object) {
687 
-
688 
-    if(ht_global_opt("fast_hclust")) {
689 
-        hclust = fastcluster::hclust
690 
-    } else {
691 
-        hclust = stats::hclust
692 
-    }
693 
-
694 
-    mat = object@matrix
695 
-    distance = object@column_dend_param$distance
696 
-    method = object@column_dend_param$method
697 
-    order = object@column_order
698 
-    reorder = object@column_dend_param$reorder
699 
-
700 
-    if(object@column_dend_param$cluster) {
701 
-        if(!is.null(object@column_dend_param$obj)) {
702 
-            object@column_dend = object@column_dend_param$obj
703 
-        } else if(!is.null(object@column_dend_param$fun)) {
704 
-            object@column_dend = object@column_dend_param$fun(t(mat))
705 
-        } else {
706 
-            object@column_dend = hclust(get_dist(t(mat), distance), method = method)
707 
-        }
708 
-        column_order = get_dend_order(object@column_dend)  # we don't need the pre-defined orders
709 
-
710 
-        if(inherits(object@column_dend, "hclust")) {
711 
-            object@column_dend = as.dendrogram(object@column_dend)
712 
-        }
713 
-
714 
-        if(identical(reorder, NULL)) {
715 
-            if(is.numeric(mat)) {
716 
-                reorder = TRUE
717 
-            } else {
718 
-                reorder = FALSE
719 
-            }
720 
-        }
721 
-
722 
-        do_reorder = TRUE
723 
-        if(identical(reorder, NA) || identical(reorder, FALSE)) {
724 
-            do_reorder = FALSE
725 
-        }
726 
-        if(identical(reorder, TRUE)) {
727 
-            do_reorder = TRUE
728 
-            reorder = colMeans(mat, na.rm = TRUE)
729 
-        }
730 
-
731 
-        if(do_reorder) {
732 
-            if(length(reorder) != ncol(mat)) {
733 
-                stop("weight of reordering should have same length as number of columns.\n")
734 
-            }
735 
-            object@column_dend = reorder(object@column_dend, reorder)
736 
-            column_order = order.dendrogram(object@column_dend)
737 
-        }
738 
-    } else {
739 
-        column_order = order
740 
-    }
741 
-
742 
-    # re-order
743 
-    object@column_order = column_order
744 
-
745 
-    if(ncol(mat) != length(column_order)) {
746 
-        stop("Number of columns in the matrix are not the same as the length of\nthe cluster or the column order.")
747 
-    }
748 
-
749 
-    return(object)
750 
-})
751 
-
752 725
753 726 
 # == title
754 727 
 # Make cluster on rows
... ... 
@@ -773,57 +746,94 @@ setMethod(f = "make_row_cluster",
773 746 
     signature = "Heatmap",
774 747 
     definition = function(object) {
775 748
749 
+    make_cluster(object, "row")
750 
+})
751 
+
752 
+setMethod(f = "make_column_cluster",
753 
+    signature = "Heatmap",
754 
+    definition = function(object) {
755 
+
756 
+    make_cluster(object, "column")
757 
+})
758 
+
759 
+make_cluster = function(object, which = c("row", "column")) {
760 
+
761 
+    which = match.arg(which)[1]
762 
+
763 
+    verbose = object@heatmap_param$verbose
764 
+
776 765 
     if(ht_global_opt("fast_hclust")) {
777 766 
         hclust = fastcluster::hclust
767 
+        if(verbose) qqcat("apply hclust by fastcluster::hclust\n")
778 768 
     } else {
779 769 
         hclust = stats::hclust
780 770 
     }
781 771
782 772 
     mat = object@matrix
783 
-    distance = object@row_dend_param$distance
784 
-    method = object@row_dend_param$method
785 
-    order = object@row_order  # pre-defined row order
786 
-    km = object@matrix_param$km
787 
-    km_title = object@matrix_param$km_title
788 
-    split = object@matrix_param$split
789 
-    reorder = object@row_dend_param$reorder
773 
+    distance = slot(object, paste0(which, "_dend_param"))$distance
774 
+    method = slot(object, paste0(which, "_dend_param"))$method
775 
+    order = slot(object, paste0(which, "_order"))  # pre-defined row order
776 
+    km = getElement(object@matrix_param, paste0(which, "_km"))
777 
+    split = getElement(object@matrix_param, paste0(which, "_split"))
778 
+    reorder = slot(object, paste0(which, "_dend_param"))$reorder
779 
+    cluster = slot(object, paste0(which, "_dend_param"))$cluster
780 
+    gap = getElement(object@matrix_param, paste0(which, "_gap"))
790 781
791 
-    if(object@row_dend_param$cluster) {
782 
+    dend_param = slot(object, paste0(which, "_dend_param"))
783 
+    dend_list = slot(object, paste0(which, "_dend_list"))
784 
+    dend_slice = slot(object, paste0(which, "_dend_slice"))
785 
+    order_list = slot(object, paste0(which, "_order_list"))
786 
+    order = slot(object, paste0(which, "_order"))
787 
+
788 
+    names_param = slot(object, paste0(which, "_names_param"))
789 
+
790 
+    if(cluster) {
792 791
793 792 
         if(is.numeric(split) && length(split) == 1) {
794 
-            if(is.null(object@row_dend_param$obj)) {
795 
-                object@row_dend_param$obj = hclust(get_dist(mat, distance), method = method)
793 
+            if(is.null(dend_param$obj)) {
794 
+                if(verbose) qqcat("split @{which}s by cutree, apply hclust on the entire @{which}s\n")
795 
+                if(which == "row") {
796 
+                    dend_param$obj = hclust(get_dist(mat, distance), method = method)
797 
+                } else {
798 
+                    dend_param$obj = hclust(get_dist(t(mat), distance), method = method)
799 
+                }
796 800 
             }
797 801 
         }
798 802
799 
-        if(!is.null(object@row_dend_param$obj)) {
803 
+        if(!is.null(dend_param$obj)) {
800 804 
             if(km > 1) {
801 
-                stop("You can not make k-means clustering since you have already specified a clustering object.")
805 
+                stop("You can not make k-means partition since you have already specified a clustering object.")
802 806 
             }
803 807
804 
-            if(inherits(object@row_dend_param$obj, "hclust")) {
805 
-                object@row_dend_param$obj = as.dendrogram(object@row_dend_param$obj)
808 
+            if(inherits(dend_param$obj, "hclust")) {
809 
+                dend_param$obj = as.dendrogram(dend_param$obj)
810 
+                if(verbose) qqcat("convert hclust object to dendrogram object\n")
806 811 
             }
807 812
808 813 
             if(is.null(split)) {
809 
-                object@row_dend_list = list(object@row_dend_param$obj)
810 
-                object@row_order_list = list(get_dend_order(object@row_dend_param$obj))
814 
+                dend_list = list(dend_param$obj)
815 
+                order_list = list(get_dend_order(dend_param$obj))
816 
+                if(verbose) qqcat("since you provided a clustering object and @{which}_split is null, the entrie clustering object is taken as an one-element list.\n")
811 817 
             } else {
812 818 
                 if(length(split) > 1 || !is.numeric(split)) {
813 
-                    stop("Since you specified a clustering object, you can only split rows by providing a number (number of row slices.")
819 
+                    stop(qq("Since you specified a clustering object, you can only split @{which}s by providing a number (number of @{which} slices)."))
814 820 
                 }
815 821 
                 if(split < 2) {
816 822 
                     stop("Here `split` should be equal or larger than 2.")
817 823 
                 }
818 824
819 
-                object@row_dend_list = cut_dendrogram(object@row_dend_param$obj, split)
820 
-                sth = tapply(order.dendrogram(object@row_dend_param$obj),
821 
-                    rep(seq_along(object@row_dend_list), times = sapply(object@row_dend_list, nobs)),
825 
+                ct = cut_dendrogram(dend_param$obj, split)
826 
+                dend_list = ct$lower
827 
+                dend_slice = ct$upper
828 
+                sth = tapply(order.dendrogram(dend_param$obj),
829 
+                    rep(seq_along(dend_list), times = sapply(dend_list, nobs)),
822 830 
                     function(x) x)
823 831 
                 attributes(sth) = NULL
824 
-                object@row_order_list = sth
832 
+                order_list = sth
833 
+                if(verbose) qqcat("cut @{which} dendrogram into @{split} slices.\n")
825 834 
             }
826 835
836 
+            ### do reordering if specified
827 837 
             if(identical(reorder, NULL)) {
828 838 
                 if(is.numeric(mat)) {
829 839 
                     reorder = TRUE
... ... 
@@ -838,70 +848,141 @@ setMethod(f = "make_row_cluster",
838 848 
             }
839 849 
             if(identical(reorder, TRUE)) {
840 850 
                 do_reorder = TRUE
841 
-                reorder = -rowMeans(mat, na.rm = TRUE)
851 
+                if(which == "row") {
852 
+                    reorder = -rowMeans(mat, na.rm = TRUE)
853 
+                } else {
854 
+                    reorder = -colMeans(mat, na.rm = TRUE)
855 
+                }
842 856 
             }
843 857
844 858 
             if(do_reorder) {
845 859
846 
-                if(length(reorder) != nrow(mat)) {
847 
-                    stop("weight of reordering should have same length as number of rows.\n")
860 
+                if(which == "row") {
861 
+                    if(length(reorder) != nrow(mat)) {
862 
+                        stop("weight of reordering should have same length as number of rows.\n")
863 
+                    }
864 
+                } else {
865 
+                    if(length(reorder) != ncol(mat)) {
866 
+                        stop("weight of reordering should have same length as number of columns\n")
867 
+                    }
868 
+                }
869 
+
870 
+                for(i in seq_along(dend_list)) {
871 
+                    if(length(order_list[[i]]) > 1) {
872 
+                        sub_ind = sort(order_list[[i]])
873 
+                        dend_list[[i]] = reorder(dend_list[[i]], reorder[sub_ind])
874 
+                        # the order of object@row_dend_list[[i]] is the order corresponding to the big dendrogram
875 
+                        order_list[[i]] = order.dendrogram(dend_list[[i]])
876 
+                    }
848 877 
                 }
849 
-                row_order_list = object@row_order_list
850 
-                row_dend_list = object@row_dend_list
851 
-                o_row_order_list = row_order_list
852 
-                for(i in seq_along(row_dend_list)) {
853 
-                    if(length(row_order_list[[i]]) > 1) {
854 
-                        sub_ind = which(seq_len(nrow(mat)) %in% o_row_order_list[[i]])
855 
-                        object@row_dend_list[[i]] = reorder(object@row_dend_list[[i]], reorder[sub_ind])
856 
-                        # object@row_order_list[[i]] = sub_ind[ order(order.dendrogram(object@row_dend_list[[i]])) ]
857 
-                        object@row_order_list[[i]] = order.dendrogram(object@row_dend_list[[i]])
878 
+            }
879 
+
880 
+            dend_list = lapply(dend_list, adjust_dend_by_x)
881 
+
882 
+            slot(object, paste0(which, "_order")) = unlist(order_list)
883 
+            slot(object, paste0(which, "_order_list")) = order_list
884 
+            slot(object, paste0(which, "_dend_list")) = dend_list
885 
+            slot(object, paste0(which, "_dend_param")) = dend_param
886 
+            slot(object, paste0(which, "_dend_slice")) = dend_slice
887 
+            split = data.frame(rep(seq_along(order_list), times = sapply(order_list, length)))
888 
+            object@matrix_param[[ paste0(which, "_split") ]] = split
889 
+
890 
+            # adjust row_names_param$gp if the length of some elements is the same as row slices
891 
+            for(i in seq_along(names_param$gp)) {
892 
+                if(length(names_param$gp[[i]]) == length(order_list)) {
893 
+                    gp_temp = NULL
894 
+                    for(j in seq_along(order_list)) {
895 
+                        gp_temp[ order_list[[j]] ] = names_param$gp[[i]][j]
858 896 
                     }
897 
+                    names_param$gp[[i]] = gp_temp
859 898 
                 }
860 899 
             }
900 
+            if(!is.null(names_param$anno)) {
901 
+                names_param$anno@var_env$gp = names_param$gp
902 
+            }
903 
+            slot(object, paste0(which, "_names_param")) = names_param
904 
+
905 
+            n_slice = length(order_list)
906 
+            if(length(gap) == 1) {
907 
+                gap = rep(gap, n_slice)
908 
+            } else if(length(gap) == n_slice - 1) {
909 
+                gap = unit.c(gap, unit(0, "mm"))
910 
+            } else if(length(gap) != n_slice) {
911 
+                stop(qq("Length of `gap` should be 1 or number of @{which} slices."))
912 
+            }
913 
+            object@matrix_param[[ paste0(which, "_gap") ]] = gap# adjust title
914 
+
915 
+            title = slot(object, paste0(which, "_title"))
916 
+            if(!is.null(split)) {
917 
+                if(length(title) == 0 && !is.null(title)) { ## default title
918 
+                    title = apply(unique(split), 1, paste, collapse = ",")
919 
+                } else if(length(title) == 1) {
920 
+                    if(grepl("%s", title)) {
921 
+                        title = apply(unique(split), 1, function(x) {
922 
+                            lt = lapply(x, function(x) x)
923 
+                            lt$fmt = title
924 
+                            do.call(sprintf, lt)
925 
+                        })
926 
+                    }
927 
+                }
928 
+            }
929 
+            slot(object, paste0(which, "_title")) = title
930 
+
861 931 
             return(object)
862 932 
         }
863 933
864 
-        row_order = seq_len(nrow(mat))
865 934 
     } else {
866 
-        row_order = order
935 
+        if(verbose) qqcat("no clustering is applied/exists on @{which}s\n")
867 936 
     }
868 
-
937 
+
938 
+    if(verbose) qq("clustering object is not pre-defined, clustering is applied to each @{which} slice\n")
869 939 
     # make k-means clustering to add a split column
870 940 
     if(km > 1 && is.numeric(mat)) {
871 
-        km.fit = kmeans(mat, centers = km)
872 
-        cluster = km.fit$cluster
873 
-        meanmat = lapply(unique(cluster), function(i) {
874 
-            colMeans(mat[cluster == i, , drop = FALSE])
875 
-        })
941 
+        if(which == "row") {
942 
+            km.fit = kmeans(mat, centers = km)
943 
+            cl = km.fit$cluster
944 
+            meanmat = lapply(unique(cl), function(i) {
945 
+                colMeans(mat[cl == i, , drop = FALSE])
946 
+            })
947 
+        } else {
948 
+            km.fit = kmeans(t(mat), centers = km)
949 
+            cl = km.fit$cluster
950 
+            meanmat = lapply(unique(cl), function(i) {
951 
+                rowMeans(mat[, cl == i, drop = FALSE])
952 
+            })
953 
+        }
954 
+
876 955 
         meanmat = as.matrix(as.data.frame(meanmat))
877 956 
         hc = hclust(dist(t(meanmat)))
878 957 
         weight = colMeans(meanmat)
879 958 
         hc = as.hclust(reorder(as.dendrogram(hc), -weight))
880 
-        cluster2 = numeric(length(cluster))
959 
+        cl2 = numeric(length(cl))
881 960 
         for(i in seq_along(hc$order)) {
882 
-            cluster2[cluster == hc$order[i]] = i
961 
+            cl2[cl == hc$order[i]] = i
883 962 
         }
884 
-        cluster2 = factor(paste0("cluster", cluster2), levels = paste0("cluster", seq_along(hc$order)))
885 
-        cluster2 = factor(sprintf(km_title, cluster2), levels = sprintf(km_title, seq_along(hc$order)))
963 
+        cl2 = factor(cl2, levels = seq_along(hc$order))
886 964
887 965 
         if(is.null(split)) {
888 
-            split = data.frame(cluster2)
966 
+            split = data.frame(cl2)
889 967 
         } else if(is.matrix(split)) {
890 968 
             split = as.data.frame(split)
891 
-            split = cbind(cluster2, split)
969 
+            split = cbind(cl2, split)
892 970 
         } else if(is.null(ncol(split))) {
893 
-            split = data.frame(cluster2, split)
971 
+            split = data.frame(cl2, split)
894 972 
         } else {
895 
-            split = cbind(cluster2, split)
973 
+            split = cbind(cl2, split)
896 974 
         }
975 
+        if(verbose) qqcat("apply k-means (@{km} groups) on @{which}s, append to the `split` data frame\n")
897 976
898 977 
     }
899 978
900 979 
     # split the original order into a list according to split
901 
-    row_order_list = list()
980 
+    order_list = list()
902 981 
     if(is.null(split)) {
903 
-        row_order_list[[1]] = row_order
982 
+        order_list[[1]] = order
904 983 
     } else {
984 
+
985 
+        if(verbose) qqcat("process `split` data frame\n")
905 986 
         if(is.null(ncol(split))) split = data.frame(split)
906 987 
         if(is.matrix(split)) split = as.data.frame(split)
907 988
... ... 
@@ -916,53 +997,58 @@ setMethod(f = "make_row_cluster",
916 997 
             }
917 998 
         }
918 999
919 
-        split_name = NULL
920 
-        combined_name_fun = object@row_title_param$combined_name_fun
921 
-        if(!is.null(combined_name_fun)) {
922 
-            split_name = apply(as.matrix(split), 1, combined_name_fun)
923 
-        } else {
924 
-            split_name = apply(as.matrix(split), 1, paste, collapse = "\n")
925 
-        }
926 
-
927 
-        row_order2 = do.call("order", split)
928 
-        row_level = unique(split_name[row_order2])
929 
-        for(k in seq_along(row_level)) {
930 
-            l = split_name == row_level[k]
931 
-            row_order_list[[k]] = intersect(row_order, which(l))
932 
-        }
1000 
+        split_name = apply(as.matrix(split), 1, paste, collapse = "\n")
933 1001
934 
-        object@row_order_list = row_order_list
935 
-
936 
-        if(!is.null(combined_name_fun)) {
937 
-            object@row_title = row_level
1002 
+        order2 = do.call("order", split)
1003 
+        level = unique(split_name[order2])
1004 
+        for(k in seq_along(level)) {
1005 
+            l = split_name == level[k]
1006 
+            order_list[[k]] = intersect(order, which(l))
938 1007 
         }
1008 
+        names(order_list) = level
939 1009 
     }
940 
-    o_row_order_list = row_order_list
1010 
+
941 1011 
     # make dend in each slice
942 
-    if(object@row_dend_param$cluster) {
943 
-        row_dend_list = rep(list(NULL), length(row_order_list))
944 
-        for(i in seq_along(row_order_list)) {
945 
-            submat = mat[ row_order_list[[i]], , drop = FALSE]
946 
-            if(nrow(submat) > 1) {
947 
-                if(!is.null(object@row_dend_param$fun)) {
948 
-                    row_dend_list[[i]] = object@row_dend_param$fun(mat)
949 
-                    row_order_list[[i]] = row_order_list[[i]][ get_dend_order(row_dend_list[[i]]) ]
1012 
+    if(cluster) {
1013 
+        if(verbose) qqcat("apply clustering on each @{cluster} slice (@{length(order_list)} slices)\n")
1014 
+        dend_list = rep(list(NULL), length(order_list))
1015 
+        for(i in seq_along(order_list)) {
1016 
+            if(which == "row") {
1017 
+                submat = mat[ order_list[[i]], , drop = FALSE]
1018 
+            } else {
1019 
+                submat = mat[, order_list[[i]], drop = FALSE]
1020 
+            }
1021 
+            nd = 0
1022 
+            if(which == "row") nd = nrow(submat) else nd = ncol(submat)
1023 
+            if(nd > 1) {
1024 
+                if(!is.null(dend_param$fun)) {
1025 
+                    if(which == "row") {
1026 
+                        dend_list[[i]] = dend_param$fun(submat)
1027 
+                    } else {
1028 
+                        dend_list[[i]] = dend_param$fun(t(submat))
1029 
+                    }
1030 
+                    order_list[[i]] = order_list[[i]][ get_dend_order(dend_list[[i]]) ]
950 1031 
                 } else {
951 
-                    #if(is.numeric(mat)) {
952 
-                        row_dend_list[[i]] = hclust(get_dist(submat, distance), method = method)
953 
-                        row_order_list[[i]] = row_order_list[[i]][ get_dend_order(row_dend_list[[i]]) ]
1032 
+
1033 
+                        if(which == "row") {
1034 
+                            dend_list[[i]] = hclust(get_dist(submat, distance), method = method)
1035 
+                        } else {
1036 
+                            dend_list[[i]] = hclust(get_dist(t(submat), distance), method = method)
1037 
+                        }
1038 
+                        order_list[[i]] = order_list[[i]][ get_dend_order(dend_list[[i]]) ]
954 1039 
                     #}
955 1040 
                 }
956 1041 
             } else {
957 
-                #row_dend_list[[i]] = NULL
958 
-                row_order_list[[i]] = row_order_list[[i]][1]
1042 
+                # a dendrogram with one leaf
1043 
+                dend_list[[i]] = structure(1, members = 1, height = 0, leaf = TRUE, class = "dendrogram")
1044 
+                order_list[[i]] = order_list[[i]][1]
959 1045 
             }
960 1046 
         }
961 
-        object@row_dend_list = row_dend_list
1047 
+        names(dend_list) = names(order_list)
962 1048
963 
-        for(i in seq_along(object@row_dend_list)) {
964 
-            if(inherits(object@row_dend_list[[i]], "hclust")) {
965 
-                object@row_dend_list[[i]] = as.dendrogram(object@row_dend_list[[i]])
1049 
+        for(i in seq_along(dend_list)) {
1050 
+            if(inherits(dend_list[[i]], "hclust")) {
1051 
+                dend_list[[i]] = as.dendrogram(dend_list[[i]])
966 1052 
             }
967 1053 
         }
968 1054
... ... 
@@ -980,47 +1066,108 @@ setMethod(f = "make_row_cluster",
980 1066 
         }
981 1067 
         if(identical(reorder, TRUE)) {
982 1068 
             do_reorder = TRUE
983 
-            reorder = -rowMeans(mat, na.rm = TRUE)
1069 
+            if(which == "row") {
1070 
+                reorder = -rowMeans(mat, na.rm = TRUE)
1071 
+            } else {
1072 
+                reorder = -colMeans(mat, na.rm = TRUE)
1073 
+            }
984 1074 
         }
985 1075
986 1076 
         if(do_reorder) {
987 1077
988 
-            if(length(reorder) != nrow(mat)) {
989 
-                stop("weight of reordering should have same length as number of rows.\n")
1078 
+            if(which == "row") {
1079 
+                if(length(reorder) != nrow(mat)) {
1080 
+                    stop("weight of reordering should have same length as number of rows\n")
1081 
+                }
1082 
+            } else {
1083 
+                if(length(reorder) != ncol(mat)) {
1084 
+                    stop("weight of reordering should have same length as number of columns\n")
1085 
+                }
990 1086 
             }
991 
-            for(i in seq_along(row_dend_list)) {
992 
-                if(length(row_order_list[[i]]) > 1) {
993 
-                    sub_ind = which(seq_len(nrow(mat)) %in% o_row_order_list[[i]])
994 
-                    object@row_dend_list[[i]] = reorder(object@row_dend_list[[i]], reorder[sub_ind])
995 
-                    row_order_list[[i]] = sub_ind[ order.dendrogram(object@row_dend_list[[i]]) ]
1087 
+            for(i in seq_along(dend_list)) {
1088 
+                if(length(order_list[[i]]) > 1) {
1089 
+                    sub_ind = sort(order_list[[i]])
1090 
+                    dend_list[[i]] = reorder(dend_list[[i]], reorder[sub_ind])
1091 
+                    order_list[[i]] = sub_ind[ order.dendrogram(dend_list[[i]]) ]
996 1092 
                 }
997 1093 
             }
1094 
+            if(verbose) qqcat("reorder dendrograms in each @{which} slice\n")
998 1095 
         }
999 
-    }
1000 1096
1001 
-
1097 
+        if(length(order_list) > 1) {
1098 
+            if(which == "row") {
1099 
+                slice_mean = sapply(order_list, function(ind) colMeans(mat[ind, , drop = FALSE]))
1100 
+            } else {
1101 
+                slice_mean = sapply(order_list, function(ind) rowMeans(mat[, ind, drop = FALSE]))
1102 
+            }
1103 
+            dend_slice = as.dendrogram(hclust(dist(t(slice_mean))))
1104 
+            if(verbose) qqcat("perform clustering on mean of @{which} slices\n")
1105 
+        }
1106 
+    }
1002 1107
1003 
-    object@row_order_list = row_order_list
1004 
-    object@matrix_param$split = split
1108 
+    dend_list = lapply(dend_list, adjust_dend_by_x)
1005 1109
1110 
+    slot(object, paste0(which, "_order")) = unlist(order_list)
1111 
+    slot(object, paste0(which, "_order_list")) = order_list
1112 
+    slot(object, paste0(which, "_dend_list")) = dend_list
1113 
+    slot(object, paste0(which, "_dend_param")) = dend_param
1114 
+    slot(object, paste0(which, "_dend_slice")) = dend_slice
1115 
+    object@matrix_param[[ paste0(which, "_split") ]] = split
1006 1116
1007 
-    if(nrow(mat) != length(unlist(row_order_list))) {
1008 
-        stop("Number of rows in the matrix are not the same as the length of\nthe cluster or the row orders.")
1117 
+    if(which == "row") {
1118 
+        if(nrow(mat) != length(order)) {
1119 
+            stop(qq("Number of rows in the matrix are not the same as the length of the cluster or the @{which} orders."))
1120 
+        }
1121 
+    } else {
1122 
+        if(ncol(mat) != length(order)) {
1123 
+            stop(qq("Number of columns in the matrix are not the same as the length of the cluster or the @{which} orders."))
1124 
+        }
1009 1125 
     }
1010 1126
1011 
-    # adjust row_names_param$gp if the length of some elements is the same as row slices
1012 
-    for(i in seq_along(object@row_names_param$gp)) {
1013 
-        if(length(object@row_names_param$gp[[i]]) == length(object@row_order_list)) {
1127 
+    # adjust names_param$gp if the length of some elements is the same as slices
1128 
+    for(i in seq_along(names_param$gp)) {
1129 
+        if(length(names_param$gp[[i]]) == length(order_list)) {
1014 1130 
             gp_temp = NULL
1015 
-            for(j in seq_along(object@row_order_list)) {
1016 
-                gp_temp[ object@row_order_list[[j]] ] = object@row_names_param$gp[[i]][j]
1131 
+            for(j in seq_along(order_list)) {
1132 
+                gp_temp[ order_list[[j]] ] = names_param$gp[[i]][j]
1017 1133 
             }
1018 
-            object@row_names_param$gp[[i]] = gp_temp
1134 
+            names_param$gp[[i]] = gp_temp
1019 1135 
         }
1020 1136 
     }
1137 
+    if(!is.null(names_param$anno)) {
1138 
+        names_param$anno@var_env$gp = names_param$gp
1139 
+    }
1140 
+    slot(object, paste0(which, "_names_param")) = names_param
1141 
+
1142 
+    n_slice = length(order_list)
1143 
+    if(length(gap) == 1) {
1144 
+        gap = rep(gap, n_slice)
1145 
+    } else if(length(gap) == n_slice - 1) {
1146 
+        gap = unit.c(gap, unit(0, "mm"))
1147 
+    } else if(length(gap) != n_slice) {
1148 
+        stop(qq("Length of `gap` should be 1 or number of @{which} slices."))
1149 
+    }
1150 
+    object@matrix_param[[ paste0(which, "_gap") ]] = gap
1151 
+
1152 
+    # adjust title
1153 
+    title = slot(object, paste0(which, "_title"))
1154 
+    if(!is.null(split)) {
1155 
+        if(length(title) == 0 && !is.null(title)) { ## default title
1156 
+            title = apply(unique(split), 1, paste, collapse = ",")
1157 
+        } else if(length(title) == 1) {
1158 
+            if(grepl("%s", title)) {
1159 
+                title = apply(unique(split), 1, function(x) {
1160 
+                    lt = lapply(x, function(x) x)
1161 
+                    lt$fmt = title