From 154358b66f57354ea56df2562cbe1fd841c13610 Mon Sep 17 00:00:00 2001 From: Yunuuuu Date: Sun, 22 Sep 2024 20:22:05 +0800 Subject: [PATCH] add function `layout_theme()` and `layout_annotation()` --- NAMESPACE | 31 ++- R/activate.R | 10 +- R/align-.R | 4 +- R/alignpatch-align_plots.R | 87 ++++++-- R/alignpatch-alignpatches.R | 2 +- R/alignpatch-build.R | 17 +- R/layout-.R | 68 ++++-- R/layout-heatmap-.R | 65 +++--- R/layout-heatmap-add.R | 5 +- R/layout-heatmap-build.R | 6 +- R/layout-stack-.R | 34 +-- R/layout-stack-add.R | 3 - R/layout-stack-build.R | 6 +- R/utils-rd.R | 6 +- README.Rmd | 20 +- README.html | 22 +- README.md | 20 +- _pkgdown.yml | 16 +- man/align.Rd | 4 +- man/align_dendro.Rd | 4 +- man/align_gg.Rd | 4 +- man/align_kmeans.Rd | 4 +- man/align_reorder.Rd | 4 +- man/ggalign_stat.Rd | 2 +- man/{layout_heatmap.Rd => heatmap_layout.Rd} | 18 +- man/hmanno.Rd | 2 +- man/layout-add.Rd | 2 +- man/layout-operator.Rd | 11 +- man/layout_annotation.Rd | 23 ++ man/layout_theme.Rd | 208 ++++++++++++++++++ man/show-Layout-method.Rd | 2 +- man/stack_active.Rd | 6 +- man/{layout_stack.Rd => stack_layout.Rd} | 8 +- pkgdown/favicon/apple-touch-icon-120x120.png | Bin 0 -> 15566 bytes pkgdown/favicon/apple-touch-icon-152x152.png | Bin 0 -> 21678 bytes pkgdown/favicon/apple-touch-icon-180x180.png | Bin 0 -> 27122 bytes pkgdown/favicon/apple-touch-icon-60x60.png | Bin 0 -> 6041 bytes pkgdown/favicon/apple-touch-icon-76x76.png | Bin 0 -> 8045 bytes pkgdown/favicon/apple-touch-icon.png | Bin 0 -> 27122 bytes pkgdown/favicon/favicon-16x16.png | Bin 0 -> 1337 bytes pkgdown/favicon/favicon-32x32.png | Bin 0 -> 2537 bytes pkgdown/favicon/favicon.ico | Bin 0 -> 15086 bytes tests/testthat/test-layout_heatmap.R | 21 +- ...{layout-heatmap.Rmd => heatmap-layout.Rmd} | 6 +- ...{align-layout.Rmd => layout-customize.Rmd} | 0 vignettes/{align-plot.Rmd => layout-plot.Rmd} | 0 .../{layout-stack.Rmd => stack-layout.Rmd} | 6 +- 47 files changed, 561 insertions(+), 196 deletions(-) rename man/{layout_heatmap.Rd => heatmap_layout.Rd} (85%) create mode 100644 man/layout_annotation.Rd create mode 100644 man/layout_theme.Rd rename man/{layout_stack.Rd => stack_layout.Rd} (80%) create mode 100644 pkgdown/favicon/apple-touch-icon-120x120.png create mode 100644 pkgdown/favicon/apple-touch-icon-152x152.png create mode 100644 pkgdown/favicon/apple-touch-icon-180x180.png create mode 100644 pkgdown/favicon/apple-touch-icon-60x60.png create mode 100644 pkgdown/favicon/apple-touch-icon-76x76.png create mode 100644 pkgdown/favicon/apple-touch-icon.png create mode 100644 pkgdown/favicon/favicon-16x16.png create mode 100644 pkgdown/favicon/favicon-32x32.png create mode 100644 pkgdown/favicon/favicon.ico rename vignettes/{layout-heatmap.Rmd => heatmap-layout.Rmd} (97%) rename vignettes/{align-layout.Rmd => layout-customize.Rmd} (100%) rename vignettes/{align-plot.Rmd => layout-plot.Rmd} (100%) rename vignettes/{layout-stack.Rmd => stack-layout.Rmd} (93%) diff --git a/NAMESPACE b/NAMESPACE index a5b0da2b..b1be8fda 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -35,7 +35,6 @@ S3method(alignpatch,spacer) S3method(alignpatch,trellis) S3method(alignpatch,wrapped_patch) S3method(alignpatch,wrapped_plot) -S3method(as.list,alignpatches) S3method(as_areas,"NULL") S3method(as_areas,align_area) S3method(as_areas,character) @@ -90,16 +89,15 @@ S3method(grid.draw,patch_ggplot) S3method(heatmap_add,facetted_pos_scales) S3method(heatmap_add,gg) S3method(heatmap_add,labels) +S3method(heatmap_layout,"NULL") +S3method(heatmap_layout,default) +S3method(heatmap_layout,formula) +S3method(heatmap_layout,functon) +S3method(heatmap_layout,matrix) S3method(layout_add,HeatmapLayout) S3method(layout_add,StackLayout) S3method(layout_and_add,HeatmapLayout) S3method(layout_and_add,StackLayout) -S3method(layout_heatmap,"NULL") -S3method(layout_heatmap,default) -S3method(layout_heatmap,formula) -S3method(layout_heatmap,functon) -S3method(layout_heatmap,matrix) -S3method(layout_heatmap_add,"NULL") S3method(layout_heatmap_add,Align) S3method(layout_heatmap_add,data.frame) S3method(layout_heatmap_add,default) @@ -120,13 +118,6 @@ S3method(layout_heatmap_subtract,facetted_pos_scales) S3method(layout_heatmap_subtract,gg) S3method(layout_heatmap_subtract,ggplot) S3method(layout_heatmap_subtract,labels) -S3method(layout_stack,"NULL") -S3method(layout_stack,character) -S3method(layout_stack,data.frame) -S3method(layout_stack,default) -S3method(layout_stack,matrix) -S3method(layout_stack,numeric) -S3method(layout_stack_add,"NULL") S3method(layout_stack_add,Align) S3method(layout_stack_add,HeatmapLayout) S3method(layout_stack_add,default) @@ -180,6 +171,12 @@ S3method(set_context,HeatmapLayout) S3method(set_context,StackLayout) S3method(set_layout,HeatmapLayout) S3method(set_layout,StackLayout) +S3method(stack_layout,"NULL") +S3method(stack_layout,character) +S3method(stack_layout,data.frame) +S3method(stack_layout,default) +S3method(stack_layout,matrix) +S3method(stack_layout,numeric) export(Align) export(GeomDraw) export(align) @@ -207,16 +204,18 @@ export(ggpanel) export(ggstack) export(gpar) export(hclust2) +export(heatmap_layout) export(hmanno) export(inset) export(is.ggheatmap) export(is.ggstack) -export(layout_heatmap) -export(layout_stack) +export(layout_annotation) +export(layout_theme) export(patch) export(patch_titles) export(read_example) export(stack_active) +export(stack_layout) export(unit) export(wrap) exportMethods("$") diff --git a/R/activate.R b/R/activate.R index 212851ed..203825d7 100644 --- a/R/activate.R +++ b/R/activate.R @@ -29,11 +29,11 @@ #' Used to modify the data after layout has been created, but before the data is #' handled of to the ggplot2 for rendering. Use this hook if the you needs #' change the default data for all `geoms`. -#' @param theme `r rd_theme()` Only used when position is `NULL`. +#' @param theme `r rd_layout_theme()` Only used when position is `NULL`. #' @param what What should get activated for the anntoation stack? Only used #' when position is not `NULL`. See [stack_active] for details. #' @return A `heatmap_active` object which can be added into -#' [HeatmapLayout][layout_heatmap]. +#' [HeatmapLayout][heatmap_layout]. #' @examples #' ggheatmap(matrix(rnorm(81), nrow = 9)) + #' hmanno("top") + @@ -86,11 +86,11 @@ hmanno <- function(position = NULL, size = NULL, width = NULL, height = NULL, #' Usually you are waive to use this, since the adding procedure can be #' easily changed. #' * `NULL`: Remove any active context, this is useful when the active -#' context is a [layout_heatmap()] object, where any `Align` objects will +#' context is a [heatmap_layout()] object, where any `Align` objects will #' be added into the heatmap. By removing the active context, we can add -#' `Align` object into the [layout_stack()] . +#' `Align` object into the [stack_layout()] . #' @return A `stack_active` object which can be added into -#' [StackLayout][layout_stack]. +#' [StackLayout][stack_layout]. #' @examples #' ggstack(matrix(1:9, nrow = 3L)) + #' ggheatmap() + diff --git a/R/align-.R b/R/align-.R index ac9a8042..deae6b33 100644 --- a/R/align-.R +++ b/R/align-.R @@ -14,12 +14,12 @@ #' the observations. It means the `NROW(data)` must return the same number with #' the parallel `layout` axis. #' -#' - `layout_heatmap`: for column annotation, the `layout` data will be +#' - `heatmap_layout`: for column annotation, the `layout` data will be #' transposed before using (If data is a `function`, it will be applied with #' the transposed matrix). This is necessary because column annotation uses #' heatmap columns as observations, but we need rows. #' -#' - `layout_stack`: the `layout` data will be used as it is since we place all +#' - `stack_layout`: the `layout` data will be used as it is since we place all #' plots along a single axis. #' #' @param size Plot size, can be an [unit][grid::unit] object. diff --git a/R/alignpatch-align_plots.R b/R/alignpatch-align_plots.R index 31d45193..d2de48a4 100644 --- a/R/alignpatch-align_plots.R +++ b/R/alignpatch-align_plots.R @@ -17,7 +17,7 @@ #' @param guides Which guide should be collected? A string containing one or #' more of `r rd_values(.tlbr)`. #' @inheritParams ggplot2::labs -#' @param theme `r rd_theme()` +#' @param theme `r rd_layout_theme()` #' @return A `alignpatches` object. #' @examples #' # directly copied from patchwork @@ -52,11 +52,6 @@ align_plots <- function(..., ncol = NULL, nrow = NULL, byrow = TRUE, title = NULL, subtitle = NULL, caption = NULL, theme = NULL) { plots <- rlang::dots_list(..., .ignore_empty = "all") - assert_bool(byrow) - if (!is.null(guides)) { - assert_position(guides) - guides <- setup_position(guides) - } assert_s3_class(theme, "theme", null_ok = TRUE) nms <- names(plots) if (!is.null(nms) && is.character(design)) { @@ -71,27 +66,85 @@ align_plots <- function(..., ncol = NULL, nrow = NULL, byrow = TRUE, } design <- as_areas(design) patches <- lapply(plots, alignpatch) - new_alignpatches(patches, list( + new_alignpatches(patches, + design = layout_design( + ncol = ncol, + nrow = nrow, + byrow = byrow, + widths = widths, + heights = heights, + design = design, + guides = guides + ), + annotation = layout_annotation( + title = title, + subtitle = subtitle, + caption = caption + ), + theme = theme + ) +} + +new_alignpatches <- function(patches, design, annotation, theme) { + structure( + list( + patches = patches, design = design, + annotation = annotation, theme = theme + ), + # Will ensure serialisation includes a link to the `ggalign` + # namespace + `_namespace` = namespace_link, + class = "alignpatches" + ) +} + +############################################################# +#' @inherit patchwork::plot_layout +#' @inheritParams patchwork::plot_layout +#' @importFrom ggplot2 waiver +#' @noRd +layout_design <- function(ncol = waiver(), nrow = waiver(), byrow = waiver(), + widths = waiver(), heights = waiver(), + design = waiver(), guides = waiver()) { + if (!is.waive(byrow)) assert_bool(byrow) + if (!is.waive(design)) design <- as_areas(design) + if (!is.waive(guides) && !is.null(guides)) { + assert_position(guides) + guides <- setup_position(guides) + } + structure(list( ncol = ncol, nrow = nrow, byrow = byrow, widths = widths, heights = heights, design = design, - guides = guides, - title = title, subtitle = subtitle, caption = caption - ), theme = theme) + guides = guides + ), class = c("layout_design", "plot_layout")) } -new_alignpatches <- function(patches, layout, theme) { +#' Annotate the whole layout +#' +#' @inheritParams ggplot2::labs +#' @return A `layout_annotation` object to be added into `r rd_layout()`. +#' @importFrom ggplot2 waiver +#' @export +layout_annotation <- function(title = waiver(), subtitle = waiver(), + caption = waiver()) { structure( - list(patches = patches, layout = layout, theme = theme), - # Will ensure serialisation includes a link to the `ggalign` - # namespace - `_namespace` = ggalign_namespace_link, - class = "alignpatches" + list(title = title, subtitle = subtitle, caption = caption), + class = c("layout_annotation", "plot_annotation") ) } +#' Modify components of the layout theme +#' @inherit ggplot2::theme description sections references author source note format +#' @inheritDotParams ggplot2::theme +#' @note Only used to render the `guides`, `title`, `subtitle`, `caption`, +#' `margins` and `background`. +#' @return A `layout_theme` object to be added into `r rd_layout()`. +#' @examples +#' layout_theme(plot.background = element_rect(fill = "green")) +#' @importFrom ggplot2 theme #' @export -as.list.alignpatches <- function(x, ...) .subset2(x, "patches") +layout_theme <- function(...) add_class(ggplot2::theme(...), "layout_theme") diff --git a/R/alignpatch-alignpatches.R b/R/alignpatch-alignpatches.R index 3ec8d1b3..fce85c67 100644 --- a/R/alignpatch-alignpatches.R +++ b/R/alignpatch-alignpatches.R @@ -11,7 +11,7 @@ PatchAlignpatches <- ggproto("PatchAlignpatches", Patch, #' @importFrom ggplot2 wrap_dims calc_element zeroGrob patch_gtable = function(self, guides, plot = self$plot) { patches <- .subset2(plot, "patches") - layout <- .subset2(plot, "layout") + layout <- .subset2(plot, "design") # complete the theme object theme <- complete_theme(.subset2(plot, "theme")) diff --git a/R/alignpatch-build.R b/R/alignpatch-build.R index 5125753c..72822279 100644 --- a/R/alignpatch-build.R +++ b/R/alignpatch-build.R @@ -44,15 +44,17 @@ grid.draw.alignpatches <- function(x, recording = TRUE) { #' @export ggalign_build.alignpatches <- function(x) x -#' @importFrom ggplot2 find_panel element_render theme +#' @importFrom ggplot2 find_panel element_render theme theme_get #' @importFrom gtable gtable_add_grob gtable_add_rows gtable_add_cols #' @importFrom rlang arg_match0 #' @export ggalign_gtable.alignpatches <- function(x) { - layout <- .subset2(x, "layout") - theme <- .subset2(x, "theme") + annotation <- .subset2(x, "annotation") - # use complete_theme() when ggplot2 release + # ensure theme has no missing value + theme <- .subset2(x, "theme") %||% theme_get() + + # `TODO`: use `complete_theme()` from ggplot2 release theme <- complete_theme(theme) x$theme <- theme table <- alignpatch(x)$patch_gtable() @@ -62,21 +64,22 @@ ggalign_gtable.alignpatches <- function(x) { # Add title, subtitle, and caption ------------------- # https://github.com/tidyverse/ggplot2/blob/2e08bba0910c11a46b6de9e375fade78b75d10dc/R/plot-build.R#L219C3-L219C9 title <- element_render( - theme, "plot.title", .subset2(layout, "title"), + theme = theme, "plot.title", + .subset2(annotation, "title"), margin_y = TRUE, margin_x = TRUE ) title_height <- grobHeight(title) # Subtitle subtitle <- element_render( - theme, "plot.subtitle", .subset2(layout, "subtitle"), + theme, "plot.subtitle", .subset2(annotation, "subtitle"), margin_y = TRUE, margin_x = TRUE ) subtitle_height <- grobHeight(subtitle) # whole plot annotation caption <- element_render( - theme, "plot.caption", .subset2(layout, "caption"), + theme, "plot.caption", .subset2(annotation, "caption"), margin_y = TRUE, margin_x = TRUE ) caption_height <- grobHeight(caption) diff --git a/R/layout-.R b/R/layout-.R index 5dd90de1..c58b932c 100644 --- a/R/layout-.R +++ b/R/layout-.R @@ -1,10 +1,10 @@ # Will ensure serialisation includes a link to the ggalign namespace # Copied from patchwork -ggalign_namespace_link <- function() NULL +namespace_link <- function() NULL # https://stackoverflow.com/questions/65817557/s3-methods-extending-ggplot2-gg-function # Here we use S4 object to override the double dispatch of `+.gg` method -# +# TODO: use S7 #' A `Layout` object #' #' A `Layout` object defines how to place the plots. @@ -13,11 +13,14 @@ ggalign_namespace_link <- function() NULL methods::setClass("Layout", list( active = "ANY", - # used by `ggsave` - theme = "ANY", + # control the layout, `theme` will also be used by `ggsave` + annotation = "list", theme = "ANY", `_namespace` = "ANY" ), - prototype = list(active = NULL, `_namespace` = ggalign_namespace_link) + prototype = list( + active = NULL, annotation = list(), + `_namespace` = namespace_link + ) ) is.layout <- function(x) methods::is(x, "Layout") @@ -34,7 +37,7 @@ alignpatch.Layout <- function(x) alignpatch(ggalign_build(x)) #' Print Layout object #' -#' @param object A [layout_heatmap()] or [layout_stack()] object. +#' @param object A `r rd_layout()`. #' @return The input invisiblely. #' @importFrom methods show #' @export @@ -60,7 +63,7 @@ methods::setMethod("$", "Layout", function(x, name) { ############################################################# #' Add components to `Layout` #' -#' @param e1 A [layout_heatmap()] or [layout_stack()] object. +#' @param e1 A `r rd_layout()`. #' @param e2 An object to be added to the plot, including [gg][ggplot2::+.gg] #' elements or [align] object. #' @return A modified `Layout` object. @@ -74,6 +77,7 @@ methods::setMethod("$", "Layout", function(x, name) { NULL #' @rdname layout-add +#' @importFrom utils modifyList #' @export methods::setMethod("+", c("Layout", "ANY"), function(e1, e2) { if (missing(e2)) { @@ -82,12 +86,31 @@ methods::setMethod("+", c("Layout", "ANY"), function(e1, e2) { "i" = "Did you accidentally put {.code +} on a new line?" )) } + if (is.null(e2)) return(e1) # styler: off + if (inherits(e2, "layout_theme")) { + if (is.null(e1@theme)) { + e1@theme <- e2 + } else { + e1@theme <- e1@theme + e2 + } + return(e1) + } + if (inherits(e2, "layout_annotation")) { + e2 <- e2[!vapply(e2, is.waive, logical(1L), USE.NAMES = FALSE)] + e1@annotation <- modifyList(e1@annotation, e2, keep.null = TRUE) + return(e1) + } + # Get the name of what was passed in as e2, and pass along so that it # can be displayed in error messages e2name <- deparse(substitute(e2)) layout_add(e1, e2, e2name) }) +is_layout_components <- function(x) { + inherits(x, "layout_theme") || inherits(x, "layout_annotation") +} + #' @keywords internal layout_add <- function(layout, object, object_name) { UseMethod("layout_add") @@ -109,20 +132,21 @@ layout_add.StackLayout <- function(layout, object, object_name) { #' @details #' In order to reduce code repetition `ggalign` provides two operators for #' adding ggplot elements (geoms, themes, facets, etc.) to multiple/all plots in -#' [layout_heatmap()] or [layout_stack()] object. +#' `r rd_layout()`. #' #' Like `patchwork`, `&` add the element to all plots in the plot. If the -#' element is a [theme][ggplot2::theme], this will also modify the layout theme. +#' element is a [theme][ggplot2::theme], this will also modify the layout +#' theme. #' #' Unlike `patchwork`, the `-` operator adds ggplot2 elements (geoms, themes, #' facets, etc.) rather than a ggplot plot. The key difference between `&` and -#' `-` is in how they behave in [layout_heatmap()]. The `-` operator only -#' applies the element to the current active context in [layout_heatmap()]. +#' `-` is in how they behave in [heatmap_layout()]. The `-` operator only +#' applies the element to the current active context in [heatmap_layout()]. #' Using `-` might seem unintuitive if you think of the operator as "subtract", #' the underlying reason is that `-` is the only operator in the same precedence #' group as `+`. #' -#' @param e1 A [layout_heatmap()] or [layout_stack()] object. +#' @param e1 A `r rd_layout()`. #' @param e2 An object to be added to the plot. #' @return A modified `Layout` object. #' @examples @@ -154,14 +178,21 @@ methods::setMethod("&", c("Layout", "ANY"), function(e1, e2) { )) } if (is.null(e2)) return(e1) # styler: off + if (is_layout_components(e2)) { + cli::cli_abort(c( + "Cannot use {.code &} to control the layout theme or annotation", + i = "Try to use {.code +} instead" + )) + } + # Get the name of what was passed in as e2, and pass along so that it # can be displayed in error messages e2name <- deparse(substitute(e2)) e1 <- layout_and_add(e1, e2, e2name) - # we won't remove the margins around the layout + # to align with `patchwork`, we also modify the layout theme + # when using `&` to add the theme object. if (inherits(e2, "theme")) { - e2$plot.margin <- NULL e1@theme <- e1@theme + e2 } e1 @@ -194,6 +225,12 @@ methods::setMethod("-", c("Layout", "ANY"), function(e1, e2) { )) } if (is.null(e2)) return(e1) # styler: off + if (is_layout_components(e2)) { + cli::cli_abort(c( + "Cannot use {.code -} to control the layout theme or annotation", + i = "Try to use {.code +} instead" + )) + } # Get the name of what was passed in as e2, and pass along so that it # can be displayed in error messages @@ -219,7 +256,7 @@ layout_subtract.StackLayout <- function(layout, object, object_name) { ############################################################ #' Get the statistics from the layout #' -#' @param x A [layout_heatmap()] or [layout_stack()] object. +#' @param x A `r rd_layout()`. #' @param ... Not used currently. #' @return The statistics #' @export @@ -240,6 +277,7 @@ ggalign_stat.StackLayout <- function(x, ..., what) { .subset2(.subset2(x@plots, what), "statistics") } +############################################################ ############################################################ # layout should be one of "index", "nobs", "panel" get_layout <- function(x, layout, ...) UseMethod("get_layout") diff --git a/R/layout-heatmap-.R b/R/layout-heatmap-.R index d88b7078..2a21b87b 100644 --- a/R/layout-heatmap-.R +++ b/R/layout-heatmap-.R @@ -1,6 +1,6 @@ #' Arrange plots around a Heatmap #' -#' `ggheatmap` is an alias of `layout_heatmap`. +#' `ggheatmap` is an alias of `heatmap_layout`. #' #' @param data A numeric or character vector, a data frame, and any other data #' which can be converted into a matrix. Simple vector will be converted into a @@ -9,8 +9,10 @@ #' will using `aes(.data$.x, .data$.y)`. #' @param ... Additional arguments passed to [geom_tile][ggplot2::geom_tile]. #' Only used when `filling = TRUE`. +#' @param width,height Heatmap body width/height, can be a [unit][grid::unit] +#' object. #' @param filling A boolean value indicates whether to fill the heatmap. If you -#' want to custom the filling style, you can set to `FALSE`. +#' want to customize the filling style, you can set to `FALSE`. #' @inheritParams align #' @inheritParams ggplot2::ggplot #' @section ggplot2 specification: @@ -35,21 +37,22 @@ #' @examples #' ggheatmap(1:10) #' ggheatmap(letters) +#' ggheatmap(matrix(rnorm(81), nrow = 9L)) #' @importFrom ggplot2 aes #' @export -layout_heatmap <- function(data, mapping = aes(), +heatmap_layout <- function(data, mapping = aes(), ..., - filling = TRUE, + width = NA, height = NA, filling = TRUE, set_context = TRUE, order = NULL, name = NULL) { if (missing(data)) { - .layout_heatmap( + .heatmap_layout( data = NULL, mapping = mapping, - ..., filling = filling, + ..., width = width, height = height, filling = filling, set_context = set_context, order = order, name = name, nobs_list = list(), call = current_call() ) } else { - UseMethod("layout_heatmap") + UseMethod("heatmap_layout") } } @@ -63,13 +66,12 @@ methods::setClass( plot = "ANY", facetted_pos_scales = "ANY", params = "list", - set_context = "logical", - order = "integer", - name = "character", - # Used by the layout, + # If we regard heatmap layout as a plot, and put it into the stack + # layout, we need following arguments to control it's behavour + set_context = "logical", order = "integer", name = "character", + # Used by the layout itself, # top, left, bottom, right must be a StackLayout object. - top = "ANY", left = "ANY", - bottom = "ANY", right = "ANY", + top = "ANY", left = "ANY", bottom = "ANY", right = "ANY", panel_list = "list", index_list = "list", nobs_list = "list" ), prototype = list( @@ -81,13 +83,13 @@ methods::setClass( ) #' @export -#' @rdname layout_heatmap -ggheatmap <- layout_heatmap +#' @rdname heatmap_layout +ggheatmap <- heatmap_layout -#' @importFrom ggplot2 waiver theme +#' @importFrom ggplot2 waiver #' @export -layout_heatmap.matrix <- function(data, ...) { - .layout_heatmap( +heatmap_layout.matrix <- function(data, ...) { + .heatmap_layout( data = data, ..., nobs_list = list(x = ncol(data), y = nrow(data)), call = current_call() @@ -95,26 +97,26 @@ layout_heatmap.matrix <- function(data, ...) { } #' @export -layout_heatmap.NULL <- function(data, ...) { - .layout_heatmap( +heatmap_layout.NULL <- function(data, ...) { + .heatmap_layout( data = data, nobs_list = list(), ..., call = current_call() ) } #' @export -layout_heatmap.formula <- function(data, ...) { - .layout_heatmap( +heatmap_layout.formula <- function(data, ...) { + .heatmap_layout( data = allow_lambda(data), ..., nobs_list = list(), call = current_call() ) } #' @export -layout_heatmap.functon <- layout_heatmap.NULL +heatmap_layout.functon <- heatmap_layout.NULL #' @export -layout_heatmap.default <- function(data, ...) { +heatmap_layout.default <- function(data, ...) { call <- current_call() data <- tryCatch( as.matrix(data), @@ -125,7 +127,7 @@ layout_heatmap.default <- function(data, ...) { ), call = call) } ) - .layout_heatmap( + .heatmap_layout( data = data, ..., nobs_list = list(x = ncol(data), y = nrow(data)), call = call @@ -133,12 +135,14 @@ layout_heatmap.default <- function(data, ...) { } #' @importFrom ggplot2 aes -.layout_heatmap <- function(data, mapping = aes(), +.heatmap_layout <- function(data, mapping = aes(), ..., - filling = TRUE, + width = NA, height = NA, filling = TRUE, set_context = TRUE, order = NULL, name = NULL, # following parameters are used internally nobs_list, call = caller_call()) { + width <- check_size(width) + height <- check_size(height) assert_bool(filling, call = call) assert_bool(set_context, call = call) if (is.null(order) || is.na(order)) { @@ -150,6 +154,7 @@ layout_heatmap.default <- function(data, ...) { } else if (!is.integer(order)) { cli::cli_abort("{.arg order} must be a single number", call = call) } + assert_string(name, empty_ok = FALSE, na_ok = TRUE, null_ok = TRUE) plot <- ggplot2::ggplot(mapping = mapping) + heatmap_theme() plot <- add_default_mapping(plot, aes(.data$.x, .data$.y)) + @@ -178,9 +183,9 @@ layout_heatmap.default <- function(data, ...) { "HeatmapLayout", data = data, params = list( + width = width, + height = height, # following parameters can be controlled by `active` object. - width = unit(NA, "null"), - height = unit(NA, "null"), guides = waiver(), free_labs = waiver(), free_spaces = waiver(), @@ -190,7 +195,7 @@ layout_heatmap.default <- function(data, ...) { order = order, name = name %||% NA_character_, plot = plot, nobs_list = nobs_list, # used by ggsave - theme = default_theme() + theme = NULL ) } diff --git a/R/layout-heatmap-add.R b/R/layout-heatmap-add.R index ffc35912..7464c815 100644 --- a/R/layout-heatmap-add.R +++ b/R/layout-heatmap-add.R @@ -8,9 +8,6 @@ layout_heatmap_add.default <- function(object, heatmap, object_name) { cli::cli_abort("Cannot add {.code {object_name}} to {.cls ggheatmap}") } -#' @export -layout_heatmap_add.NULL <- function(object, heatmap, object_name) heatmap - #' @export layout_heatmap_add.Align <- function(object, heatmap, object_name) { if (is.null(position <- get_context(heatmap))) { @@ -77,7 +74,7 @@ layout_heatmap_add.heatmap_active <- function(object, heatmap, object_name) { if (is.null(stack <- slot(heatmap, object))) { data <- heatmap@data if (!is_horizontal(direction)) data <- t(data) - stack <- layout_stack(data = data, direction = direction) + stack <- stack_layout(data = data, direction = direction) stack <- set_panel(stack, value = get_panel(heatmap, axis)) stack <- set_index(stack, value = get_index(heatmap, axis)) diff --git a/R/layout-heatmap-build.R b/R/layout-heatmap-build.R index 9976f7f1..ffaa6c47 100644 --- a/R/layout-heatmap-build.R +++ b/R/layout-heatmap-build.R @@ -24,6 +24,7 @@ ggalign_build.HeatmapLayout <- function(x) { design <- trim_area(do.call(c, design[keep])) params <- x@params + annotation <- x@annotation align_plots( !!!.subset(plots, keep), design = design, @@ -31,7 +32,10 @@ ggalign_build.HeatmapLayout <- function(x) { widths = .subset2(sizes, "width"), # No parent layout, by default we'll always collect guides guides = .subset2(params, "guides") %|w|% "tlbr", - theme = x@theme + title = .subset2(annotation, "title"), + subtitle = .subset2(annotation, "subtitle"), + caption = .subset2(annotation, "caption"), + theme = x@theme %||% default_theme() ) } diff --git a/R/layout-stack-.R b/R/layout-stack-.R index 8f96999e..b578809b 100644 --- a/R/layout-stack-.R +++ b/R/layout-stack-.R @@ -2,7 +2,7 @@ # add annotation into annotation list #' Put plots horizontally or vertically #' -#' `ggstack` is an alias of `layout_stack`. +#' `ggstack` is an alias of `stack_layout`. #' #' @param data A numeric or character vector, a data frame, or a matrix. #' @param direction A string of `"horizontal"` or `"vertical"`, indicates the @@ -12,15 +12,15 @@ #' @examples #' ggstack(matrix(rnorm(100L), nrow = 10L)) + align_dendro() #' @export -layout_stack <- function(data, direction = NULL, ...) { +stack_layout <- function(data, direction = NULL, ...) { if (missing(data)) { - .layout_stack( + .stack_layout( data = NULL, nobs = NULL, direction = direction, call = current_call() ) } else { - UseMethod("layout_stack") + UseMethod("stack_layout") } } @@ -44,38 +44,38 @@ methods::setClass( ) #' @export -#' @rdname layout_stack -ggstack <- layout_stack +#' @rdname stack_layout +ggstack <- stack_layout #' @export -layout_stack.matrix <- function(data, ...) { - .layout_stack( +stack_layout.matrix <- function(data, ...) { + .stack_layout( data = data, nobs = nrow(data), ..., call = current_call() ) } #' @export -layout_stack.data.frame <- layout_stack.matrix +stack_layout.data.frame <- stack_layout.matrix #' @export -layout_stack.numeric <- function(data, ...) { - .layout_stack( +stack_layout.numeric <- function(data, ...) { + .stack_layout( data = as.matrix(data), nobs = length(data), ..., call = current_call() ) } #' @export -layout_stack.character <- layout_stack.numeric +stack_layout.character <- stack_layout.numeric #' @export -layout_stack.NULL <- function(data, ...) { - .layout_stack(data = data, nobs = NULL, ..., call = current_call()) +stack_layout.NULL <- function(data, ...) { + .stack_layout(data = data, nobs = NULL, ..., call = current_call()) } #' @importFrom grid unit -.layout_stack <- function(data, nobs, direction = NULL, +.stack_layout <- function(data, nobs, direction = NULL, call = caller_call()) { direction <- match.arg(direction, c("horizontal", "vertical")) methods::new("StackLayout", @@ -87,12 +87,12 @@ layout_stack.NULL <- function(data, ...) { ), nobs = nobs, # following parameters are used by ggsave - theme = default_theme() + theme = NULL ) } #' @export -layout_stack.default <- function(data, ...) { +stack_layout.default <- function(data, ...) { cli::cli_abort(c( paste( "{.arg data} must be a numeric or character vector,", diff --git a/R/layout-stack-add.R b/R/layout-stack-add.R index 840e9023..4e09c744 100644 --- a/R/layout-stack-add.R +++ b/R/layout-stack-add.R @@ -190,9 +190,6 @@ layout_stack_add.labels <- layout_stack_add.gg #' @export layout_stack_add.facetted_pos_scales <- layout_stack_add.gg -#' @export -layout_stack_add.NULL <- function(object, stack, object_name) stack - #' @export layout_stack_add.default <- function(object, stack, object_name) { cli::cli_abort("Cannot add {.code {object_name}} into the stack layout") diff --git a/R/layout-stack-build.R b/R/layout-stack-build.R index d4690f30..b3e513e9 100644 --- a/R/layout-stack-build.R +++ b/R/layout-stack-build.R @@ -80,6 +80,7 @@ stack_build <- function(x, plot_data = waiver(), guides = waiver(), if (is_empty(.subset2(patches, "plots"))) { return(list(plot = NULL, size = NULL)) } + annotation <- x@annotation plot <- align_plots( !!!.subset2(patches, "plots"), design = area( @@ -99,7 +100,10 @@ stack_build <- function(x, plot_data = waiver(), guides = waiver(), do.call(unit.c, attr(patches, "sizes")) ), guides = guides %|w|% "tlbr", - theme = x@theme + title = .subset2(annotation, "title"), + subtitle = .subset2(annotation, "subtitle"), + caption = .subset2(annotation, "caption"), + theme = x@theme %||% default_theme() ) list(plot = plot, size = .subset2(params, "size")) } diff --git a/R/utils-rd.R b/R/utils-rd.R index f8119cd5..91724fd3 100644 --- a/R/utils-rd.R +++ b/R/utils-rd.R @@ -4,10 +4,14 @@ rd_values <- function(x, quote = TRUE, code = TRUE, sep = ", ", final = "and") { oxford_comma(x, sep = sep, final = final) } -rd_theme <- function() { +rd_layout_theme <- function() { paste( "A [theme()][ggplot2::theme] object to rendering the guides", "title, subtitle, caption, margins and background.", sep = ", " ) } + +rd_layout <- function() { + "[heatmap_layout()] or [stack_layout()] object" +} diff --git a/README.Rmd b/README.Rmd index fa8bf9ed..f9e39570 100644 --- a/README.Rmd +++ b/README.Rmd @@ -37,11 +37,11 @@ remotes::install_github("Yunuuuu/ggalign") ## Overviews `ggalign` pacakge provides two layout to arrange ggplot objects: - - `layout_heatmap()`/`ggheatmap()`: Arrange ggplot into a Heatmap layout. See - `vignette("layout-heatmap")` for details. + - `heatmap_layout()`/`ggheatmap()`: Arrange ggplot into a Heatmap layout. See + `vignette("heatmap-layout")` for details. - - `layout_stack()`/`ggstack()`: Arrange ggplot vertically or horizontally. See - `vignette("layout-stack")` for details. + - `stack_layout()`/`ggstack()`: Arrange ggplot vertically or horizontally. See + `vignette("stack-layout")` for details. To further customize these layouts, we offer following functions: @@ -52,7 +52,7 @@ To further customize these layouts, we offer following functions: - `align_dendro()`: Reorder or Group layout based on hierarchical clustering For more detailed instructions on customizing layouts, see the vignette: -`vignette("align-layout")`. +`vignette("layout-customize")`. Additionally, plots can be added in the layout with following functions: @@ -61,14 +61,14 @@ Additionally, plots can be added in the layout with following functions: data. For more information on adding plots, refer to the vignette: -`vignette("align-plot")`. +`vignette("layout-plot")`. ## Documentation -- [Heatmap Layout](https://yunuuuu.github.io/ggalign/articles/layout-heatmap.html) -- [Layout Customization](https://yunuuuu.github.io/ggalign/articles/align-layout.html) -- [Layout Plot](https://yunuuuu.github.io/ggalign/articles/align-plot.html) -- [Stack Layout](https://yunuuuu.github.io/ggalign/articles/layout-stack.html) +- [Heatmap Layout](https://yunuuuu.github.io/ggalign/articles/heatmap-layout.html) +- [Layout Customization](https://yunuuuu.github.io/ggalign/articles/layout-customize.html) +- [Layout Plot](https://yunuuuu.github.io/ggalign/articles/layout-plot.html) +- [Stack Layout](https://yunuuuu.github.io/ggalign/articles/stack-layout.html) - [Scales and Facets](https://yunuuuu.github.io/ggalign/articles/scales-and-facets.html) ## Examples diff --git a/README.html b/README.html index bafdadcf..ade5a02a 100644 --- a/README.html +++ b/README.html @@ -604,7 +604,7 @@

ggalign -ggalign website

+ggalign website

R-CMD-check Codecov test coverage CRAN status

@@ -623,12 +623,12 @@

Overviews

ggalign pacakge provides two layout to arrange ggplot objects:

To further customize these layouts, we offer following functions:

For more detailed instructions on customizing layouts, see the -vignette: vignette("align-layout").

+vignette: vignette("layout-customize").

Additionally, plots can be added in the layout with following functions:

For more information on adding plots, refer to the vignette: -vignette("align-plot").

+vignette("layout-plot").

Documentation