R/HeatmapList-layout.R

# == 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`.
# -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.
# -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.
# -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.
#
# == 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(),

    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,
    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,
    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) {

    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") {
        object@layout$page_size = unit(dev.size("cm"), "cm")
    } else {
        grid::upViewport()
        object@layout$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(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(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(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(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()`."))
            }
        }
    }

    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
                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"))
                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
                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"))
                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
    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)) + ht_opt$TITLE_PADDING*2
            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)) + ht_opt$TITLE_PADDING*2
            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
    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)) + ht_opt$TITLE_PADDING*2
            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)) + ht_opt$TITLE_PADDING*2
            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
    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)) {
                    ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@left_annotation))
                }
                if(object@ht_list_param$merge_legends && !is.null(ht@top_annotation)) {
                    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(object@ht_list_param$merge_legends && !is.null(ht@bottom_annotation)) {
                    ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@bottom_annotation))
                }
                if(!is.null(ht@right_annotation)) {
                    ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@right_annotation))
                }
            } else if(inherits(object@ht_list[[i]], "HeatmapAnnotation")) {
                ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(object@ht_list[[i]]))
            }
        } else {
            if(inherits(object@ht_list[[i]], "Heatmap")) {
                if(object@ht_list_param$merge_legends && !is.null(ht@left_annotation)) {
                    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(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)) {
                    ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@bottom_annotation))
                }
                if(object@ht_list_param$merge_legends && !is.null(ht@right_annotation)) {
                    ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@right_annotation))
                }
            } else if(inherits(object@ht_list[[i]], "HeatmapAnnotation")) {
                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(2, 0, 0, 0), "mm")
            size = heatmap_legend_size(object, legend_list = heatmap_legend_list, max_width = calc_legends_max_width(object))
            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(0, 0, 2, 0), "mm")
            size = heatmap_legend_size(object, legend_list = heatmap_legend_list, max_width = calc_legends_max_width(object))
            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(0, 0, 0, 2), "mm")
            size = heatmap_legend_size(object, legend_list = heatmap_legend_list, max_height = calc_legends_max_height(object))
            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(0, 2, 0, 0), "mm")
            size = heatmap_legend_size(object, legend_list = heatmap_legend_list, max_height = calc_legends_max_height(object))
            object@heatmap_legend_param$size = size
            object@layout$layout_heatmap_legend_right_width = size[1]
            object@layout$layout_index = rbind(object@layout$layout_index, heamap_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)))
        } 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)))
        }
    } 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@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))
                    }
                }
            } 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@right_annotation)) {
                        ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@right_annotation))
                    }
                }
            }
        }
    } 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(2, 0, 0, 0), "mm")
            size = annotation_legend_size(object, legend_list = annotation_legend_list, max_width = calc_legends_max_width(object))
            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(0, 0, 2, 0), "mm")
            size = annotation_legend_size(object, legend_list = annotation_legend_list, max_width = calc_legends_max_width(object))
            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(0, 0, 0, 2), "mm")
            size = annotation_legend_size(object, legend_list = annotation_legend_list, max_height = calc_legends_max_height(object))
            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(0, 2, 0, 0), "mm")
            size = annotation_legend_size(object, legend_list = annotation_legend_list, max_height = calc_legends_max_height(object))
            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)))
        } 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)))
        }
    } else {
        object@annotation_legend_param$size = unit(c(0, 0), "null")
    }

    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) {
    gh = object@layout$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) {
    gh = object@layout$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))
    }
})
zhongmicai/complexHeatmap documentation built on May 7, 2019, 6:11 a.m.