eanno: collapse width and height into size argument

Yunuuuu · Jul 11, 2024 · ad94452 · ad94452
1 parent e38e681
commit ad94452
Show file tree

Hide file tree

Showing 11 changed files with 165 additions and 133 deletions.
diff --git a/R/anno-gg.R b/R/anno-gg.R
@@ -13,7 +13,7 @@
 #'     top_annotation = eheat_anno(
 #'         ggplot = anno_gg(g, "panel",
 #'             clip = "off",
-#'             height = unit(6, "cm"),
+#'             size = unit(6, "cm"),
 #'             show_name = FALSE
 #'         )
 #'     )
@@ -24,7 +24,7 @@
 #'     top_annotation = eheat_anno(
 #'         ggplot = anno_gg(g, "panel",
 #'             clip = "on",
-#'             height = unit(6, "cm"),
+#'             size = unit(6, "cm"),
 #'             show_name = FALSE
 #'         )
 #'     )
@@ -34,7 +34,7 @@
 #' ggheat(m,
 #'     top_annotation = eheat_anno(
 #'         ggplot = anno_gg(g, "plot",
-#'             height = unit(6, "cm"),
+#'             size = unit(6, "cm"),
 #'             show_name = FALSE
 #'         )
 #'     )
@@ -44,15 +44,14 @@
 #' ggheat(m,
 #'     top_annotation = eheat_anno(
 #'         ggplot = anno_gg(g, "full",
-#'             height = unit(6, "cm"),
+#'             size = unit(6, "cm"),
 #'             show_name = FALSE
 #'         )
 #'     )
 #' )
 #' @export
 anno_gg <- function(gg, align_with = "full", clip = NULL, gt = NULL,
-                    width = NULL, height = NULL, show_name = FALSE,
-                    which = NULL) {
+                    size = NULL, show_name = FALSE, which = NULL) {
     if (is.null(gt)) {
         assert_s3_class(gg, "ggplot")
         gt <- ggplot2::ggplotGrob(gg)
@@ -67,7 +66,7 @@ anno_gg <- function(gg, align_with = "full", clip = NULL, gt = NULL,
             margins <- setup_margins(clip, vp)
             .ggfit(gt, align_with, margins)
         },
-        which = which, width = width, height = height,
+        which = which, size = size,
         show_name = show_name, fun_name = "anno_gg"
     )
 }
@@ -78,7 +77,7 @@ anno_gg <- function(gg, align_with = "full", clip = NULL, gt = NULL,
 #'     top_annotation = eheat_anno(
 #'         ggplot = anno_gg2(g, "panel",
 #'             margins = NULL,
-#'             height = unit(6, "cm"),
+#'             size = unit(6, "cm"),
 #'             show_name = FALSE
 #'         )
 #'     )
@@ -89,7 +88,7 @@ anno_gg <- function(gg, align_with = "full", clip = NULL, gt = NULL,
 #'     top_annotation = eheat_anno(
 #'         ggplot = anno_gg2(g, "panel",
 #'             margins = "l",
-#'             height = unit(6, "cm"),
+#'             size = unit(6, "cm"),
 #'             show_name = FALSE
 #'         )
 #'     )
@@ -100,7 +99,7 @@ anno_gg <- function(gg, align_with = "full", clip = NULL, gt = NULL,
 #'     top_annotation = eheat_anno(
 #'         ggplot = anno_gg2(g, "panel",
 #'             margins = "r",
-#'             height = unit(6, "cm"),
+#'             size = unit(6, "cm"),
 #'             show_name = FALSE
 #'         )
 #'     )
@@ -110,7 +109,7 @@ anno_gg <- function(gg, align_with = "full", clip = NULL, gt = NULL,
 #' ggheat(m,
 #'     top_annotation = eheat_anno(
 #'         ggplot = anno_gg2(g, "plot",
-#'             height = unit(6, "cm"),
+#'             size = unit(6, "cm"),
 #'             show_name = FALSE
 #'         )
 #'     )
@@ -120,7 +119,7 @@ anno_gg <- function(gg, align_with = "full", clip = NULL, gt = NULL,
 #' ggheat(m,
 #'     top_annotation = eheat_anno(
 #'         ggplot = anno_gg2(g, "full",
-#'             height = unit(6, "cm"),
+#'             size = unit(6, "cm"),
 #'             show_name = FALSE
 #'         )
 #'     )
@@ -133,8 +132,7 @@ anno_gg2 <- function(gg, align_with = "full",
                          "axis", "lab", "guide",
                          "subtitle", "title", "caption"
                      ),
-                     gt = NULL,
-                     width = NULL, height = NULL, show_name = FALSE,
+                     gt = NULL, size = NULL, show_name = FALSE,
                      which = NULL) {
     if (is.null(gt)) {
         assert_s3_class(gg, "ggplot")
@@ -150,7 +148,7 @@ anno_gg2 <- function(gg, align_with = "full",
         function(index, k, n) {
             .ggfit(gt, align_with, margins, elements)
         },
-        which = which, width = width, height = height,
+        which = which, size = size,
         show_name = show_name, fun_name = "anno_gg2"
     )
 }
diff --git a/R/eanno.R b/R/eanno.R
@@ -25,6 +25,20 @@
 #' @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.
+#' @param size The `width/height` of the plotting region (the viewport) that the
+#' annotation is drawn. If it is a `row` annotation, `size` is regarded as the
+#' `width`, otherwise, the `height`. `size` must be an absolute
+#' [unit][grid::unit] object.  Since the
+#' [AnnotationFunction][ComplexHeatmap::AnnotationFunction-class] object is
+#' always contained by the
+#' [SingleAnnotation-class][ComplexHeatmap::SingleAnnotation-class] object, you
+#' can only set the `width` of row annotations or `height` of column
+#' annotations, while e.g. the `height` of the row annotation and `width` of the
+#' column annotations is always `unit(1, "npc")` which means it always fully
+#' filled in the parent `SingleAnnotation` and only in
+#' [SingleAnnotation][ComplexHeatmap::SingleAnnotation] or even
+#' [HeatmapAnnotation][ComplexHeatmap::HeatmapAnnotation] can adjust the
+#' `height` of the row annotations or `width` of the column annotations.
 #' @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.
@@ -54,7 +68,7 @@
 #'         if (k == 1) grid.yaxis()
 #'         popViewport()
 #'     },
-#'     height = unit(2, "cm")
+#'     size = unit(2, "cm")
 #' )
 #' m <- rbind(1:10, 11:20)
 #' eheat(m, top_annotation = eheat_anno(foo = anno))
@@ -70,15 +84,16 @@
 #'         popViewport()
 #'     },
 #'     data = rnorm(10L), subset_rule = TRUE,
-#'     height = unit(2, "cm")
+#'     size = unit(2, "cm")
 #' )
 #' draw(anno)
 #' draw(anno[1:2])
 #' @seealso [AnnotationFunction][ComplexHeatmap::AnnotationFunction]
 #' @return A `ExtendedAnnotation` object.
 #' @export
-eanno <- function(draw_fn, ..., data = NULL, which = NULL, subset_rule = NULL,
-                  width = NULL, height = NULL, show_name = TRUE,
+eanno <- function(draw_fn, ..., data = NULL,
+                  size = NULL, show_name = TRUE, which = NULL,
+                  subset_rule = NULL,
                   legends_margin = NULL, legends_panel = NULL,
                   fun_name = NULL) {
     if (ht_opt$verbose) {
@@ -149,9 +164,9 @@ eanno <- function(draw_fn, ..., data = NULL, which = NULL, subset_rule = NULL,
     anno@which <- which
     anno@fun <- unclass(draw_fn)
     anno@fun_name <- fun_name %||% "eanno"
-    anno_size <- anno_width_and_height(which, width, height, unit(1, "cm"))
-    anno@width <- anno_size$width
-    anno@height <- anno_size$height
+    anno_size <- anno_width_and_height(which, size, unit(1, "cm"))
+    anno@width <- .subset2(anno_size, "width")
+    anno@height <- .subset2(anno_size, "height")
     anno@show_name <- show_name
     anno@n <- n
     anno@data_scale <- c(0L, 1L)
@@ -466,27 +481,15 @@ methods::setMethod(
     }
 )
 
-anno_width_and_height <- function(which, width = NULL, height = NULL,
+anno_width_and_height <- function(which, size = NULL,
                                   default = unit(10, "mm")) {
-    params <- list(width = width, height = height)
+    size <- size %||% default
+    if (!ComplexHeatmap::is_abs_unit(size)) {
+        cli::cli_abort("{.arg size} must be an absolute unit.", )
+    }
     if (which == "row") {
-        # we flip the width and height in this way, both row and column
-        # annotation, height must be absolute unit
-        params <- flip_gp(params)
-        arg <- "width" # nolint
+        list(width = size, height = unit(1L, "npc"))
     } else {
-        arg <- "height"
-    }
-    if (is.null(.subset2(params, "height"))) {
-        params$height <- default
-    } else if (!ComplexHeatmap::is_abs_unit(.subset2(params, "height"))) {
-        cli::cli_abort(paste(
-            "{.arg {arg}} of the {.field {which}} annotation",
-            "must be an absolute unit."
-        ))
-    }
-    if (is.null(.subset2(params, "width"))) {
-        params$width <- unit(1L, "npc")
+        list(width = unit(1L, "npc"), height = size)
     }
-    if (which == "row") flip_gp(params) else params
 }
diff --git a/R/eheat_anno.R b/R/eheat_anno.R
@@ -10,22 +10,23 @@
 #'
 #' @param ... Additional arguments passed to
 #' [HeatmapAnnotation][ComplexHeatmap::HeatmapAnnotation].
-#' @param annotation_size Height/width of each annotation for column/row
+#' @param annotation_size `Height/width` of each annotation for column/row
+#' annotation.
+#' @param size `Height/width` of the whole annotations for column/row
 #' annotation.
-#' @param size Height/width of the whole annotations for column/row annotation.
 #' @param which A string of `"row"` or `"column"`.
 #' @return A [HeatmapAnnotation][ComplexHeatmap::HeatmapAnnotation-class]
 #' object.
 #' @examples
-#' # No need to specify which argument if combine with `ggheat` or `eheat`
+#' # No need to specify `which` argument if combined with `ggheat` or `eheat`
 #' g <- ggplot(mpg, aes(displ, hwy, colour = class)) +
 #'     geom_point()
 #' m <- matrix(rnorm(100), 10)
 #' ggheat(m,
 #'     top_annotation = eheat_anno(
 #'         ggplot = anno_gg(g, "panel",
 #'             clip = "on",
-#'             height = unit(6, "cm"),
+#'             size = unit(6, "cm"),
 #'             show_name = FALSE
 #'         )
 #'     )

diff --git a/R/gganno.R b/R/gganno.R
@@ -34,16 +34,15 @@
 #' @examples
 #' draw(gganno(function(p) {
 #'     p + geom_point(aes(y = value))
-#' }, data = rnorm(10L), height = unit(10, "cm"), width = unit(0.7, "npc")))
+#' }, data = rnorm(10L), size = unit(10, "cm")))
 #' @return A `ggAnno` object.
 #' @export
 #' @name gganno
-gganno <- function(ggfn, ..., data = NULL,
-                   which = NULL, width = NULL, height = NULL) {
+gganno <- function(ggfn, ..., data = NULL, size = NULL, which = NULL) {
     if (missing(ggfn)) ggfn <- ~.x
     out <- eanno(
         draw_fn = ggfn, ..., data = data, subset_rule = NULL,
-        which = which, width = width, height = height,
+        size = size, which = which,
         show_name = FALSE, fun_name = "gganno",
         legends_margin = NULL, legends_panel = NULL
     )