diff --git a/DESCRIPTION b/DESCRIPTION index a3e0366..535ab96 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: eheat Title: Extended ComplexHeatmap -Version: 0.99.5 +Version: 0.99.6 Authors@R: person("Yun", "Peng", , "yunyunp96@163.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0003-2801-3332")) Description: This package serves as a bridge between the ggplot2 and ComplexHeatmap packages. Essentially, all ggplot2 geometries and operations can be utilized in ComplexHeatmap. @@ -31,12 +31,13 @@ Collate: 'eanno.R' 'eheat-package.R' 'eheat.R' - 'ggheat.R' 'gganno.R' 'ggfit.R' + 'ggheat.R' 'import-standalone-assert.R' 'import-standalone-cli.R' 'import-standalone-obj-type.R' + 'internal-methods.R' 'legend.R' 'prepare.R' 'utils-assert.R' diff --git a/NAMESPACE b/NAMESPACE index f36eec8..b40e62a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -40,6 +40,7 @@ exportMethods(make_layout) exportMethods(prepare) importClassesFrom(ComplexHeatmap,AnnotationFunction) importClassesFrom(ComplexHeatmap,Heatmap) +importClassesFrom(ComplexHeatmap,HeatmapAnnotation) importFrom(ComplexHeatmap,draw) importFrom(ComplexHeatmap,ht_opt) importFrom(ComplexHeatmap,make_layout) diff --git a/R/eanno.R b/R/eanno.R index 2c0f449..918ff82 100644 --- a/R/eanno.R +++ b/R/eanno.R @@ -4,15 +4,16 @@ #' Manual](https://jokergoo.github.io/ComplexHeatmap-reference/book/heatmap-annotations.html#implement-new-annotation-functions) #' for details. #' -#' The function must have at least three arguments: `index`, `k` and `n` (the -#' names of the arguments can be arbitrary) where `k` and `n` are optional. -#' `index` corresponds to the indices of rows or columns of the heatmap. The -#' value of `index` is not necessarily to be the whole row indices or column -#' indices in the heatmap. It can also be a subset of the indices if the -#' annotation is split into slices according to the split of the heatmap. +#' The function must have at least Four arguments: `index`, `k`, `n`, and +#' `matrix` (the names of the arguments can be arbitrary) where `k` and `n` are +#' optional. `index` corresponds to the indices of rows or columns of the +#' heatmap. The value of `index` is not necessarily to be the whole row indices +#' or column indices in the heatmap. It can also be a subset of the indices if +#' the annotation is split into slices according to the split of the heatmap. #' `index` is reordered according to the reordering of heatmap rows or columns #' (e.g. by clustering). So, `index` actually contains a list of row or column -#' indices for the current slice after row or column reordering. +#' indices for the current slice after row or column reordering. `matrix` will +#' contain the data passed into the argument `matrix`. #' #' k corresponds to the current slice and n corresponds to the total number of #' slices. @@ -65,7 +66,7 @@ #' n <- length(index) #' pushViewport(viewport(xscale = c(0.5, n + 0.5), yscale = c(0, 10))) #' grid.rect() -#' grid.points(1:n, self[index], default.units = "native") +#' grid.points(1:n, self[index, drop = TRUE], default.units = "native") #' if (k == 1) grid.yaxis() #' popViewport() #' }, @@ -117,15 +118,25 @@ eanno <- function(draw_fn, ..., matrix = NULL, which = NULL, subset_rule = NULL, } if (subsettable <- subset_rule) { - subset_rule <- lapply( - dots[rlang::have_name(dots)], - function(x) TRUE - ) + subsettable_args <- dots[rlang::have_name(dots)] + if (length(subsettable_args)) { + subset_rule <- rep_len(TRUE, length(subsettable_args)) + names(subset_rule) <- rlang::names2(subsettable_args) + } else { + subset_rule <- list() + } } } else if (is.list(subset_rule)) { if (!rlang::is_named2(subset_rule)) { cli::cli_abort("{.arg subset_rule} must be named") } + missing_rules <- setdiff( + rlang::names2(subset_rule), + rlang::names2(dots) + ) + if (length(missing_rules)) { + cli::cli_abort("Cannot find {.val {missing_rules}} in {.arg ...}") + } subset_rule <- lapply(subset_rule, allow_lambda) if (!all(vapply(subset_rule, is.function, logical(1L)))) { cli::cli_abort("{.arg subset_rule} must be a list of function") @@ -237,16 +248,16 @@ methods::setValidity("ExtendedAnnotation", function(object) { TRUE }) -wrap_anno_fn <- function(fn, matrix, dots) { - force(matrix) - force(dots) - +wrap_anno_fn <- function(object) { # prepare annotation function -------------------------- + matrix <- object@matrix + dots <- object@dots + fn <- object@fun args <- formals(fn) - # is.null is a fast path for a common case; the %in% check is slower but also - # catches the case where there's a `self = NULL` argument. - has_self <- !is.null(args[["self"]]) || "self" %in% names(args) - if (has_self) { + + # is.null is a fast path for a common case; the %in% check is slower but + # also catches the case where there's a `self = NULL` argument. + if (!is.null(.subset2(args, "self")) || "self" %in% names(args)) { function(index, k, n) { rlang::inject(fn(index, k, n, !!!dots, self = matrix)) } @@ -258,21 +269,33 @@ wrap_anno_fn <- function(fn, matrix, dots) { } #' @param object An [ExtendedAnnotation][eanno] object. -#' @param order_list Heatmap order list (column/row) after clustering. -#' @param heat_matrix Heatmap matrix. +#' @param viewport A viewport for this annotation. +#' @param heatmap Heatmap object after clustering. #' @param name A string, the name of the annotation. #' @importFrom ComplexHeatmap make_layout #' @export -#' @rdname eanno +#' @rdname internal-method methods::setMethod( "make_layout", "ExtendedAnnotation", - function(object, order_list, ..., heat_matrix = NULL, name = NULL) { + function(object, ..., viewport = NULL, heatmap = NULL, name = NULL) { + # we initialize the ExtendedAnnotation object and extract the + # legends which <- object@which + if (is.null(name)) { + id <- object@fun_name + } else { + id <- sprintf("%s (%s)", object@fun_name, name) + } # prepare ExtendedAnnotation matrix data --------------------------- mat <- object@matrix + if (is.null(heatmap)) { + heat_matrix <- NULL + } else { + heat_matrix <- heatmap@matrix + } if (is.null(heat_matrix) && (is.null(mat) || is.function(mat))) { cli::cli_abort(paste( - "You must provide a matrix in", object@fun_name, + "You must provide a matrix in", id, "in order to draw {.cls {fclass(object)}} directly" )) } @@ -288,27 +311,26 @@ methods::setMethod( column = t(heat_matrix) ) if (!is.matrix(mat <- mat(data))) { - cli::cli_abort("{.fn @matrix} must return a matrix") + cli::cli_abort("{.fn @matrix} of {id} must return a matrix") } object@n <- nrow(mat) } object@matrix <- mat # call `eheat_prepare` to modify object after make_layout ---------- - object <- eheat_prepare(object, order_list, name) - - initialized_eanno_fn <- wrap_anno_fn(object@fun, mat, object@dots) + # for `eheat_prepare`, the actual geom matrix has been added + object <- eheat_prepare( + object, + viewport = viewport, + heatmap = heatmap, name = name + ) - if (is.null(name)) { - vp_name <- NULL # should be called from draw directly - } else { - vp_name <- sprintf("annotation_%s", name) - } - dots <- rlang::list2(...) + initialized_eanno_fn <- wrap_anno_fn(object) + force(viewport) object@fun <- function(index, k, n) { # in the first slice, we always insert annotation viewport if (k == 1L) { - if (!is.null(heat_matrix)) { + if (!is.null(viewport)) { # current viewport: `draw,AnnotationFunction` function # parent viewport - 1: `draw,HeatmapAnnotation` function # parent viewport - 2: `draw,HeatmapAnnotation` function @@ -326,20 +348,7 @@ methods::setMethod( # -- "main_heatmap_list" current_vp <- grid::current.viewport()$name grid::upViewport(5L) - if (which == "row") { - yscale <- c(0.5, n + 0.5) - xscale <- c(0, 1) - } else { - xscale <- c(0.5, n + 0.5) - yscale <- c(0, 1) - } - vp <- grid::viewport( - x = dots$x, y = dots$y, width = dots$width, - height = dots$height, just = dots$just, - xscale = xscale, yscale = yscale, - name = vp_name - ) - grid::pushViewport(vp) + grid::pushViewport(viewport) grid::seekViewport(current_vp) } } @@ -356,10 +365,13 @@ methods::setMethod( # }) # in the last slice, we draw legends in the panel if (k == n && length(object@legends_panel)) { - if (is.null(vp_name)) { + if (is.null(viewport)) { lapply(object@legends_panel, draw) } else { - .eheat_decorate(vp_name, lapply(object@legends_panel, draw)) + .eheat_decorate( + viewport$name, + lapply(object@legends_panel, draw) + ) } } } @@ -400,7 +412,7 @@ methods::setMethod( # since `eheat` will initialize `eanno` when preparing the main # heatmap layout. if (k == 1L && !object@initialized) { - order_list <- NULL + heatmap <- NULL pos <- 1L nframes <- sys.nframe() - 1L # total parents # https://github.com/jokergoo/ComplexHeatmap/blob/7d95ca5cf533b98bd0351eecfc6805ad30c754c0/R/HeatmapList-draw_component.R#L670 @@ -411,28 +423,17 @@ methods::setMethod( if (is_from_eheat(env) && exists("ht_main", envir = env, inherits = FALSE) && is_call_from(pos, "draw_heatmap_list")) { - obj <- .subset2(env, "ht_main") - if (methods::.hasSlot(obj, "row_order_list") && - methods::.hasSlot(obj, "column_order_list")) { - order_list <- switch(object@which, - row = obj@row_order_list, - column = obj@column_order_list - ) - } + heatmap <- .subset2(env, "ht_main") } pos <- pos + 1L } - if (is.null(order_list)) { - if (n == 1L) { - order_list <- list(index) - } else { - cli::cli_abort("Cannot initialize {.cls {object@name}}") - } + if (is.null(heatmap) && n > 1L) { + cli::cli_abort("Cannot initialize {.cls {object@name}}") } # we can only supply heatmap matrix when called from `make_layout` # of heatmap, there is no heatmap matrix when called from draw # directly. - object <- make_layout(object, order_list) + object <- make_layout(object, heatmap = heatmap) } # will create a new viewport methods::callNextMethod( diff --git a/R/eheat.R b/R/eheat.R index a0fed6b..0d76c36 100644 --- a/R/eheat.R +++ b/R/eheat.R @@ -15,8 +15,10 @@ #' ``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 -#' . +#' objects. Check +#' . You can always use +#' `self` to indicates the matrix attached in this Heatmap. +#' - `layer_fun`: Similar as ``cell_fun``, but is vectorized. #' - `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 @@ -194,13 +196,13 @@ methods::setClass( contains = "Heatmap" ) -#' @param object A `ExtendedHeatmap` object. #' @examples #' prepare(eheat(matrix(rnorm(81), nrow = 9))) #' @inheritParams ComplexHeatmap::prepare #' @importFrom ComplexHeatmap prepare #' @export -#' @rdname eheat +#' @keywords internal +#' @rdname internal-method methods::setMethod( f = "prepare", signature = "ExtendedHeatmap", definition = function(object, process_rows = TRUE, process_columns = TRUE) { @@ -227,117 +229,130 @@ methods::setMethod( } ) -#' @examples -#' make_layout(prepare(eheat(matrix(rnorm(81), nrow = 9)))) +wrap_heat_fn <- function(object, fun_name) { + fn <- .subset2(object@matrix_param, fun_name) + if (is.null(fn)) return(fn) # styler: off + args <- formals(fn) + + # is.null is a fast path for a common case; the %in% check is slower but + # also catches the case where there's a `self = NULL` argument. + if (!is.null(.subset2(args, "self")) || "self" %in% names(args)) { + matrix <- object@matrix + function(j, i, x, y, w, h, fill) { + fn(j, i, x, y, w, h, fill, self = matrix) + } + } else { + fn + } +} + +#' @importClassesFrom ComplexHeatmap HeatmapAnnotation #' @importFrom ComplexHeatmap make_layout #' @export -#' @rdname eheat -methods::setMethod( - f = "make_layout", signature = "ExtendedHeatmap", - definition = function(object) { - object <- methods::callNextMethod() +#' @keywords internal +#' @rdname internal-method +methods::setMethod("make_layout", "ExtendedHeatmap", function(object) { + object <- methods::callNextMethod() - # run eheat_prepare --------------------------------- - # New generics to extend ComplexHeatmap easily - # we can insert legends and modify `draw_fn` here - object <- eheat_prepare(object) + # run eheat_prepare --------------------------------- + # New generics to extend ComplexHeatmap easily + # we can insert legends and modify `draw_fn` here + object <- eheat_prepare(object) - # draw panel legends -------------------------------- - initialized_eheat_fn <- object@matrix_param$layer_fun + # we extend ComplexHeatmap by applying `make_layout` for each annotation + # and extracted legends + for (position in c("top", "bottom", "left", "right")) { + anno_nm <- sprintf("%s_annotation", position) + annotation <- methods::slot(object, anno_nm) + if (is.null(annotation)) next + methods::slot(object, anno_nm) <- make_layout(annotation, object) + } - n <- 0L - total <- length(object@row_order_list) * - length(object@column_order_list) - object@matrix_param$layer_fun <- function(j, i, x, y, w, h, fill) { - n <<- n + 1L - if (!is.null(initialized_eheat_fn)) { - initialized_eheat_fn(j, i, x, y, w, h, fill) - } - # in the last slice, we draw panel legends - if (n == total && length(object@legends_panel)) { - # https://github.com/jokergoo/ComplexHeatmap/blob/7d95ca5cf533b98bd0351eecfc6805ad30c754c0/R/Heatmap-class.R#L1730 - heatmap_body_vp_name <- sprintf( - "%s_heatmap_body_wrap", object@name - ) - .eheat_decorate(heatmap_body_vp_name, { - lapply(object@legends_panel, draw) - }) - } + # draw panel legends -------------------------------- + initialized_eheat_fn <- wrap_heat_fn(object, "layer_fun") + object@matrix_param$cell_fun <- wrap_heat_fn(object, "cell_fun") + n <- 0L + total <- length(object@row_order_list) * length(object@column_order_list) + object@matrix_param$layer_fun <- function(j, i, x, y, w, h, fill) { + n <<- n + 1L + if (!is.null(initialized_eheat_fn)) { + initialized_eheat_fn(j, i, x, y, w, h, fill) + } + # in the last slice, we draw panel legends + if (n == total && length(object@legends_panel)) { + # https://github.com/jokergoo/ComplexHeatmap/blob/7d95ca5cf533b98bd0351eecfc6805ad30c754c0/R/Heatmap-class.R#L1730 + heatmap_body_vp_name <- sprintf("%s_heatmap_body_wrap", object@name) + .eheat_decorate(heatmap_body_vp_name, { + lapply(object@legends_panel, draw) + }) } + } + object +}) - # we extend ComplexHeatmap by applying `make_layout` for each annotation - # and extracted legends - for (position in c("top", "bottom", "left", "right")) { - anno_nm <- sprintf("%s_annotation", position) - annotation <- methods::slot(object, anno_nm) - if (is.null(annotation)) next - # we call `make_layout` to initialize ExtendedAnnotation and extract - # legends - anno_list <- annotation@anno_list - anno_sizes <- annotation@anno_size - anno_gaps <- annotation@gap - nms <- names(anno_list) - n_anno <- length(nms) - for (i in seq_along(anno_list)) { - anno <- anno_list[[i]]@fun - # if the annotation exits and is `ExtendedAnnotation` - if (!inherits(anno, "ExtendedAnnotation")) next - order_list <- switch(anno@which, - row = object@row_order_list, - column = object@column_order_list - ) - # we initialize the ExtendedAnnotation object and extract the - # legends - # start from the last annoation which is put on right/bottom - # and we always add a viewport for the whole annotation. - just <- switch(position, - top = , - bottom = c(0, 1), - left = , - right = c(1, 1) - ) - x <- switch(position, - top = , - bottom = unit(0, "npc"), - left = , - right = sum(anno_sizes[seq_len(i)]) + - sum(anno_gaps[seq_len(i)]) - - anno_gaps[i] - ) - width <- switch(position, - top = , - bottom = unit(1, "npc"), - left = , - right = anno_sizes[i] - ) - y <- switch(position, - top = , - bottom = sum(anno_sizes[seq(i, n_anno)]) + - sum(anno_gaps[seq(i, n_anno)]) - - anno_gaps[n_anno], - left = , - right = unit(1, "npc") - ) - height <- switch(position, - top = , - bottom = anno_sizes[i], - left = , - right = unit(1, "npc") - ) - anno <- make_layout( - anno, order_list, - position = position, - x = x, y = y, width = width, height = height, just = just, - heat_name = object@name, - heat_matrix = object@matrix, - name = .subset(nms, i) - ) - anno_list[[i]]@fun <- anno - # we add annotation legends - add_eheat_legends("annotation_legend_list", anno@legends_margin) - } - methods::slot(object, anno_nm)@anno_list <- anno_list +#' @importClassesFrom ComplexHeatmap HeatmapAnnotation +#' @importFrom ComplexHeatmap make_layout +#' @export +#' @keywords internal +#' @rdname internal-method +methods::setMethod( + "make_layout", "HeatmapAnnotation", + function(object, heatmap) { + # we call `make_layout` to initialize ExtendedAnnotation and extract + # legends + anno_list <- object@anno_list + anno_sizes <- object@anno_size + anno_gaps <- object@gap + nms <- names(anno_list) + n_anno <- length(anno_list) + for (i in seq_along(anno_list)) { + anno <- anno_list[[i]]@fun + # if the annotation exits and is `ExtendedAnnotation` + if (!inherits(anno, "ExtendedAnnotation")) next + which <- anno@which + # we allocate each annotation a viewport ---------------- + # always add a viewport for the whole annotation. + # start from the last annoation which is put on right/bottom + just <- switch(which, + row = c(1, 1), + column = c(0, 1) + ) + x <- switch(which, + row = sum(anno_sizes[seq_len(i)]) + + sum(anno_gaps[seq_len(i)]) - + anno_gaps[i], + column = unit(0, "npc") + ) + width <- switch(which, + row = anno_sizes[i], + column = unit(1, "npc") + ) + y <- switch(which, + row = unit(1, "npc"), + column = sum(anno_sizes[seq(i, n_anno)]) + + sum(anno_gaps[seq(i, n_anno)]) - + anno_gaps[n_anno] + ) + height <- switch(which, + row = unit(1, "npc"), + column = anno_sizes[i] + ) + name <- .subset(nms, i) + vp <- grid::viewport( + x = x, y = y, width = width, height = height, just = just, + name = sprintf("annotation_%s", name) + ) + anno <- make_layout( + anno, + viewport = vp, + heatmap = heatmap, + name = name + ) + anno_list[[i]]@fun <- anno + # we add annotation legends + add_eheat_legends("annotation_legend_list", anno@legends_margin) } + object@anno_list <- anno_list object } ) diff --git a/R/gganno.R b/R/gganno.R index 903bacb..9a30f7b 100644 --- a/R/gganno.R +++ b/R/gganno.R @@ -44,18 +44,15 @@ gganno <- function(ggfn, ..., matrix = NULL, #' @export #' @rdname gganno -#' @include ggheat.R -methods::setClass( - "ggAnno", - slots = list(ggparams = "list"), - contains = "ExtendedAnnotation" -) +#' @include eanno.R +methods::setClass("ggAnno", contains = "ExtendedAnnotation") +#' @inheritParams internal-method #' @importFrom ggplot2 ggplot #' @importFrom ggplot2 aes #' @export #' @rdname eheat_prepare -eheat_prepare.ggAnno <- function(object, order_list, name = NULL, ...) { +eheat_prepare.ggAnno <- function(object, ..., viewport, heatmap, name) { if (is.null(name)) { id <- "(gganno)" fn_id <- "{.fn ggfn}" @@ -66,6 +63,14 @@ eheat_prepare.ggAnno <- function(object, order_list, name = NULL, ...) { which <- object@which # we always regard matrix row as the observations matrix <- object@matrix + if (is.null(heatmap)) { + order_list <- list(seq_len(nrow(matrix))) + } else { + order_list <- switch(which, + row = heatmap@row_order_list, + column = heatmap@column_order_list + ) + } data <- as_tibble0(matrix, rownames = NULL) # nolint if (length(order_list) > 1L) { with_slice <- TRUE @@ -161,7 +166,6 @@ eheat_prepare.ggAnno <- function(object, order_list, name = NULL, ...) { gt <- ggplot2::ggplotGrob(p) # nolint object@fun <- function(index, k, n) { - vp <- flip_viewport(which, xscale = c(0.5, n + 0.5), yscale = c(0, 1)) if (with_slice) { m <- NULL if (which == "row") { @@ -191,8 +195,7 @@ eheat_prepare.ggAnno <- function(object, order_list, name = NULL, ...) { .ggfit( gt_area(gt, pattern, margins = m), align_with = "panel", margins = m, - elements = c("axis", "lab"), - vp = vp + elements = c("axis", "lab") ) } object@dots <- list() diff --git a/R/ggheat.R b/R/ggheat.R index 565c506..8cdf47c 100644 --- a/R/ggheat.R +++ b/R/ggheat.R @@ -51,7 +51,7 @@ methods::setClass( contains = "ExtendedHeatmap" ) -methods::setValidity("ExtendedAnnotation", function(object) { +methods::setValidity("ggHeatmap", function(object) { ggfn <- object@ggfn if (!is.null(ggfn) && !is.function(ggfn)) { cli::cli_abort("{.code @ggfn} must be a function or NULL") diff --git a/R/internal-methods.R b/R/internal-methods.R new file mode 100644 index 0000000..28e8438 --- /dev/null +++ b/R/internal-methods.R @@ -0,0 +1,6 @@ +#' Internal methods to extend ComplexHeatmap +#' +#' @param object See method signatures. +#' @return A modified object with the same class. +#' @name internal-method +NULL diff --git a/R/prepare.R b/R/prepare.R index c862c53..b6fc0d9 100644 --- a/R/prepare.R +++ b/R/prepare.R @@ -1,10 +1,9 @@ #' Prepare ExtendedHeatmap #' @param object A [ExtendedHeatmap][eheat] or [ExtendedAnnotation][eanno] #' object. -#' @param ... Additional arguments passed to specific methods -#' @return An modified [ExtendedHeatmap][eheat] or [ExtendedAnnotation][eanno] -#' object. -#' @examples +#' @param ... Not used currently. +#' @return An modified `object` with the same class. +#' @examples #' eheat_prepare(eheat(matrix(rnorm(81), nrow = 9))) #' @export eheat_prepare <- function(object, ...) { @@ -17,10 +16,9 @@ eheat_prepare.ExtendedHeatmap <- function(object, ...) { object } -#' @inheritParams eanno #' @export #' @rdname eheat_prepare -eheat_prepare.ExtendedAnnotation <- function(object, order_list, name = NULL, - ...) { +eheat_prepare.ExtendedAnnotation <- function(object, ..., + viewport, heatmap, name) { object } diff --git a/man/eanno.Rd b/man/eanno.Rd index fd2ff65..b074e64 100644 --- a/man/eanno.Rd +++ b/man/eanno.Rd @@ -4,7 +4,6 @@ \name{eanno} \alias{eanno} \alias{ExtendedAnnotation-class} -\alias{make_layout,ExtendedAnnotation-method} \title{Constructor of AnnotationFunction Class} \usage{ eanno( @@ -20,23 +19,22 @@ eanno( legends_panel = NULL, fun_name = NULL ) - -\S4method{make_layout}{ExtendedAnnotation}(object, order_list, ..., heat_matrix = NULL, name = NULL) } \arguments{ \item{draw_fn}{A function which defines how to draw the annotation. See \href{https://jokergoo.github.io/ComplexHeatmap-reference/book/heatmap-annotations.html#implement-new-annotation-functions}{ComplexHeatmap Manual} for details. -The function must have at least three arguments: \code{index}, \code{k} and \code{n} (the -names of the arguments can be arbitrary) where \code{k} and \code{n} are optional. -\code{index} corresponds to the indices of rows or columns of the heatmap. The -value of \code{index} is not necessarily to be the whole row indices or column -indices in the heatmap. It can also be a subset of the indices if the -annotation is split into slices according to the split of the heatmap. +The function must have at least Four arguments: \code{index}, \code{k}, \code{n}, and +\code{matrix} (the names of the arguments can be arbitrary) where \code{k} and \code{n} are +optional. \code{index} corresponds to the indices of rows or columns of the +heatmap. The value of \code{index} is not necessarily to be the whole row indices +or column indices in the heatmap. It can also be a subset of the indices if +the annotation is split into slices according to the split of the heatmap. \code{index} is reordered according to the reordering of heatmap rows or columns (e.g. by clustering). So, \code{index} actually contains a list of row or column -indices for the current slice after row or column reordering. +indices for the current slice after row or column reordering. \code{matrix} will +contain the data passed into the argument \code{matrix}. k corresponds to the current slice and n corresponds to the total number of slices. @@ -72,14 +70,6 @@ details. Only object with \link{make_legends} methods can be put in \code{legends_panel}.} \item{fun_name}{Name of the annotation function, only used for message.} - -\item{object}{An \link[=eanno]{ExtendedAnnotation} object.} - -\item{order_list}{Heatmap order list (column/row) after clustering.} - -\item{heat_matrix}{Heatmap matrix.} - -\item{name}{A string, the name of the annotation.} } \value{ A \code{ExtendedAnnotation} object. @@ -116,7 +106,7 @@ anno <- eanno( n <- length(index) pushViewport(viewport(xscale = c(0.5, n + 0.5), yscale = c(0, 10))) grid.rect() - grid.points(1:n, self[index], default.units = "native") + grid.points(1:n, self[index, drop = TRUE], default.units = "native") if (k == 1) grid.yaxis() popViewport() }, diff --git a/man/eheat.Rd b/man/eheat.Rd index 8c67bc1..dd1e3a5 100644 --- a/man/eheat.Rd +++ b/man/eheat.Rd @@ -4,15 +4,9 @@ \name{eheat} \alias{eheat} \alias{ExtendedHeatmap-class} -\alias{prepare,ExtendedHeatmap-method} -\alias{make_layout,ExtendedHeatmap-method} \title{Extended Heatmap} \usage{ eheat(matrix, ..., legends_margin = list(), legends_panel = list()) - -\S4method{prepare}{ExtendedHeatmap}(object, process_rows = TRUE, process_columns = TRUE) - -\S4method{make_layout}{ExtendedHeatmap}(object) } \arguments{ \item{matrix}{A matrix, if it is a simple vector, it will be converted to a @@ -32,8 +26,10 @@ parameters will be passed into this function: \code{j}, \code{i}, \code{x}, \cod \code{width}, \code{height}, \code{fill} which are column index, row index in \code{matrix}, coordinate of the cell, the width and height of the cell and the filled color. \code{x}, \code{y}, \code{width} and \code{height} are all \code{grid::unit} -objects. -layer_fun Similar as \code{cell_fun}, but is vectorized. Check -\url{https://jokergoo.github.io/ComplexHeatmap-reference/book/a-single-heatmap.html#customize-the-heatmap-body}. +objects. Check +\url{https://jokergoo.github.io/ComplexHeatmap-reference/book/a-single-heatmap.html#customize-the-heatmap-body}. You can always use +\code{self} to indicates the matrix attached in this Heatmap. +\item \code{layer_fun}: Similar as \code{cell_fun}, but is vectorized. \item \code{jitter}: Random shifts added to the matrix. The value can be logical or a single numeric value. It it is \code{TRUE}, random values from uniform distribution between 0 and 1e-10 are generated. If it is a numeric @@ -176,12 +172,6 @@ added in the \code{heatmap_legend_list} of plotted in the heatmap matrix panel.Only object with \link{make_legends} methods can be put in \code{legends_margin}. Only object with \link[=draw-method]{draw} methods can be put in \code{legends_panel}.} - -\item{object}{A \code{ExtendedHeatmap} object.} - -\item{process_rows}{Whether to process rows of the heatmap.} - -\item{process_columns}{Whether to process columns of the heatmap.} } \value{ A \code{ExtendedHeatmap} Object. @@ -207,6 +197,4 @@ graphics. } \examples{ eheat(matrix(rnorm(81), nrow = 9)) -prepare(eheat(matrix(rnorm(81), nrow = 9))) -make_layout(prepare(eheat(matrix(rnorm(81), nrow = 9)))) } diff --git a/man/eheat_prepare.Rd b/man/eheat_prepare.Rd index c57b98f..478f192 100644 --- a/man/eheat_prepare.Rd +++ b/man/eheat_prepare.Rd @@ -1,36 +1,37 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ggheat.R, R/gganno.R, R/prepare.R -\name{eheat_prepare.ggHeatmap} -\alias{eheat_prepare.ggHeatmap} +% Please edit documentation in R/gganno.R, R/ggheat.R, R/prepare.R +\name{eheat_prepare.ggAnno} \alias{eheat_prepare.ggAnno} +\alias{eheat_prepare.ggHeatmap} \alias{eheat_prepare} \alias{eheat_prepare.ExtendedHeatmap} \alias{eheat_prepare.ExtendedAnnotation} \title{Prepare ExtendedHeatmap} \usage{ -\method{eheat_prepare}{ggHeatmap}(object, ...) +\method{eheat_prepare}{ggAnno}(object, ..., viewport, heatmap, name) -\method{eheat_prepare}{ggAnno}(object, order_list, name = NULL, ...) +\method{eheat_prepare}{ggHeatmap}(object, ...) eheat_prepare(object, ...) \method{eheat_prepare}{ExtendedHeatmap}(object, ...) -\method{eheat_prepare}{ExtendedAnnotation}(object, order_list, name = NULL, ...) +\method{eheat_prepare}{ExtendedAnnotation}(object, ..., viewport, heatmap, name) } \arguments{ \item{object}{A \link[=eheat]{ExtendedHeatmap} or \link[=eanno]{ExtendedAnnotation} object.} -\item{...}{Additional arguments passed to specific methods} +\item{...}{Not used currently.} + +\item{viewport}{A viewport for this annotation.} -\item{order_list}{Heatmap order list (column/row) after clustering.} +\item{heatmap}{Heatmap object after clustering.} \item{name}{A string, the name of the annotation.} } \value{ -An modified \link[=eheat]{ExtendedHeatmap} or \link[=eanno]{ExtendedAnnotation} -object. +An modified \code{object} with the same class. } \description{ Prepare ExtendedHeatmap diff --git a/man/internal-method.Rd b/man/internal-method.Rd new file mode 100644 index 0000000..21b25f4 --- /dev/null +++ b/man/internal-method.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/eanno.R, R/eheat.R, R/internal-methods.R +\name{make_layout,ExtendedAnnotation-method} +\alias{make_layout,ExtendedAnnotation-method} +\alias{prepare,ExtendedHeatmap-method} +\alias{make_layout,ExtendedHeatmap-method} +\alias{make_layout,HeatmapAnnotation-method} +\alias{internal-method} +\title{Internal methods to extend ComplexHeatmap} +\usage{ +\S4method{make_layout}{ExtendedAnnotation}(object, ..., viewport = NULL, heatmap = NULL, name = NULL) + +\S4method{prepare}{ExtendedHeatmap}(object, process_rows = TRUE, process_columns = TRUE) + +\S4method{make_layout}{ExtendedHeatmap}(object) + +\S4method{make_layout}{HeatmapAnnotation}(object, heatmap) +} +\arguments{ +\item{object}{See method signatures.} + +\item{viewport}{A viewport for this annotation.} + +\item{heatmap}{Heatmap object after clustering.} + +\item{name}{A string, the name of the annotation.} + +\item{process_rows}{Whether to process rows of the heatmap.} + +\item{process_columns}{Whether to process columns of the heatmap.} +} +\value{ +A modified object with the same class. +} +\description{ +Internal methods to extend ComplexHeatmap +} +\examples{ +prepare(eheat(matrix(rnorm(81), nrow = 9))) +} +\keyword{internal}