Heatmap-class.R

###############################
# class for single heatmap
#

# == title
# Class for a Single Heatmap
#
# == details
# The `Heatmap-class` is not responsible for heatmap legend and annotation legends. The `draw,Heatmap-method` method
# constructs a `HeatmapList-class` object which only contains one single heatmap
# and call `draw,HeatmapList-method` to make the complete heatmap.
#
# == methods
# The `Heatmap-class` provides following methods:
#
# - `Heatmap`: constructor method.
# - `draw,Heatmap-method`: draw a single heatmap.
# - `add_heatmap,Heatmap-method` append heatmaps and annotations to a list of heatmaps.
# - `row_order,HeatmapList-method`: get order of rows
# - `column_order,HeatmapList-method`: get order of columns
# - `row_dend,HeatmapList-method`: get row dendrograms
# - `column_dend,HeatmapList-method`: get column dendrograms
#
# == author
# Zuguang Gu <z.gu@dkfz.de>
#
Heatmap = setClass("Heatmap",
    slots = list(
        name = "character",

        matrix = "matrix",  # one or more matrix which are spliced by rows
        matrix_param = "list",
        matrix_color_mapping = "ANY",
        matrix_legend_param = "ANY",

        row_title = "ANY",
        row_title_param = "list",
        column_title = "ANY",
        column_title_param = "list",

        row_dend_list = "list", # one or more row clusters
        row_dend_slice = "ANY",
        row_dend_param = "list", # parameters for row cluster
        row_order_list = "list",
        row_order = "numeric",

        column_dend_list = "list",
        column_dend_slice = "ANY",
        column_dend_param = "list", # parameters for column cluster
        column_order_list = "list",
        column_order = "numeric",

        row_names_param = "list",
        column_names_param = "list",

        top_annotation = "ANY", # NULL or a `HeatmapAnnotation` object
        top_annotation_param = "list",
        bottom_annotation = "ANY",
        bottom_annotation_param = "list",
        left_annotation = "ANY", # NULL or a `HeatmapAnnotation` object
        left_annotation_param = "list",
        right_annotation = "ANY",
        right_annotation_param = "list",

        heatmap_param = "list",

        layout = "list"
    ),
    contains = "AdditiveUnit"
)



# == title
# Constructor method for Heatmap class
#
# == param
# -matrix A matrix. Either numeric or character. If it is a simple vector, it will be
#         converted to a one-column matrix.
# -col A vector of colors if the color mapping is discrete or a color mapping 
#      function if the matrix is continuous numbers (should be generated by `circlize::colorRamp2`). If the matrix is continuous,
#      the value can also be a vector of colors so that colors can be interpolated. Pass to `ColorMapping`. For more details
#      and examples, please refer to https://jokergoo.github.io/ComplexHeatmap-reference/book/a-single-heatmap.html#colors .
# -name Name of the heatmap. By default the heatmap name is used as the title of the heatmap legend.
# -na_col Color for ``NA`` values.
# -rect_gp Graphic parameters for drawing rectangles (for heatmap body). The value should be specified by `grid::gpar` and ``fill`` parameter is ignored.
# -color_space The color space in which colors are interpolated. Only used if ``matrix`` is numeric and 
#            ``col`` is a vector of colors. Pass to `circlize::colorRamp2`.
# -border Whether draw border. The value can be logical or a string of color.
# -cell_fun Self-defined function to add graphics on each cell. Seven parameters will be passed into 
#           this function: ``j``, ``i``, ``x``, ``y``, ``width``, ``height``, ``fill`` which are column index,
#           row index in ``matrix``, coordinate of the cell,
#           the width and height of the cell and the filled color. ``x``, ``y``, ``width`` and ``height`` are all `grid::unit` objects.
# -layer_fun Similar as ``cell_fun``, but is vectorized. Check https://jokergoo.github.io/ComplexHeatmap-reference/book/a-single-heatmap.html#customize-the-heatmap-body .
# -jitter Random shifts added to the matrix. The value can be logical or a single numeric value. It it is ``TRUE``, random 
#      values from uniform distribution between 0 and 1e-10 are generated. If it is a numeric value,
#      the range for the uniform distribution is (0, ``jitter``). It is mainly to solve the problem of "Error: node stack overflow"
#      when there are too many identical rows/columns for plotting the dendrograms.
# -row_title Title on the row.
# -row_title_side Will the title be put on the left or right of the heatmap?
# -row_title_gp Graphic parameters for row title.
# -row_title_rot Rotation of row title. Only 0, 90, 270 are allowed to set.
# -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 column title.
# -column_title_rot Rotation of column titles. Only 0, 90, 270 are allowed to set.
# -cluster_rows If the value is a logical, it controls whether to make cluster on rows. The value can also
#               be a `stats::hclust` or a `stats::dendrogram` which already contains clustering.
#               Check https://jokergoo.github.io/ComplexHeatmap-reference/book/a-single-heatmap.html#clustering .
# -cluster_row_slices If rows are split into slices, whether perform clustering on the slice means?
# -clustering_distance_rows It can be a pre-defined character which is in 
#                ("euclidean", "maximum", "manhattan", "canberra", "binary", 
#                "minkowski", "pearson", "spearman", "kendall"). It can also be a function.
#                If the function has one argument, the input argument should be a matrix and 
#                the returned value should be a `stats::dist` object. If the function has two arguments,
#                the input arguments are two vectors and the function calculates distance between these
#                two vectors.
# -clustering_method_rows Method to perform hierarchical clustering, pass to `stats::hclust`.
# -row_dend_side Should the row dendrogram be put on the left or right of the heatmap?
# -row_dend_width Width of the row dendrogram, should be a `grid::unit` object.
# -show_row_dend Whether show row dendrogram?
# -row_dend_gp Graphic parameters for the dendrogram segments. If users already provide a `stats::dendrogram`
#                object with edges rendered, this argument will be ignored.
# -row_dend_reorder Apply reordering on row dendrograms. The value can be a logical value or a vector which contains weight 
#               which is used to reorder rows. The reordering is applied by `stats::reorder.dendrogram`.
# -cluster_columns Whether make cluster on columns? Same settings as ``cluster_rows``.
# -cluster_column_slices If columns are split into slices, whether perform clustering on the slice means?
# -clustering_distance_columns Same setting as ``clustering_distance_rows``.
# -clustering_method_columns Method to perform hierarchical clustering, pass to `stats::hclust`.
# -column_dend_side Should the column dendrogram be put on the top or bottom of the heatmap?
# -column_dend_height height of the column cluster, should be a `grid::unit` object.
# -show_column_dend Whether show column dendrogram?
# -column_dend_gp Graphic parameters for dendrogram segments. Same settings as ``row_dend_gp``.
# -column_dend_reorder Apply reordering on column dendrograms. Same settings as ``row_dend_reorder``.
# -row_order Order of rows. Manually setting row order turns off clustering.
# -column_order Order of column.
# -row_labels Optional row labels which are put as row names in the heatmap.
# -row_names_side Should the row names be put on the left or right of the heatmap?
# -show_row_names Whether show row names.
# -row_names_max_width Maximum width of row names viewport.
# -row_names_gp Graphic parameters for row names.
# -row_names_rot Rotation of row names.
# -row_names_centered Should row names put centered?
# -column_labels Optional column labels which are put as column names in the heatmap.
# -column_names_side Should the column names be put on the top or bottom of the heatmap?
# -column_names_max_height Maximum height of column names viewport.
# -show_column_names Whether show column names.
# -column_names_gp Graphic parameters for drawing text.
# -column_names_rot Rotation of column names.
# -column_names_centered Should column names put centered?
# -top_annotation A `HeatmapAnnotation` object.
# -bottom_annotation A `HeatmapAnnotation` object.
# -left_annotation It should be specified by `rowAnnotation`.
# -right_annotation it should be specified by `rowAnnotation`.
# -km Apply k-means clustering on rows. If the value is larger than 1, the heatmap will be split by rows according to the k-means clustering.
#     For each row slice, hierarchical clustering is still applied with parameters above.
# -split A vector or a data frame by which the rows are split. But if ``cluster_rows`` is a clustering object, ``split`` can be a single number
#        indicating to split the dendrogram by `stats::cutree`.
# -row_km Same as ``km``.
# -row_km_repeats Number of k-means runs to get a consensus k-means clustering. Note if ``row_km_repeats`` is set to more than one, the final number
#                of groups might be smaller than ``row_km``, but this might means the original ``row_km`` is not a good choice.
# -row_split Same as ``split``.
# -column_km K-means clustering on columns.
# -column_km_repeats Number of k-means runs to get a consensus k-means clustering. Similar as ``row_km_repeats``.
# -column_split Split on columns. For heatmap splitting, please refer to https://jokergoo.github.io/ComplexHeatmap-reference/book/a-single-heatmap.html#heatmap-split .
# -gap Gap between row slices if the heatmap is split by rows. The value should be a `grid::unit` object.
# -row_gap Same as ``gap``.
# -column_gap Gap between column slices.
# -show_parent_dend_line When heatmap is split, whether to add a dashed line to mark parent dendrogram and children dendrograms?
# -width Width of the heatmap body.
# -height Height of the heatmap body.
# -heatmap_width Width of the whole heatmap (including heatmap components)
# -heatmap_height Height of the whole heatmap (including heatmap components). Check https://jokergoo.github.io/ComplexHeatmap-reference/book/a-single-heatmap.html#size-of-the-heatmap .
# -show_heatmap_legend Whether show heatmap legend?
# -heatmap_legend_param A list contains parameters for the heatmap legends. See `color_mapping_legend,ColorMapping-method` for all available parameters.
# -use_raster Whether render the heatmap body as a raster image. It helps to reduce file size when the matrix is huge. Note if ``cell_fun``
#       is set, ``use_raster`` is enforced to be ``FALSE``.
# -raster_device Graphic device which is used to generate the raster image.
# -raster_quality A value set to larger than 1 will improve the quality of the raster image.
# -raster_device_param A list of further parameters for the selected graphic device. For raster image support, please check https://jokergoo.github.io/ComplexHeatmap-reference/book/a-single-heatmap.html#heatmap-as-raster-image .
# -raster_resize Whether resize the matrix to let the dimension of the matrix the same as the dimension of the raster image?
# -post_fun A function which will be executed after the heatmap list is drawn.
#
# == details
# The initialization function only applies parameter checking and fill values to the slots with some validation.
# 
# Following methods can be applied to the `Heatmap-class` object:
#
# - `show,Heatmap-method`: draw a single heatmap with default parameters
# - `draw,Heatmap-method`: draw a single heatmap.
# - ``+`` or `\%v\%` append heatmaps and annotations to a list of heatmaps.
#
# The constructor function pretends to be a high-level graphic function because the ``show`` method
# of the `Heatmap-class` object actually plots the graphics.
#
# == seealso
# https://jokergoo.github.io/ComplexHeatmap-reference/book/a-single-heatmap.html
#
# == value
# A `Heatmap-class` object.
#
# == author
# Zuguang Gu <z.gu@dkfz.de>
#
Heatmap = function(matrix, col, name, 
    na_col = "grey", 
    color_space = "LAB",
    rect_gp = gpar(col = NA), 
    border = NA,
    cell_fun = NULL,
    layer_fun = NULL,
    jitter = FALSE,

    row_title = character(0), 
    row_title_side = c("left", "right"), 
    row_title_gp = gpar(fontsize = 14), 
    row_title_rot = switch(row_title_side[1], "left" = 90, "right" = 270),
    column_title = character(0), 
    column_title_side = c("top", "bottom"), 
    column_title_gp = gpar(fontsize = 14), 
    column_title_rot = 0,

    cluster_rows = TRUE, 
    cluster_row_slices = TRUE,
    clustering_distance_rows = "euclidean",
    clustering_method_rows = "complete", 
    row_dend_side = c("left", "right"),
    row_dend_width = unit(10, "mm"), 
    show_row_dend = TRUE, 
    row_dend_reorder = is.logical(cluster_rows) || is.function(cluster_rows),
    row_dend_gp = gpar(), 
    cluster_columns = TRUE, 
    cluster_column_slices = TRUE,
    clustering_distance_columns = "euclidean", 
    clustering_method_columns = "complete",
    column_dend_side = c("top", "bottom"), 
    column_dend_height = unit(10, "mm"), 
    show_column_dend = TRUE, 
    column_dend_gp = gpar(), 
    column_dend_reorder = is.logical(cluster_columns) || is.function(cluster_columns),

    row_order = NULL, 
    column_order = NULL,

    row_labels = rownames(matrix),
    row_names_side = c("right", "left"), 
    show_row_names = TRUE, 
    row_names_max_width = unit(6, "cm"), 
    row_names_gp = gpar(fontsize = 12), 
    row_names_rot = 0,
    row_names_centered = FALSE,
    column_labels = colnames(matrix),
    column_names_side = c("bottom", "top"), 
    show_column_names = TRUE, 
    column_names_max_height = unit(6, "cm"), 
    column_names_gp = gpar(fontsize = 12),
    column_names_rot = 90,
    column_names_centered = FALSE,

    top_annotation = NULL,
    bottom_annotation = NULL,
    left_annotation = NULL,
    right_annotation = NULL,

    km = 1, 
    split = NULL, 
    row_km = km,
    row_km_repeats = 1,
    row_split = split,
    column_km = 1,
    column_km_repeats = 1,
    column_split = NULL,
    gap = unit(1, "mm"),
    row_gap = unit(1, "mm"),
    column_gap = unit(1, "mm"),
    show_parent_dend_line = ht_opt$show_parent_dend_line,

    heatmap_width = unit(1, "npc"),
    width = NULL,
    heatmap_height = unit(1, "npc"), 
    height = NULL,

    show_heatmap_legend = TRUE,
    heatmap_legend_param = list(title = name),

    use_raster = (nrow(matrix) > 2000 && ncol(matrix) > 1) || (ncol(matrix) > 2000 && nrow(matrix) > 1), 
    raster_device = c("png", "jpeg", "tiff", "CairoPNG", "CairoJPEG", "CairoTIFF"),
    raster_quality = 2,
    raster_device_param = list(),
    raster_resize = FALSE,

    post_fun = NULL) {

    dev.null()
    on.exit(dev.off2())

    verbose = ht_opt("verbose")

    .Object = new("Heatmap")
    if(missing(name)) {
        name = paste0("matrix_", get_heatmap_index() + 1)
        increase_heatmap_index()
    }
    if(name == "") {
        stop_wrap("Heatmap name cannot be empty string.")
    }
    .Object@name = name

    # re-define some of the argument values according to global settings
    called_args = names(as.list(match.call())[-1])
    for(opt_name in c("row_names_gp", "column_names_gp", "row_title_gp", "column_title_gp")) {
        opt_name2 = paste0("heatmap_", opt_name)
        if(! opt_name %in% called_args) { # if this argument is not called
            if(!is.null(ht_opt(opt_name2))) {
                if(verbose) qqcat("re-assign @{opt_name} with `ht_opt('@{opt_name2}'')`\n")
                assign(opt_name, ht_opt(opt_name2))
            }
        }
    }

    if("top_annotation_height" %in% called_args) {
        stop_wrap("`top_annotation_height` is removed. Set the height directly in `HeatmapAnnotation()`.")
    }
    if("bottom_annotation_height" %in% called_args) {
        stop_wrap("`bottom_annotation_height` is removed. Set the height directly in `HeatmapAnnotation()`.")
    }
    if("combined_name_fun" %in% called_args) {
        stop_wrap("`combined_name_fun` is removed. Please directly set `row_names_title`. See https://jokergoo.github.io/ComplexHeatmap-reference/book/a-single-heatmap.html#titles-for-splitting")
    }

    if("heatmap_legend_param" %in% called_args) {
        for(opt_name in setdiff(c("title_gp", "title_position", "labels_gp", "grid_width", "grid_height", "border"), names(heatmap_legend_param))) {
            opt_name2 = paste0("legend_", opt_name)
            if(!is.null(ht_opt(opt_name2)))
                if(verbose) qqcat("re-assign heatmap_legend_param$@{opt_name} with `ht_opt('@{opt_name2}'')`\n")
                heatmap_legend_param[[opt_name]] = ht_opt(opt_name2)
        }
    } else {
        for(opt_name in c("title_gp", "title_position", "labels_gp", "grid_width", "grid_height", "border")) {
            opt_name2 = paste0("legend_", opt_name)
            if(!is.null(ht_opt(opt_name2)))
                if(verbose) qqcat("re-assign heatmap_legend_param$@{opt_name} with `ht_opt('@{opt_name2}'')`\n")
                heatmap_legend_param[[opt_name]] = ht_opt(opt_name2)
        }
    }

    if(is.data.frame(matrix)) {
        if(verbose) qqcat("convert data frame to matrix\n")
        warning_wrap("The input is a data frame, convert it to the matrix.")
        matrix = as.matrix(matrix)
    }
    fa_level = NULL
    if(!is.matrix(matrix)) {
        if(is.atomic(matrix)) {
            if(is.factor(matrix)) {
                fa_level = levels(matrix)
            }
            rn = names(matrix)
            matrix = matrix(matrix, ncol = 1)
            if(!is.null(rn)) rownames(matrix) = rn
            if(!missing(name)) colnames(matrix) = name
            if(verbose) qqcat("convert simple vector to one-column matrix\n")
        } else {
            stop_wrap("If input is not a matrix, it should be a simple vector.")
        }
    }

    # if(ncol(matrix) == 0 || nrow(matrix) == 0) {
    #     show_heatmap_legend = FALSE
    #     .Object@heatmap_param$show_heatmap_legend = FALSE
    # }
    
    # if(ncol(matrix) == 0 && (!is.null(left_annotation) || !is.null(right_annotation))) {
    #     message_wrap("If you have row annotations for a zeor-column matrix, please directly use in form of `rowAnnotation(...) + NULL`")
    #     return(invisible(NULL))
    # }
    # if(nrow(matrix) == 0 && (!is.null(top_annotation) || !is.null(bottom_annotation))) {
    #     message_wrap("If you have column annotations for a zero-row matrix, please directly use in form of `HeatmapAnnotation(...) %v% NULL`")
    #     return(invisible(NULL))
    # }

    ### normalize km/split and row_km/row_split
    if(missing(row_km)) row_km = km
    if(is.null(row_km)) row_km = 1
    if(missing(row_split)) row_split = split
    if(missing(row_gap)) row_gap = gap
    if(is.null(column_km)) column_km = 1

    ####### zero and one column matrix ########
    if(ncol(matrix) == 0 || nrow(matrix) == 0) {
        if(!inherits(cluster_columns, c("dendrogram", "hclust"))) {
            cluster_columns = FALSE
            show_column_dend = FALSE
        }
        if(!inherits(cluster_rows, c("dendrogram", "hclust"))) {
            cluster_rows = FALSE
            show_row_dend = FALSE
        }
        row_km = 1
        column_km = 1
        if(verbose) qqcat("zero row/column matrix, set cluster_columns/rows to FALSE\n")
    }
    if(ncol(matrix) == 1) {
        if(!inherits(cluster_columns, c("dendrogram", "hclust"))) {
            cluster_columns = FALSE
            show_column_dend = FALSE
        }
        column_km = 1
        if(verbose) qqcat("one-column matrix, set cluster_columns to FALSE\n")
    }
    if(nrow(matrix) == 1) {
        if(!inherits(cluster_rows, c("dendrogram", "hclust"))) {
            cluster_rows = FALSE
            show_row_dend = FALSE
        }
        row_km = 1
        if(verbose) qqcat("one-row matrix, set cluster_rows to FALSE\n")
    }

    if(is.character(matrix)) {
        called_args = names(match.call()[-1])
        if("clustering_distance_rows" %in% called_args) {
        } else if(inherits(cluster_rows, c("dendrogram", "hclust"))) {
        } else {
            cluster_rows = FALSE
            show_row_dend = FALSE
        }
        row_dend_reorder = FALSE
        cluster_row_slices = FALSE

        if("clustering_distance_columns" %in% called_args) {
        } else if(inherits(cluster_columns, c("dendrogram", "hclust"))) {
        } else {
            cluster_columns = FALSE
            show_column_dend = FALSE
        }
        column_dend_reorder = FALSE
        cluster_column_slices = FALSE
        row_km = 1
        column_km = 1
        if(verbose) qqcat("matrix is character. Do not cluster unless distance method is provided.\n")
    }
    .Object@matrix = matrix

    .Object@matrix_param$row_km = row_km
    .Object@matrix_param$row_km_repeats = row_km_repeats
    .Object@matrix_param$row_gap = row_gap
    .Object@matrix_param$column_km = column_km
    .Object@matrix_param$column_km_repeats = column_km_repeats
    .Object@matrix_param$column_gap = column_gap
    .Object@matrix_param$jitter = jitter

    ### check row_split and column_split ###
    if(!is.null(row_split)) {
        if(inherits(cluster_rows, c("dendrogram", "hclust"))) {
            if(is.numeric(row_split) && length(row_split) == 1) {
                .Object@matrix_param$row_split = row_split
            } else {
                stop_wrap("When `cluster_rows` is a dendrogram, `row_split` can only be a single number.")
            }
        } else {
            if(identical(cluster_rows, TRUE) && is.numeric(row_split) && length(row_split) == 1) {

            } else {
                if(!is.data.frame(row_split)) row_split = data.frame(row_split)
                if(nrow(row_split) != nrow(matrix)) {
                    stop_wrap("Length or nrow of `row_split` should be same as nrow of `matrix`.")
                }
            }
        }
    }
    .Object@matrix_param$row_split = row_split

    if(!is.null(column_split)) {
        if(inherits(cluster_columns, c("dendrogram", "hclust"))) {
            if(is.numeric(column_split) && length(column_split) == 1) {
                .Object@matrix_param$column_split = column_split
            } else {
               stop_wrap("When `cluster_columns` is a dendrogram, `column_split` can only be a single number.")
            }
        } else {
            if(identical(cluster_columns, TRUE) && is.numeric(column_split) && length(column_split) == 1) {

            } else {
                if(!is.data.frame(column_split)) column_split = data.frame(column_split)
                if(nrow(column_split) != ncol(matrix)) {
                    stop_wrap("Length or ncol of `column_split` should be same as ncol of `matrix`.")
                }
            }
        }
    }
    .Object@matrix_param$column_split = column_split


    ### parameters for heatmap body ###
    .Object@matrix_param$gp = check_gp(rect_gp)
    if(missing(border)) {
        if(!is.null(ht_opt$heatmap_border)) border = ht_opt$heatmap_border
    }
    if(identical(border, TRUE)) border = "black"
    .Object@matrix_param$border = border
    .Object@matrix_param$cell_fun = cell_fun
    .Object@matrix_param$layer_fun = layer_fun
    
    ### color for main matrix #########
    if(ncol(matrix) > 0 && nrow(matrix) > 0) {
        if(missing(col)) {
            col = default_col(matrix, main_matrix = TRUE)
            if(!is.null(fa_level)) {
                col = col[fa_level]
            }
            if(verbose) qqcat("color is not specified, use randomly generated colors\n")
        }
        if(is.function(col)) {
            .Object@matrix_color_mapping = ColorMapping(col_fun = col, name = name, na_col = na_col)
            if(verbose) qqcat("input color is a color mapping function\n")
        } else {
            if(is.null(names(col))) {
                if(length(col) == length(unique(as.vector(matrix)))) {
                    if(is.null(fa_level)) {
                        names(col) = sort(unique(as.vector(matrix)))
                    } else {
                        names(col) = fa_level
                    }
                    .Object@matrix_color_mapping = ColorMapping(colors = col, name = name, na_col = na_col)
                    if(verbose) qqcat("input color is a vector with no names, treat it as discrete color mapping\n")
                } else if(is.numeric(matrix)) {
                    col = colorRamp2(seq(min(matrix, na.rm = TRUE), max(matrix, na.rm = TRUE), length = length(col)),
                                     col, space = color_space)
                    .Object@matrix_color_mapping = ColorMapping(col_fun = col, name = name, na_col = na_col)
                    if(verbose) qqcat("input color is a vector with no names, treat it as continuous color mapping\n")
                } else {
                    stop_wrap("`col` should have names to map to values in `mat`.")
                }
            } else {
                if(is.null(fa_level)) {
                    col = col[intersect(c(names(col), "_NA_"), as.character(matrix))]
                } else {
                    col = col[intersect(c(fa_level, "_NA_"), names(col))]
                }
                .Object@matrix_color_mapping = ColorMapping(colors = col, name = name, na_col = na_col)
                if(verbose) qqcat("input color is a named vector\n")
            }
        }
        .Object@matrix_legend_param = heatmap_legend_param
    }
    
    ##### titles, should also consider titles after row splitting #####
    if(identical(row_title, NA) || identical(row_title, "")) {
        row_title = character(0)
    }
    .Object@row_title = row_title
    .Object@row_title_param$rot = row_title_rot %% 360
    .Object@row_title_param$side = match.arg(row_title_side)[1]
    .Object@row_title_param$gp = check_gp(row_title_gp)  # if the number of settings is same as number of row-splits, gp will be adjusted by `make_row_dend`
    .Object@row_title_param$just = get_text_just(rot = row_title_rot, side = .Object@row_title_param$side)

    if(identical(column_title, NA) || identical(column_title, "")) {
        column_title = character(0)
    }
    .Object@column_title = column_title
    .Object@column_title_param$rot = column_title_rot %% 360
    .Object@column_title_param$side = match.arg(column_title_side)[1]
    .Object@column_title_param$gp = check_gp(column_title_gp)
    .Object@column_title_param$just = get_text_just(rot = column_title_rot, side = .Object@column_title_param$side)

    ### row labels/column labels ###
    if(is.null(rownames(matrix))) {
        show_row_names = FALSE
    }
    .Object@row_names_param$labels = row_labels
    .Object@row_names_param$side = match.arg(row_names_side)[1]
    .Object@row_names_param$show = show_row_names
    .Object@row_names_param$gp = check_gp(row_names_gp)
    .Object@row_names_param$rot = row_names_rot
    .Object@row_names_param$centered = row_names_centered
    .Object@row_names_param$max_width = row_names_max_width + unit(2, "mm")
    # we use anno_text to draw row/column names because it already takes care of text rotation
    if(show_row_names) {
        if(length(row_labels) != nrow(matrix)) {
            stop_wrap("Length of `row_labels` should be the same as the nrow of matrix.")
        }
        if(row_names_centered) {
            row_names_anno = anno_text(row_labels, which = "row", gp = row_names_gp, rot = row_names_rot,
                location = 0.5, 
                just = "center")
        } else {
            row_names_anno = anno_text(row_labels, which = "row", gp = row_names_gp, rot = row_names_rot,
                location = ifelse(.Object@row_names_param$side == "left", 1, 0), 
                just = ifelse(.Object@row_names_param$side == "left", "right", "left"))
        }
        .Object@row_names_param$anno = row_names_anno
    }

    if(is.null(colnames(matrix))) {
        show_column_names = FALSE
    }
    .Object@column_names_param$labels = column_labels
    .Object@column_names_param$side = match.arg(column_names_side)[1]
    .Object@column_names_param$show = show_column_names
    .Object@column_names_param$gp = check_gp(column_names_gp)
    .Object@column_names_param$rot = column_names_rot
    .Object@column_names_param$centered = column_names_centered
    .Object@column_names_param$max_height = column_names_max_height + unit(2, "mm")
    if(show_column_names) {
        if(length(column_labels) != ncol(matrix)) {
            stop_wrap("Length of `column_labels` should be the same as the ncol of matrix.")
        }
        if(column_names_centered) {
            column_names_anno = anno_text(column_labels, which = "column", gp = column_names_gp, rot = column_names_rot,
            location = 0.5, 
            just = "center")
        } else {
            column_names_anno = anno_text(column_labels, which = "column", gp = column_names_gp, rot = column_names_rot,
                location = ifelse(.Object@column_names_param$side == "top", 0, 1), 
                just = ifelse(.Object@column_names_param$side == "top", 
                         ifelse(.Object@column_names_param$rot >= 0, "left", "right"),
                         ifelse(.Object@column_names_param$rot >= 0, "right", "left")
                        ))
        }
        .Object@column_names_param$anno = column_names_anno
    }

    #### dendrograms ########
    if(missing(cluster_rows) && !missing(row_order)) {
        cluster_rows = FALSE
    }
    if(is.logical(cluster_rows)) {
        if(!cluster_rows) {
            row_dend_width = unit(0, "mm")
            show_row_dend = FALSE
        }
        .Object@row_dend_param$cluster = cluster_rows
    } else if(inherits(cluster_rows, "dendrogram") || inherits(cluster_rows, "hclust")) {
        .Object@row_dend_param$obj = cluster_rows
        .Object@row_dend_param$cluster = TRUE
    } else if(inherits(cluster_rows, "function")) {
        .Object@row_dend_param$fun = cluster_rows
        .Object@row_dend_param$cluster = TRUE
    } else {
        oe = try(cluster_rows <- as.dendrogram(cluster_rows), silent = TRUE)
        if(!inherits(oe, "try-error")) {
            .Object@row_dend_param$obj = cluster_rows
            .Object@row_dend_param$cluster = TRUE
        } else {
            stop_wrap("`cluster_rows` should be a logical value, a clustering function or a clustering object.")
        }
    }
    if(!show_row_dend) {
        row_dend_width = unit(0, "mm")
    }
    .Object@row_dend_list = list()
    .Object@row_dend_param$distance = clustering_distance_rows
    .Object@row_dend_param$method = clustering_method_rows
    .Object@row_dend_param$side = match.arg(row_dend_side)[1]
    .Object@row_dend_param$width = row_dend_width + ht_opt$DENDROGRAM_PADDING  # append the gap
    .Object@row_dend_param$show = show_row_dend
    .Object@row_dend_param$gp = check_gp(row_dend_gp)
    .Object@row_dend_param$reorder = row_dend_reorder
    .Object@row_order_list = list() # default order
    if(is.null(row_order)) {
        .Object@row_order = seq_len(nrow(matrix))
    }  else {
        if(is.character(row_order)) {
            row_order = structure(seq_len(nrow(matrix)), names = rownames(matrix))[row_order]
        }
        if(any(is.na(row_order))) {
            stop_wrap("`row_order` should not contain NA values.")
        }
        if(length(row_order) != nrow(matrix)) {
            stop_wrap("length of `row_order` should be same as the number of marix rows.")
        }
        .Object@row_order = row_order
    }
    .Object@row_dend_param$cluster_slices = cluster_row_slices

    if(missing(cluster_columns) && !missing(column_order)) {
        cluster_columns = FALSE
    }
    if(is.logical(cluster_columns)) {
        if(!cluster_columns) {
            column_dend_height = unit(0, "mm")
            show_column_dend = FALSE
        }
        .Object@column_dend_param$cluster = cluster_columns
    } else if(inherits(cluster_columns, "dendrogram") || inherits(cluster_columns, "hclust")) {
        .Object@column_dend_param$obj = cluster_columns
        .Object@column_dend_param$cluster = TRUE
    } else if(inherits(cluster_columns, "function")) {
        .Object@column_dend_param$fun = cluster_columns
        .Object@column_dend_param$cluster = TRUE
    } else {
        oe = try(cluster_columns <- as.dendrogram(cluster_columns), silent = TRUE)
        if(!inherits(oe, "try-error")) {
            .Object@column_dend_param$obj = cluster_columns
            .Object@column_dend_param$cluster = TRUE
        } else {
            stop_wrap("`cluster_columns` should be a logical value, a clustering function or a clustering object.")
        }
    }
    if(!show_column_dend) {
        column_dend_height = unit(0, "mm")
    }
    .Object@column_dend_list = list()
    .Object@column_dend_param$distance = clustering_distance_columns
    .Object@column_dend_param$method = clustering_method_columns
    .Object@column_dend_param$side = match.arg(column_dend_side)[1]
    .Object@column_dend_param$height = column_dend_height + ht_opt$DENDROGRAM_PADDING  # append the gap
    .Object@column_dend_param$show = show_column_dend
    .Object@column_dend_param$gp = check_gp(column_dend_gp)
    .Object@column_dend_param$reorder = column_dend_reorder
    if(is.null(column_order)) {
        .Object@column_order = seq_len(ncol(matrix))
    } else {
        if(is.character(column_order)) {
            column_order = structure(seq_len(ncol(matrix)), names = colnames(matrix))[column_order]
        }
        if(any(is.na(column_order))) {
            stop_wrap("`column_order` should not contain NA values.")
        }
        if(length(column_order) != ncol(matrix)) {
            stop_wrap("length of `column_order` should be same as the number of marix columns")
        }
        .Object@column_order = column_order
    }
    .Object@column_dend_param$cluster_slices = cluster_column_slices

    ######### annotations #############
    .Object@top_annotation = top_annotation # a `HeatmapAnnotation` object
    if(is.null(top_annotation)) {
        .Object@top_annotation_param$height = unit(0, "mm")    
    } else {
        .Object@top_annotation_param$height = height(top_annotation) + ht_opt$COLUMN_ANNO_PADDING  # append the gap
    }
    if(!is.null(top_annotation)) {
        if(length(top_annotation) > 0) {
            if(!.Object@top_annotation@which == "column") {
                stop_wrap("`which` in `top_annotation` should only be `column`.")
            }
        }
        nb = nobs(top_annotation)
        if(!is.na(nb)) {
            if(nb != ncol(.Object@matrix)) {
                stop_wrap("number of observations in top annotation should be as same as ncol of the matrix.")
            }
        }
    }
    
    .Object@bottom_annotation = bottom_annotation # a `HeatmapAnnotation` object
    if(is.null(bottom_annotation)) {
        .Object@bottom_annotation_param$height = unit(0, "mm")
    } else {
        .Object@bottom_annotation_param$height = height(bottom_annotation) + ht_opt$COLUMN_ANNO_PADDING  # append the gap
    }
    if(!is.null(bottom_annotation)) {
        if(length(bottom_annotation) > 0) {
            if(!.Object@bottom_annotation@which == "column") {
                stop_wrap("`which` in `bottom_annotation` should only be `column`.")
            }
        }
        nb = nobs(bottom_annotation)
        if(!is.na(nb)) {
            if(nb != ncol(.Object@matrix)) {
                stop_wrap("number of observations in bottom anntotion should be as same as ncol of the matrix.")
            }
        }
    }

    .Object@left_annotation = left_annotation # a `rowAnnotation` object
    if(is.null(left_annotation)) {
        .Object@left_annotation_param$width = unit(0, "mm")
    } else {
        .Object@left_annotation_param$width = width(left_annotation) + ht_opt$ROW_ANNO_PADDING  # append the gap
    }
    if(!is.null(left_annotation)) {
        if(length(left_annotation) > 0) {
            if(!.Object@left_annotation@which == "row") {
                stop_wrap("`which` in `left_annotation` should only be `row`, or consider using `rowAnnotation()`.")
            }
        }
        nb = nobs(left_annotation)
        if(!is.na(nb)) {
            if(nb != nrow(.Object@matrix)) {
                stop_wrap("number of observations in left anntotion should be same as nrow of the matrix.")
            }
        }
    }

    .Object@right_annotation = right_annotation # a `rowAnnotation` object
    if(is.null(right_annotation)) {
        .Object@right_annotation_param$width = unit(0, "mm")
    } else {
        .Object@right_annotation_param$width = width(right_annotation) + ht_opt$ROW_ANNO_PADDING  # append the gap
    }
    if(!is.null(right_annotation)) {
        if(length(right_annotation) > 0) {
            if(!.Object@right_annotation@which == "row") {
                stop_wrap("`which` in `right_annotation` should only be `row`, or consider using `rowAnnotation()`.")
            }
        }
        nb = nobs(right_annotation)
        if(!is.na(nb)) {
            if(nb != nrow(.Object@matrix)) {
                stop_wrap("number of observations in right anntotion should be same as nrow of the matrix.")
            }
        }
    }

    .Object@layout = list(
        layout_size = list(
            column_title_top_height = unit(0, "mm"),
            column_dend_top_height = unit(0, "mm"),
            column_anno_top_height = unit(0, "mm"),
            column_names_top_height = unit(0, "mm"),
            column_title_bottom_height = unit(0, "mm"),
            column_dend_bottom_height = unit(0, "mm"),
            column_anno_bottom_height = unit(0, "mm"),
            column_names_bottom_height = unit(0, "mm"),

            row_title_left_width = unit(0, "mm"),
            row_dend_left_width = unit(0, "mm"),
            row_names_left_width = unit(0, "mm"),
            row_dend_right_width = unit(0, "mm"),
            row_names_right_width = unit(0, "mm"),
            row_title_right_width = unit(0, "mm"),
            row_anno_left_width = unit(0, "mm"),
            row_anno_right_width = unit(0, "mm")
        ),

        layout_index = matrix(nrow = 0, ncol = 2),
        graphic_fun_list = list(),
        initialized = FALSE
    )

    if(is.null(width)) {
        width = unit(ncol(matrix), "null")
    } else if(is.numeric(width) && !inherits(width, "unit")) {
        width = unit(width, "null")
    } else if(!inherits(width, "unit")) {
        stop_wrap("`width` should be a `unit` object or a single number.")
    }

    if(is.null(height)) {
        height = unit(nrow(matrix), "null")
    } else if(is.numeric(height) && !inherits(height, "unit")) {
        height = unit(height, "null")
    } else if(!inherits(height, "unit")) {
        stop_wrap("`height` should be a `unit` object or a single number.")
    }

    if(!is.null(width) && !is.null(heatmap_width)) {
        if(is_abs_unit(width) && is_abs_unit(heatmap_width)) {
            stop_wrap("`heatmap_width` and `width` should not all be the absolute units.")
        }
    }
    if(!is.null(height) && !is.null(heatmap_height)) {
        if(is_abs_unit(height) && is_abs_unit(heatmap_height)) {
            stop_wrap("`heatmap_height` and `height` should not all be the absolute units.")
        }
    }
    
    .Object@matrix_param$width = width
    .Object@matrix_param$height = height

    .Object@heatmap_param$width = heatmap_width
    .Object@heatmap_param$height = heatmap_height
    .Object@heatmap_param$show_heatmap_legend = show_heatmap_legend
    .Object@heatmap_param$use_raster = use_raster
    .Object@heatmap_param$raster_device = match.arg(raster_device)[1]
    .Object@heatmap_param$raster_quality = raster_quality
    .Object@heatmap_param$raster_device_param = raster_device_param
    .Object@heatmap_param$raster_resize = raster_resize
    .Object@heatmap_param$verbose = verbose
    .Object@heatmap_param$post_fun = post_fun
    .Object@heatmap_param$calling_env = parent.frame()
    .Object@heatmap_param$show_parent_dend_line = show_parent_dend_line

    if(nrow(matrix) == 0) {
        .Object@matrix_param$height = unit(0, "mm")
    }
    if(ncol(matrix) == 0) {
        .Object@matrix_param$width = unit(0, "mm")
    }

    return(.Object)

}


# == title
# Make Cluster on Rows
#
# == param
# -object A `Heatmap-class` object.
#
# == details
# The function will fill or adjust ``row_dend_list``, ``row_order_list``, ``row_title`` and ``matrix_param`` slots.
#
# If ``order`` is defined, no clustering will be applied.
#
# This function is only for internal use.
#
# == value
# A `Heatmap-class` object.
#
# == author
# Zuguang Gu <z.gu@dkfz.de>
#
setMethod(f = "make_row_cluster",
    signature = "Heatmap",
    definition = function(object) {

    object = make_cluster(object, "row")
    if(length(object@row_title) > 1) {
        if(length(object@row_title) != length(object@row_order_list)) {
            stop_wrap("If `row_title` is set with length > 1, the length should be as same as the number of row slices.")
        }
    }
    return(object)  
})

# == title
# Make Cluster on Columns
#
# == param
# -object A `Heatmap-class` object.
#
# == details
# The function will fill or adjust ``column_dend_list``,
# ``column_order_list``, ``column_title`` and ``matrix_param`` slots.
#
# If ``order`` is defined, no clustering will be applied.
#
# This function is only for internal use.
#
# == value
# A `Heatmap-class` object.
#
# == author
# Zuguang Gu <z.gu@dkfz.de>
#
setMethod(f = "make_column_cluster",
    signature = "Heatmap",
    definition = function(object) {

    object = make_cluster(object, "column")
    if(length(object@column_title) > 1) {
        if(length(object@column_title) != length(object@column_order_list)) {
            stop_wrap("If `column_title` is set with length > 1, the length should be as same as the number of column slices.")
        }
    }
    return(object)
})

make_cluster = function(object, which = c("row", "column")) {

    which = match.arg(which)[1]

    verbose = object@heatmap_param$verbose

    if(ht_opt("fast_hclust")) {
        hclust = fastcluster::hclust
        if(verbose) qqcat("apply hclust by fastcluster::hclust\n")
    } else {
        hclust = stats::hclust
    }

    mat = object@matrix
    jitter = object@matrix_param$jitter
    if(is.numeric(mat)) {
        if(is.logical(jitter)) {
            if(jitter) {
                mat = mat + runif(length(mat), min = 0, max = 1e-10)
            }
        } else {
            mat = mat + runif(length(mat), min = 0, max = jitter + 0)
        }
    }

    distance = slot(object, paste0(which, "_dend_param"))$distance
    method = slot(object, paste0(which, "_dend_param"))$method
    order = slot(object, paste0(which, "_order"))  # pre-defined row order
    km = getElement(object@matrix_param, paste0(which, "_km"))
    km_repeats = getElement(object@matrix_param, paste0(which, "_km_repeats"))
    split = getElement(object@matrix_param, paste0(which, "_split"))
    reorder = slot(object, paste0(which, "_dend_param"))$reorder
    cluster = slot(object, paste0(which, "_dend_param"))$cluster
    cluster_slices = slot(object, paste0(which, "_dend_param"))$cluster_slices
    gap = getElement(object@matrix_param, paste0(which, "_gap"))

    dend_param = slot(object, paste0(which, "_dend_param"))
    dend_list = slot(object, paste0(which, "_dend_list"))
    dend_slice = slot(object, paste0(which, "_dend_slice"))
    order_list = slot(object, paste0(which, "_order_list"))
    order = slot(object, paste0(which, "_order"))

    names_param = slot(object, paste0(which, "_names_param"))

    dend_param$split_by_cutree = FALSE

    if(!is.null(dend_param$obj)) {
        if(inherits(dend_param$obj, "hclust")) {
            ncl = length(dend_param$obj$order)
        } else {
            ncl = nobs(dend_param$obj)
        }

        if(which == "row") {
            if(ncl != nrow(mat)) {
                stop_wrap("The length of the row clustering object is not the same as the number of matrix rows.")
            }
        } else {
            if(ncl != ncol(mat)) {
                stop_wrap("The length of the column clustering object is not the same as the number of matrix columns")
            }
        }
    }

    if(cluster) {

        if(is.numeric(split) && length(split) == 1) {
            if(is.null(dend_param$obj)) {
                if(verbose) qqcat("split @{which}s by cutree, apply hclust on the entire @{which}s\n")
                if(which == "row") {
                    dend_param$obj = hclust(get_dist(mat, distance), method = method)
                } else {
                    dend_param$obj = hclust(get_dist(t(mat), distance), method = method)
                }
            }
        }

        if(!is.null(dend_param$obj)) {
            if(km > 1) {
                stop_wrap("You can not perform k-means clustering since you have already specified a clustering object.")
            }

            if(inherits(dend_param$obj, "hclust")) {
                dend_param$obj = as.dendrogram(dend_param$obj)
                if(verbose) qqcat("convert hclust object to dendrogram object\n")
            }

            if(is.null(split)) {
                dend_list = list(dend_param$obj)
                order_list = list(get_dend_order(dend_param$obj))
                if(verbose) qqcat("since you provided a clustering object and @{which}_split is null, the entrie clustering object is taken as an one-element list.\n")
            } else {
                if(length(split) > 1 || !is.numeric(split)) {
                    stop_wrap(qq("Since you specified a clustering object, you can only split @{which}s by providing a number (number of @{which} slices)."))
                }
                if(split < 2) {
                    stop_wrap(qq("`@{which}_split` should be >= 2."))
                }
                dend_param$split_by_cutree = TRUE
                
                ct = cut_dendrogram(dend_param$obj, split)
                dend_list = ct$lower
                dend_slice = ct$upper
                sth = tapply(order.dendrogram(dend_param$obj), 
                    rep(seq_along(dend_list), times = sapply(dend_list, nobs)), 
                    function(x) x)
                attributes(sth) = NULL
                order_list = sth
                if(verbose) qqcat("cut @{which} dendrogram into @{split} slices.\n")
            }

            ### do reordering if specified
            if(identical(reorder, NULL)) {
                if(is.numeric(mat)) {
                    reorder = TRUE
                } else {
                    reorder = FALSE
                }
            }

            do_reorder = TRUE
            if(identical(reorder, NA) || identical(reorder, FALSE)) {
                do_reorder = FALSE
            }
            if(identical(reorder, TRUE)) {
                do_reorder = TRUE
                if(which == "row") {
                    reorder = -rowMeans(mat, na.rm = TRUE)
                } else {
                    reorder = -colMeans(mat, na.rm = TRUE)
                }
            }

            if(do_reorder) {

                if(which == "row") {
                    if(length(reorder) != nrow(mat)) {
                        stop_wrap("weight of reordering should have same length as number of rows.\n")
                    }
                } else {
                    if(length(reorder) != ncol(mat)) {
                        stop_wrap("weight of reordering should have same length as number of columns\n")
                    }
                }
                
                for(i in seq_along(dend_list)) {
                    if(length(order_list[[i]]) > 1) {
                        sub_ind = sort(order_list[[i]])
                        dend_list[[i]] = reorder(dend_list[[i]], reorder[sub_ind], mean)
                        # the order of object@row_dend_list[[i]] is the order corresponding to the big dendrogram
                        order_list[[i]] = order.dendrogram(dend_list[[i]])
                    }
                }
            }

            dend_list = lapply(dend_list, adjust_dend_by_x)

            slot(object, paste0(which, "_order")) = unlist(order_list)
            slot(object, paste0(which, "_order_list")) = order_list
            slot(object, paste0(which, "_dend_list")) = dend_list
            slot(object, paste0(which, "_dend_param")) = dend_param
            slot(object, paste0(which, "_dend_slice")) = dend_slice

            if(!is.null(split)) {
                split = data.frame(rep(seq_along(order_list), times = sapply(order_list, length)))
                object@matrix_param[[ paste0(which, "_split") ]] = split

                # adjust row_names_param$gp if the length of some elements is the same as row slices
                for(i in seq_along(names_param$gp)) {
                    if(length(names_param$gp[[i]]) == length(order_list)) {
                        gp_temp = NULL
                        for(j in seq_along(order_list)) {
                            gp_temp[ order_list[[j]] ] = names_param$gp[[i]][j]
                        }
                        names_param$gp[[i]] = gp_temp
                    }
                }
                if(!is.null(names_param$anno)) {
                    names_param$anno@var_env$gp = names_param$gp
                }
                slot(object, paste0(which, "_names_param")) = names_param

                n_slice = length(order_list)
                if(length(gap) == 1) {
                    gap = rep(gap, n_slice)
                } else if(length(gap) == n_slice - 1) {
                    gap = unit.c(gap, unit(0, "mm"))
                } else if(length(gap) != n_slice) {
                    stop_wrap(qq("Length of `gap` should be 1 or number of @{which} slices."))
                }
                object@matrix_param[[ paste0(which, "_gap") ]] = gap # adjust title
                
                title = slot(object, paste0(which, "_title"))
                if(!is.null(split)) {
                    if(length(title) == 0 && !is.null(title)) { ## default title
                        title = apply(unique(split), 1, paste, collapse = ",")
                    } else if(length(title) == 1) {
                        if(grepl("%s", title)) {
                            title = apply(unique(split), 1, function(x) {
                                lt = lapply(x, function(x) x)
                                lt$fmt = title
                                do.call(sprintf, lt)
                            })
                        } else if(grepl("@\\{.+\\}", title)) {
                            title = apply(unique(split), 1, function(x) {
                                x = x
                                envir = environment()
                                title = get("title")
                                op = parent.env(envir)
                                calling_env = object@heatmap_param$calling_env
                                parent.env(envir) = calling_env
                                title = GetoptLong::qq(title, envir = envir)
                                parent.env(envir) = op
                                return(title)
                            })
                        } else if(grepl("\\{.+\\}", title)) {
                            if(!requireNamespace("glue")) {
                                stop_wrap("You need to install glue package.")
                            }
                            title = apply(unique(split), 1, function(x) {
                                x = x
                                envir = environment()
                                title = get("title")
                                op = parent.env(envir)
                                calling_env = object@heatmap_param$calling_env
                                parent.env(envir) = calling_env
                                title = glue::glue(title, envir = calling_env)
                                parent.env(envir) = op
                                return(title)
                            })
                        }
                    }
                }
                slot(object, paste0(which, "_title")) = title
            }
            return(object)
        }

    } else {
        if(verbose) qqcat("no clustering is applied/exists on @{which}s\n")
    }

    if(verbose) qq("clustering object is not pre-defined, clustering is applied to each @{which} slice\n")
    # make k-means clustering to add a split column
    consensus_kmeans = function(mat, centers, km_repeats) {
        partition_list = lapply(seq_len(km_repeats), function(i) {
            as.cl_hard_partition(kmeans(mat, centers))
        })
        partition_list = cl_ensemble(list = partition_list)
        partition_consensus = cl_consensus(partition_list)
        as.vector(cl_class_ids(partition_consensus)) 
    }
    if(km > 1 && is.numeric(mat)) {
        if(which == "row") {
            # km.fit = kmeans(mat, centers = km)
            # cl = km.fit$cluster
            cl = consensus_kmeans(mat, km, km_repeats)
            meanmat = lapply(sort(unique(cl)), function(i) {
                colMeans(mat[cl == i, , drop = FALSE])
            })
        } else {
            # km.fit = kmeans(t(mat), centers = km)
            # cl = km.fit$cluster
            cl = consensus_kmeans(t(mat), km, km_repeats)
            meanmat = lapply(sort(unique(cl)), function(i) {
                rowMeans(mat[, cl == i, drop = FALSE])
            })
        }

        meanmat = do.call("cbind", meanmat)
        # if `reorder` is a vector, the slice dendrogram is reordered by the mean of reorder in each slice
        # or else, weighted by the mean of `meanmat`.
        if(length(reorder) > 1) {
            weight = tapply(reorder, cl, mean)
        } else {
            weight = colMeans(meanmat)
        }
        if(cluster_slices) {
            hc = hclust(dist(t(meanmat)))
            hc = as.hclust(reorder(as.dendrogram(hc), weight, mean))
        } else {
            hc = list(order = order(weight))
        }

        cl2 = numeric(length(cl))
        for(i in seq_along(hc$order)) {
            cl2[cl == hc$order[i]] = i
        }
        cl2 = factor(cl2, levels = seq_along(hc$order))

        if(is.null(split)) {
            split = data.frame(cl2)
        } else if(is.matrix(split)) {
            split = as.data.frame(split)
            split = cbind(cl2, split)
        } else if(is.null(ncol(split))) {
            split = data.frame(cl2, split)
        } else {
            split = cbind(cl2, split)
        }
        if(verbose) qqcat("apply k-means (@{km} groups) on @{which}s, append to the `split` data frame\n")
            
    }

    # split the original order into a list according to split
    order_list = list()
    if(is.null(split)) {
        order_list[[1]] = order
    } else {

        if(verbose) cat("process `split` data frame\n")
        if(is.null(ncol(split))) split = data.frame(split)
        if(is.matrix(split)) split = as.data.frame(split)

        for(i in seq_len(ncol(split))) {
            if(is.numeric(split[[i]])) {
                split[[i]] = factor(as.character(split[[i]]), levels = as.character(sort(unique(split[[i]]))))
            } else if(!is.factor(split[[i]])) {
                split[[i]] = factor(split[[i]])
            } else {
                # re-factor
                split[[i]] = factor(split[[i]], levels = intersect(levels(split[[i]]), unique(split[[i]])))
            }
        }

        split_name = apply(as.matrix(split), 1, paste, collapse = ",")

        order2 = do.call("order", split)
        level = unique(split_name[order2])
        for(k in seq_along(level)) {
            l = split_name == level[k]
            order_list[[k]] = intersect(order, which(l))
        }
        names(order_list) = level
    }

    # make dend in each slice
    if(cluster) {
        if(verbose) qqcat("apply clustering on each slice (@{length(order_list)} slices)\n")
        dend_list = rep(list(NULL), length(order_list))
        for(i in seq_along(order_list)) {
            if(which == "row") {
                submat = mat[ order_list[[i]], , drop = FALSE]
            } else {
                submat = mat[, order_list[[i]], drop = FALSE]
            }
            nd = 0
            if(which == "row") nd = nrow(submat) else nd = ncol(submat)
            if(nd > 1) {
                if(!is.null(dend_param$fun)) {
                    if(which == "row") {
                        obj = dend_param$fun(submat)
                    } else {
                        obj = dend_param$fun(t(submat))
                    }
                    if(inherits(obj, "dendrogram") || inherits(obj, "hclust")) {
                        dend_list[[i]] = obj
                    } else {
                        oe = try(obj <- as.dendrogram(obj), silent = TRUE)
                        if(inherits(oe, "try-error")) {
                            stop_wrap("the clustering function must return a `dendrogram` object or a object that can be coerced to `dendrogram` class.")
                        }
                        dend_list[[i]] = obj
                    }
                    order_list[[i]] = order_list[[i]][ get_dend_order(dend_list[[i]]) ]
                } else {

                        if(which == "row") {
                            dend_list[[i]] = hclust(get_dist(submat, distance), method = method)
                        } else {
                            dend_list[[i]] = hclust(get_dist(t(submat), distance), method = method)
                        }
                        order_list[[i]] = order_list[[i]][ get_dend_order(dend_list[[i]]) ]
                    #}
                }
            } else {
                # a dendrogram with one leaf
                dend_list[[i]] = structure(1, members = 1, height = 0, leaf = TRUE, class = "dendrogram")
                order_list[[i]] = order_list[[i]][1]
            }
        }
        names(dend_list) = names(order_list)

        for(i in seq_along(dend_list)) {
            if(inherits(dend_list[[i]], "hclust")) {
                dend_list[[i]] = as.dendrogram(dend_list[[i]])
            }
        }

        if(identical(reorder, NULL)) {
            if(is.numeric(mat)) {
                reorder = TRUE
            } else {
                reorder = FALSE
            }
        }

        do_reorder = TRUE
        if(identical(reorder, NA) || identical(reorder, FALSE)) {
            do_reorder = FALSE
        }
        if(identical(reorder, TRUE)) {
            do_reorder = TRUE
            if(which == "row") {
                reorder = -rowMeans(mat, na.rm = TRUE)
            } else {
                reorder = -colMeans(mat, na.rm = TRUE)
            }
        }

        if(do_reorder) {

            if(which == "row") {
                if(length(reorder) != nrow(mat)) {
                    stop_wrap("weight of reordering should have same length as number of rows\n")
                }
            } else {
                if(length(reorder) != ncol(mat)) {
                    stop_wrap("weight of reordering should have same length as number of columns\n")
                }
            }
            for(i in seq_along(dend_list)) {
                if(length(order_list[[i]]) > 1) {
                    sub_ind = sort(order_list[[i]])
                    dend_list[[i]] = reorder(dend_list[[i]], reorder[sub_ind], mean)
                    order_list[[i]] = sub_ind[ order.dendrogram(dend_list[[i]]) ]
                }
            }
            if(verbose) qqcat("reorder dendrograms in each @{which} slice\n")
        }

        if(length(order_list) > 1 && cluster_slices) {
            if(which == "row") {
                slice_mean = sapply(order_list, function(ind) colMeans(mat[ind, , drop = FALSE]))
            } else {
                slice_mean = sapply(order_list, function(ind) rowMeans(mat[, ind, drop = FALSE]))
            }
            if(!is.matrix(slice_mean)) {
                slice_mean = matrix(slice_mean, nrow = 1)
            }
            dend_slice = as.dendrogram(hclust(dist(t(slice_mean))))
            if(verbose) qqcat("perform clustering on mean of @{which} slices\n")

            slice_od = order.dendrogram(dend_slice)
            order_list = order_list[slice_od]
            dend_list = dend_list[slice_od]
        }
    }

    dend_list = lapply(dend_list, adjust_dend_by_x)

    slot(object, paste0(which, "_order")) = unlist(order_list)
    slot(object, paste0(which, "_order_list")) = order_list
    slot(object, paste0(which, "_dend_list")) = dend_list
    slot(object, paste0(which, "_dend_param")) = dend_param
    slot(object, paste0(which, "_dend_slice")) = dend_slice
    object@matrix_param[[ paste0(which, "_split") ]] = split

    if(which == "row") {
        if(nrow(mat) != length(order)) {
            stop_wrap(qq("Number of rows in the matrix are not the same as the length of the cluster or the @{which} orders."))
        }
    } else {
        if(ncol(mat) != length(order)) {
            stop_wrap(qq("Number of columns in the matrix are not the same as the length of the cluster or the @{which} orders."))
        }
    }

    # adjust names_param$gp if the length of some elements is the same as slices
    for(i in seq_along(names_param$gp)) {
        if(length(names_param$gp[[i]]) == length(order_list)) {
            gp_temp = NULL
            for(j in seq_along(order_list)) {
                gp_temp[ order_list[[j]] ] = names_param$gp[[i]][j]
            }
            names_param$gp[[i]] = gp_temp   
        }
    }
    if(!is.null(names_param$anno)) {
        names_param$anno@var_env$gp = names_param$gp
    }
    slot(object, paste0(which, "_names_param")) = names_param

    n_slice = length(order_list)
    if(length(gap) == 1) {
        gap = rep(gap, n_slice)
    } else if(length(gap) == n_slice - 1) {
        gap = unit.c(gap, unit(0, "mm"))
    } else if(length(gap) != n_slice) {
        stop_wrap(qq("Length of `gap` should be 1 or number of @{which} slices."))
    }
    object@matrix_param[[ paste0(which, "_gap") ]] = gap
    
    # adjust title
    title = slot(object, paste0(which, "_title"))
    if(!is.null(split)) {
        if(length(title) == 0 && !is.null(title)) { ## default title
            title = names(order_list)
        } else if(length(title) == 1) {
            if(grepl("%s", title)) {
                title = apply(unique(split[order2, , drop = FALSE]), 1, function(x) {
                    lt = lapply(x, function(x) x)
                    lt$fmt = title
                    do.call(sprintf, lt)
                })
            } else if(grepl("@\\{.+\\}", title)) {
                title = apply(unique(split), 1, function(x) {
                    x = x
                    envir = environment()
                    title = get("title")
                    op = parent.env(envir)
                    calling_env = object@heatmap_param$calling_env
                    parent.env(envir) = calling_env
                    title = GetoptLong::qq(title, envir = envir)
                    parent.env(envir) = op
                    return(title)
                })
            } else if(grepl("\\{.+\\}", title)) {
                if(!requireNamespace("glue")) {
                    stop_wrap("You need to install glue package.")
                }
                title = apply(unique(split), 1, function(x) {
                    x = x
                    envir = environment()
                    title = get("title")
                    op = parent.env(envir)
                    calling_env = object@heatmap_param$calling_env
                    parent.env(envir) = calling_env
                    title = glue::glue(title, envir = calling_env)
                    parent.env(envir) = op
                    return(title)
                })
            }
        }
    }
    slot(object, paste0(which, "_title")) = title
    # check whether height of the dendrogram is zero
    if(all(sapply(dend_list, dend_heights) == 0)) {
        slot(object, paste0(which, "_dend_param"))$show = FALSE
    }
    return(object)

}

# == title
# Draw a Single Heatmap
#
# == param
# -object A `Heatmap-class` object.
# -internal If ``TRUE``, it is only used inside the calling of `draw,HeatmapList-method`. 
#           It only draws the heatmap without legends where the legend will be drawn by `draw,HeatmapList-method`. 
# -test Only for testing. If it is ``TRUE``, the heatmap body is directly drawn.
# -... Pass to `draw,HeatmapList-method`.
#
# == detail
# The function creates a `HeatmapList-class` object which only contains a single heatmap
# and call `draw,HeatmapList-method` to make the final heatmap.
#
# There are some arguments which control the some settings of the heatmap such as legends.
# Please go to `draw,HeatmapList-method` for these arguments.
#
# == value
# A `HeatmapList-class` object.
#
# == author
# Zuguang Gu <z.gu@dkfz.de>
#
setMethod(f = "draw",
    signature = "Heatmap",
    definition = function(object, internal = FALSE, test = FALSE, ...) {

    if(test) {
        object = prepare(object)
        grid.newpage()
        if(is_abs_unit(object@heatmap_param$width)) {
            width = object@heatmap_param$width
        } else {
            width = 0.8
        }
        if(is_abs_unit(object@heatmap_param$height)) {
            height = object@heatmap_param$height
        } else {
            height = 0.8
        }
        pushViewport(viewport(width = width, height = height))
        draw(object, internal = TRUE)
        upViewport()
    } else {
        if(internal) {  # a heatmap without legend
            # if(ncol(object@matrix) == 0 || nrow(object@matrix) == 0) return(invisible(NULL))
            if(nrow(object@layout$layout_index) == 0) return(invisible(NULL))
            layout = grid.layout(nrow = length(HEATMAP_LAYOUT_COLUMN_COMPONENT), 
                ncol = length(HEATMAP_LAYOUT_ROW_COMPONENT), widths = component_width(object), 
                heights = component_height(object))
            pushViewport(viewport(layout = layout))
            ht_layout_index = object@layout$layout_index
            ht_graphic_fun_list = object@layout$graphic_fun_list
            for(j in seq_len(nrow(ht_layout_index))) {
                if(HEATMAP_LAYOUT_COLUMN_COMPONENT["heatmap_body"] %in% ht_layout_index[j, 1] && 
                   HEATMAP_LAYOUT_ROW_COMPONENT["heatmap_body"] %in% ht_layout_index[j, 2]) {
                    pushViewport(viewport(layout.pos.row = ht_layout_index[j, 1], layout.pos.col = ht_layout_index[j, 2], name = paste(object@name, "heatmap_body_wrap", sep = "_")))
                } else {
                    pushViewport(viewport(layout.pos.row = ht_layout_index[j, 1], layout.pos.col = ht_layout_index[j, 2]))
                }
                ht_graphic_fun_list[[j]](object)
                upViewport()
            }
            upViewport()
        } else {
            # if(ncol(object@matrix) == 0) {
            #     stop_wrap("Single heatmap should contains a matrix with at least one column. Zero-column matrix can only be appended to the heatmap list.")
            # }
            ht_list = new("HeatmapList")
            ht_list = add_heatmap(ht_list, object)
            draw(ht_list, ...)
        }
    }
})

# == title
# Prepare the Heatmap
#
# == param
# -object A `Heatmap-class` object.
# -process_rows Whether to process rows of the heatmap.
# -process_columns Whether to process columns of the heatmap.
#
# == detail
# The preparation of the heatmap includes following steps:
#
# - making clustering on rows (by calling `make_row_cluster,Heatmap-method`)
# - making clustering on columns (by calling `make_column_cluster,Heatmap-method`)
# - making the layout of the heatmap (by calling `make_layout,Heatmap-method`)
#
# This function is only for internal use.
#
# == value
# The `Heatmap-class` object.
#
# == author
# Zuguang Gu <z.gu@dkfz.de>
#
setMethod(f = "prepare",
    signature = "Heatmap",
    definition = function(object, process_rows = TRUE, process_columns = TRUE) {

    if(object@layout$initialized) {
        return(object)
    }
    
    if(process_rows) {
        object = make_row_cluster(object)
    }
    if(process_columns) {
        object = make_column_cluster(object)
    }

    object = make_layout(object)
    return(object)

})