version bump

kbSSR · Mar 26, 2019 · 0d456ec · 0d456ec
1 parent 9c4d56c
commit 0d456ec
Show file tree

Hide file tree

Showing 19 changed files with 172 additions and 195 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: ComplexHeatmap
 Type: Package
 Title: Make Complex Heatmaps
-Version: 1.99.6
+Version: 1.99.7
 Date: 2019-03-15
 Author: Zuguang Gu
 Maintainer: Zuguang Gu <[email protected]>

diff --git a/NEWS b/NEWS
@@ -1,11 +1,13 @@
 CHANGES in VERSION 1.99.6
 
-* adjust the size of heatmap annotations and add testing scripts
-* run multiple times k-means to get a consensus partition
-* `show_heatmap_legend` is set to FALSE if `rect_gp = gpar(type = "none")`
-* add `restore_matrix()`
-* add `row_names_centered`/`column_names_centered` arguments to `Heatmap()`
-* `gp` in `anno_text()` supports `fill` and `border`
+* adjust the size of heatmap annotations and add testing scripts.
+* run multiple times k-means to get a consensus partition.
+* `show_heatmap_legend` is set to FALSE if `rect_gp = gpar(type = "none")`.
+* add `restore_matrix()`.
+* add `row_names_centered`/`column_names_centered` arguments to `Heatmap()`.
+* `gp` in `anno_text()` supports `fill` and `border`.
+* `Legend` adds boxplot-style legend.
+* adjustment according to annotation extension is improved.
 
 ========================
 

diff --git a/R/AnnotationFunction-class.R b/R/AnnotationFunction-class.R
@@ -391,7 +391,7 @@ setMethod(f = "show",
 			cat("  subsetable variable:", paste(var_subsetable, collapse = ", "), "\n")
 		}
 	}
-	cat("  this object is ", ifelse(object@subsetable, "\b", "not "), "subsetable\n", sep = "")
+	cat("  this object is ", ifelse(object@subsetable, "", "not "), "subsetable\n", sep = "")
 	dirt = c("bottom", "left", "top", "right")
 	for(i in 1:4) {
 		if(!identical(unit(0, "mm"), object@extended[i])) {

diff --git a/R/Heatmap-class.R b/R/Heatmap-class.R
@@ -354,9 +354,17 @@ Heatmap = function(matrix, col, name,
         }
     }
 
-    if(ncol(matrix) == 0) {
-        show_heatmap_legend = FALSE
-        .Object@heatmap_param$show_heatmap_legend = FALSE
+    # if(ncol(matrix) == 0 || nrow(matrix) == 0) {
+    #     show_heatmap_legend = FALSE
+    #     .Object@heatmap_param$show_heatmap_legend = FALSE
+    # }
+    if(ncol(matrix) == 0 && (!is.null(left_annotation) || !is.null(right_annotation))) {
+        message_wrap("If you have row annotations for a zeor-column matrix, please directly use in form of `rowAnnotation(...) + NULL`")
+        return(invisible(NULL))
+    }
+    if(nrow(matrix) == 0 && (!is.null(top_annotation) || !is.null(bottom_annotation))) {
+        message_wrap("If you have column annotations for a zero-row matrix, please directly use in form of `HeatmapAnnotation(...) %v% NULL`")
+        return(invisible(NULL))
     }
     if(identical(rect_gp$type, "none")) {
         show_heatmap_legend = FALSE
@@ -1430,6 +1438,10 @@ make_cluster = function(object, which = c("row", "column")) {
         }
     }
     slot(object, paste0(which, "_title")) = title
+    # check whether height of the dendrogram is zero
+    if(all(sapply(dend_list, dend_heights) == 0)) {
+        slot(object, paste0(which, "_dend_param"))$show = FALSE
+    }
     return(object)
 
 }

diff --git a/R/HeatmapAnnotation-class.R b/R/HeatmapAnnotation-class.R
@@ -52,7 +52,7 @@ HeatmapAnnotation = setClass("HeatmapAnnotation",
 #      See `SingleAnnotation` for how to set colors.
 # -na_col Color for ``NA`` values in simple annotations.
 # -annotation_legend_param A list which contains parameters for annotation legends. See `color_mapping_legend,ColorMapping-method` for all possible options.
-# -show_legend Whether show annotation legends. The value can be one single value or a vector which corresponds to simple annotations.
+# -show_legend Whether show annotation legends. The value can be one single value or a vector.
 # -which Are these row annotations or column annotations?
 # -gp Graphic parameters for simple annotations (with ``fill`` parameter ignored).
 # -border border of single annotations.
@@ -215,6 +215,10 @@ HeatmapAnnotation = function(...,
     if(length(show_legend) == 1) {
 		show_legend = recycle_param(show_legend, simple_anno_name, TRUE)
 	}
+	# check length of show_legend
+	if(length(show_legend) == length(anno_value_list) && !all(l_simple_anno)) {
+		show_legend = show_legend[l_simple_anno]
+	}
 
 	###### normalize `heatmap_legend_param` #######
 	if(length(annotation_legend_param) == 0) {

diff --git a/R/HeatmapList-class.R b/R/HeatmapList-class.R
@@ -206,6 +206,7 @@ setMethod(f = "add_heatmap",
 # -km = this modifies ``km`` of the main heatmap
 # -split this modifies ``split`` of the main heatmap
 # -row_km this modifies ``row_km`` of the main heatmap
+# -row_km_repeats this modifies ``row_km_repeats`` of the main heatmap
 # -row_split this modifies ``row_split`` of the main heatmap
 # -height this modifies ``height`` of the main heatmap
 # -heatmap_height this modifies ``heatmap_height`` of the main heatmap
@@ -219,6 +220,7 @@ setMethod(f = "add_heatmap",
 # -column_dend_gp this modifies ``column_dend_gp`` of the main heatmap
 # -column_order this modifies ``column_order`` of the main heatmap
 # -column_km this modifies ``column_km`` of the main heatmap
+# -column_km_repeats this modifies ``column_km_repeats`` of the main heatmap
 # -column_split this modifies ``column_split`` of the main heatmap
 # -width this modifies ``width`` of the main heatmap
 # -heatmap_width this modifies ``heatmap_width`` of the main heatmap
@@ -298,6 +300,7 @@ setMethod(f = "draw",
     km = NULL,
     split = NULL,
     row_km = km,
+    row_km_repeats = NULL,
     row_split = split,
     height = NULL,
     heatmap_height = NULL,
@@ -312,6 +315,7 @@ setMethod(f = "draw",
     column_dend_gp = NULL,
     column_order = NULL,
     column_km = NULL,
+    column_km_repeats = NULL,
     column_split = NULL,
     width = NULL,
     heatmap_width = NULL,
@@ -465,6 +469,7 @@ setMethod(f = "draw",
         row_dend_gp = row_dend_gp,
         row_order = row_order,
         row_km = row_km,
+        row_km_repeats = row_km_repeats,
         row_split = row_split,
         height = height,
         heatmap_height = heatmap_height,
@@ -479,6 +484,7 @@ setMethod(f = "draw",
         column_dend_gp = column_dend_gp,
         column_order = column_order,
         column_km = column_km,
+        column_km_repeats = column_km_repeats,
         column_split = column_split,
         width = width,
         heatmap_width = heatmap_width
@@ -514,7 +520,7 @@ setMethod(f = "draw",
     ht_graphic_fun_list = object@layout$graphic_fun_list
 
     for(j in seq_len(nrow(ht_layout_index))) {
-        pushViewport(viewport(layout.pos.row = ht_layout_index[j, 1], layout.pos.col = ht_layout_index[j, 2]))
+        pushViewport(viewport(name = paste0("global-", rownames(ht_layout_index)[j]), layout.pos.row = ht_layout_index[j, 1], layout.pos.col = ht_layout_index[j, 2]))
         ht_graphic_fun_list[[j]](object)
         upViewport()
     }

diff --git a/R/HeatmapList-draw_component.R b/R/HeatmapList-draw_component.R
@@ -50,6 +50,7 @@ setMethod(f = "adjust_heatmap_list",
         }
 
         # since each heatmap actually has nine rows, calculate the maximum height of corresponding rows in all heatmap 
+        max_title_component_width = unit(c(0, 0), "mm")
         max_title_component_height = unit.c(
             max(do.call("unit.c", lapply(object@ht_list[ht_index], function(ht) component_height(ht, "column_title_top")))),
             max(do.call("unit.c", lapply(object@ht_list[ht_index], function(ht) component_height(ht, "column_title_bottom"))))
@@ -191,6 +192,7 @@ setMethod(f = "adjust_heatmap_list",
             object@layout$row_anno_max_bottom_extended = row_anno_max_bottom_extended
             object@layout$max_bottom_component_height = max_bottom_component_height
             object@layout$max_title_component_height = max_title_component_height
+            object@layout$max_title_component_width = max_title_component_width
 
             ## left and right
             column_anno_max_left_extended = unit(0, "mm")
@@ -251,6 +253,7 @@ setMethod(f = "adjust_heatmap_list",
             }
         }
 
+        max_title_component_height = unit(c(0, 0), "mm")
         max_title_component_width = unit.c(
             max(do.call("unit.c", lapply(object@ht_list[ht_index], function(ht) component_width(ht, "row_title_left")))),
             max(do.call("unit.c", lapply(object@ht_list[ht_index], function(ht) component_width(ht, "row_title_right"))))
@@ -392,13 +395,15 @@ setMethod(f = "adjust_heatmap_list",
             object@layout$column_anno_max_right_extended = column_anno_max_right_extended
             object@layout$max_right_component_width = max_right_component_width
             object@layout$max_title_component_width = max_title_component_width
+            object@layout$max_title_component_height = max_title_component_height
 
             ## top and bottom
             row_anno_max_top_extended = unit(0, "mm")
             max_top_component_height = unit(0, "mm")
             if(inherits(object@ht_list[[1]], "Heatmap")) {
                 ht_first = object@ht_list[[1]]
                 max_top_component_height = sum(component_height(ht_first, c("column_names_top", "column_dend_top", "column_anno_top", "column_title_top")))
+
                 u = unit(0, "mm")
                 if(!is.null(ht_first@left_annotation)) {
                     u = unit.c(u, ht_first@left_annotation@extended[3])
@@ -499,20 +504,22 @@ setMethod(f = "adjust_heatmap_list",
             }
         }
     }
+
     if(is.null(adjust_annotation_extension)) adjust_annotation_extension = TRUE
     if(adjust_annotation_extension) {
-        if(object@layout$row_anno_max_bottom_extended[[1]] > object@layout$max_bottom_component_height[[1]]) {
-            padding[1] = object@layout$row_anno_max_bottom_extended - object@layout$max_bottom_component_height
+        # note e.g. max_*_component_height does not include the height of titles
+        if(object@layout$row_anno_max_bottom_extended[[1]] > object@layout$max_bottom_component_height[[1]]+ object@layout$max_title_component_height[[2]]) {
+            padding[1] = object@layout$row_anno_max_bottom_extended - object@layout$max_bottom_component_height - object@layout$max_title_component_height[2]
         }
-        if(object@layout$column_anno_max_left_extended[[1]] > object@layout$max_left_component_width[[1]]) {
-            padding[2] = object@layout$column_anno_max_left_extended - object@layout$max_left_component_width + GLOBAL_PADDING[2]
+        if(object@layout$column_anno_max_left_extended[[1]] > object@layout$max_left_component_width[[1]] + object@layout$max_title_component_width[[1]]) {
+            padding[2] = object@layout$column_anno_max_left_extended - object@layout$max_left_component_width - object@layout$max_title_component_width[1]
         }
 
-        if(object@layout$row_anno_max_top_extended[[1]] > object@layout$max_top_component_height[[1]]) {
-            padding[3] = object@layout$row_anno_max_top_extended - object@layout$max_top_component_height + GLOBAL_PADDING[3]
+        if(object@layout$row_anno_max_top_extended[[1]] > object@layout$max_top_component_height[[1]] + object@layout$max_title_component_height[[1]]) {
+            padding[3] = object@layout$row_anno_max_top_extended - object@layout$max_top_component_height - object@layout$max_title_component_height[1]
         }
-        if(object@layout$column_anno_max_right_extended[[1]] > object@layout$max_right_component_width[[1]]) {
-            padding[4] = object@layout$column_anno_max_right_extended - object@layout$max_right_component_width + GLOBAL_PADDING[4]
+        if(object@layout$column_anno_max_right_extended[[1]] > object@layout$max_right_component_width[[1]] + object@layout$max_title_component_width[[2]]) {
+            padding[4] = object@layout$column_anno_max_right_extended - object@layout$max_right_component_width - object@layout$max_title_component_width[2]
         }
     }
     object@layout$heatmap_list_padding = padding

diff --git a/R/HeatmapList-layout.R b/R/HeatmapList-layout.R
@@ -35,6 +35,7 @@
 # -row_dend_gp Overwrite the corresponding setting in the main heatmap.
 # -row_order Overwrite the corresponding setting in the main heatmap.
 # -row_km Overwrite the corresponding setting in the main heatmap.
+# -row_km_repeats Overwrite the corresponding setting in the main heatmap.
 # -row_split Overwrite the corresponding setting in the main heatmap.
 # -height Overwrite the corresponding setting in the main heatmap.
 # -heatmap_height Overwrite the corresponding setting in the main heatmap.
@@ -48,6 +49,7 @@
 # -column_dend_gp Overwrite the corresponding setting in the main heatmap.
 # -column_order Overwrite the corresponding setting in the main heatmap.
 # -column_km Overwrite the corresponding setting in the main heatmap.
+# -column_km_repeats Overwrite the corresponding setting in the main heatmap.
 # -column_split Overwrite the corresponding setting in the main heatmap.
 # -width Overwrite the corresponding setting in the main heatmap.
 # -heatmap_width Overwrite the corresponding setting in the main heatmap.
@@ -104,6 +106,7 @@ setMethod(f = "make_layout",
     row_dend_gp = NULL,
     row_order = NULL,
     row_km = NULL,
+    row_km_repeats = NULL,
     row_split = NULL,
     height = NULL,
     heatmap_height = NULL,
@@ -118,6 +121,7 @@ setMethod(f = "make_layout",
     column_dend_gp = NULL,
     column_order = NULL,
     column_km = NULL,
+    column_km_repeats = NULL,
     column_split = NULL,
     width = NULL,
     heatmap_width = NULL) {
@@ -235,6 +239,10 @@ setMethod(f = "make_layout",
             object@ht_list[[i_main]]@matrix_param$row_km = row_km
             if(verbose) qqcat("set row_km to main heatmap\n")
         }
+        if(!is.null(row_km_repeats)) {
+            object@ht_list[[i_main]]@matrix_param$row_km_repeats = row_km_repeats
+            if(verbose) qqcat("set row_km_repeats to main heatmap\n")
+        }
 
         if(!is.null(row_gap)) {
             object@ht_list[[i_main]]@matrix_param$row_gap = row_gap
@@ -372,6 +380,10 @@ setMethod(f = "make_layout",
             object@ht_list[[i_main]]@matrix_param$column_km = column_km
             if(verbose) qqcat("set column_km to main heatmap\n")
         }
+        if(!is.null(column_km_repeats)) {
+            object@ht_list[[i_main]]@matrix_param$column_km_repeats = column_km_repeats
+            if(verbose) qqcat("set column_km_repeats to main heatmap\n")
+        }
 
         if(!is.null(column_gap)) {
             object@ht_list[[i_main]]@matrix_param$column_gap = column_gap
@@ -848,6 +860,16 @@ setMethod(f = "make_layout",
             }
         }
     }
+    if(length(heatmap_legend_list) != 0) {
+        if(inherits(heatmap_legend_list, c("Legends", "grob"))) {
+            heatmap_legend_list = list(heatmap_legend_list)
+        }
+    }
+    if(length(annotation_legend_list) != 0) {
+        if(inherits(annotation_legend_list, c("Legends", "grob"))) {
+            annotation_legend_list = list(annotation_legend_list)
+        }
+    }
     if(merge_legends) {
         heatmap_legend_list = c(heatmap_legend_list, annotation_legend_list)
     }

diff --git a/R/grid.Legend.R b/R/grid.Legend.R
@@ -60,7 +60,7 @@ Legends = function(...) {
 # -labels_rot Text rotation for labels. It should only be used for horizontal continuous legend.
 # -border Color of legend grid borders. It also works for the ticks in the continuous legend.
 # -background Background colors for the grids. It is used when points and lines are the legend graphics.
-# -type Type of legends. The value can be one of ``grid``, ``points`` and ``lines``.
+# -type Type of legends. The value can be one of ``grid``, ``points``, ``lines`` and ``boxplot``.
 # -legend_gp Graphic parameters for the legend grids. You should control the filled color of the legend grids by ``gpar(fill = ...)``.
 # -pch Type of points if points are used as legend. Note you can use single-letter as pch, e.g. ``pch = 'A'``.
 #      There are three additional integers that are valid for ``pch``: 26 and 27 for single diagonal lines and 28 for double diagonal lines.
@@ -425,6 +425,18 @@ discrete_legend_body = function(at, labels = at, nrow = NULL, ncol = 1, by_row =
 					         gp = subset_gp(legend_gp, index))
 			))
 		}
+		if(any(c("boxplot", "box") %in% type)) {
+			gl = c(gl, list(
+				segmentsGrob(x0 = grid_x, y0 = grid_y - grid_height*0.45, 
+					         x1 = grid_x, y1 = grid_y + grid_height*0.45,
+					         gp = subset_gp(legend_gp, index)),
+				rectGrob(x = grid_x, y = grid_y, width = grid_width*0.9, height = grid_height*0.5,
+					     gp = subset_gp(legend_gp, index)),
+				segmentsGrob(x0 = grid_x - grid_width*0.45, y0 = grid_y, 
+					         x1 = grid_x + grid_width*0.45, y1 = grid_y,
+					         gp = subset_gp(legend_gp, index))
+			))
+		}
 	}
 
 	class(gl) = "gList"
@@ -742,6 +754,8 @@ horizontal_continuous_legend_body = function(at, labels = at, col_fun,
 # == param
 # -... A list of objects returned by `Legend`.
 # -gap Gap between two neighbouring legends. The value is a `grid::unit` object with length of one.
+#      It is the same as ``row_gap`` if the direction if vertial and the same as ``column_gap`` if
+#      the direction is horizontal.
 # -row_gap Horizontal gaps between legends.
 # -column_gap Vertical gaps between legends.
 # -direction The direction to arrange legends.
@@ -765,7 +779,7 @@ horizontal_continuous_legend_body = function(at, labels = at, col_fun,
 # draw(pd, test = "two legends")
 # pd = packLegend(lgd1, lgd2, direction = "horizontal")
 # draw(pd, test = "two legends packed horizontally")
-packLegend = function(...,gap = unit(2, "mm"), row_gap = unit(2, "mm"), column_gap = unit(2, "mm"),
+packLegend = function(..., gap = unit(2, "mm"), row_gap = unit(2, "mm"), column_gap = unit(2, "mm"),
 	direction = c("vertical", "horizontal"),
 	max_width = NULL, max_height = NULL, list = NULL) {
 

diff --git a/R/oncoPrint.R b/R/oncoPrint.R
@@ -94,8 +94,8 @@ oncoPrint = function(mat,
 	if("axis_gp" %in% arg_names) {
 		stop_wrap("`axis_gp` is removed from the arguments. Please set `axis_param(gp = ...)` in `anno_oncoprint_barplot()` when you define the `top_annotation` or `right_annotation`.")
 	}
-	if("show_row_names" %in% arg_names) {
-		stop_wrap("`show_row_names` is removed from the arguments. Please directly remove `anno_oncoprint_barplot()` in `right_annotation` to remove barplots on the left of the oncoPrint.")
+	if("show_row_barplot" %in% arg_names) {
+		stop_wrap("`show_row_barplot` is removed from the arguments. Please directly remove `anno_oncoprint_barplot()` in `right_annotation` to remove barplots on the right of the oncoPrint.")
 	}
 	if("row_barplot_width" %in% arg_names) {
 		stop_wrap("`row_barplot_width` is removed from the arguments. Please directly set `width` in `anno_oncoprint_barplot()` in `right_annotation`.")
@@ -110,6 +110,10 @@ oncoPrint = function(mat,
 		stop_wrap("`barplot_ignore` is removed from the arguments. The subset of alterations now can be controlled in `anno_oncoprint_barplot()`.")
 	}
 
+	if(inherits(col, "function")) {
+		stop_wrap("`col` should be specified as a vector.")
+	}
+
 	# convert mat to mat_list
 	if(inherits(mat, "data.frame")) {
 		mat = as.matrix(mat)
@@ -152,8 +156,7 @@ oncoPrint = function(mat,
 		stop_wrap("Incorrect type of 'mat'")
 	}
 
-	cat("All mutation types:", paste(all_type, collapse = ", "), "\n")
-
+	message_wrap(paste0("All mutation types: ", paste(all_type, collapse = ", ")))
 
 	# type as the third dimension
 	arr = array(FALSE, dim = c(dim(mat_list[[1]]), length(all_type)), dimnames = c(dimnames(mat_list[[1]]), list(all_type)))
@@ -573,7 +576,7 @@ anno_oncoprint_barplot = function(type = NULL, which = c("column", "row"),
 			axis = axis, axis_param = axis_param)@fun
 		fun(index, k, n)
 	}
-	
+
 	if(which == "row") {
 		fun = row_fun
 	} else if(which == "column") {
@@ -592,8 +595,19 @@ anno_oncoprint_barplot = function(type = NULL, which = c("column", "row"),
 	anno@subsetable = TRUE
 	anno@show_name = FALSE
 
+	if(exists("arr", envir = parent.frame(1))) {
+		arr = get("arr", envir = parent.frame(1))
+		if(which == "row") {
+			data_scale = c(0, max(apply(arr, 1, sum)))
+		} else {
+			data_scale = c(0, max(apply(arr, 2, sum)))
+		}
+	} else {
+		data_scale = c(0, 100)
+	}
+
 	axis_param = validate_axis_param(axis_param, which)
-	axis_grob = if(axis) construct_axis_grob(axis_param, which, c(0, 100)) else NULL
+	axis_grob = if(axis) construct_axis_grob(axis_param, which, data_scale) else NULL
 	anno@extended = update_anno_extend(anno, axis_grob, axis_param)
 
 	return(anno)