Nothing
R/HeatmapList-layout.R
In ComplexHeatmap: Make Complex Heatmaps
Defines functions
has_heatmap_list_component
heatmap_list_layout_index
calc_legends_max_width
calc_legends_max_height
# == title
# Make Layout for the Heatmap List
#
# == param
# -object A `HeatmapList-class` object.
# -row_title Title on the row.
# -row_title_side Will the title be put on the left or right of the heatmap list?
# -row_title_gp Graphic parameters for the row title.
# -column_title Title on the column.
# -column_title_side Will the title be put on the top or bottom of the heatmap?
# -column_title_gp Graphic parameters for the column title.
# -heatmap_legend_side Side of the heatmap legends.
# -merge_legends Whether to put heatmap legends and annotation legends together. By default they are put in different viewports.
# -show_heatmap_legend Whether show heatmap legends.
# -heatmap_legend_list A list of self-defined legends, should be wrapped into a list of `grid::grob` objects. Normally they are constructed by `Legend`.
# -annotation_legend_side Side of annotation legends.
# -show_annotation_legend Whether show annotation legends.
# -annotation_legend_list A list of self-defined legends, should be wrapped into a list of `grid::grob` objects. Normally they are constructed by `Legend`.
# -align_heatmap_legend How to align the legends to heatmap. Possible values are "heatmap_center", "heatmap_top" and "global_center". If the value is ``NULL``,
# it automatically picks the proper value from the three options.
# -align_annotation_legend How to align the legends to heatmap. Possible values are "heatmap_center", "heatmap_top" and "global_center".
# -legend_grouping How the legends are grouped. Values should be "adjusted" or "original".
# -ht_gap Gap between heatmaps, should be a `grid::unit` object. It can be a vector of length 1 or the number of heamtaps/annotations.
# -main_heatmap Name or index for the main heatmap.
# -padding Padding of the whole plot. The four values correspond to the bottom, left, top and right paddings.
# -auto_adjust whether apply automatic adjustment? The auto-adjustment includes turning off dendrograms, titles and row/columns for non-main heatmaps.
# -row_dend_side If auto-adjustment is on, to put the row dendrograms of the main heatmap to the most left side of the heatmap list or the most right side?
# -row_sub_title_side There can be sub titles generated by the splitting of heatmaps. Similar setting as ``row_dend_side``.
# -column_dend_side Similar setting as ``row_dend_side``.
# -column_sub_title_side Similar setting as ``row_sub_title_side``.
# -row_gap Overwrite the corresponding setting in the main heatmap.
# -cluster_rows Overwrite the corresponding setting in the main heatmap.
# -cluster_row_slices Overwrite the corresponding setting in the main heatmap.
# -clustering_distance_rows Overwrite the corresponding setting in the main heatmap.
# -clustering_method_rows Overwrite the corresponding setting in the main heatmap.same setting as in `Heatmap`, if it is specified, ``clustering_method_rows`` in main heatmap is ignored.
# -row_dend_width Overwrite the corresponding setting in the main heatmap.
# -show_row_dend same Overwrite the corresponding setting in the main heatmap.
# -row_dend_reorder Overwrite the corresponding setting in the main heatmap.
# -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.
# -column_gap Overwrite the corresponding setting in the main heatmap.
# -cluster_columns Overwrite the corresponding setting in the main heatmap.
# -cluster_column_slices Overwrite the corresponding setting in the main heatmap.
# -clustering_distance_columns Overwrite the corresponding setting in the main heatmap.
# -clustering_method_columns Overwrite the corresponding setting in the main heatmap.
# -column_dend_width column Overwrite the corresponding setting in the main heatmap.
# -show_column_dend Overwrite the corresponding setting in the main heatmap.
# -column_dend_reorder Overwrite the corresponding setting in the main heatmap.
# -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.
# -use_raster Overwrite the corresponding setting in every heatmap.
# -raster_device Overwrite the corresponding setting in every heatmap.
# -raster_quality Overwrite the corresponding setting in every heatmap.
# -raster_device_param Overwrite the corresponding setting in every heatmap.
# -raster_resize Overwrite the corresponding setting in every heatmap.
#
# == detail
# It sets the size of each component of the heatmap list and adjusts graphic
# parameters for each heatmap if necessary.
#
# This function is only for internal use.
#
# == value
# A `HeatmapList-class` object in which settings for all heatmap are adjusted.
#
# == author
# Zuguang Gu <z.gu@dkfz.de>
#
setMethod(f = "make_layout",
signature = "HeatmapList",
definition = function(object,
row_title = character(0),
row_title_side = c("left", "right"),
row_title_gp = gpar(fontsize = 14),
column_title = character(0),
column_title_side = c("top", "bottom"),
column_title_gp = gpar(fontsize = 14),
heatmap_legend_side = c("right", "left", "bottom", "top"),
merge_legends = FALSE,
show_heatmap_legend = TRUE,
heatmap_legend_list = list(),
annotation_legend_side = c("right", "left", "bottom", "top"),
show_annotation_legend = TRUE,
annotation_legend_list = list(),
align_heatmap_legend = NULL,
align_annotation_legend = NULL,
legend_grouping = c("adjusted", "original"),
ht_gap = unit(2, "mm"),
main_heatmap = which(sapply(object@ht_list, inherits, "Heatmap"))[1],
padding = GLOBAL_PADDING,
auto_adjust = TRUE,
row_dend_side = c("original", "left", "right"),
row_sub_title_side = c("original", "left", "right"),
column_dend_side = c("original", "top", "bottom"),
column_sub_title_side = c("original", "top", "bottom"),
row_gap = NULL,
cluster_rows = NULL,
cluster_row_slices = NULL,
clustering_distance_rows = NULL,
clustering_method_rows = NULL,
row_dend_width = NULL,
show_row_dend = NULL,
row_dend_reorder = NULL,
row_dend_gp = NULL,
row_order = NULL,
row_km = NULL,
row_km_repeats = NULL,
row_split = NULL,
height = NULL,
heatmap_height = NULL,
column_gap = NULL,
cluster_columns = NULL,
cluster_column_slices = NULL,
clustering_distance_columns = NULL,
clustering_method_columns = NULL,
column_dend_width = NULL,
show_column_dend = NULL,
column_dend_reorder = NULL,
column_dend_gp = NULL,
column_order = NULL,
column_km = NULL,
column_km_repeats = NULL,
column_split = NULL,
width = NULL,
heatmap_width = NULL,
use_raster = NULL,
raster_device = NULL,
raster_quality = NULL,
raster_device_param = NULL,
raster_resize = NULL) {
verbose = ht_opt("verbose")
if(object@layout$initialized) {
if(verbose) qqcat("heatmap list is already initialized\n")
return(object)
}
# the size of the plotting page
# if current viewport is top viewport
current_vp = current.viewport()$name
if(current_vp == "ROOT") {
page_size = unit(par("din"), "in")
} else {
grid::upViewport()
page_size = unit.c(convertWidth(unit(1, "npc"), "mm"),
convertHeight(unit(1, "npc"), "mm"))
grid::downViewport(current_vp)
}
object@ht_list_param$padding = padding
n_ht = length(object@ht_list)
i_main = main_heatmap[1]
direction = object@direction
# i_main is aleays numeric index
if(is.character(i_main)) {
i_main = which(names(object@ht_list) == i_main)[1]
if(length(i_main) == 0) {
stop_wrap(qq("cannot find heatmap '@{main_heatmap}'"))
}
}
if(verbose) qqcat("@{n_ht} heatmaps/annotations, main heatmap: @{i_main}th\n")
if(inherits(object@ht_list[[i_main]], "HeatmapAnnotation")) {
stop_wrap("the main heatmap can only be the heatmap.")
}
nr = nrow(object@ht_list[[i_main]]@matrix)
nc = ncol(object@ht_list[[i_main]]@matrix)
if(n_ht > 1) {
if(length(ht_gap) == 1) {
if(inherits(ht_gap, "unit")) {
ht_gap = rep(ht_gap, n_ht)
}
} else if(length(ht_gap) == n_ht - 1) {
ht_gap = unit.c(ht_gap, unit(0, "mm"))
} else if(length(ht_gap) > n_ht) {
stop_wrap(paste0("length of `ht_gap` can only be 1 or ", n_ht-1, "."))
}
} else {
if(!is.unit(ht_gap)) {
warning_wrap("`ht_gap` should be a unit object, reset it to unit(0, 'mm').")
ht_gap = unit(rep(0, n_ht), "mm")
}
}
object@ht_list_param$ht_gap = ht_gap
# adjust gaps if some heatmap has zero row/column
for(i in seq_len(n_ht)) {
if(inherits(object@ht_list[[i]], "Heatmap")) {
if(direction == "horizontal") {
if(i == 1 && ncol(object@ht_list[[1]]@matrix) == 0) {
ht_gap[1] = unit(0, "mm")
if(verbose) qqcat("The first heatmap has zero column, set the first gap to unit(0, 'mm')\n")
} else if(i == n_ht && ncol(object@ht_list[[n_ht]]@matrix) == 0) {
ht_gap[n_ht - 1] = unit(0, "mm")
if(verbose) qqcat("The last heatmap has zero column, set the last gap to unit(0, 'mm')\n")
} else if(ncol(object@ht_list[[i]]@matrix) == 0) {
ht_gap[i] = unit(0, "mm")
if(verbose) qqcat("The @{i}th heatmap has zero column, set the @{i}th gap to unit(0, 'mm')\n")
}
} else {
if(i == 1 && nrow(object@ht_list[[1]]@matrix) == 0) {
ht_gap[1] = unit(0, "mm")
if(verbose) qqcat("The first heatmap has zero row, set the first gap to unit(0, 'mm')\n")
} else if(i == n_ht && nrow(object@ht_list[[n_ht]]@matrix) == 0) {
ht_gap[n_ht - 1] = unit(0, "mm")
if(verbose) qqcat("The last heatmap has zero row, set the last gap to unit(0, 'mm')\n")
} else if(nrow(object@ht_list[[i]]@matrix) == 0) {
ht_gap[i] = unit(0, "mm")
if(verbose) qqcat("The @{i}th heatmap has zero row, set the @{i}th gap to unit(0, 'mm')\n")
}
}
}
}
### update some values for the main heatmap
ht_nr = nrow(object@ht_list[[i_main]]@matrix)
ht_nc = ncol(object@ht_list[[i_main]]@matrix)
if(direction == "horizontal") {
if(!is.null(row_split)) {
object@ht_list[[i_main]]@matrix_param$row_split = row_split
if(verbose) qqcat("set row_split to main heatmap\n")
if(is.data.frame(row_split)) {
if(nrow(row_split) != ht_nr) {
stop_wrap("`row_split` should have same nrow as the main matrix.")
}
} else if(is.atomic(row_split)) {
if(length(row_split) > 1 && length(row_split) != ht_nr) {
stop_wrap("`row_split` should have same length as nrow of the main matrix.")
}
if(length(row_split) == 1 && !object@ht_list[[i_main]]@row_dend_param$cluster) {
stop_wrap("Since there is no row clustering for the main heatmap, `row_split` is not allowed to set as a single number.")
}
}
}
if(!is.null(row_km)) {
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
if(verbose) qqcat("set row_gap to main heatmap\n")
}
if(!is.null(cluster_rows)) {
if(is.null(show_row_dend) && identical(cluster_rows, TRUE)) {
show_row_dend = TRUE
}
if(inherits(cluster_rows, c("dendrogram", "hclust"))) {
object@ht_list[[i_main]]@row_dend_param$obj = cluster_rows
object@ht_list[[i_main]]@row_dend_param$cluster = TRUE
if(verbose) qqcat("set cluster_rows to main heatmap\n")
} else if(inherits(cluster_rows, "function")) {
object@ht_list[[i_main]]@row_dend_param$fun = cluster_rows
object@ht_list[[i_main]]@row_dend_param$cluster = TRUE
if(verbose) qqcat("set cluster_rows to main heatmap\n")
} else {
object@ht_list[[i_main]]@row_dend_param$cluster = cluster_rows
if(verbose) qqcat("set cluster_rows to main heatmap\n")
if(!cluster_rows) {
row_dend_width = unit(0, "mm")
show_row_dend = FALSE
} else {
row_dend_width = unit(10, "mm")
}
}
}
if(!is.null(cluster_row_slices)) {
object@ht_list[[i_main]]@row_dend_param$cluster_slices = cluster_row_slices
if(verbose) qqcat("set cluster_row_slices to main heatmap\n")
}
if(!is.null(show_row_dend)) {
if(!show_row_dend) {
row_dend_width = unit(0, "mm")
}
}
if(!is.null(clustering_distance_rows)) {
object@ht_list[[i_main]]@row_dend_param$distance = clustering_distance_rows
if(verbose) qqcat("set clustering_distance_rows to main heatmap\n")
}
if(!is.null(clustering_method_rows)) {
object@ht_list[[i_main]]@row_dend_param$method = clustering_method_rows
if(verbose) qqcat("set clustering_method_rows to main heatmap\n")
}
if(!is.null(row_dend_width)) {
if(unclass(row_dend_width)[[1]] == 0) {
object@ht_list[[i_main]]@row_dend_param$width = unit(0, "mm")
} else {
object@ht_list[[i_main]]@row_dend_param$width = row_dend_width + ht_opt$DENDROGRAM_PADDING # append the gap
}
}
if(!is.null(show_row_dend)) {
object@ht_list[[i_main]]@row_dend_param$show = show_row_dend
}
if(!is.null(row_dend_gp)) {
object@ht_list[[i_main]]@row_dend_param$gp = check_gp(row_dend_gp)
if(verbose) qqcat("set row_dend_gp to main heatmap\n")
}
if(!is.null(row_dend_reorder)) {
object@ht_list[[i_main]]@row_dend_param$reorder = row_dend_reorder
if(verbose) qqcat("set row_dend_reorder to main heatmap\n")
}
if(!is.null(row_order)) {
if(any(is.na(row_order))) {
stop_wrap("`row_order` should not contain NA values.")
}
if(length(row_order) != nrow(object@ht_list[[i_main]]@matrix)) {
stop_wrap("length of `row_order` should be same as the number of main marix rows.")
}
if(is.character(row_order)) {
row_order = structure(seq_len(nrow(object@ht_list[[i_main]]@matrix)), names = rownames(object@ht_list[[i_main]]@matrix))[row_order]
}
object@ht_list[[i_main]]@row_order = row_order
if(verbose) qqcat("set row_order to main heatmap\n")
}
if(!is.null(height) && !is.null(heatmap_height)) {
stop_wrap("You can only specify one of `height` and `heatmap_height` in draw().")
}
if(!is.null(height)) {
if(!inherits(height, "unit")) {
stop_wrap("`height` specified in `draw()` should be a unit.")
}
if(!is_abs_unit(height)) {
stop_wrap("`height` specified in `draw()` should be an absolute unit.")
}
}
if(!is.null(heatmap_height)) {
if(!inherits(heatmap_height, "unit")) {
stop_wrap("`heatmap_height` specified in `draw()` should be a unit.")
}
if(!is_abs_unit(heatmap_height)) {
stop_wrap("`heatmap_height` specified in `draw()` should be an absolute unit.")
}
}
if(!is.null(height) && is.null(heatmap_height)) {
object@ht_list[[i_main]]@matrix_param$height = height
object@ht_list[[i_main]]@heatmap_param$height = unit(1, "npc")
} else if(is.null(height) && !is.null(heatmap_height)) {
object@ht_list[[i_main]]@matrix_param$height = unit(1, "npc")
object@ht_list[[i_main]]@heatmap_param$height = heatmap_height
}
# column_* should not be set for horizontal heatmap list
for(obj_nm in c("column_split", "column_km", "column_gap", "cluster_columns", "show_column_dend", "clustering_distance_columns",
"clustering_method_columns", "column_dend_width", "show_column_dend", "column_dend_gp", "column_dend_reorder",
"column_order", "width", "heatmap_width")) {
if(!is.null(get(obj_nm))) {
message_wrap(paste0("'", obj_nm, "' should not be set in draw() for horizontal heatmap list (Note a single heatmap is a horizontal heatmap list). Please directly set it in `Heatmap()`."))
}
}
} else {
if(!is.null(column_split)) {
object@ht_list[[i_main]]@matrix_param$column_split = column_split
if(verbose) qqcat("set column_split to main heatmap\n")
if(is.data.frame(column_split)) {
if(nrow(column_split) != ht_nc) {
stop_wrap("`column_split` should have same ncol as the main matrix.")
}
} else if(is.atomic(column_split)) {
if(length(column_split) > 1 && length(column_split) != ht_nr) {
stop_wrap("`column_split` should have same length as ncol of the main matrix.")
}
if(length(column_split) == 1 && !object@ht_list[[i_main]]@column_dend_param$cluster) {
stop_wrap("Since there is no column clustering for the main heatmap, `column_split` is not allowed to set as a single number.")
}
}
}
if(!is.null(column_km)) {
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
if(verbose) qqcat("set column_gap to main heatmap\n")
}
if(!is.null(cluster_columns)) {
if(is.null(show_column_dend) && identical(cluster_columns, TRUE)) {
show_column_dend = TRUE
}
if(inherits(cluster_columns, c("dendrogram", "hclust"))) {
object@ht_list[[i_main]]@column_dend_param$obj = cluster_columns
object@ht_list[[i_main]]@column_dend_param$cluster = TRUE
if(verbose) qqcat("set cluster_columns to main heatmap\n")
} else if(inherits(cluster_columns, "function")) {
object@ht_list[[i_main]]@column_dend_param$fun = cluster_columns
object@ht_list[[i_main]]@column_dend_param$cluster = TRUE
if(verbose) qqcat("set cluster_columns to main heatmap\n")
} else {
object@ht_list[[i_main]]@column_dend_param$cluster = cluster_columns
if(verbose) qqcat("set cluster_columns to main heatmap\n")
if(!cluster_columns) {
column_dend_width = unit(0, "mm")
show_column_dend = FALSE
} else {
column_dend_width = unit(10, "mm")
}
}
}
if(!is.null(cluster_column_slices)) {
object@ht_list[[i_main]]@column_dend_param$cluster_slices = cluster_column_slices
if(verbose) qqcat("set cluster_column_slices to main heatmap\n")
}
if(!is.null(show_column_dend)) {
if(!show_column_dend) {
column_dend_width = unit(0, "mm")
}
}
if(!is.null(clustering_distance_columns)) {
object@ht_list[[i_main]]@column_dend_param$distance = clustering_distance_columns
if(verbose) qqcat("set clustering_distance_columns to main heatmap\n")
}
if(!is.null(clustering_method_columns)) {
object@ht_list[[i_main]]@column_dend_param$method = clustering_method_columns
if(verbose) qqcat("set clustering_method_columns to main heatmap\n")
}
if(!is.null(column_dend_width)) {
if(unclass(column_dend_width)[[1]] == 0) {
object@ht_list[[i_main]]@column_dend_param$width = unit(0, "mm")
} else {
object@ht_list[[i_main]]@column_dend_param$width = column_dend_width + ht_opt$DENDROGRAM_PADDING # append the gap
}
}
if(!is.null(show_column_dend)) {
object@ht_list[[i_main]]@column_dend_param$show = show_column_dend
}
if(!is.null(column_dend_gp)) {
object@ht_list[[i_main]]@column_dend_param$gp = check_gp(column_dend_gp)
if(verbose) qqcat("set column_dend_gp to main heatmap\n")
}
if(!is.null(column_dend_reorder)) {
object@ht_list[[i_main]]@column_dend_param$reorder = column_dend_reorder
if(verbose) qqcat("set column_dend_reorder to main heatmap\n")
}
if(!is.null(column_order)) {
if(any(is.na(column_order))) {
stop_wrap("`column_order` should not contain NA values.")
}
if(length(column_order) != ncol(object@ht_list[[i_main]]@matrix)) {
stop_wrap("length of `column_order` should be same as the number of main marix columns.")
}
if(is.character(column_order)) {
column_order = structure(seq_len(ncol(object@ht_list[[i_main]]@matrix)), names = colnames(object@ht_list[[i_main]]@matrix))[column_order]
}
object@ht_list[[i_main]]@column_order = column_order
if(verbose) qqcat("set column_order to main heatmap\n")
}
if(!is.null(width) && !is.null(heatmap_width)) {
stop_wrap("You can only specify one of `width` and `heatmap_width` in draw().")
}
if(!is.null(width)) {
if(!inherits(width, "unit")) {
stop_wrap("`width` specified in `draw()` should be a unit.")
}
if(!is_abs_unit(width)) {
stop_wrap("`width` specified in `draw()` should be an absolute unit.")
}
}
if(!is.null(heatmap_width)) {
if(!inherits(heatmap_width, "unit")) {
stop_wrap("`heatmap_width` specified in `draw()` should be a unit.")
}
if(!is_abs_unit(heatmap_width)) {
stop_wrap("`heatmap_width` specified in `draw()` should be an absolute unit.")
}
}
if(!is.null(width) && is.null(heatmap_width)) {
object@ht_list[[i_main]]@matrix_param$width = width
object@ht_list[[i_main]]@heatmap_param$width = unit(1, "npc")
} else if(is.null(width) && !is.null(heatmap_width)) {
object@ht_list[[i_main]]@matrix_param$width = unit(1, "npc")
object@ht_list[[i_main]]@heatmap_param$width = heatmap_width
}
# row_* should not be set for vertical heatmap list
for(obj_nm in c("row_split", "row_km", "row_gap", "cluster_rows", "show_row_dend", "clustering_distance_rows",
"clustering_method_rows", "row_dend_width", "show_row_dend", "row_dend_gp", "row_dend_reorder",
"row_order", "height", "heatmap_height")) {
if(!is.null(get(obj_nm))) {
message_wrap(paste0("'", obj_nm, "' should not be set in draw() for vertical heatmap list. Please directly set it in `Heatmap()`."))
}
}
}
### parameter for all heatmaps
for(i in seq_len(n_ht)) {
if(!is.null(use_raster)) {
object@ht_list[[i]]@heatmap_param$use_raster = use_raster
}
if(!is.null(raster_device)) {
object@ht_list[[i]]@heatmap_param$raster_device = raster_device
}
if(!is.null(raster_quality)) {
object@ht_list[[i]]@heatmap_param$raster_quality = raster_quality
}
if(!is.null(raster_device_param)) {
object@ht_list[[i]]@heatmap_param$raster_device_param = raster_device_param
}
if(!is.null(raster_resize)) {
object@ht_list[[i]]@heatmap_param$raster_resize = raster_resize
}
}
if(verbose) qqcat("auto adjust all heatmap/annotations by the main heatmap\n")
######## auto adjust ##########
ht_main = object@ht_list[[i_main]]
if(direction == "horizontal") {
ht_main = make_row_cluster(ht_main) # with pre-defined order
if(verbose) qqcat("perform row clustering on the main heatmap\n")
} else {
ht_main = make_column_cluster(ht_main) # with pre-defined order
if(verbose) qqcat("perform column clustering on the main heatmap\n")
}
object@ht_list[[i_main]] = ht_main
if(direction == "horizontal") {
row_dend_side = match.arg(row_dend_side)[1]
row_sub_title_side = match.arg(row_sub_title_side)[1]
if(row_dend_side == "left" || row_sub_title_side == "left") {
# if the first one is a HeatmapAnnotation object
# add a heatmap with zero column so that we can put titles and dend on the most left
if(inherits(object@ht_list[[1]], "HeatmapAnnotation")) {
object@ht_list = c(list(Heatmap(matrix(nrow = nr, ncol = 0))), object@ht_list)
ht_gap = unit.c(unit(0, "mm"), ht_gap)
i_main = i_main + 1
n_ht = n_ht + 1
if(verbose) qqcat("add a zero-column heatmap for row dend/title on the very left\n")
}
}
if(row_dend_side == "right" || row_sub_title_side == "right") {
# if the last one is a HeatmapAnnotation object
if(inherits(object@ht_list[[ length(object@ht_list) ]], "HeatmapAnnotation")) {
object@ht_list = c(object@ht_list, list(Heatmap(matrix(nrow = nr, ncol = 0))))
ht_gap = unit.c(ht_gap, unit(0, "mm"))
n_ht = n_ht + 1
if(verbose) qqcat("add a zero-column heatmap for row dend/title on the very right\n")
}
}
} else {
column_dend_side = match.arg(column_dend_side)[1]
column_sub_title_side = match.arg(column_sub_title_side)[1]
if(column_dend_side == "top" || column_sub_title_side == "top") {
if(inherits(object@ht_list[[1]], "HeatmapAnnotation")) {
object@ht_list = c(list(Heatmap(matrix(nrow = 0, ncol = nc))), object@ht_list)
ht_gap = unit.c(unit(0, "mm"), ht_gap)
i_main = i_main + 1
n_ht = n_ht + 1
if(verbose) qqcat("add a zero-row heatmap for column dend/title on the very top\n")
}
}
if(column_dend_side == "bottom" || column_sub_title_side == "bottom") {
if(inherits(object@ht_list[[ length(object@ht_list) ]], "HeatmapAnnotation")) {
object@ht_list = c(object@ht_list, list(Heatmap(matrix(nrow = 0, ncol = nc))))
ht_gap = unit.c(ht_gap, unit(0, "mm"))
n_ht = n_ht + 1
if(verbose) qqcat("add a zero-column heatmap for row dend/title on the very bottom\n")
}
}
}
object@ht_list_param$main_heatmap = i_main
object@ht_list_param$ht_gap = ht_gap
object@ht_list_param$merge_legends = merge_legends
if(!is.null(padding)) {
if(length(padding) == 1) {
padding = rep(padding, 4)
} else if(length(padding) == 2) {
padding = rep(padding, 2)
} else if(length(padding) != 4) {
stop_wrap("`padding` can only have length of 1, 2, 4")
}
}
object@ht_list_param$padding = padding
object@ht_list_param$auto_adjust = auto_adjust
## orders of other heatmaps should be changed
if(direction == "horizontal") {
for(i in seq_len(n_ht)) {
if(inherits(object@ht_list[[i]], "Heatmap") & i != i_main) {
object@ht_list[[i]]@row_order_list = ht_main@row_order_list
object@ht_list[[i]]@row_order = ht_main@row_order
object@ht_list[[i]]@row_dend_param$show = FALSE
object@ht_list[[i]]@row_dend_param$cluster = FALSE # don't do clustering because cluster was already done
}
}
if(verbose) qqcat("adjust row order for all other heatmaps\n")
} else {
for(i in seq_len(n_ht)) {
if(inherits(object@ht_list[[i]], "Heatmap") & i != i_main) {
object@ht_list[[i]]@column_order_list = ht_main@column_order_list
object@ht_list[[i]]@column_order = ht_main@column_order
object@ht_list[[i]]@column_dend_param$show = FALSE
object@ht_list[[i]]@column_dend_param$cluster = FALSE # don't do clustering because cluster was already done
}
}
if(verbose) qqcat("adjust column order for all other heatmaps\n")
}
# width and height
if(direction == "horizontal") {
for(i in seq_len(n_ht)) {
if(inherits(object@ht_list[[i]], "Heatmap") & i != i_main) {
object@ht_list[[i]]@matrix_param$height = object@ht_list[[i_main]]@matrix_param$height
object@ht_list[[i]]@heatmap_param$height = object@ht_list[[i_main]]@heatmap_param$height
}
}
if(verbose) qqcat("adjust heights for all other heatmaps\n")
} else {
for(i in seq_len(n_ht)) {
if(inherits(object@ht_list[[i]], "Heatmap") & i != i_main) {
object@ht_list[[i]]@matrix_param$width = object@ht_list[[i_main]]@matrix_param$width
object@ht_list[[i]]@heatmap_param$width = object@ht_list[[i_main]]@heatmap_param$width
}
}
if(verbose) qqcat("adjust width for all other heatmaps\n")
}
if(auto_adjust) {
if(direction == "horizontal") {
for(i in seq_len(n_ht)) {
if(inherits(object@ht_list[[i]], "Heatmap")) {
if(i == 1 && !is.null(object@ht_list[[i]]@row_names_param$anno) && object@ht_list[[i]]@row_names_param$side == "left") {
} else if(i == n_ht && !is.null(object@ht_list[[i]]@row_names_param$anno) && object@ht_list[[i]]@row_names_param$side == "right") {
} else {
object@ht_list[[i]]@row_names_param$anno = NULL
object@ht_list[[i]]@row_names_param$show = FALSE
}
}
}
} else {
for(i in seq_len(n_ht)) {
if(inherits(object@ht_list[[i]], "Heatmap")) {
if(i == 1 && !is.null(object@ht_list[[i]]@column_names_param$anno) && object@ht_list[[i]]@column_names_param$side == "top") {
} else if(i == n_ht && !is.null(object@ht_list[[i]]@column_names_param$anno) && object@ht_list[[i]]@column_names_param$side == "bottom") {
} else {
object@ht_list[[i]]@column_names_param$anno = NULL
object@ht_list[[i]]@column_names_param$show = FALSE
}
}
}
}
}
if(direction == "horizontal") {
# update other heatmaps' row titles
for(i in seq_len(n_ht)) {
if(inherits(object@ht_list[[i]], "Heatmap") && i != i_main) {
object@ht_list[[i]]@row_title = character(0)
}
}
if(verbose) qqcat("remove row titles for all other heatmaps\n")
} else {
for(i in seq_len(n_ht)) {
if(inherits(object@ht_list[[i]], "Heatmap") && i != i_main) {
object@ht_list[[i]]@column_title = character(0)
}
}
if(verbose) qqcat("remove column titles for all other heatmaps\n")
}
if(direction == "horizontal") {
if(row_dend_side == "left") {
# move dend to the first one
object@ht_list[[i_main]]@row_dend_param$show = FALSE
object@ht_list[[1]]@row_dend_list = ht_main@row_dend_list
object@ht_list[[1]]@row_dend_slice = ht_main@row_dend_slice
object@ht_list[[1]]@row_dend_param = ht_main@row_dend_param
object@ht_list[[1]]@row_dend_param$side = "left"
if(verbose) qqcat("add dendrogram of the main heatmap to the left of the first heatmap\n")
} else if(row_dend_side == "right") {
object@ht_list[[i_main]]@row_dend_param$show = FALSE
object@ht_list[[n_ht]]@row_dend_list = ht_main@row_dend_list
object@ht_list[[n_ht]]@row_dend_slice = ht_main@row_dend_slice
object@ht_list[[n_ht]]@row_dend_param = ht_main@row_dend_param
object@ht_list[[n_ht]]@row_dend_param$side = "right"
if(verbose) qqcat("add dendrogram of the main heatmap to the right of the last heatmap\n")
}
if(row_sub_title_side == "left") {
object@ht_list[[i_main]]@row_title = character(0)
object@ht_list[[1]]@row_title = ht_main@row_title
object@ht_list[[1]]@row_title_param = ht_main@row_title_param
object@ht_list[[1]]@row_title_param$side = "left"
object@ht_list[[1]]@row_title_param$just = get_text_just(ht_main@row_title_param$rot, "left")
if(verbose) qqcat("add row title of the main heatmap to the left of the first heatmap\n")
} else if(row_sub_title_side == "right") {
object@ht_list[[i_main]]@row_title = character(0)
object@ht_list[[n_ht]]@row_title = ht_main@row_title
object@ht_list[[n_ht]]@row_title_param = ht_main@row_title_param
object@ht_list[[n_ht]]@row_title_param$side = "right"
object@ht_list[[n_ht]]@row_title_param$just = get_text_just(ht_main@row_title_param$rot, "right")
if(verbose) qqcat("add row title of the main heatmap to the right of the last heatmap\n")
}
} else {
if(column_dend_side == "top") {
object@ht_list[[i_main]]@column_dend_param$show = FALSE
object@ht_list[[1]]@column_dend_list = ht_main@column_dend_list
object@ht_list[[1]]@column_dend_slice = ht_main@column_dend_slice
object@ht_list[[1]]@column_dend_param = ht_main@column_dend_param
object@ht_list[[1]]@column_dend_param$side = "top"
if(verbose) qqcat("add dendrogram of the main heatmap to the top of the first heatmap\n")
} else if(column_dend_side == "bottom") {
object@ht_list[[i_main]]@column_dend_param$show = FALSE
object@ht_list[[n_ht]]@column_dend_list = ht_main@column_dend_list
object@ht_list[[n_ht]]@column_dend_slice = ht_main@column_dend_slice
object@ht_list[[n_ht]]@column_dend_param = ht_main@column_dend_param
object@ht_list[[n_ht]]@column_dend_param$side = "bottom"
if(verbose) qqcat("add dendrogram of the main heatmap to the bottom of the last heatmap\n")
}
if(column_sub_title_side == "top") {
object@ht_list[[i_main]]@column_title = character(0)
object@ht_list[[1]]@column_title = ht_main@column_title
object@ht_list[[1]]@column_title_param = ht_main@column_title_param
object@ht_list[[1]]@column_title_param$side = "top"
object@ht_list[[1]]@column_title_param$just = get_text_just(ht_main@column_title_param$rot, "top")
if(verbose) qqcat("add column title of the main heatmap to the top of the first heatmap\n")
} else if(column_sub_title_side == "bottom") {
object@ht_list[[i_main]]@column_title = character(0)
object@ht_list[[n_ht]]@column_title = ht_main@column_title
object@ht_list[[n_ht]]@column_title_param = ht_main@column_title_param
object@ht_list[[n_ht]]@column_title_param$side = "bottom"
object@ht_list[[n_ht]]@column_title_param$just = get_text_just(ht_main@row_title_param$rot, "bottom")
if(verbose) qqcat("add column title of the main heatmap to the bottom of the last heatmap\n")
}
}
# gap
if(direction == "horizontal") {
for(i in seq_len(n_ht)) {
if(inherits(object@ht_list[[i]], "Heatmap")) {
object@ht_list[[i]]@matrix_param$row_gap = ht_main@matrix_param$row_gap
}
}
if(verbose) qqcat("adjust row_gap for all other heatmaps\n")
} else {
for(i in seq_len(n_ht)) {
if(inherits(object@ht_list[[i]], "Heatmap")) {
object@ht_list[[i]]@matrix_param$column_gap = ht_main@matrix_param$column_gap
}
}
if(verbose) qqcat("adjust column_gap for all other heatmaps\n")
}
if(direction == "horizontal") {
for(i in seq_len(n_ht)) {
# supress row clustering because all rows in all heatmaps are adjusted
if(inherits(object@ht_list[[i]], "Heatmap")) {
if(verbose) qqcat("prepare layout for heatmap: @{object@ht_list[[i]]@name}\n")
object@ht_list[[i]] = prepare(object@ht_list[[i]], process_rows = FALSE)
}
}
} else {
for(i in seq_len(n_ht)) {
if(inherits(object@ht_list[[i]], "Heatmap")) {
if(verbose) qqcat("prepare layout for heatmap: @{object@ht_list[[i]]@name}\n")
object@ht_list[[i]] = prepare(object@ht_list[[i]], process_columns = FALSE)
}
}
}
############################################
## title on top or bottom
if(!is.null(ht_opt$TITLE_PADDING)) {
title_padding = ht_opt$TITLE_PADDING
} else {
title_padding = unit(c(0, 0), "points")
title_padding[1] = title_padding[1] + unit(5.5, "points") +
convertHeight(grobDescent(textGrob(label = "jA", gp = column_title_gp)), "inches")
}
column_title_side = match.arg(column_title_side)[1]
if(length(column_title) == 0) {
column_title = character(0)
} else if(!inherits(column_title, c("expression", "call"))) {
if(is.na(column_title)) {
column_title = character(0)
} else if(column_title == "") {
column_title = character(0)
}
}
object@column_title = column_title
object@column_title_param$gp = check_gp(column_title_gp)
object@column_title_param$side = column_title_side
if(length(column_title) > 0) {
if(column_title_side == "top") {
object@layout$layout_column_title_top_height = grobHeight(textGrob(column_title, gp = column_title_gp)) + sum(title_padding)
object@layout$layout_index = rbind(object@layout$layout_index, column_title_top = heatmap_list_layout_index("column_title_top"))
} else {
object@layout$layout_column_title_bottom_height = grobHeight(textGrob(column_title, gp = column_title_gp)) + sum(title_padding)
object@layout$layout_index = rbind(object@layout$layout_index, column_title_bottom = heatmap_list_layout_index("column_title_bottom"))
}
object@layout$graphic_fun_list = c(object@layout$graphic_fun_list, function(object) draw_title(object, which = "column"))
}
############################################
## title on left or right
if(!is.null(ht_opt$TITLE_PADDING)) {
title_padding = ht_opt$TITLE_PADDING
} else {
title_padding = unit(c(0, 0), "points")
title_padding[1] = title_padding[1] + unit(5.5, "points") +
convertHeight(grobDescent(textGrob(label = "jA", gp = row_title_gp)), "inches")
}
row_title_side = match.arg(row_title_side)[1]
if(length(row_title) == 0) {
row_title = character(0)
} else if(!inherits(row_title, c("expression", "call"))) {
if(is.na(row_title)) {
row_title = character(0)
} else if(row_title == "") {
row_title = character(0)
}
}
object@row_title = row_title
object@row_title_param$gp = check_gp(row_title_gp)
object@row_title_param$side = row_title_side
if(length(row_title) > 0) {
if(row_title_side == "left") {
object@layout$layout_row_title_left_width = grobHeight(textGrob(row_title, gp = row_title_gp)) + sum(title_padding)
object@layout$layout_index = rbind(object@layout$layout_index, row_title_left = heatmap_list_layout_index("row_title_left"))
} else {
object@layout$layout_row_title_right_width = grobHeight(textGrob(row_title, gp = row_title_gp)) + sum(title_padding)
object@layout$layout_index = rbind(object@layout$layout_index, row_title_right = heatmap_list_layout_index("row_title_right"))
}
object@layout$graphic_fun_list = c(object@layout$graphic_fun_list, function(object) draw_title(object, which = "row"))
}
#################################################
## heatmap legend to top, bottom, left and right
# default values
legend_grouping = match.arg(legend_grouping)[1]
object@ht_list_param$legend_grouping = legend_grouping
ColorMappingList = list()
for(i in seq_along(object@ht_list)) {
ht = object@ht_list[[i]]
if(direction == "horizontal") {
if(inherits(object@ht_list[[i]], "Heatmap")) {
if(!is.null(ht@left_annotation)) {
if(object@ht_list_param$merge_legends || legend_grouping == "adjusted") {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@left_annotation))
}
}
if(!is.null(ht@top_annotation)) {
if(object@ht_list_param$merge_legends) {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@top_annotation))
}
}
if(object@ht_list[[i]]@heatmap_param$show_heatmap_legend) {
ColorMappingList = c.list(ColorMappingList, object@ht_list[[i]]@matrix_color_mapping)
}
if(!is.null(ht@bottom_annotation)) {
if(object@ht_list_param$merge_legends) {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@bottom_annotation))
}
}
if(!is.null(ht@right_annotation)) {
if(object@ht_list_param$merge_legends || legend_grouping == "adjusted") {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@right_annotation))
}
}
} else if(inherits(object@ht_list[[i]], "HeatmapAnnotation")) {
if(object@ht_list_param$merge_legends || legend_grouping == "adjusted") {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(object@ht_list[[i]]))
}
}
} else {
if(inherits(object@ht_list[[i]], "Heatmap")) {
if(!is.null(ht@left_annotation)) {
if(object@ht_list_param$merge_legends) {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@left_annotation))
}
}
if(!is.null(ht@top_annotation)) {
if(object@ht_list_param$merge_legends || legend_grouping == "adjusted") {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@top_annotation))
}
}
if(object@ht_list[[i]]@heatmap_param$show_heatmap_legend) {
ColorMappingList = c.list(ColorMappingList, object@ht_list[[i]]@matrix_color_mapping)
}
if(!is.null(ht@bottom_annotation)) {
if(object@ht_list_param$merge_legends || legend_grouping == "adjusted") {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@bottom_annotation))
}
}
if(!is.null(ht@right_annotation)) {
if(object@ht_list_param$merge_legends) {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@right_annotation))
}
}
} else if(inherits(object@ht_list[[i]], "HeatmapAnnotation")) {
if(object@ht_list_param$merge_legends || legend_grouping == "adjusted") {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(object@ht_list[[i]]))
}
}
}
}
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)
}
if(length(ColorMappingList) == 0 && length(heatmap_legend_list) == 0) {
show_heatmap_legend = FALSE
}
# ### proper max_height/max_width for legends #####
# ht_main = object@ht_list[[i_main]]
# max_legend_height = unit(dev.size("cm")[2], "cm") - object@ht_list_param$padding[1] -object@ht_list_param$padding[3] -
# ht_main@layout$layout_size$column_title_top_height - ht_main@layout$layout_size$column_dend_top_height -
# ht_main@layout$layout_size$column_title_bottom_height - ht_main@layout$layout_size$column_dend_bottom_height
# if(heatmap_legend_side %in% c("top", "bottom") && annotation_legend_side %in% c("left", "right") ||
# heatmap_legend_side %in% c("left", "right") && annotation_legend_side %in% c("top", "bottom")) {
# max_legend_width = unit(dev.size("cm")[1], "cm")
# }
object@heatmap_legend_param$show = show_heatmap_legend
heatmap_legend_side = match.arg(heatmap_legend_side)[1]
object@heatmap_legend_param$side = heatmap_legend_side
if(show_heatmap_legend) {
if(heatmap_legend_side == "top") {
object@heatmap_legend_param$padding = unit.c(ht_opt$HEATMAP_LEGEND_PADDING, unit(c(0, 0, 0), "mm")) #unit(c(2, 0, 0, 0), "mm")
size = heatmap_legend_size(object, legend_list = heatmap_legend_list, max_width = calc_legends_max_width(object, page_size))
object@heatmap_legend_param$size = size
object@layout$layout_heatmap_legend_top_height = size[2]
object@layout$layout_index = rbind(object@layout$layout_index, heatmap_legend_top = heatmap_list_layout_index("heatmap_legend_top"))
} else if(heatmap_legend_side == "bottom") {
object@heatmap_legend_param$padding = unit.c(unit(c(0, 0), "mm"), ht_opt$HEATMAP_LEGEND_PADDING, unit(0, "mm")) # unit(c(0, 0, 2, 0), "mm")
size = heatmap_legend_size(object, legend_list = heatmap_legend_list, max_width = calc_legends_max_width(object, page_size))
object@heatmap_legend_param$size = size
object@layout$layout_heatmap_legend_bottom_height = size[2]
object@layout$layout_index = rbind(object@layout$layout_index, heatmap_legend_bottom = heatmap_list_layout_index("heatmap_legend_bottom"))
} else if(heatmap_legend_side == "left") {
object@heatmap_legend_param$padding = unit.c(unit(c(0, 0, 0), "mm"), ht_opt$HEATMAP_LEGEND_PADDING) # unit(c(0, 0, 0, 2), "mm")
size = heatmap_legend_size(object, legend_list = heatmap_legend_list, max_height = calc_legends_max_height(object, page_size))
object@heatmap_legend_param$size = size
object@layout$layout_heatmap_legend_left_width = size[1]
object@layout$layout_index = rbind(object@layout$layout_index, heatmap_legend_left = heatmap_list_layout_index("heatmap_legend_left"))
} else if(heatmap_legend_side == "right") {
object@heatmap_legend_param$padding = unit.c(unit(0, "mm"), ht_opt$HEATMAP_LEGEND_PADDING, unit(c(0, 0), "mm")) # unit(c(0, 2, 0, 0), "mm")
size = heatmap_legend_size(object, legend_list = heatmap_legend_list, max_height = calc_legends_max_height(object, page_size))
object@heatmap_legend_param$size = size
object@layout$layout_heatmap_legend_right_width = size[1]
object@layout$layout_index = rbind(object@layout$layout_index, heatmap_legend_right = heatmap_list_layout_index("heatmap_legend_right"))
}
if(heatmap_legend_side %in% c("top", "bottom")) {
object@layout$graphic_fun_list = c(object@layout$graphic_fun_list, function(object) draw_heatmap_legend(object, legend_list = heatmap_legend_list, max_width = calc_legends_max_width(object, page_size)))
} else {
object@layout$graphic_fun_list = c(object@layout$graphic_fun_list, function(object) draw_heatmap_legend(object, legend_list = heatmap_legend_list, max_height = calc_legends_max_height(object, page_size)))
}
} else {
object@heatmap_legend_param$size = unit(c(0, 0), "mm")
}
#################################################
## annotation legend to top, bottom, left and right
# default values
ColorMappingList = list()
if(!merge_legends) {
for(i in seq_along(object@ht_list)) {
ht = object@ht_list[[i]]
if(direction == "horizontal") {
if(inherits(ht, "Heatmap")) {
if(!is.null(ht@left_annotation)) {
if(legend_grouping == "original") {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@left_annotation))
}
}
if(!is.null(ht@top_annotation)) {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@top_annotation))
}
if(!is.null(ht@bottom_annotation)) {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@bottom_annotation))
}
if(!is.null(ht@right_annotation)) {
if(legend_grouping == "original") {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@right_annotation))
}
}
} else if(inherits(ht, "HeatmapAnnotation")) {
if(legend_grouping == "original") {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht))
}
}
} else {
if(inherits(ht, "Heatmap")) {
if(!is.null(ht@left_annotation)) {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@left_annotation))
}
if(!is.null(ht@top_annotation)) {
if(legend_grouping == "original") {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@top_annotation))
}
}
if(!is.null(ht@bottom_annotation)) {
if(legend_grouping == "original") {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@bottom_annotation))
}
}
if(!is.null(ht@top_annotation)) {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@top_annotation))
}
} else if(inherits(ht, "HeatmapAnnotation")) {
if(legend_grouping == "original") {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht))
}
}
}
}
} else {
annotation_legend_list = list()
}
if(length(ColorMappingList) == 0 && length(annotation_legend_list) == 0) {
show_annotation_legend = FALSE
}
object@annotation_legend_param$show = show_annotation_legend
annotation_legend_side = match.arg(annotation_legend_side)[1]
object@annotation_legend_param$side = annotation_legend_side
if(show_annotation_legend) {
if(annotation_legend_side == "top") {
object@annotation_legend_param$padding = unit.c(ht_opt$ANNOTATION_LEGEND_PADDING, unit(c(0, 0, 0), "mm")) # unit(c(2, 0, 0, 0), "mm")
size = annotation_legend_size(object, legend_list = annotation_legend_list, max_width = calc_legends_max_width(object, page_size))
object@annotation_legend_param$size = size
object@layout$layout_annotation_legend_top_height = size[2]
object@layout$layout_index = rbind(object@layout$layout_index, annotation_legend_top = heatmap_list_layout_index("annotation_legend_top"))
} else if(annotation_legend_side == "bottom") {
object@annotation_legend_param$padding = unit.c(unit(c(0, 0), "mm"), ht_opt$ANNOTATION_LEGEND_PADDING, unit(0, "mm")) # unit(c(0, 0, 2, 0), "mm")
size = annotation_legend_size(object, legend_list = annotation_legend_list, max_width = calc_legends_max_width(object, page_size))
object@annotation_legend_param$size = size
object@layout$layout_annotation_legend_bottom_height = size[2]
object@layout$layout_index = rbind(object@layout$layout_index, annotation_legend_bottom = heatmap_list_layout_index("annotation_legend_bottom"))
} else if(annotation_legend_side == "left") {
object@annotation_legend_param$padding = unit.c(unit(c(0, 0, 0), "mm"), ht_opt$ANNOTATION_LEGEND_PADDING) # unit(c(0, 0, 0, 2), "mm")
size = annotation_legend_size(object, legend_list = annotation_legend_list, max_height = calc_legends_max_height(object, page_size))
object@annotation_legend_param$size = size
object@layout$layout_annotation_legend_left_width = size[1]
object@layout$layout_index = rbind(object@layout$layout_index, annotation_legend_left = heatmap_list_layout_index("annotation_legend_left"))
} else if(annotation_legend_side == "right") {
object@annotation_legend_param$padding = unit.c(unit(0, "mm"), ht_opt$ANNOTATION_LEGEND_PADDING, unit(c(0, 0), "mm")) # unit(c(0, 2, 0, 0), "mm")
size = annotation_legend_size(object, legend_list = annotation_legend_list, max_height = calc_legends_max_height(object, page_size))
object@annotation_legend_param$size = size
object@layout$layout_annotation_legend_right_width = size[1]
object@layout$layout_index = rbind(object@layout$layout_index, annotation_legend_right = heatmap_list_layout_index("annotation_legend_right"))
}
if(annotation_legend_side %in% c("top", "bottom")) {
object@layout$graphic_fun_list = c(object@layout$graphic_fun_list, function(object) draw_annotation_legend(object, legend_list = annotation_legend_list, max_width = calc_legends_max_width(object, page_size)))
} else {
object@layout$graphic_fun_list = c(object@layout$graphic_fun_list, function(object) draw_annotation_legend(object, legend_list = annotation_legend_list, max_height = calc_legends_max_height(object, page_size)))
}
} else {
object@annotation_legend_param$size = unit(c(0, 0), "null")
}
object@heatmap_legend_param$align_legend = align_heatmap_legend
object@annotation_legend_param$align_legend = align_annotation_legend
object = adjust_heatmap_list(object)
object@layout$layout_index = rbind(heatmaplist = heatmap_list_layout_index("heatmap_list"), object@layout$layout_index)
object@layout$graphic_fun_list = c(function(object) draw_heatmap_list(object), object@layout$graphic_fun_list)
if(direction == "horizontal") {
main_matrix_rn = rownames(object@ht_list[[i_main]]@matrix)
if(!is.null(main_matrix_rn)) {
for(i in seq_len(n_ht)) {
if(i == i_main) next
if(inherits(object@ht_list[[i]], "Heatmap")) {
matrix_rn = rownames(object@ht_list[[i]]@matrix)
if(!is.null(matrix_rn)) {
# if same set but different order
if(setequal(main_matrix_rn, matrix_rn)) {
if(!identical(main_matrix_rn, matrix_rn)) {
warning_wrap("Row names of heatmap ", i, " is not consistent as the main heatmap (", i_main, ")", sep = "")
}
}
}
}
}
}
} else {
main_matrix_cn = colnames(object@ht_list[[i_main]]@matrix)
if(!is.null(main_matrix_cn)) {
for(i in seq_len(n_ht)) {
if(i == i_main) next
if(inherits(object@ht_list[[i]], "Heatmap")) {
matrix_cn = colnames(object@ht_list[[i]]@matrix)
if(!is.null(matrix_cn)) {
# if same set but different order
if(setequal(main_matrix_cn, matrix_cn)) {
if(!identical(main_matrix_cn, matrix_cn)) {
warning_wrap("Column names of heatmap ", i, " is not consistent as the main heatmap (", i_main, ")", sep = "")
}
}
}
}
}
}
}
object@layout$initialized = TRUE
return(object)
})
calc_legends_max_height = function(object, page_size) {
gh = page_size[2]
h = gh - object@layout$layout_column_title_top_height - object@layout$layout_column_title_bottom_height -
object@ht_list_param$padding[1] - object@ht_list_param$padding[3]
convertHeight(h, "mm")
}
calc_legends_max_width = function(object, page_size) {
gh = page_size[1]
h = gh - object@layout$layout_row_title_right_width - object@layout$layout_row_title_left_width -
object@ht_list_param$padding[2] - object@ht_list_param$padding[4]
convertWidth(h, "mm")
}
HEATMAP_LIST_LAYOUT_COLUMN_COMPONENT = 1:7
names(HEATMAP_LIST_LAYOUT_COLUMN_COMPONENT) = c("annotation_legend_top", "heatmap_legend_top", "column_title_top",
"heatmap_list", "column_title_bottom", "heatmap_legend_bottom", "annotation_legend_bottom")
HEATMAP_LIST_LAYOUT_ROW_COMPONENT = 1:7
names(HEATMAP_LIST_LAYOUT_ROW_COMPONENT) = c("annotation_legend_left", "heatmap_legend_left", "row_title_left",
"heatmap_list", "row_title_right", "heatmap_legend_right", "annotation_legend_right")
heatmap_list_layout_index = function(nm) {
if(nm == "heatmap_list") { # heatmap_body
ind = c(HEATMAP_LIST_LAYOUT_COLUMN_COMPONENT["heatmap_list"], HEATMAP_LIST_LAYOUT_ROW_COMPONENT["heatmap_list"])
} else if(nm %in% names(HEATMAP_LIST_LAYOUT_COLUMN_COMPONENT)) {
ind = c(HEATMAP_LIST_LAYOUT_COLUMN_COMPONENT[nm], HEATMAP_LIST_LAYOUT_ROW_COMPONENT["heatmap_list"])
} else if(nm %in% names(HEATMAP_LIST_LAYOUT_ROW_COMPONENT)) {
ind = c(HEATMAP_LIST_LAYOUT_COLUMN_COMPONENT["heatmap_list"], HEATMAP_LIST_LAYOUT_ROW_COMPONENT[nm])
}
names(ind) = c("layout.pos.row", "layout.pos.col")
return(ind)
}
has_heatmap_list_component = function(object, component) {
m = object@layout$layout_index
ind = heatmap_list_layout_index(component)
any(m[, 1] == ind[1] & m[, 2] == ind[2])
}
# == title
# Width of Heatmap List Components
#
# == param
# -object A `HeatmapList-class` object.
# -k Which component in the heatmap list. Values are in ``ComplexHeatmap:::HEATMAP_LIST_LAYOUT_ROW_COMPONENT``.
#
# == detail
# This function is only for internal use.
#
# == value
# A `grid::unit` object.
#
# == author
# Zuguang Gu <z.gu@dkfz.de>
#
setMethod(f = "component_width",
signature = "HeatmapList",
definition = function(object, k = HEATMAP_LIST_LAYOUT_ROW_COMPONENT) {
if(is.numeric(k)) {
component_name = names(HEATMAP_LIST_LAYOUT_ROW_COMPONENT)[k]
} else {
component_name = k
}
direction = object@direction
# this function is used for grid.layout, so null unit is allowed
.single_unit_horizontal = function(nm) {
if(nm == "heatmap_list") {
width = sum(do.call("unit.c", lapply(object@ht_list, function(ht) {
if(inherits(ht, "Heatmap")) {
ht@heatmap_param$width
} else {
width(ht) # width of the row annotation, always a fixed unit
}
})))
if(is_abs_unit(width)) {
width + sum(object@ht_list_param$ht_gap) - object@ht_list_param$ht_gap[length(object@ht_list_param$ht_gap)] + object@layout$heatmap_list_padding[2] + object@layout$heatmap_list_padding[4]
} else {
unit(1, "null")
}
} else {
object@layout[[paste0("layout_", nm, "_width")]]
}
}
.single_unit_vertical = function(nm) {
if(nm == "heatmap_list") {
width = max(do.call("unit.c", lapply(object@ht_list, function(ht) {
if(inherits(ht, "Heatmap")) {
ht@heatmap_param$width
} else {
# the width of column annotation is always unit(1, "npc")
w = width(ht)
# if a relative unit, reset to unit(0, "mm")
if(!is_abs_unit(w)) w = unit(0, "mm")
w
}
})))
if(is_abs_unit(width)) {
# if height is zeor, this means, there is no heatmap and no width is set for all heatmapannotations
if(convertWidth(width, "mm", valueOnly = TRUE) == 0) {
unit(1, "null")
} else {
width + object@layout$heatmap_list_padding[2] + object@layout$heatmap_list_padding[4]
}
} else {
unit(1, "null")
}
} else {
object@layout[[paste0("layout_", nm, "_width")]]
}
}
if(direction == "horizontal") {
do.call("unit.c", lapply(component_name, .single_unit_horizontal))
} else {
do.call("unit.c", lapply(component_name, .single_unit_vertical))
}
})
# == title
# Height of Heatmap List Components
#
# == param
# -object A `HeatmapList-class` object.
# -k Which component in the heatmap list. Values are in ``ComplexHeatmap:::HEATMAP_LIST_LAYOUT_COLUMN_COMPONENT``.
#
# == value
# A `grid::unit` object.
#
# == author
# Zuguang Gu <z.gu@dkfz.de>
#
setMethod(f = "component_height",
signature = "HeatmapList",
definition = function(object, k = HEATMAP_LIST_LAYOUT_COLUMN_COMPONENT) {
if(is.numeric(k)) {
component_name = names(HEATMAP_LIST_LAYOUT_COLUMN_COMPONENT)[k]
} else {
component_name = k
}
direction = object@direction
# this function is used for grid.layout, so null unit is allowed
.single_unit_vertical = function(nm) {
if(nm == "heatmap_list") {
height = sum(do.call("unit.c", lapply(object@ht_list, function(ht) {
if(inherits(ht, "Heatmap")) {
ht@heatmap_param$height
} else {
height(ht) # width of the row annotation, always a fixed unit
}
})))
if(is_abs_unit(height)) {
height + sum(object@ht_list_param$ht_gap) - object@ht_list_param$ht_gap[length(object@ht_list_param$ht_gap)] + object@layout$heatmap_list_padding[1] + object@layout$heatmap_list_padding[3]
} else {
unit(1, "null")
}
} else {
object@layout[[paste0("layout_", nm, "_height")]]
}
}
.single_unit_horizontal = function(nm) {
if(nm == "heatmap_list") {
height = max(do.call("unit.c", lapply(object@ht_list, function(ht) {
if(inherits(ht, "Heatmap")) {
ht@heatmap_param$height
} else {
h = height(ht)
if(!is_abs_unit(h)) h = unit(0, "mm")
h
}
})))
if(is_abs_unit(height)) {
# if height is zeor, this means, there is no heatmap and no width is set for all heatmapannotations
if(convertWidth(height, "mm", valueOnly = TRUE) == 0) {
unit(1, "null")
} else {
height + object@layout$heatmap_list_padding[1] + object@layout$heatmap_list_padding[3]
}
} else {
unit(1, "null")
}
} else {
object@layout[[paste0("layout_", nm, "_height")]]
}
}
if(direction == "horizontal") {
do.call("unit.c", lapply(component_name, .single_unit_horizontal))
} else {
do.call("unit.c", lapply(component_name, .single_unit_vertical))
}
})
Try the ComplexHeatmap package in your browser
Any scripts or data that you put into this service are public.
ComplexHeatmap documentation built on Nov. 14, 2020, 2:01 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions has_heatmap_list_component heatmap_list_layout_index calc_legends_max_width calc_legends_max_height
# == title
# Make Layout for the Heatmap List
#
# == param
# -object A `HeatmapList-class` object.
# -row_title Title on the row.
# -row_title_side Will the title be put on the left or right of the heatmap list?
# -row_title_gp Graphic parameters for the row title.
# -column_title Title on the column.
# -column_title_side Will the title be put on the top or bottom of the heatmap?
# -column_title_gp Graphic parameters for the column title.
# -heatmap_legend_side Side of the heatmap legends.
# -merge_legends Whether to put heatmap legends and annotation legends together. By default they are put in different viewports.
# -show_heatmap_legend Whether show heatmap legends.
# -heatmap_legend_list A list of self-defined legends, should be wrapped into a list of `grid::grob` objects. Normally they are constructed by `Legend`.
# -annotation_legend_side Side of annotation legends.
# -show_annotation_legend Whether show annotation legends.
# -annotation_legend_list A list of self-defined legends, should be wrapped into a list of `grid::grob` objects. Normally they are constructed by `Legend`.
# -align_heatmap_legend How to align the legends to heatmap. Possible values are "heatmap_center", "heatmap_top" and "global_center". If the value is ``NULL``,
# it automatically picks the proper value from the three options.
# -align_annotation_legend How to align the legends to heatmap. Possible values are "heatmap_center", "heatmap_top" and "global_center".
# -legend_grouping How the legends are grouped. Values should be "adjusted" or "original".
# -ht_gap Gap between heatmaps, should be a `grid::unit` object. It can be a vector of length 1 or the number of heamtaps/annotations.
# -main_heatmap Name or index for the main heatmap.
# -padding Padding of the whole plot. The four values correspond to the bottom, left, top and right paddings.
# -auto_adjust whether apply automatic adjustment? The auto-adjustment includes turning off dendrograms, titles and row/columns for non-main heatmaps.
# -row_dend_side If auto-adjustment is on, to put the row dendrograms of the main heatmap to the most left side of the heatmap list or the most right side?
# -row_sub_title_side There can be sub titles generated by the splitting of heatmaps. Similar setting as ``row_dend_side``.
# -column_dend_side Similar setting as ``row_dend_side``.
# -column_sub_title_side Similar setting as ``row_sub_title_side``.
# -row_gap Overwrite the corresponding setting in the main heatmap.
# -cluster_rows Overwrite the corresponding setting in the main heatmap.
# -cluster_row_slices Overwrite the corresponding setting in the main heatmap.
# -clustering_distance_rows Overwrite the corresponding setting in the main heatmap.
# -clustering_method_rows Overwrite the corresponding setting in the main heatmap.same setting as in `Heatmap`, if it is specified, ``clustering_method_rows`` in main heatmap is ignored.
# -row_dend_width Overwrite the corresponding setting in the main heatmap.
# -show_row_dend same Overwrite the corresponding setting in the main heatmap.
# -row_dend_reorder Overwrite the corresponding setting in the main heatmap.
# -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.
# -column_gap Overwrite the corresponding setting in the main heatmap.
# -cluster_columns Overwrite the corresponding setting in the main heatmap.
# -cluster_column_slices Overwrite the corresponding setting in the main heatmap.
# -clustering_distance_columns Overwrite the corresponding setting in the main heatmap.
# -clustering_method_columns Overwrite the corresponding setting in the main heatmap.
# -column_dend_width column Overwrite the corresponding setting in the main heatmap.
# -show_column_dend Overwrite the corresponding setting in the main heatmap.
# -column_dend_reorder Overwrite the corresponding setting in the main heatmap.
# -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.
# -use_raster Overwrite the corresponding setting in every heatmap.
# -raster_device Overwrite the corresponding setting in every heatmap.
# -raster_quality Overwrite the corresponding setting in every heatmap.
# -raster_device_param Overwrite the corresponding setting in every heatmap.
# -raster_resize Overwrite the corresponding setting in every heatmap.
#
# == detail
# It sets the size of each component of the heatmap list and adjusts graphic
# parameters for each heatmap if necessary.
#
# This function is only for internal use.
#
# == value
# A `HeatmapList-class` object in which settings for all heatmap are adjusted.
#
# == author
# Zuguang Gu <z.gu@dkfz.de>
#
setMethod(f = "make_layout",
signature = "HeatmapList",
definition = function(object,
row_title = character(0),
row_title_side = c("left", "right"),
row_title_gp = gpar(fontsize = 14),
column_title = character(0),
column_title_side = c("top", "bottom"),
column_title_gp = gpar(fontsize = 14),
heatmap_legend_side = c("right", "left", "bottom", "top"),
merge_legends = FALSE,
show_heatmap_legend = TRUE,
heatmap_legend_list = list(),
annotation_legend_side = c("right", "left", "bottom", "top"),
show_annotation_legend = TRUE,
annotation_legend_list = list(),
align_heatmap_legend = NULL,
align_annotation_legend = NULL,
legend_grouping = c("adjusted", "original"),
ht_gap = unit(2, "mm"),
main_heatmap = which(sapply(object@ht_list, inherits, "Heatmap"))[1],
padding = GLOBAL_PADDING,
auto_adjust = TRUE,
row_dend_side = c("original", "left", "right"),
row_sub_title_side = c("original", "left", "right"),
column_dend_side = c("original", "top", "bottom"),
column_sub_title_side = c("original", "top", "bottom"),
row_gap = NULL,
cluster_rows = NULL,
cluster_row_slices = NULL,
clustering_distance_rows = NULL,
clustering_method_rows = NULL,
row_dend_width = NULL,
show_row_dend = NULL,
row_dend_reorder = NULL,
row_dend_gp = NULL,
row_order = NULL,
row_km = NULL,
row_km_repeats = NULL,
row_split = NULL,
height = NULL,
heatmap_height = NULL,
column_gap = NULL,
cluster_columns = NULL,
cluster_column_slices = NULL,
clustering_distance_columns = NULL,
clustering_method_columns = NULL,
column_dend_width = NULL,
show_column_dend = NULL,
column_dend_reorder = NULL,
column_dend_gp = NULL,
column_order = NULL,
column_km = NULL,
column_km_repeats = NULL,
column_split = NULL,
width = NULL,
heatmap_width = NULL,
use_raster = NULL,
raster_device = NULL,
raster_quality = NULL,
raster_device_param = NULL,
raster_resize = NULL) {
verbose = ht_opt("verbose")
if(object@layout$initialized) {
if(verbose) qqcat("heatmap list is already initialized\n")
return(object)
}
# the size of the plotting page
# if current viewport is top viewport
current_vp = current.viewport()$name
if(current_vp == "ROOT") {
page_size = unit(par("din"), "in")
} else {
grid::upViewport()
page_size = unit.c(convertWidth(unit(1, "npc"), "mm"),
convertHeight(unit(1, "npc"), "mm"))
grid::downViewport(current_vp)
}
object@ht_list_param$padding = padding
n_ht = length(object@ht_list)
i_main = main_heatmap[1]
direction = object@direction
# i_main is aleays numeric index
if(is.character(i_main)) {
i_main = which(names(object@ht_list) == i_main)[1]
if(length(i_main) == 0) {
stop_wrap(qq("cannot find heatmap '@{main_heatmap}'"))
}
}
if(verbose) qqcat("@{n_ht} heatmaps/annotations, main heatmap: @{i_main}th\n")
if(inherits(object@ht_list[[i_main]], "HeatmapAnnotation")) {
stop_wrap("the main heatmap can only be the heatmap.")
}
nr = nrow(object@ht_list[[i_main]]@matrix)
nc = ncol(object@ht_list[[i_main]]@matrix)
if(n_ht > 1) {
if(length(ht_gap) == 1) {
if(inherits(ht_gap, "unit")) {
ht_gap = rep(ht_gap, n_ht)
}
} else if(length(ht_gap) == n_ht - 1) {
ht_gap = unit.c(ht_gap, unit(0, "mm"))
} else if(length(ht_gap) > n_ht) {
stop_wrap(paste0("length of `ht_gap` can only be 1 or ", n_ht-1, "."))
}
} else {
if(!is.unit(ht_gap)) {
warning_wrap("`ht_gap` should be a unit object, reset it to unit(0, 'mm').")
ht_gap = unit(rep(0, n_ht), "mm")
}
}
object@ht_list_param$ht_gap = ht_gap
# adjust gaps if some heatmap has zero row/column
for(i in seq_len(n_ht)) {
if(inherits(object@ht_list[[i]], "Heatmap")) {
if(direction == "horizontal") {
if(i == 1 && ncol(object@ht_list[[1]]@matrix) == 0) {
ht_gap[1] = unit(0, "mm")
if(verbose) qqcat("The first heatmap has zero column, set the first gap to unit(0, 'mm')\n")
} else if(i == n_ht && ncol(object@ht_list[[n_ht]]@matrix) == 0) {
ht_gap[n_ht - 1] = unit(0, "mm")
if(verbose) qqcat("The last heatmap has zero column, set the last gap to unit(0, 'mm')\n")
} else if(ncol(object@ht_list[[i]]@matrix) == 0) {
ht_gap[i] = unit(0, "mm")
if(verbose) qqcat("The @{i}th heatmap has zero column, set the @{i}th gap to unit(0, 'mm')\n")
}
} else {
if(i == 1 && nrow(object@ht_list[[1]]@matrix) == 0) {
ht_gap[1] = unit(0, "mm")
if(verbose) qqcat("The first heatmap has zero row, set the first gap to unit(0, 'mm')\n")
} else if(i == n_ht && nrow(object@ht_list[[n_ht]]@matrix) == 0) {
ht_gap[n_ht - 1] = unit(0, "mm")
if(verbose) qqcat("The last heatmap has zero row, set the last gap to unit(0, 'mm')\n")
} else if(nrow(object@ht_list[[i]]@matrix) == 0) {
ht_gap[i] = unit(0, "mm")
if(verbose) qqcat("The @{i}th heatmap has zero row, set the @{i}th gap to unit(0, 'mm')\n")
}
}
}
}
### update some values for the main heatmap
ht_nr = nrow(object@ht_list[[i_main]]@matrix)
ht_nc = ncol(object@ht_list[[i_main]]@matrix)
if(direction == "horizontal") {
if(!is.null(row_split)) {
object@ht_list[[i_main]]@matrix_param$row_split = row_split
if(verbose) qqcat("set row_split to main heatmap\n")
if(is.data.frame(row_split)) {
if(nrow(row_split) != ht_nr) {
stop_wrap("`row_split` should have same nrow as the main matrix.")
}
} else if(is.atomic(row_split)) {
if(length(row_split) > 1 && length(row_split) != ht_nr) {
stop_wrap("`row_split` should have same length as nrow of the main matrix.")
}
if(length(row_split) == 1 && !object@ht_list[[i_main]]@row_dend_param$cluster) {
stop_wrap("Since there is no row clustering for the main heatmap, `row_split` is not allowed to set as a single number.")
}
}
}
if(!is.null(row_km)) {
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
if(verbose) qqcat("set row_gap to main heatmap\n")
}
if(!is.null(cluster_rows)) {
if(is.null(show_row_dend) && identical(cluster_rows, TRUE)) {
show_row_dend = TRUE
}
if(inherits(cluster_rows, c("dendrogram", "hclust"))) {
object@ht_list[[i_main]]@row_dend_param$obj = cluster_rows
object@ht_list[[i_main]]@row_dend_param$cluster = TRUE
if(verbose) qqcat("set cluster_rows to main heatmap\n")
} else if(inherits(cluster_rows, "function")) {
object@ht_list[[i_main]]@row_dend_param$fun = cluster_rows
object@ht_list[[i_main]]@row_dend_param$cluster = TRUE
if(verbose) qqcat("set cluster_rows to main heatmap\n")
} else {
object@ht_list[[i_main]]@row_dend_param$cluster = cluster_rows
if(verbose) qqcat("set cluster_rows to main heatmap\n")
if(!cluster_rows) {
row_dend_width = unit(0, "mm")
show_row_dend = FALSE
} else {
row_dend_width = unit(10, "mm")
}
}
}
if(!is.null(cluster_row_slices)) {
object@ht_list[[i_main]]@row_dend_param$cluster_slices = cluster_row_slices
if(verbose) qqcat("set cluster_row_slices to main heatmap\n")
}
if(!is.null(show_row_dend)) {
if(!show_row_dend) {
row_dend_width = unit(0, "mm")
}
}
if(!is.null(clustering_distance_rows)) {
object@ht_list[[i_main]]@row_dend_param$distance = clustering_distance_rows
if(verbose) qqcat("set clustering_distance_rows to main heatmap\n")
}
if(!is.null(clustering_method_rows)) {
object@ht_list[[i_main]]@row_dend_param$method = clustering_method_rows
if(verbose) qqcat("set clustering_method_rows to main heatmap\n")
}
if(!is.null(row_dend_width)) {
if(unclass(row_dend_width)[[1]] == 0) {
object@ht_list[[i_main]]@row_dend_param$width = unit(0, "mm")
} else {
object@ht_list[[i_main]]@row_dend_param$width = row_dend_width + ht_opt$DENDROGRAM_PADDING # append the gap
}
}
if(!is.null(show_row_dend)) {
object@ht_list[[i_main]]@row_dend_param$show = show_row_dend
}
if(!is.null(row_dend_gp)) {
object@ht_list[[i_main]]@row_dend_param$gp = check_gp(row_dend_gp)
if(verbose) qqcat("set row_dend_gp to main heatmap\n")
}
if(!is.null(row_dend_reorder)) {
object@ht_list[[i_main]]@row_dend_param$reorder = row_dend_reorder
if(verbose) qqcat("set row_dend_reorder to main heatmap\n")
}
if(!is.null(row_order)) {
if(any(is.na(row_order))) {
stop_wrap("`row_order` should not contain NA values.")
}
if(length(row_order) != nrow(object@ht_list[[i_main]]@matrix)) {
stop_wrap("length of `row_order` should be same as the number of main marix rows.")
}
if(is.character(row_order)) {
row_order = structure(seq_len(nrow(object@ht_list[[i_main]]@matrix)), names = rownames(object@ht_list[[i_main]]@matrix))[row_order]
}
object@ht_list[[i_main]]@row_order = row_order
if(verbose) qqcat("set row_order to main heatmap\n")
}
if(!is.null(height) && !is.null(heatmap_height)) {
stop_wrap("You can only specify one of `height` and `heatmap_height` in draw().")
}
if(!is.null(height)) {
if(!inherits(height, "unit")) {
stop_wrap("`height` specified in `draw()` should be a unit.")
}
if(!is_abs_unit(height)) {
stop_wrap("`height` specified in `draw()` should be an absolute unit.")
}
}
if(!is.null(heatmap_height)) {
if(!inherits(heatmap_height, "unit")) {
stop_wrap("`heatmap_height` specified in `draw()` should be a unit.")
}
if(!is_abs_unit(heatmap_height)) {
stop_wrap("`heatmap_height` specified in `draw()` should be an absolute unit.")
}
}
if(!is.null(height) && is.null(heatmap_height)) {
object@ht_list[[i_main]]@matrix_param$height = height
object@ht_list[[i_main]]@heatmap_param$height = unit(1, "npc")
} else if(is.null(height) && !is.null(heatmap_height)) {
object@ht_list[[i_main]]@matrix_param$height = unit(1, "npc")
object@ht_list[[i_main]]@heatmap_param$height = heatmap_height
}
# column_* should not be set for horizontal heatmap list
for(obj_nm in c("column_split", "column_km", "column_gap", "cluster_columns", "show_column_dend", "clustering_distance_columns",
"clustering_method_columns", "column_dend_width", "show_column_dend", "column_dend_gp", "column_dend_reorder",
"column_order", "width", "heatmap_width")) {
if(!is.null(get(obj_nm))) {
message_wrap(paste0("'", obj_nm, "' should not be set in draw() for horizontal heatmap list (Note a single heatmap is a horizontal heatmap list). Please directly set it in `Heatmap()`."))
}
}
} else {
if(!is.null(column_split)) {
object@ht_list[[i_main]]@matrix_param$column_split = column_split
if(verbose) qqcat("set column_split to main heatmap\n")
if(is.data.frame(column_split)) {
if(nrow(column_split) != ht_nc) {
stop_wrap("`column_split` should have same ncol as the main matrix.")
}
} else if(is.atomic(column_split)) {
if(length(column_split) > 1 && length(column_split) != ht_nr) {
stop_wrap("`column_split` should have same length as ncol of the main matrix.")
}
if(length(column_split) == 1 && !object@ht_list[[i_main]]@column_dend_param$cluster) {
stop_wrap("Since there is no column clustering for the main heatmap, `column_split` is not allowed to set as a single number.")
}
}
}
if(!is.null(column_km)) {
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
if(verbose) qqcat("set column_gap to main heatmap\n")
}
if(!is.null(cluster_columns)) {
if(is.null(show_column_dend) && identical(cluster_columns, TRUE)) {
show_column_dend = TRUE
}
if(inherits(cluster_columns, c("dendrogram", "hclust"))) {
object@ht_list[[i_main]]@column_dend_param$obj = cluster_columns
object@ht_list[[i_main]]@column_dend_param$cluster = TRUE
if(verbose) qqcat("set cluster_columns to main heatmap\n")
} else if(inherits(cluster_columns, "function")) {
object@ht_list[[i_main]]@column_dend_param$fun = cluster_columns
object@ht_list[[i_main]]@column_dend_param$cluster = TRUE
if(verbose) qqcat("set cluster_columns to main heatmap\n")
} else {
object@ht_list[[i_main]]@column_dend_param$cluster = cluster_columns
if(verbose) qqcat("set cluster_columns to main heatmap\n")
if(!cluster_columns) {
column_dend_width = unit(0, "mm")
show_column_dend = FALSE
} else {
column_dend_width = unit(10, "mm")
}
}
}
if(!is.null(cluster_column_slices)) {
object@ht_list[[i_main]]@column_dend_param$cluster_slices = cluster_column_slices
if(verbose) qqcat("set cluster_column_slices to main heatmap\n")
}
if(!is.null(show_column_dend)) {
if(!show_column_dend) {
column_dend_width = unit(0, "mm")
}
}
if(!is.null(clustering_distance_columns)) {
object@ht_list[[i_main]]@column_dend_param$distance = clustering_distance_columns
if(verbose) qqcat("set clustering_distance_columns to main heatmap\n")
}
if(!is.null(clustering_method_columns)) {
object@ht_list[[i_main]]@column_dend_param$method = clustering_method_columns
if(verbose) qqcat("set clustering_method_columns to main heatmap\n")
}
if(!is.null(column_dend_width)) {
if(unclass(column_dend_width)[[1]] == 0) {
object@ht_list[[i_main]]@column_dend_param$width = unit(0, "mm")
} else {
object@ht_list[[i_main]]@column_dend_param$width = column_dend_width + ht_opt$DENDROGRAM_PADDING # append the gap
}
}
if(!is.null(show_column_dend)) {
object@ht_list[[i_main]]@column_dend_param$show = show_column_dend
}
if(!is.null(column_dend_gp)) {
object@ht_list[[i_main]]@column_dend_param$gp = check_gp(column_dend_gp)
if(verbose) qqcat("set column_dend_gp to main heatmap\n")
}
if(!is.null(column_dend_reorder)) {
object@ht_list[[i_main]]@column_dend_param$reorder = column_dend_reorder
if(verbose) qqcat("set column_dend_reorder to main heatmap\n")
}
if(!is.null(column_order)) {
if(any(is.na(column_order))) {
stop_wrap("`column_order` should not contain NA values.")
}
if(length(column_order) != ncol(object@ht_list[[i_main]]@matrix)) {
stop_wrap("length of `column_order` should be same as the number of main marix columns.")
}
if(is.character(column_order)) {
column_order = structure(seq_len(ncol(object@ht_list[[i_main]]@matrix)), names = colnames(object@ht_list[[i_main]]@matrix))[column_order]
}
object@ht_list[[i_main]]@column_order = column_order
if(verbose) qqcat("set column_order to main heatmap\n")
}
if(!is.null(width) && !is.null(heatmap_width)) {
stop_wrap("You can only specify one of `width` and `heatmap_width` in draw().")
}
if(!is.null(width)) {
if(!inherits(width, "unit")) {
stop_wrap("`width` specified in `draw()` should be a unit.")
}
if(!is_abs_unit(width)) {
stop_wrap("`width` specified in `draw()` should be an absolute unit.")
}
}
if(!is.null(heatmap_width)) {
if(!inherits(heatmap_width, "unit")) {
stop_wrap("`heatmap_width` specified in `draw()` should be a unit.")
}
if(!is_abs_unit(heatmap_width)) {
stop_wrap("`heatmap_width` specified in `draw()` should be an absolute unit.")
}
}
if(!is.null(width) && is.null(heatmap_width)) {
object@ht_list[[i_main]]@matrix_param$width = width
object@ht_list[[i_main]]@heatmap_param$width = unit(1, "npc")
} else if(is.null(width) && !is.null(heatmap_width)) {
object@ht_list[[i_main]]@matrix_param$width = unit(1, "npc")
object@ht_list[[i_main]]@heatmap_param$width = heatmap_width
}
# row_* should not be set for vertical heatmap list
for(obj_nm in c("row_split", "row_km", "row_gap", "cluster_rows", "show_row_dend", "clustering_distance_rows",
"clustering_method_rows", "row_dend_width", "show_row_dend", "row_dend_gp", "row_dend_reorder",
"row_order", "height", "heatmap_height")) {
if(!is.null(get(obj_nm))) {
message_wrap(paste0("'", obj_nm, "' should not be set in draw() for vertical heatmap list. Please directly set it in `Heatmap()`."))
}
}
}
### parameter for all heatmaps
for(i in seq_len(n_ht)) {
if(!is.null(use_raster)) {
object@ht_list[[i]]@heatmap_param$use_raster = use_raster
}
if(!is.null(raster_device)) {
object@ht_list[[i]]@heatmap_param$raster_device = raster_device
}
if(!is.null(raster_quality)) {
object@ht_list[[i]]@heatmap_param$raster_quality = raster_quality
}
if(!is.null(raster_device_param)) {
object@ht_list[[i]]@heatmap_param$raster_device_param = raster_device_param
}
if(!is.null(raster_resize)) {
object@ht_list[[i]]@heatmap_param$raster_resize = raster_resize
}
}
if(verbose) qqcat("auto adjust all heatmap/annotations by the main heatmap\n")
######## auto adjust ##########
ht_main = object@ht_list[[i_main]]
if(direction == "horizontal") {
ht_main = make_row_cluster(ht_main) # with pre-defined order
if(verbose) qqcat("perform row clustering on the main heatmap\n")
} else {
ht_main = make_column_cluster(ht_main) # with pre-defined order
if(verbose) qqcat("perform column clustering on the main heatmap\n")
}
object@ht_list[[i_main]] = ht_main
if(direction == "horizontal") {
row_dend_side = match.arg(row_dend_side)[1]
row_sub_title_side = match.arg(row_sub_title_side)[1]
if(row_dend_side == "left" || row_sub_title_side == "left") {
# if the first one is a HeatmapAnnotation object
# add a heatmap with zero column so that we can put titles and dend on the most left
if(inherits(object@ht_list[[1]], "HeatmapAnnotation")) {
object@ht_list = c(list(Heatmap(matrix(nrow = nr, ncol = 0))), object@ht_list)
ht_gap = unit.c(unit(0, "mm"), ht_gap)
i_main = i_main + 1
n_ht = n_ht + 1
if(verbose) qqcat("add a zero-column heatmap for row dend/title on the very left\n")
}
}
if(row_dend_side == "right" || row_sub_title_side == "right") {
# if the last one is a HeatmapAnnotation object
if(inherits(object@ht_list[[ length(object@ht_list) ]], "HeatmapAnnotation")) {
object@ht_list = c(object@ht_list, list(Heatmap(matrix(nrow = nr, ncol = 0))))
ht_gap = unit.c(ht_gap, unit(0, "mm"))
n_ht = n_ht + 1
if(verbose) qqcat("add a zero-column heatmap for row dend/title on the very right\n")
}
}
} else {
column_dend_side = match.arg(column_dend_side)[1]
column_sub_title_side = match.arg(column_sub_title_side)[1]
if(column_dend_side == "top" || column_sub_title_side == "top") {
if(inherits(object@ht_list[[1]], "HeatmapAnnotation")) {
object@ht_list = c(list(Heatmap(matrix(nrow = 0, ncol = nc))), object@ht_list)
ht_gap = unit.c(unit(0, "mm"), ht_gap)
i_main = i_main + 1
n_ht = n_ht + 1
if(verbose) qqcat("add a zero-row heatmap for column dend/title on the very top\n")
}
}
if(column_dend_side == "bottom" || column_sub_title_side == "bottom") {
if(inherits(object@ht_list[[ length(object@ht_list) ]], "HeatmapAnnotation")) {
object@ht_list = c(object@ht_list, list(Heatmap(matrix(nrow = 0, ncol = nc))))
ht_gap = unit.c(ht_gap, unit(0, "mm"))
n_ht = n_ht + 1
if(verbose) qqcat("add a zero-column heatmap for row dend/title on the very bottom\n")
}
}
}
object@ht_list_param$main_heatmap = i_main
object@ht_list_param$ht_gap = ht_gap
object@ht_list_param$merge_legends = merge_legends
if(!is.null(padding)) {
if(length(padding) == 1) {
padding = rep(padding, 4)
} else if(length(padding) == 2) {
padding = rep(padding, 2)
} else if(length(padding) != 4) {
stop_wrap("`padding` can only have length of 1, 2, 4")
}
}
object@ht_list_param$padding = padding
object@ht_list_param$auto_adjust = auto_adjust
## orders of other heatmaps should be changed
if(direction == "horizontal") {
for(i in seq_len(n_ht)) {
if(inherits(object@ht_list[[i]], "Heatmap") & i != i_main) {
object@ht_list[[i]]@row_order_list = ht_main@row_order_list
object@ht_list[[i]]@row_order = ht_main@row_order
object@ht_list[[i]]@row_dend_param$show = FALSE
object@ht_list[[i]]@row_dend_param$cluster = FALSE # don't do clustering because cluster was already done
}
}
if(verbose) qqcat("adjust row order for all other heatmaps\n")
} else {
for(i in seq_len(n_ht)) {
if(inherits(object@ht_list[[i]], "Heatmap") & i != i_main) {
object@ht_list[[i]]@column_order_list = ht_main@column_order_list
object@ht_list[[i]]@column_order = ht_main@column_order
object@ht_list[[i]]@column_dend_param$show = FALSE
object@ht_list[[i]]@column_dend_param$cluster = FALSE # don't do clustering because cluster was already done
}
}
if(verbose) qqcat("adjust column order for all other heatmaps\n")
}
# width and height
if(direction == "horizontal") {
for(i in seq_len(n_ht)) {
if(inherits(object@ht_list[[i]], "Heatmap") & i != i_main) {
object@ht_list[[i]]@matrix_param$height = object@ht_list[[i_main]]@matrix_param$height
object@ht_list[[i]]@heatmap_param$height = object@ht_list[[i_main]]@heatmap_param$height
}
}
if(verbose) qqcat("adjust heights for all other heatmaps\n")
} else {
for(i in seq_len(n_ht)) {
if(inherits(object@ht_list[[i]], "Heatmap") & i != i_main) {
object@ht_list[[i]]@matrix_param$width = object@ht_list[[i_main]]@matrix_param$width
object@ht_list[[i]]@heatmap_param$width = object@ht_list[[i_main]]@heatmap_param$width
}
}
if(verbose) qqcat("adjust width for all other heatmaps\n")
}
if(auto_adjust) {
if(direction == "horizontal") {
for(i in seq_len(n_ht)) {
if(inherits(object@ht_list[[i]], "Heatmap")) {
if(i == 1 && !is.null(object@ht_list[[i]]@row_names_param$anno) && object@ht_list[[i]]@row_names_param$side == "left") {
} else if(i == n_ht && !is.null(object@ht_list[[i]]@row_names_param$anno) && object@ht_list[[i]]@row_names_param$side == "right") {
} else {
object@ht_list[[i]]@row_names_param$anno = NULL
object@ht_list[[i]]@row_names_param$show = FALSE
}
}
}
} else {
for(i in seq_len(n_ht)) {
if(inherits(object@ht_list[[i]], "Heatmap")) {
if(i == 1 && !is.null(object@ht_list[[i]]@column_names_param$anno) && object@ht_list[[i]]@column_names_param$side == "top") {
} else if(i == n_ht && !is.null(object@ht_list[[i]]@column_names_param$anno) && object@ht_list[[i]]@column_names_param$side == "bottom") {
} else {
object@ht_list[[i]]@column_names_param$anno = NULL
object@ht_list[[i]]@column_names_param$show = FALSE
}
}
}
}
}
if(direction == "horizontal") {
# update other heatmaps' row titles
for(i in seq_len(n_ht)) {
if(inherits(object@ht_list[[i]], "Heatmap") && i != i_main) {
object@ht_list[[i]]@row_title = character(0)
}
}
if(verbose) qqcat("remove row titles for all other heatmaps\n")
} else {
for(i in seq_len(n_ht)) {
if(inherits(object@ht_list[[i]], "Heatmap") && i != i_main) {
object@ht_list[[i]]@column_title = character(0)
}
}
if(verbose) qqcat("remove column titles for all other heatmaps\n")
}
if(direction == "horizontal") {
if(row_dend_side == "left") {
# move dend to the first one
object@ht_list[[i_main]]@row_dend_param$show = FALSE
object@ht_list[[1]]@row_dend_list = ht_main@row_dend_list
object@ht_list[[1]]@row_dend_slice = ht_main@row_dend_slice
object@ht_list[[1]]@row_dend_param = ht_main@row_dend_param
object@ht_list[[1]]@row_dend_param$side = "left"
if(verbose) qqcat("add dendrogram of the main heatmap to the left of the first heatmap\n")
} else if(row_dend_side == "right") {
object@ht_list[[i_main]]@row_dend_param$show = FALSE
object@ht_list[[n_ht]]@row_dend_list = ht_main@row_dend_list
object@ht_list[[n_ht]]@row_dend_slice = ht_main@row_dend_slice
object@ht_list[[n_ht]]@row_dend_param = ht_main@row_dend_param
object@ht_list[[n_ht]]@row_dend_param$side = "right"
if(verbose) qqcat("add dendrogram of the main heatmap to the right of the last heatmap\n")
}
if(row_sub_title_side == "left") {
object@ht_list[[i_main]]@row_title = character(0)
object@ht_list[[1]]@row_title = ht_main@row_title
object@ht_list[[1]]@row_title_param = ht_main@row_title_param
object@ht_list[[1]]@row_title_param$side = "left"
object@ht_list[[1]]@row_title_param$just = get_text_just(ht_main@row_title_param$rot, "left")
if(verbose) qqcat("add row title of the main heatmap to the left of the first heatmap\n")
} else if(row_sub_title_side == "right") {
object@ht_list[[i_main]]@row_title = character(0)
object@ht_list[[n_ht]]@row_title = ht_main@row_title
object@ht_list[[n_ht]]@row_title_param = ht_main@row_title_param
object@ht_list[[n_ht]]@row_title_param$side = "right"
object@ht_list[[n_ht]]@row_title_param$just = get_text_just(ht_main@row_title_param$rot, "right")
if(verbose) qqcat("add row title of the main heatmap to the right of the last heatmap\n")
}
} else {
if(column_dend_side == "top") {
object@ht_list[[i_main]]@column_dend_param$show = FALSE
object@ht_list[[1]]@column_dend_list = ht_main@column_dend_list
object@ht_list[[1]]@column_dend_slice = ht_main@column_dend_slice
object@ht_list[[1]]@column_dend_param = ht_main@column_dend_param
object@ht_list[[1]]@column_dend_param$side = "top"
if(verbose) qqcat("add dendrogram of the main heatmap to the top of the first heatmap\n")
} else if(column_dend_side == "bottom") {
object@ht_list[[i_main]]@column_dend_param$show = FALSE
object@ht_list[[n_ht]]@column_dend_list = ht_main@column_dend_list
object@ht_list[[n_ht]]@column_dend_slice = ht_main@column_dend_slice
object@ht_list[[n_ht]]@column_dend_param = ht_main@column_dend_param
object@ht_list[[n_ht]]@column_dend_param$side = "bottom"
if(verbose) qqcat("add dendrogram of the main heatmap to the bottom of the last heatmap\n")
}
if(column_sub_title_side == "top") {
object@ht_list[[i_main]]@column_title = character(0)
object@ht_list[[1]]@column_title = ht_main@column_title
object@ht_list[[1]]@column_title_param = ht_main@column_title_param
object@ht_list[[1]]@column_title_param$side = "top"
object@ht_list[[1]]@column_title_param$just = get_text_just(ht_main@column_title_param$rot, "top")
if(verbose) qqcat("add column title of the main heatmap to the top of the first heatmap\n")
} else if(column_sub_title_side == "bottom") {
object@ht_list[[i_main]]@column_title = character(0)
object@ht_list[[n_ht]]@column_title = ht_main@column_title
object@ht_list[[n_ht]]@column_title_param = ht_main@column_title_param
object@ht_list[[n_ht]]@column_title_param$side = "bottom"
object@ht_list[[n_ht]]@column_title_param$just = get_text_just(ht_main@row_title_param$rot, "bottom")
if(verbose) qqcat("add column title of the main heatmap to the bottom of the last heatmap\n")
}
}
# gap
if(direction == "horizontal") {
for(i in seq_len(n_ht)) {
if(inherits(object@ht_list[[i]], "Heatmap")) {
object@ht_list[[i]]@matrix_param$row_gap = ht_main@matrix_param$row_gap
}
}
if(verbose) qqcat("adjust row_gap for all other heatmaps\n")
} else {
for(i in seq_len(n_ht)) {
if(inherits(object@ht_list[[i]], "Heatmap")) {
object@ht_list[[i]]@matrix_param$column_gap = ht_main@matrix_param$column_gap
}
}
if(verbose) qqcat("adjust column_gap for all other heatmaps\n")
}
if(direction == "horizontal") {
for(i in seq_len(n_ht)) {
# supress row clustering because all rows in all heatmaps are adjusted
if(inherits(object@ht_list[[i]], "Heatmap")) {
if(verbose) qqcat("prepare layout for heatmap: @{object@ht_list[[i]]@name}\n")
object@ht_list[[i]] = prepare(object@ht_list[[i]], process_rows = FALSE)
}
}
} else {
for(i in seq_len(n_ht)) {
if(inherits(object@ht_list[[i]], "Heatmap")) {
if(verbose) qqcat("prepare layout for heatmap: @{object@ht_list[[i]]@name}\n")
object@ht_list[[i]] = prepare(object@ht_list[[i]], process_columns = FALSE)
}
}
}
############################################
## title on top or bottom
if(!is.null(ht_opt$TITLE_PADDING)) {
title_padding = ht_opt$TITLE_PADDING
} else {
title_padding = unit(c(0, 0), "points")
title_padding[1] = title_padding[1] + unit(5.5, "points") +
convertHeight(grobDescent(textGrob(label = "jA", gp = column_title_gp)), "inches")
}
column_title_side = match.arg(column_title_side)[1]
if(length(column_title) == 0) {
column_title = character(0)
} else if(!inherits(column_title, c("expression", "call"))) {
if(is.na(column_title)) {
column_title = character(0)
} else if(column_title == "") {
column_title = character(0)
}
}
object@column_title = column_title
object@column_title_param$gp = check_gp(column_title_gp)
object@column_title_param$side = column_title_side
if(length(column_title) > 0) {
if(column_title_side == "top") {
object@layout$layout_column_title_top_height = grobHeight(textGrob(column_title, gp = column_title_gp)) + sum(title_padding)
object@layout$layout_index = rbind(object@layout$layout_index, column_title_top = heatmap_list_layout_index("column_title_top"))
} else {
object@layout$layout_column_title_bottom_height = grobHeight(textGrob(column_title, gp = column_title_gp)) + sum(title_padding)
object@layout$layout_index = rbind(object@layout$layout_index, column_title_bottom = heatmap_list_layout_index("column_title_bottom"))
}
object@layout$graphic_fun_list = c(object@layout$graphic_fun_list, function(object) draw_title(object, which = "column"))
}
############################################
## title on left or right
if(!is.null(ht_opt$TITLE_PADDING)) {
title_padding = ht_opt$TITLE_PADDING
} else {
title_padding = unit(c(0, 0), "points")
title_padding[1] = title_padding[1] + unit(5.5, "points") +
convertHeight(grobDescent(textGrob(label = "jA", gp = row_title_gp)), "inches")
}
row_title_side = match.arg(row_title_side)[1]
if(length(row_title) == 0) {
row_title = character(0)
} else if(!inherits(row_title, c("expression", "call"))) {
if(is.na(row_title)) {
row_title = character(0)
} else if(row_title == "") {
row_title = character(0)
}
}
object@row_title = row_title
object@row_title_param$gp = check_gp(row_title_gp)
object@row_title_param$side = row_title_side
if(length(row_title) > 0) {
if(row_title_side == "left") {
object@layout$layout_row_title_left_width = grobHeight(textGrob(row_title, gp = row_title_gp)) + sum(title_padding)
object@layout$layout_index = rbind(object@layout$layout_index, row_title_left = heatmap_list_layout_index("row_title_left"))
} else {
object@layout$layout_row_title_right_width = grobHeight(textGrob(row_title, gp = row_title_gp)) + sum(title_padding)
object@layout$layout_index = rbind(object@layout$layout_index, row_title_right = heatmap_list_layout_index("row_title_right"))
}
object@layout$graphic_fun_list = c(object@layout$graphic_fun_list, function(object) draw_title(object, which = "row"))
}
#################################################
## heatmap legend to top, bottom, left and right
# default values
legend_grouping = match.arg(legend_grouping)[1]
object@ht_list_param$legend_grouping = legend_grouping
ColorMappingList = list()
for(i in seq_along(object@ht_list)) {
ht = object@ht_list[[i]]
if(direction == "horizontal") {
if(inherits(object@ht_list[[i]], "Heatmap")) {
if(!is.null(ht@left_annotation)) {
if(object@ht_list_param$merge_legends || legend_grouping == "adjusted") {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@left_annotation))
}
}
if(!is.null(ht@top_annotation)) {
if(object@ht_list_param$merge_legends) {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@top_annotation))
}
}
if(object@ht_list[[i]]@heatmap_param$show_heatmap_legend) {
ColorMappingList = c.list(ColorMappingList, object@ht_list[[i]]@matrix_color_mapping)
}
if(!is.null(ht@bottom_annotation)) {
if(object@ht_list_param$merge_legends) {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@bottom_annotation))
}
}
if(!is.null(ht@right_annotation)) {
if(object@ht_list_param$merge_legends || legend_grouping == "adjusted") {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@right_annotation))
}
}
} else if(inherits(object@ht_list[[i]], "HeatmapAnnotation")) {
if(object@ht_list_param$merge_legends || legend_grouping == "adjusted") {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(object@ht_list[[i]]))
}
}
} else {
if(inherits(object@ht_list[[i]], "Heatmap")) {
if(!is.null(ht@left_annotation)) {
if(object@ht_list_param$merge_legends) {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@left_annotation))
}
}
if(!is.null(ht@top_annotation)) {
if(object@ht_list_param$merge_legends || legend_grouping == "adjusted") {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@top_annotation))
}
}
if(object@ht_list[[i]]@heatmap_param$show_heatmap_legend) {
ColorMappingList = c.list(ColorMappingList, object@ht_list[[i]]@matrix_color_mapping)
}
if(!is.null(ht@bottom_annotation)) {
if(object@ht_list_param$merge_legends || legend_grouping == "adjusted") {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@bottom_annotation))
}
}
if(!is.null(ht@right_annotation)) {
if(object@ht_list_param$merge_legends) {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@right_annotation))
}
}
} else if(inherits(object@ht_list[[i]], "HeatmapAnnotation")) {
if(object@ht_list_param$merge_legends || legend_grouping == "adjusted") {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(object@ht_list[[i]]))
}
}
}
}
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)
}
if(length(ColorMappingList) == 0 && length(heatmap_legend_list) == 0) {
show_heatmap_legend = FALSE
}
# ### proper max_height/max_width for legends #####
# ht_main = object@ht_list[[i_main]]
# max_legend_height = unit(dev.size("cm")[2], "cm") - object@ht_list_param$padding[1] -object@ht_list_param$padding[3] -
# ht_main@layout$layout_size$column_title_top_height - ht_main@layout$layout_size$column_dend_top_height -
# ht_main@layout$layout_size$column_title_bottom_height - ht_main@layout$layout_size$column_dend_bottom_height
# if(heatmap_legend_side %in% c("top", "bottom") && annotation_legend_side %in% c("left", "right") ||
# heatmap_legend_side %in% c("left", "right") && annotation_legend_side %in% c("top", "bottom")) {
# max_legend_width = unit(dev.size("cm")[1], "cm")
# }
object@heatmap_legend_param$show = show_heatmap_legend
heatmap_legend_side = match.arg(heatmap_legend_side)[1]
object@heatmap_legend_param$side = heatmap_legend_side
if(show_heatmap_legend) {
if(heatmap_legend_side == "top") {
object@heatmap_legend_param$padding = unit.c(ht_opt$HEATMAP_LEGEND_PADDING, unit(c(0, 0, 0), "mm")) #unit(c(2, 0, 0, 0), "mm")
size = heatmap_legend_size(object, legend_list = heatmap_legend_list, max_width = calc_legends_max_width(object, page_size))
object@heatmap_legend_param$size = size
object@layout$layout_heatmap_legend_top_height = size[2]
object@layout$layout_index = rbind(object@layout$layout_index, heatmap_legend_top = heatmap_list_layout_index("heatmap_legend_top"))
} else if(heatmap_legend_side == "bottom") {
object@heatmap_legend_param$padding = unit.c(unit(c(0, 0), "mm"), ht_opt$HEATMAP_LEGEND_PADDING, unit(0, "mm")) # unit(c(0, 0, 2, 0), "mm")
size = heatmap_legend_size(object, legend_list = heatmap_legend_list, max_width = calc_legends_max_width(object, page_size))
object@heatmap_legend_param$size = size
object@layout$layout_heatmap_legend_bottom_height = size[2]
object@layout$layout_index = rbind(object@layout$layout_index, heatmap_legend_bottom = heatmap_list_layout_index("heatmap_legend_bottom"))
} else if(heatmap_legend_side == "left") {
object@heatmap_legend_param$padding = unit.c(unit(c(0, 0, 0), "mm"), ht_opt$HEATMAP_LEGEND_PADDING) # unit(c(0, 0, 0, 2), "mm")
size = heatmap_legend_size(object, legend_list = heatmap_legend_list, max_height = calc_legends_max_height(object, page_size))
object@heatmap_legend_param$size = size
object@layout$layout_heatmap_legend_left_width = size[1]
object@layout$layout_index = rbind(object@layout$layout_index, heatmap_legend_left = heatmap_list_layout_index("heatmap_legend_left"))
} else if(heatmap_legend_side == "right") {
object@heatmap_legend_param$padding = unit.c(unit(0, "mm"), ht_opt$HEATMAP_LEGEND_PADDING, unit(c(0, 0), "mm")) # unit(c(0, 2, 0, 0), "mm")
size = heatmap_legend_size(object, legend_list = heatmap_legend_list, max_height = calc_legends_max_height(object, page_size))
object@heatmap_legend_param$size = size
object@layout$layout_heatmap_legend_right_width = size[1]
object@layout$layout_index = rbind(object@layout$layout_index, heatmap_legend_right = heatmap_list_layout_index("heatmap_legend_right"))
}
if(heatmap_legend_side %in% c("top", "bottom")) {
object@layout$graphic_fun_list = c(object@layout$graphic_fun_list, function(object) draw_heatmap_legend(object, legend_list = heatmap_legend_list, max_width = calc_legends_max_width(object, page_size)))
} else {
object@layout$graphic_fun_list = c(object@layout$graphic_fun_list, function(object) draw_heatmap_legend(object, legend_list = heatmap_legend_list, max_height = calc_legends_max_height(object, page_size)))
}
} else {
object@heatmap_legend_param$size = unit(c(0, 0), "mm")
}
#################################################
## annotation legend to top, bottom, left and right
# default values
ColorMappingList = list()
if(!merge_legends) {
for(i in seq_along(object@ht_list)) {
ht = object@ht_list[[i]]
if(direction == "horizontal") {
if(inherits(ht, "Heatmap")) {
if(!is.null(ht@left_annotation)) {
if(legend_grouping == "original") {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@left_annotation))
}
}
if(!is.null(ht@top_annotation)) {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@top_annotation))
}
if(!is.null(ht@bottom_annotation)) {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@bottom_annotation))
}
if(!is.null(ht@right_annotation)) {
if(legend_grouping == "original") {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@right_annotation))
}
}
} else if(inherits(ht, "HeatmapAnnotation")) {
if(legend_grouping == "original") {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht))
}
}
} else {
if(inherits(ht, "Heatmap")) {
if(!is.null(ht@left_annotation)) {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@left_annotation))
}
if(!is.null(ht@top_annotation)) {
if(legend_grouping == "original") {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@top_annotation))
}
}
if(!is.null(ht@bottom_annotation)) {
if(legend_grouping == "original") {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@bottom_annotation))
}
}
if(!is.null(ht@top_annotation)) {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@top_annotation))
}
} else if(inherits(ht, "HeatmapAnnotation")) {
if(legend_grouping == "original") {
ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht))
}
}
}
}
} else {
annotation_legend_list = list()
}
if(length(ColorMappingList) == 0 && length(annotation_legend_list) == 0) {
show_annotation_legend = FALSE
}
object@annotation_legend_param$show = show_annotation_legend
annotation_legend_side = match.arg(annotation_legend_side)[1]
object@annotation_legend_param$side = annotation_legend_side
if(show_annotation_legend) {
if(annotation_legend_side == "top") {
object@annotation_legend_param$padding = unit.c(ht_opt$ANNOTATION_LEGEND_PADDING, unit(c(0, 0, 0), "mm")) # unit(c(2, 0, 0, 0), "mm")
size = annotation_legend_size(object, legend_list = annotation_legend_list, max_width = calc_legends_max_width(object, page_size))
object@annotation_legend_param$size = size
object@layout$layout_annotation_legend_top_height = size[2]
object@layout$layout_index = rbind(object@layout$layout_index, annotation_legend_top = heatmap_list_layout_index("annotation_legend_top"))
} else if(annotation_legend_side == "bottom") {
object@annotation_legend_param$padding = unit.c(unit(c(0, 0), "mm"), ht_opt$ANNOTATION_LEGEND_PADDING, unit(0, "mm")) # unit(c(0, 0, 2, 0), "mm")
size = annotation_legend_size(object, legend_list = annotation_legend_list, max_width = calc_legends_max_width(object, page_size))
object@annotation_legend_param$size = size
object@layout$layout_annotation_legend_bottom_height = size[2]
object@layout$layout_index = rbind(object@layout$layout_index, annotation_legend_bottom = heatmap_list_layout_index("annotation_legend_bottom"))
} else if(annotation_legend_side == "left") {
object@annotation_legend_param$padding = unit.c(unit(c(0, 0, 0), "mm"), ht_opt$ANNOTATION_LEGEND_PADDING) # unit(c(0, 0, 0, 2), "mm")
size = annotation_legend_size(object, legend_list = annotation_legend_list, max_height = calc_legends_max_height(object, page_size))
object@annotation_legend_param$size = size
object@layout$layout_annotation_legend_left_width = size[1]
object@layout$layout_index = rbind(object@layout$layout_index, annotation_legend_left = heatmap_list_layout_index("annotation_legend_left"))
} else if(annotation_legend_side == "right") {
object@annotation_legend_param$padding = unit.c(unit(0, "mm"), ht_opt$ANNOTATION_LEGEND_PADDING, unit(c(0, 0), "mm")) # unit(c(0, 2, 0, 0), "mm")
size = annotation_legend_size(object, legend_list = annotation_legend_list, max_height = calc_legends_max_height(object, page_size))
object@annotation_legend_param$size = size
object@layout$layout_annotation_legend_right_width = size[1]
object@layout$layout_index = rbind(object@layout$layout_index, annotation_legend_right = heatmap_list_layout_index("annotation_legend_right"))
}
if(annotation_legend_side %in% c("top", "bottom")) {
object@layout$graphic_fun_list = c(object@layout$graphic_fun_list, function(object) draw_annotation_legend(object, legend_list = annotation_legend_list, max_width = calc_legends_max_width(object, page_size)))
} else {
object@layout$graphic_fun_list = c(object@layout$graphic_fun_list, function(object) draw_annotation_legend(object, legend_list = annotation_legend_list, max_height = calc_legends_max_height(object, page_size)))
}
} else {
object@annotation_legend_param$size = unit(c(0, 0), "null")
}
object@heatmap_legend_param$align_legend = align_heatmap_legend
object@annotation_legend_param$align_legend = align_annotation_legend
object = adjust_heatmap_list(object)
object@layout$layout_index = rbind(heatmaplist = heatmap_list_layout_index("heatmap_list"), object@layout$layout_index)
object@layout$graphic_fun_list = c(function(object) draw_heatmap_list(object), object@layout$graphic_fun_list)
if(direction == "horizontal") {
main_matrix_rn = rownames(object@ht_list[[i_main]]@matrix)
if(!is.null(main_matrix_rn)) {
for(i in seq_len(n_ht)) {
if(i == i_main) next
if(inherits(object@ht_list[[i]], "Heatmap")) {
matrix_rn = rownames(object@ht_list[[i]]@matrix)
if(!is.null(matrix_rn)) {
# if same set but different order
if(setequal(main_matrix_rn, matrix_rn)) {
if(!identical(main_matrix_rn, matrix_rn)) {
warning_wrap("Row names of heatmap ", i, " is not consistent as the main heatmap (", i_main, ")", sep = "")
}
}
}
}
}
}
} else {
main_matrix_cn = colnames(object@ht_list[[i_main]]@matrix)
if(!is.null(main_matrix_cn)) {
for(i in seq_len(n_ht)) {
if(i == i_main) next
if(inherits(object@ht_list[[i]], "Heatmap")) {
matrix_cn = colnames(object@ht_list[[i]]@matrix)
if(!is.null(matrix_cn)) {
# if same set but different order
if(setequal(main_matrix_cn, matrix_cn)) {
if(!identical(main_matrix_cn, matrix_cn)) {
warning_wrap("Column names of heatmap ", i, " is not consistent as the main heatmap (", i_main, ")", sep = "")
}
}
}
}
}
}
}
object@layout$initialized = TRUE
return(object)
})
calc_legends_max_height = function(object, page_size) {
gh = page_size[2]
h = gh - object@layout$layout_column_title_top_height - object@layout$layout_column_title_bottom_height -
object@ht_list_param$padding[1] - object@ht_list_param$padding[3]
convertHeight(h, "mm")
}
calc_legends_max_width = function(object, page_size) {
gh = page_size[1]
h = gh - object@layout$layout_row_title_right_width - object@layout$layout_row_title_left_width -
object@ht_list_param$padding[2] - object@ht_list_param$padding[4]
convertWidth(h, "mm")
}
HEATMAP_LIST_LAYOUT_COLUMN_COMPONENT = 1:7
names(HEATMAP_LIST_LAYOUT_COLUMN_COMPONENT) = c("annotation_legend_top", "heatmap_legend_top", "column_title_top",
"heatmap_list", "column_title_bottom", "heatmap_legend_bottom", "annotation_legend_bottom")
HEATMAP_LIST_LAYOUT_ROW_COMPONENT = 1:7
names(HEATMAP_LIST_LAYOUT_ROW_COMPONENT) = c("annotation_legend_left", "heatmap_legend_left", "row_title_left",
"heatmap_list", "row_title_right", "heatmap_legend_right", "annotation_legend_right")
heatmap_list_layout_index = function(nm) {
if(nm == "heatmap_list") { # heatmap_body
ind = c(HEATMAP_LIST_LAYOUT_COLUMN_COMPONENT["heatmap_list"], HEATMAP_LIST_LAYOUT_ROW_COMPONENT["heatmap_list"])
} else if(nm %in% names(HEATMAP_LIST_LAYOUT_COLUMN_COMPONENT)) {
ind = c(HEATMAP_LIST_LAYOUT_COLUMN_COMPONENT[nm], HEATMAP_LIST_LAYOUT_ROW_COMPONENT["heatmap_list"])
} else if(nm %in% names(HEATMAP_LIST_LAYOUT_ROW_COMPONENT)) {
ind = c(HEATMAP_LIST_LAYOUT_COLUMN_COMPONENT["heatmap_list"], HEATMAP_LIST_LAYOUT_ROW_COMPONENT[nm])
}
names(ind) = c("layout.pos.row", "layout.pos.col")
return(ind)
}
has_heatmap_list_component = function(object, component) {
m = object@layout$layout_index
ind = heatmap_list_layout_index(component)
any(m[, 1] == ind[1] & m[, 2] == ind[2])
}
# == title
# Width of Heatmap List Components
#
# == param
# -object A `HeatmapList-class` object.
# -k Which component in the heatmap list. Values are in ``ComplexHeatmap:::HEATMAP_LIST_LAYOUT_ROW_COMPONENT``.
#
# == detail
# This function is only for internal use.
#
# == value
# A `grid::unit` object.
#
# == author
# Zuguang Gu <z.gu@dkfz.de>
#
setMethod(f = "component_width",
signature = "HeatmapList",
definition = function(object, k = HEATMAP_LIST_LAYOUT_ROW_COMPONENT) {
if(is.numeric(k)) {
component_name = names(HEATMAP_LIST_LAYOUT_ROW_COMPONENT)[k]
} else {
component_name = k
}
direction = object@direction
# this function is used for grid.layout, so null unit is allowed
.single_unit_horizontal = function(nm) {
if(nm == "heatmap_list") {
width = sum(do.call("unit.c", lapply(object@ht_list, function(ht) {
if(inherits(ht, "Heatmap")) {
ht@heatmap_param$width
} else {
width(ht) # width of the row annotation, always a fixed unit
}
})))
if(is_abs_unit(width)) {
width + sum(object@ht_list_param$ht_gap) - object@ht_list_param$ht_gap[length(object@ht_list_param$ht_gap)] + object@layout$heatmap_list_padding[2] + object@layout$heatmap_list_padding[4]
} else {
unit(1, "null")
}
} else {
object@layout[[paste0("layout_", nm, "_width")]]
}
}
.single_unit_vertical = function(nm) {
if(nm == "heatmap_list") {
width = max(do.call("unit.c", lapply(object@ht_list, function(ht) {
if(inherits(ht, "Heatmap")) {
ht@heatmap_param$width
} else {
# the width of column annotation is always unit(1, "npc")
w = width(ht)
# if a relative unit, reset to unit(0, "mm")
if(!is_abs_unit(w)) w = unit(0, "mm")
w
}
})))
if(is_abs_unit(width)) {
# if height is zeor, this means, there is no heatmap and no width is set for all heatmapannotations
if(convertWidth(width, "mm", valueOnly = TRUE) == 0) {
unit(1, "null")
} else {
width + object@layout$heatmap_list_padding[2] + object@layout$heatmap_list_padding[4]
}
} else {
unit(1, "null")
}
} else {
object@layout[[paste0("layout_", nm, "_width")]]
}
}
if(direction == "horizontal") {
do.call("unit.c", lapply(component_name, .single_unit_horizontal))
} else {
do.call("unit.c", lapply(component_name, .single_unit_vertical))
}
})
# == title
# Height of Heatmap List Components
#
# == param
# -object A `HeatmapList-class` object.
# -k Which component in the heatmap list. Values are in ``ComplexHeatmap:::HEATMAP_LIST_LAYOUT_COLUMN_COMPONENT``.
#
# == value
# A `grid::unit` object.
#
# == author
# Zuguang Gu <z.gu@dkfz.de>
#
setMethod(f = "component_height",
signature = "HeatmapList",
definition = function(object, k = HEATMAP_LIST_LAYOUT_COLUMN_COMPONENT) {
if(is.numeric(k)) {
component_name = names(HEATMAP_LIST_LAYOUT_COLUMN_COMPONENT)[k]
} else {
component_name = k
}
direction = object@direction
# this function is used for grid.layout, so null unit is allowed
.single_unit_vertical = function(nm) {
if(nm == "heatmap_list") {
height = sum(do.call("unit.c", lapply(object@ht_list, function(ht) {
if(inherits(ht, "Heatmap")) {
ht@heatmap_param$height
} else {
height(ht) # width of the row annotation, always a fixed unit
}
})))
if(is_abs_unit(height)) {
height + sum(object@ht_list_param$ht_gap) - object@ht_list_param$ht_gap[length(object@ht_list_param$ht_gap)] + object@layout$heatmap_list_padding[1] + object@layout$heatmap_list_padding[3]
} else {
unit(1, "null")
}
} else {
object@layout[[paste0("layout_", nm, "_height")]]
}
}
.single_unit_horizontal = function(nm) {
if(nm == "heatmap_list") {
height = max(do.call("unit.c", lapply(object@ht_list, function(ht) {
if(inherits(ht, "Heatmap")) {
ht@heatmap_param$height
} else {
h = height(ht)
if(!is_abs_unit(h)) h = unit(0, "mm")
h
}
})))
if(is_abs_unit(height)) {
# if height is zeor, this means, there is no heatmap and no width is set for all heatmapannotations
if(convertWidth(height, "mm", valueOnly = TRUE) == 0) {
unit(1, "null")
} else {
height + object@layout$heatmap_list_padding[1] + object@layout$heatmap_list_padding[3]
}
} else {
unit(1, "null")
}
} else {
object@layout[[paste0("layout_", nm, "_height")]]
}
}
if(direction == "horizontal") {
do.call("unit.c", lapply(component_name, .single_unit_horizontal))
} else {
do.call("unit.c", lapply(component_name, .single_unit_vertical))
}
})
Try the ComplexHeatmap package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.