diff --git a/R/eanno.R b/R/eanno.R
index 50dafef..abbc115 100644
--- a/R/eanno.R
+++ b/R/eanno.R
@@ -4,29 +4,27 @@
#' Manual](https://jokergoo.github.io/ComplexHeatmap-reference/book/heatmap-annotations.html#implement-new-annotation-functions)
#' for details.
#'
-#' 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. `matrix` will
-#' contain the data passed into the argument `matrix`.
+#' The function must have at least Four arguments: `index`, `k`, `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. `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.
#'
-#' k corresponds to the current slice and n corresponds to the total number of
-#' slices.
+#' `k` corresponds to the current slice and `n` corresponds to the total number
+#' of slices.
#'
-#' You can always use `self` to indicates the matrix attached in this
+#' You can always use `self` to indicates the `data` attached in this
#' annotation.
#'
#' @param ... Additional arguments passed on to `draw_fn`. Only named arguments
#' can be subsettable.
-#' @param matrix A matrix, if it is a simple vector, it will be converted to a
-#' one-column matrix. Data.frame will also be coerced into matrix. If `NULL`,
-#' the matrix from heatmap will be used. You can also provide a function to
-#' transform the matrix.
+#' @param data A `matrix` or `data.frame`, if it is a simple vector, it will be
+#' converted to a one-column matrix. If `NULL`, the matrix from the heatmap will
+#' be used. You can also provide a function to transform the matrix.
#' @inheritParams ComplexHeatmap::AnnotationFunction
#' @param subset_rule A list of function to subset variables in `...`.
#' @param fun_name Name of the annotation function, only used for message.
@@ -70,7 +68,7 @@
#' if (k == 1) grid.yaxis()
#' popViewport()
#' },
-#' matrix = rnorm(10L), subset_rule = TRUE,
+#' data = rnorm(10L), subset_rule = TRUE,
#' height = unit(2, "cm")
#' )
#' draw(anno)
@@ -78,7 +76,7 @@
#' @seealso [AnnotationFunction][ComplexHeatmap::AnnotationFunction]
#' @return A `ExtendedAnnotation` object.
#' @export
-eanno <- function(draw_fn, ..., matrix = NULL, which = NULL, subset_rule = NULL,
+eanno <- function(draw_fn, ..., data = NULL, which = NULL, subset_rule = NULL,
width = NULL, height = NULL, show_name = TRUE,
legends_margin = NULL, legends_panel = NULL,
fun_name = NULL) {
@@ -91,14 +89,14 @@ eanno <- function(draw_fn, ..., matrix = NULL, which = NULL, subset_rule = NULL,
# package namespace can be used directly
draw_fn <- allow_lambda(draw_fn)
assert_(draw_fn, is.function, "a function")
- matrix <- allow_lambda(matrix)
- if (is.null(matrix)) {
+ data <- allow_lambda(data)
+ if (is.null(data)) {
n <- NA
- } else if (is.function(matrix)) {
+ } else if (is.function(data)) {
n <- NA
} else {
- matrix <- build_matrix(matrix)
- n <- nrow(matrix)
+ data <- build_anno_data(data)
+ n <- nrow(data)
}
which <- eheat_which(which)
@@ -113,7 +111,7 @@ eanno <- function(draw_fn, ..., matrix = NULL, which = NULL, subset_rule = NULL,
if (!is_scalar(subset_rule)) {
cli::cli_abort("{.arg subset_rule} must be a single boolean value")
} else if (is.na(subset_rule)) {
- cli::cli_abort("{.arg subset_rule} cannot be missing value")
+ cli::cli_abort("{.arg subset_rule} cannot be `NA`")
}
if (subsettable <- subset_rule) {
@@ -146,7 +144,7 @@ eanno <- function(draw_fn, ..., matrix = NULL, which = NULL, subset_rule = NULL,
# contruct ExtendedAnnotation -----------------------------
anno <- methods::new("ExtendedAnnotation")
anno@dots <- dots
- anno@matrix <- matrix
+ anno@data <- data
anno@which <- which
anno@fun <- draw_fn
anno@fun_name <- fun_name %||% "eanno"
@@ -184,6 +182,8 @@ eanno <- function(draw_fn, ..., matrix = NULL, which = NULL, subset_rule = NULL,
if (!x@subsettable) {
cli::cli_abort("{.arg x} is not subsettable.")
}
+
+ # subset dots ---------------------------------------
rules <- x@subset_rule
x@dots[rlang::have_name(x@dots)] <- imap(
x@dots[rlang::have_name(x@dots)], function(var, nm) {
@@ -210,7 +210,15 @@ eanno <- function(draw_fn, ..., matrix = NULL, which = NULL, subset_rule = NULL,
}
}
)
- if (is.matrix(x@matrix)) x@matrix <- x@matrix[i, , drop = FALSE]
+
+ # subset the annotation data ---------------------
+ if (inherits(x@data, c("tbl_df", "data.table"))) {
+ # For tibble and data.table, no `drop` argument
+ x@data <- x@data[i, ]
+ } else if (is.matrix(x@data) || is.data.frame(x@data)) {
+ # For matrix and data.frame
+ x@data <- x@data[i, , drop = FALSE]
+ }
if (is_scalar(x@n) && is.na(x@n)) return(x) # styler: off
if (is.logical(i)) {
x@n <- sum(i)
@@ -227,14 +235,14 @@ eanno <- function(draw_fn, ..., matrix = NULL, which = NULL, subset_rule = NULL,
methods::setClass(
"ExtendedAnnotation",
slots = list(
- matrix = "ANY",
+ data = "ANY",
dots = "list",
legends_margin = "list",
legends_panel = "list",
initialized = "logical"
),
prototype = list(
- matrix = NULL,
+ data = NULL,
dots = list(),
legends_margin = list(),
legends_panel = list(),
@@ -244,16 +252,20 @@ methods::setClass(
)
methods::setValidity("ExtendedAnnotation", function(object) {
- matrix <- object@matrix
- if (!is.null(matrix) && !is.function(matrix) && !is.matrix(matrix)) {
- cli::cli_abort("{.code @matrix} must be a matrix or a function or NULL")
+ data <- object@data
+ if (!is.null(data) && !is.function(data) &&
+ !(is.matrix(data) || inherits(data, "data.frame"))) {
+ cli::cli_abort(paste(
+ "{.code @data} must be a",
+ "matrix or data.frame or a function or `NULL`"
+ ))
}
TRUE
})
wrap_anno_fn <- function(object) {
# prepare annotation function --------------------------
- matrix <- object@matrix
+ data <- object@data
dots <- object@dots
fn <- object@fun
args <- formals(fn)
@@ -262,7 +274,7 @@ wrap_anno_fn <- function(object) {
# 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))
+ rlang::inject(fn(index, k, n, !!!dots, self = data))
}
} else {
function(index, k, n) {
@@ -290,48 +302,48 @@ methods::setMethod(
id <- sprintf("%s (%s)", object@fun_name, name)
}
# prepare ExtendedAnnotation matrix data ---------------------------
- mat <- object@matrix
+ anno_data <- object@data
if (is.null(heatmap)) {
heat_matrix <- NULL
} else {
heat_matrix <- heatmap@matrix
}
- if (is.null(heat_matrix) && (is.null(mat) || is.function(mat))) {
+ if (is.null(heat_matrix) &&
+ (is.null(anno_data) || is.function(anno_data))) {
cli::cli_abort(paste(
- "You must provide a matrix in", id,
+ "You must provide data (matrix or data.frame) in", id,
"in order to draw {.cls {fclass(object)}} directly"
))
}
- if (is.null(mat)) {
- mat <- switch(which,
+ if (is.null(anno_data)) {
+ anno_data <- switch(which,
row = heat_matrix,
column = t(heat_matrix)
)
- object@n <- nrow(mat)
- } else if (is.function(mat)) {
- data <- switch(which,
+ } else if (is.function(anno_data)) {
+ mat <- switch(which,
row = heat_matrix,
column = t(heat_matrix)
)
- mat <- tryCatch(
- build_matrix(mat(data)),
- function(cnd) {
+ anno_data <- tryCatch(
+ build_anno_data(anno_data(mat)),
+ invalid_class = function(cnd) {
cli::cli_abort(paste(
- "{.fn @matrix} of {id} must return a {.cls matrix},",
+ "{.fn @data} of {id} must return a {.cls matrix},",
"a simple vector, or a {.cls data.frame}."
))
}
)
- if (nrow(mat) != nrow(data)) {
+ if (nrow(anno_data) != nrow(mat)) {
cli::cli_abort(paste(
- "{.fn @matrix} of {id} must a {.cls matrix}",
- "with {nrow(mat)} observation{?s}, but the heatmap",
- "contain {nrow(data)} for {which} annotation."
+ "{.fn @data} of {id} return",
+ "{nrow(anno_data)} observation{?s}, but the heatmap",
+ "contain {nrow(mat)} for {which} annotation."
))
}
- object@n <- nrow(mat)
}
- object@matrix <- mat
+ object@n <- nrow(anno_data)
+ object@data <- anno_data
# call `eheat_prepare` to modify object after make_layout ----------
# for `eheat_prepare`, the actual geom matrix has been added
@@ -413,12 +425,10 @@ methods::setMethod(
}
if (missing(index)) {
if (is.na(object@n)) {
- cli::cli_abort(
- paste(
- "You must provide {.arg index} to draw",
- "{.cls {fclass(object)}} directly"
- )
- )
+ cli::cli_abort(paste(
+ "You must provide {.arg index} to draw",
+ "{.cls {fclass(object)}} directly"
+ ))
}
index <- seq_len(object@n)
}
diff --git a/R/eheat.R b/R/eheat.R
index 0d76c36..51f9525 100644
--- a/R/eheat.R
+++ b/R/eheat.R
@@ -179,7 +179,7 @@
#' @name eheat
eheat <- function(matrix, ...,
legends_margin = list(), legends_panel = list()) {
- matrix <- build_matrix(matrix)
+ matrix <- build_heatmap_matrix(matrix)
out <- ComplexHeatmap::Heatmap(matrix = matrix, ...)
out <- methods::as(out, "ExtendedHeatmap")
out@legends_margin <- legends_margin
diff --git a/R/gganno.R b/R/gganno.R
index cb3cf10..9e024ac 100644
--- a/R/gganno.R
+++ b/R/gganno.R
@@ -11,35 +11,40 @@
#' @section ggfn:
#'
#' `ggfn` accept a ggplot2 object with a default data and mapping created by
-#' `ggplot(data, aes(.data$x))` / `ggplot(data, ggplot2::aes(y = .data$y))`.
-#' The original matrix will be converted into a long-data.frame (`gganno` always
-#' regard row as the observations) with following columns:
+#' `ggplot(data, aes(.data$x))` / `ggplot(data, ggplot2::aes(y = .data$y))`.
+#'
+#' If the original data is a matrix, it'll be reshaped into a long-format
+#' data frame in the `ggplot2` plot data. The final ggplot2 plot data will
+#' contain following columns:
#' - `.slice`: the slice row (which = `"row"`) or column (which = `"column"`)
#' number.
-#' - `.row_names` and `.column_names`: the row and column names of the original
-#' matrix (only applicable when names exist).
-#' - `.row_index` and `.column_index`: the row and column index of the original
-#' matrix.
+#' - `.row_names` and `.row_index`: the row names (only applicable when names
+#' exist) and index of the original data.
+#' - `.column_names` and `.column_index`: the column names (only applicable when
+#' names exist) and index of the original data (`only applicable when
+#' the original data is a matrix`).
#' - `x` / `y`: indicating the x-axis (or y-axis) coordinates. Don't use
#' [coord_flip][ggplot2::coord_flip] to flip coordinates as it may disrupt
#' internal operations.
-#' - `value`: the actual matrix value of the annotation matrix.
+#' - `value`: the actual matrix value of the annotation matrix (`only applicable
+#' when the original data is a matrix`).
#'
#' @inherit ggheat
#' @seealso [eanno]
#' @examples
#' draw(gganno(function(p) {
#' p + geom_point(aes(y = value))
-#' }, matrix = rnorm(10L), height = unit(10, "cm"), width = unit(0.7, "npc")))
+#' }, data = rnorm(10L), height = unit(10, "cm"), width = unit(0.7, "npc")))
#' @return A `ggAnno` object.
#' @export
#' @name gganno
-gganno <- function(ggfn, ..., matrix = NULL,
+gganno <- function(ggfn, ..., data = NULL,
which = NULL, width = NULL, height = NULL) {
out <- eanno(
- draw_fn = ggfn, ..., matrix = matrix,
+ draw_fn = ggfn, ..., data = data, subset_rule = NULL,
which = which, width = width, height = height,
- show_name = FALSE, fun_name = "gganno"
+ show_name = FALSE, fun_name = "gganno",
+ legends_margin = NULL, legends_panel = NULL
)
out <- methods::as(out, "ggAnno")
out
@@ -65,9 +70,9 @@ eheat_prepare.ggAnno <- function(object, ..., viewport, heatmap, name) {
}
which <- object@which
# we always regard matrix row as the observations
- matrix <- object@matrix
+ data <- object@data
if (is.null(heatmap)) {
- order_list <- list(seq_len(nrow(matrix)))
+ order_list <- list(seq_len(nrow(data)))
} else {
order_list <- switch(which,
row = heatmap@row_order_list,
@@ -79,19 +84,25 @@ eheat_prepare.ggAnno <- function(object, ..., viewport, heatmap, name) {
} else {
with_slice <- FALSE
}
- row_nms <- rownames(matrix)
- col_nms <- colnames(matrix)
- data <- as_tibble0(matrix, rownames = NULL) # nolint
- colnames(data) <- seq_len(ncol(data))
- data$.row_index <- seq_len(nrow(data))
- data <- tidyr::pivot_longer(data,
- cols = !".row_index",
- names_to = ".column_index",
- values_to = "value"
- )
- data$.column_index <- as.integer(data$.column_index)
- if (!is.null(row_nms)) data$.row_names <- row_nms[data$.row_index]
- if (!is.null(col_nms)) data$.column_names <- col_nms[data$.column_index]
+ if (is.matrix(data)) {
+ row_nms <- rownames(data)
+ col_nms <- colnames(data)
+ data <- as_tibble0(data, rownames = NULL) # nolint
+ colnames(data) <- seq_len(ncol(data))
+ data$.row_index <- seq_len(nrow(data))
+ data <- tidyr::pivot_longer(data,
+ cols = !".row_index",
+ names_to = ".column_index",
+ values_to = "value"
+ )
+ data$.column_index <- as.integer(data$.column_index)
+ if (!is.null(row_nms)) data$.row_names <- row_nms[data$.row_index]
+ if (!is.null(col_nms)) data$.column_names <- col_nms[data$.column_index]
+ } else {
+ row_nms <- rownames(data)
+ data <- as_tibble0(data, rownames = ".row_names")
+ data$.row_index <- seq_len(nrow(data))
+ }
coords <- data_frame0(
.slice = rep(
@@ -104,7 +115,7 @@ eheat_prepare.ggAnno <- function(object, ..., viewport, heatmap, name) {
data <- merge(coords, data, by = ".row_index", all = FALSE)
nms <- c(
".slice", ".row_names", ".column_names",
- ".row_index", ".column_index", "x", "y", "value"
+ ".row_index", ".column_index", "x", "y"
)
if (which == "row") {
data <- rename(data, c(x = "y"))
@@ -118,9 +129,11 @@ eheat_prepare.ggAnno <- function(object, ..., viewport, heatmap, name) {
} else {
data$y <- reverse_trans(data$y)
}
- p <- ggplot(data[intersect(nms, names(data))], aes(y = .data$y))
+ data <- data[union(intersect(nms, names(data)), names(data))]
+ p <- ggplot(data, aes(y = .data$y))
} else {
- p <- ggplot(data[intersect(nms, names(data))], aes(x = .data$x))
+ data <- data[union(intersect(nms, names(data)), names(data))]
+ p <- ggplot(data, aes(x = .data$x))
}
p <- rlang::inject(object@fun(p, !!!object@dots))
object@dots <- list() # remove dots
diff --git a/R/utils.R b/R/utils.R
index 93f29b1..b9a934a 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -39,22 +39,46 @@ imap <- function(.x, .f, ...) {
compact <- function(.x) .x[lengths(.x) > 0L]
-build_matrix <- function(matrix, arg = rlang::caller_arg(matrix)) {
+build_heatmap_matrix <- function(matrix, arg = rlang::caller_arg(matrix)) {
if (inherits(matrix, "data.frame")) {
- matrix <- as.matrix(matrix)
+ out <- as.matrix(matrix)
} else if (!is.matrix(matrix)) {
if (is.atomic(matrix)) {
cli::cli_alert_info("convert simple vector to one-column matrix")
- matrix <- matrix(matrix, ncol = 1L)
- colnames(matrix) <- "V1"
+ out <- matrix(matrix, ncol = 1L)
+ colnames(out) <- "V1"
+ if (rlang::is_named(matrix)) rownames(out) <- names(matrix)
} else {
cli::cli_abort(paste(
"{.arg {arg}} must be a {.cls matrix},",
"a simple vector, or a {.cls data.frame}."
))
}
+ } else {
+ out <- matrix
}
- matrix
+ out
+}
+
+build_anno_data <- function(data, arg = rlang::caller_arg(data)) {
+ if (inherits(data, "data.frame")) {
+ out <- data
+ } else if (!is.matrix(data)) {
+ if (is.atomic(data)) {
+ cli::cli_alert_info("convert simple vector to one-column matrix")
+ out <- matrix(data, ncol = 1L)
+ colnames(out) <- "V1"
+ if (rlang::is_named(data)) rownames(out) <- names(data)
+ } else {
+ cli::cli_abort(paste(
+ "{.arg {arg}} must be a {.cls matrix},",
+ "a simple vector, or a {.cls data.frame}."
+ ), class = "invalid_class")
+ }
+ } else {
+ out <- data
+ }
+ out
}
pindex <- function(array, ...) {
diff --git a/README.html b/README.html
index d1182c3..724c853 100644
--- a/README.html
+++ b/README.html
@@ -907,348 +907,432 @@ gganno
ggplot2 object with a default data and mapping created by
ggplot(data, aes(.data$x)) (which = "column")
/ ggplot(data, ggplot2::aes(y = .data$y)) (which =
-"row"). The original matrix will be converted into a
-long-data.frame (gganno always regard row as the
-observations) with following columns.
+"row").
+If the original data is a matrix, it’ll be reshaped into a
+long-format data frame in the ggplot2 plot data. The final
+ggplot2 plot data will contain following columns:
-.slice: the slice row (which = "row") or
-column (which = "column") number..row_names and .column_names: the row and
-column names of the original matrix (only applicable when names
-exist)..row_index and .column_index: the row and
-column index of the original matrix.x / y: indicating the x-axis (or y-axis)
-coordinates.value: the actual matrix value of the annotation
-matrix..slice: the slice row (which = "row")
+or column (which = "column") number.
.row_names and .row_index: the row
+names (only applicable when names exist) and index of the original
+data.
.column_names and .column_index: the
+column names (only applicable when names exist) and index of the
+original data
+(only applicable when the original data is a matrix).
x / y: indicating the x-axis (or
+y-axis) coordinates. Don’t use coord_flip to flip
+coordinates as it may disrupt internal operations.
value: the actual matrix value of the annotation
+matrix
+(only applicable when the original data is a matrix).
gganno can be seamlessly combined with both
ggheat and ComplexHeatmap::Heatmap, although
legends will not be extracted in the later case.
-In general, we should just use ggheat and
-gganno.
-anno_data <- sample(1:10, nrow(small_mat))
+If a matrix is provided, it will be reshaped into long-format
+data.frame
+pdf(NULL)
draw(ggheat(small_mat,
top_annotation = HeatmapAnnotation(
foo = gganno(
- matrix = anno_data,
+ data = matrix(1:10, nrow = nrow(small_mat)),
function(p) {
- p + geom_point(aes(x, value))
- }
- ), which = "column"
- )
-))
-#> ℹ convert simple vector to one-column matrix
+ print(head(p$data))
+ p
+ }
+ ), which = "column"
+ )
+))
+#> Warning in matrix(1:10, nrow = nrow(small_mat)): data length [10] is not a
+#> sub-multiple or multiple of the number of rows [9]
+#> .slice .row_index .column_index x value
+#> 1 1 1 1 1 1
+#> 2 1 1 2 1 10
+#> 3 1 2 1 8 2
+#> 4 1 2 2 8 1
+#> 5 1 3 1 6 3
+#> 6 1 3 2 6 2
If a data frame is provided, it will be preserved in its original
+form with additional necessary column added.
+pdf(NULL)
+draw(ggheat(small_mat,
+ top_annotation = HeatmapAnnotation(
+ foo = gganno(
+ data = data.frame(
+ value = seq_len(nrow(small_mat)),
+ letter = sample(letters, nrow(small_mat), replace = TRUE)
+ ),
+ function(p) {
+ print(head(p$data))
+ p
+ }
+ ), which = "column"
+ )
+))
+#> .slice .row_names .row_index x value letter
+#> 1 1 1 1 1 1 w
+#> 2 1 2 2 8 2 r
+#> 3 1 3 3 6 3 l
+#> 4 1 4 4 2 4 r
+#> 5 1 5 5 3 5 g
+#> 6 1 6 6 7 6 z
If provided an atomic vector, it will be converted into a matrix and
+then reshaped into long-format data.frame.
+pdf(NULL)
+draw(ggheat(small_mat,
+ top_annotation = HeatmapAnnotation(
+ foo = gganno(
+ data = sample(1:10, nrow(small_mat)),
+ function(p) {
+ print(head(p$data))
+ p
+ }
+ ), which = "column"
+ )
+))
+#> ℹ convert simple vector to one-column matrix
+#> .slice .column_names .row_index .column_index x value
+#> 1 1 V1 1 1 1 9
+#> 2 1 V1 2 1 8 3
+#> 3 1 V1 3 1 6 1
+#> 4 1 V1 4 1 2 10
+#> 5 1 V1 5 1 3 7
+#> 6 1 V1 6 1 7 6
Similarly, we can leverage the geometric objects (geoms) provided by
+ggplot2 in ggfn to create annotation.
+anno_data <- sample(1:10, nrow(small_mat))
+draw(ggheat(small_mat,
+ top_annotation = HeatmapAnnotation(
+ foo = gganno(
+ data = anno_data,
+ function(p) {
+ p + geom_point(aes(x, value))
+ }
+ ), which = "column"
+ )
+))
+#> ℹ convert simple vector to one-column matrix
Legends will also be extracted, in the similar manner like passing
them into annotation_legend_list argument.
-draw(ggheat(small_mat,
- top_annotation = HeatmapAnnotation(
- foo = gganno(
- matrix = anno_data,
- function(p) {
- p + geom_bar(aes(y = value, fill = factor(.row_index)), stat = "identity")
- }, height = unit(5, "cm")
- ), which = "column"
- )
-), merge_legends = TRUE)
-#> ℹ convert simple vector to one-column matrix
+draw(ggheat(small_mat,
+ top_annotation = HeatmapAnnotation(
+ foo = gganno(
+ data = anno_data,
+ function(p) {
+ p + geom_bar(aes(y = value, fill = factor(.row_index)), stat = "identity")
+ }, height = unit(5, "cm")
+ ), which = "column"
+ )
+), merge_legends = TRUE)
+#> ℹ convert simple vector to one-column matrix
-draw(ggheat(small_mat,
- top_annotation = HeatmapAnnotation(
- foo = gganno(
- matrix = anno_data,
- function(p) {
- p + geom_boxplot(aes(y = value, fill = factor(.slice)))
- }, height = unit(5, "cm")
- ), which = "column"
- ), column_km = 2L
-), merge_legends = TRUE)
-#> ℹ convert simple vector to one-column matrix
+draw(ggheat(small_mat,
+ top_annotation = HeatmapAnnotation(
+ foo = gganno(
+ data = anno_data,
+ function(p) {
+ p + geom_boxplot(aes(y = value, fill = factor(.slice)))
+ }, height = unit(5, "cm")
+ ), which = "column"
+ ), column_km = 2L
+), merge_legends = TRUE)
+#> ℹ convert simple vector to one-column matrix
-box_matrix1 <- matrix(rnorm(ncol(small_mat)^2L, 10), nrow = ncol(small_mat))
-colnames(box_matrix1) <- rep_len("group1", ncol(small_mat))
-box_matrix2 <- matrix(rnorm(ncol(small_mat)^2L, 20), nrow = ncol(small_mat))
-colnames(box_matrix2) <- rep_len("group2", ncol(small_mat))
-draw(ggheat(small_mat,
- top_annotation = HeatmapAnnotation(
- foo = gganno(
- matrix = cbind(box_matrix1, box_matrix2),
- function(p) {
- p +
- geom_violin(
- aes(
- y = value, fill = factor(.column_names),
- color = factor(.slice),
- group = paste(.slice, .row_index, .column_names, sep = "-")
- )
- ) +
- geom_boxplot(
- aes(
- y = value, fill = factor(.column_names),
- color = factor(.slice),
- group = paste(.slice, .row_index, .column_names, sep = "-")
- ),
- width = 0.2,
- position = position_dodge(width = 0.9)
- ) +
- scale_fill_brewer(
- name = "Group", type = "qual", palette = "Set3"
- ) +
- scale_color_brewer(
- name = "Slice", type = "qual", palette = "Set1"
- )
- }, height = unit(3, "cm")
- ), which = "column"
- ), column_km = 2L
-), merge_legends = TRUE)
+box_matrix1 <- matrix(rnorm(ncol(small_mat)^2L, 10), nrow = ncol(small_mat))
+colnames(box_matrix1) <- rep_len("group1", ncol(small_mat))
+box_matrix2 <- matrix(rnorm(ncol(small_mat)^2L, 20), nrow = ncol(small_mat))
+colnames(box_matrix2) <- rep_len("group2", ncol(small_mat))
+draw(ggheat(small_mat,
+ top_annotation = HeatmapAnnotation(
+ foo = gganno(
+ data = cbind(box_matrix1, box_matrix2),
+ function(p) {
+ p +
+ geom_violin(
+ aes(
+ y = value, fill = factor(.column_names),
+ color = factor(.slice),
+ group = paste(.slice, .row_index, .column_names, sep = "-")
+ )
+ ) +
+ geom_boxplot(
+ aes(
+ y = value, fill = factor(.column_names),
+ color = factor(.slice),
+ group = paste(.slice, .row_index, .column_names, sep = "-")
+ ),
+ width = 0.2,
+ position = position_dodge(width = 0.9)
+ ) +
+ scale_fill_brewer(
+ name = "Group", type = "qual", palette = "Set3"
+ ) +
+ scale_color_brewer(
+ name = "Slice", type = "qual", palette = "Set1"
+ )
+ }, height = unit(3, "cm")
+ ), which = "column"
+ ), column_km = 2L
+), merge_legends = TRUE)
-draw(ggheat(small_mat,
- top_annotation = HeatmapAnnotation(
- foo = gganno(
- matrix = anno_data,
- function(p) {
- p + aes(y = value) + geom_text(aes(label = .row_index))
- }, height = unit(2, "cm")
- ), which = "column"
- ),
- bottom_annotation = HeatmapAnnotation(
- foo = gganno(
- function(p) {
- p + aes(y = value) +
- geom_text(aes(label = .row_index)) +
- scale_y_reverse()
- },
- matrix = anno_data,
- which = "column", height = unit(2, "cm")
- ),
- which = "column"
- ),
- right_annotation = HeatmapAnnotation(
- foo = gganno(
- function(p) {
- p + aes(x = value) +
- geom_text(aes(label = .row_index))
- },
- matrix = anno_data,
- width = unit(3, "cm")
- ),
- which = "row"
- ),
- left_annotation = HeatmapAnnotation(
- foo = gganno(
- function(p) {
- p + aes(x = value) +
- geom_text(aes(label = .row_index)) +
- scale_x_reverse()
- },
- matrix = anno_data,
- width = unit(3, "cm")
- ),
- which = "row"
- ),
- row_km = 2L, column_km = 2L,
-), merge_legends = TRUE)
-#> ℹ convert simple vector to one-column matrix
-#> ℹ convert simple vector to one-column matrix
-#> ℹ convert simple vector to one-column matrix
-#> ℹ convert simple vector to one-column matrix
+draw(ggheat(small_mat,
+ top_annotation = HeatmapAnnotation(
+ foo = gganno(
+ data = anno_data,
+ function(p) {
+ p + aes(y = value) + geom_text(aes(label = .row_index))
+ }, height = unit(2, "cm")
+ ), which = "column"
+ ),
+ bottom_annotation = HeatmapAnnotation(
+ foo = gganno(
+ function(p) {
+ p + aes(y = value) +
+ geom_text(aes(label = .row_index)) +
+ scale_y_reverse()
+ },
+ data = anno_data,
+ which = "column", height = unit(2, "cm")
+ ),
+ which = "column"
+ ),
+ right_annotation = HeatmapAnnotation(
+ foo = gganno(
+ function(p) {
+ p + aes(x = value) +
+ geom_text(aes(label = .row_index))
+ },
+ data = anno_data,
+ width = unit(3, "cm")
+ ),
+ which = "row"
+ ),
+ left_annotation = HeatmapAnnotation(
+ foo = gganno(
+ function(p) {
+ p + aes(x = value) +
+ geom_text(aes(label = .row_index)) +
+ scale_x_reverse()
+ },
+ data = anno_data,
+ width = unit(3, "cm")
+ ),
+ which = "row"
+ ),
+ row_km = 2L, column_km = 2L,
+), merge_legends = TRUE)
+#> ℹ convert simple vector to one-column matrix
+#> ℹ convert simple vector to one-column matrix
+#> ℹ convert simple vector to one-column matrix
+#> ℹ convert simple vector to one-column matrix
gganno can work with Heatmap function, in
-this way, legends won’t be extracted.
-draw(Heatmap(small_mat,
- top_annotation = HeatmapAnnotation(
- foo = gganno(
- matrix = anno_data,
- function(p) {
- p + geom_bar(aes(y = value, fill = factor(.row_index)), stat = "identity")
- }
- ), which = "column"
- )
-), merge_legends = TRUE)
-#> ℹ convert simple vector to one-column matrix
+this way, legends won’t be extracted. In general, we should just use
+ggheat and gganno.
+draw(Heatmap(small_mat,
+ top_annotation = HeatmapAnnotation(
+ foo = gganno(
+ data = anno_data,
+ function(p) {
+ p + geom_bar(aes(y = value, fill = factor(.row_index)), stat = "identity")
+ }
+ ), which = "column"
+ )
+), merge_legends = TRUE)
+#> ℹ convert simple vector to one-column matrix
anno_gg and
anno_gg2
Both function acts similar with other annotation function in
ComplexHeatmap. They accept a ggplot object and fit it in the
ComplexHeatmap annotation area.
-g <- ggplot(mpg, aes(displ, hwy, colour = class)) +
- geom_point()
-m <- matrix(rnorm(100), 10)
-
-# anno_gg-panel: clip = "off" -------
-ggheat(m,
- top_annotation = HeatmapAnnotation(
- ggplot = anno_gg(g, "panel",
- clip = "off",
- height = unit(3, "cm"),
- show_name = FALSE
- )
- )
-)
+g <- ggplot(mpg, aes(displ, hwy, colour = class)) +
+ geom_point()
+m <- matrix(rnorm(100), 10)
+
+# anno_gg-panel: clip = "off" -------
+ggheat(m,
+ top_annotation = HeatmapAnnotation(
+ ggplot = anno_gg(g, "panel",
+ clip = "off",
+ height = unit(3, "cm"),
+ show_name = FALSE
+ )
+ )
+)
-# anno_gg-panel: clip = "on" --------
-ggheat(m,
- top_annotation = HeatmapAnnotation(
- ggplot = anno_gg(g, "panel",
- clip = "on",
- height = unit(3, "cm"),
- show_name = FALSE
- )
- )
-)
+# anno_gg-panel: clip = "on" --------
+ggheat(m,
+ top_annotation = HeatmapAnnotation(
+ ggplot = anno_gg(g, "panel",
+ clip = "on",
+ height = unit(3, "cm"),
+ show_name = FALSE
+ )
+ )
+)
-# anno_gg-plot --------------------
-ggheat(m,
- top_annotation = HeatmapAnnotation(
- ggplot = anno_gg(g, "plot",
- height = unit(3, "cm"),
- show_name = FALSE
- )
- )
-)
+# anno_gg-plot --------------------
+ggheat(m,
+ top_annotation = HeatmapAnnotation(
+ ggplot = anno_gg(g, "plot",
+ height = unit(3, "cm"),
+ show_name = FALSE
+ )
+ )
+)
-
-# anno_gg-full --------------------
-ggheat(m,
- top_annotation = HeatmapAnnotation(
- ggplot = anno_gg(g, "full",
- height = unit(3, "cm"),
- show_name = FALSE
- )
- )
-)
+
+# anno_gg-full --------------------
+ggheat(m,
+ top_annotation = HeatmapAnnotation(
+ ggplot = anno_gg(g, "full",
+ height = unit(3, "cm"),
+ show_name = FALSE
+ )
+ )
+)
anno_gg2 is the same with anno_gg, it
differs in terms of its arguments, and allow more precise adjustment of
the clip feature.
-# anno_gg2-panel: margins = NULL -------
-ggheat(m,
- top_annotation = HeatmapAnnotation(
- ggplot = anno_gg2(g, "panel",
- margins = NULL,
- height = unit(3, "cm"),
- show_name = FALSE
- )
- )
-)
+# anno_gg2-panel: margins = NULL -------
+ggheat(m,
+ top_annotation = HeatmapAnnotation(
+ ggplot = anno_gg2(g, "panel",
+ margins = NULL,
+ height = unit(3, "cm"),
+ show_name = FALSE
+ )
+ )
+)
-# anno_gg2-panel: margins = "l" --------
-ggheat(m,
- top_annotation = HeatmapAnnotation(
- ggplot = anno_gg2(g, "panel",
- margins = "l",
- height = unit(3, "cm"),
- show_name = FALSE
- )
- )
-)
+# anno_gg2-panel: margins = "l" --------
+ggheat(m,
+ top_annotation = HeatmapAnnotation(
+ ggplot = anno_gg2(g, "panel",
+ margins = "l",
+ height = unit(3, "cm"),
+ show_name = FALSE
+ )
+ )
+)
-# anno_gg2-panel: margins = "r" --------
-ggheat(m,
- top_annotation = HeatmapAnnotation(
- ggplot = anno_gg2(g, "panel",
- margins = "r",
- height = unit(3, "cm"),
- show_name = FALSE
- )
- )
-)
+# anno_gg2-panel: margins = "r" --------
+ggheat(m,
+ top_annotation = HeatmapAnnotation(
+ ggplot = anno_gg2(g, "panel",
+ margins = "r",
+ height = unit(3, "cm"),
+ show_name = FALSE
+ )
+ )
+)
-# anno_gg2-plot ---------------------
-ggheat(m,
- top_annotation = HeatmapAnnotation(
- ggplot = anno_gg2(g, "plot",
- height = unit(3, "cm"),
- show_name = FALSE
- )
- )
-)
+# anno_gg2-plot ---------------------
+ggheat(m,
+ top_annotation = HeatmapAnnotation(
+ ggplot = anno_gg2(g, "plot",
+ height = unit(3, "cm"),
+ show_name = FALSE
+ )
+ )
+)
-# anno_gg2-full --------------------
-ggheat(m,
- top_annotation = HeatmapAnnotation(
- ggplot = anno_gg2(
- g + guides(colour = guide_legend(
- theme = theme(
- legend.key.size = unit(1, "mm"),
- legend.text = element_text(size = 10),
- legend.key.spacing = unit(0, "mm"),
- legend.title.position = "bottom",
- legend.key = element_blank()
- ),
- ncol = 2L
- )),
- align_with = "full",
- height = unit(3, "cm"),
- show_name = FALSE
- )
- )
-)
+# anno_gg2-full --------------------
+ggheat(m,
+ top_annotation = HeatmapAnnotation(
+ ggplot = anno_gg2(
+ g + guides(colour = guide_legend(
+ theme = theme(
+ legend.key.size = unit(1, "mm"),
+ legend.text = element_text(size = 10),
+ legend.key.spacing = unit(0, "mm"),
+ legend.title.position = "bottom",
+ legend.key = element_blank()
+ ),
+ ncol = 2L
+ )),
+ align_with = "full",
+ height = unit(3, "cm"),
+ show_name = FALSE
+ )
+ )
+)
-sessionInfo()
-#> R version 4.4.0 (2024-04-24)
-#> Platform: x86_64-pc-linux-gnu
-#> Running under: Ubuntu 24.04 LTS
-#>
-#> Matrix products: default
-#> BLAS/LAPACK: /usr/lib/x86_64-linux-gnu/libmkl_rt.so; LAPACK version 3.8.0
-#>
-#> locale:
-#> [1] LC_CTYPE=C.UTF-8 LC_NUMERIC=C LC_TIME=C.UTF-8
-#> [4] LC_COLLATE=C.UTF-8 LC_MONETARY=C.UTF-8 LC_MESSAGES=C.UTF-8
-#> [7] LC_PAPER=C.UTF-8 LC_NAME=C LC_ADDRESS=C
-#> [10] LC_TELEPHONE=C LC_MEASUREMENT=C.UTF-8 LC_IDENTIFICATION=C
-#>
-#> time zone: Asia/Shanghai
-#> tzcode source: system (glibc)
-#>
-#> attached base packages:
-#> [1] grid stats graphics grDevices utils datasets methods
-#> [8] base
-#>
-#> other attached packages:
-#> [1] eheat_0.99.7 ggplot2_3.5.1 ComplexHeatmap_2.20.0
-#>
-#> loaded via a namespace (and not attached):
-#> [1] utf8_1.2.4 generics_0.1.3 tidyr_1.3.1
-#> [4] shape_1.4.6.1 digest_0.6.36 magrittr_2.0.3
-#> [7] evaluate_0.24.0 RColorBrewer_1.1-3 iterators_1.0.14
-#> [10] circlize_0.4.16 fastmap_1.2.0 foreach_1.5.2
-#> [13] doParallel_1.0.17 GlobalOptions_0.1.2 purrr_1.0.2
-#> [16] fansi_1.0.6 viridisLite_0.4.2 scales_1.3.0
-#> [19] codetools_0.2-20 cli_3.6.3 rlang_1.1.4
-#> [22] crayon_1.5.3 munsell_0.5.1 withr_3.0.0
-#> [25] yaml_2.3.8 ggh4x_0.2.8 tools_4.4.0
-#> [28] parallel_4.4.0 dplyr_1.1.4 colorspace_2.1-0
-#> [31] GetoptLong_1.0.5 BiocGenerics_0.50.0 vctrs_0.6.5
-#> [34] R6_2.5.1 png_0.1-8 matrixStats_1.3.0
-#> [37] stats4_4.4.0 lifecycle_1.0.4 magick_2.8.3
-#> [40] S4Vectors_0.42.0 IRanges_2.38.0 clue_0.3-65
-#> [43] cluster_2.1.6 pkgconfig_2.0.3 pillar_1.9.0
-#> [46] gtable_0.3.5 glue_1.7.0 Rcpp_1.0.12
-#> [49] highr_0.11 xfun_0.45 tibble_3.2.1
-#> [52] tidyselect_1.2.1 knitr_1.47 farver_2.1.2
-#> [55] rjson_0.2.21 htmltools_0.5.8.1 labeling_0.4.3
-#> [58] rmarkdown_2.27 Cairo_1.6-2 compiler_4.4.0
sessionInfo()
+#> R version 4.4.0 (2024-04-24)
+#> Platform: x86_64-pc-linux-gnu
+#> Running under: Ubuntu 24.04 LTS
+#>
+#> Matrix products: default
+#> BLAS/LAPACK: /usr/lib/x86_64-linux-gnu/libmkl_rt.so; LAPACK version 3.8.0
+#>
+#> locale:
+#> [1] LC_CTYPE=C.UTF-8 LC_NUMERIC=C LC_TIME=C.UTF-8
+#> [4] LC_COLLATE=C.UTF-8 LC_MONETARY=C.UTF-8 LC_MESSAGES=C.UTF-8
+#> [7] LC_PAPER=C.UTF-8 LC_NAME=C LC_ADDRESS=C
+#> [10] LC_TELEPHONE=C LC_MEASUREMENT=C.UTF-8 LC_IDENTIFICATION=C
+#>
+#> time zone: Asia/Shanghai
+#> tzcode source: system (glibc)
+#>
+#> attached base packages:
+#> [1] grid stats graphics grDevices utils datasets methods
+#> [8] base
+#>
+#> other attached packages:
+#> [1] eheat_0.99.7 ggplot2_3.5.1 ComplexHeatmap_2.20.0
+#>
+#> loaded via a namespace (and not attached):
+#> [1] utf8_1.2.4 generics_0.1.3 tidyr_1.3.1
+#> [4] shape_1.4.6.1 digest_0.6.36 magrittr_2.0.3
+#> [7] evaluate_0.24.0 RColorBrewer_1.1-3 iterators_1.0.14
+#> [10] circlize_0.4.16 fastmap_1.2.0 foreach_1.5.2
+#> [13] doParallel_1.0.17 GlobalOptions_0.1.2 purrr_1.0.2
+#> [16] fansi_1.0.6 viridisLite_0.4.2 scales_1.3.0
+#> [19] codetools_0.2-20 cli_3.6.3 rlang_1.1.4
+#> [22] crayon_1.5.3 munsell_0.5.1 withr_3.0.0
+#> [25] yaml_2.3.8 ggh4x_0.2.8 tools_4.4.0
+#> [28] parallel_4.4.0 dplyr_1.1.4 colorspace_2.1-0
+#> [31] GetoptLong_1.0.5 BiocGenerics_0.50.0 vctrs_0.6.5
+#> [34] R6_2.5.1 png_0.1-8 matrixStats_1.3.0
+#> [37] stats4_4.4.0 lifecycle_1.0.4 magick_2.8.3
+#> [40] S4Vectors_0.42.0 IRanges_2.38.0 clue_0.3-65
+#> [43] cluster_2.1.6 pkgconfig_2.0.3 pillar_1.9.0
+#> [46] gtable_0.3.5 glue_1.7.0 Rcpp_1.0.12
+#> [49] highr_0.11 xfun_0.45 tibble_3.2.1
+#> [52] tidyselect_1.2.1 knitr_1.47 farver_2.1.2
+#> [55] rjson_0.2.21 htmltools_0.5.8.1 labeling_0.4.3
+#> [58] rmarkdown_2.27 Cairo_1.6-2 compiler_4.4.0