Merge pull request #33 from humanpred/claude/vigilant-joliot-c1db27

Auto-render every page for ggforce paginated facets (issue 2)

Author: billdenney

DESCRIPTION

@@ -14,6 +14,7 @@ Roxygen: list(markdown = TRUE)
 Depends: R (>= 4.3)
 Suggests:
     ggbreak,
+    ggforce,
     quarto,
     rmarkdown,
     spelling,

NAMESPACE

@@ -4,6 +4,12 @@ S3method("%+%",default)
 S3method("%+%",gglist)
 S3method("%+%",ggtibble)
 S3method(Ops,ggtibble)
+S3method(as_gglist,"NULL")
+S3method(as_gglist,default)
+S3method(as_gglist,gg)
+S3method(as_gglist,gglist)
+S3method(as_gglist,labels)
+S3method(as_gglist,list)
 S3method(chooseOpsMethod,gglist)
 S3method(chooseOpsMethod,ggtibble)
 S3method(format,gglist)
@@ -25,6 +31,7 @@ S3method(vec_arith.gglist,labels)
 S3method(vec_arith.gglist,list)
 S3method(vec_arith.gglist,uneval)
 export("%+%")
+export(as_gglist)
 export(gglist)
 export(ggplot)
 export(ggsave)

NEWS.md

@@ -1,5 +1,13 @@
 # ggtibble 1.0.2.9000
 
+* New exported S3 generic `as_gglist()` (methods for `gg`, `list`, `gglist`,
+  `labels`, and `NULL`) that promotes an input to a `gglist`.  When the input
+  uses `ggforce::facet_wrap_paginate()` or `ggforce::facet_grid_paginate()`,
+  `as_gglist()` expands the paginated plot into one element per rendered
+  page so it can be passed to `print()`, `knit_print()`, or `ggsave()` and
+  every page will render.  Page expansion is opt-in — render methods are
+  unchanged and do not call `as_gglist()` implicitly.  `ggforce` is added to
+  Suggests (issue 2).
 * New `ggtibble` knitr chunk option that simplifies rendering a `ggtibble` in
   R Markdown and Quarto reports.  Setting `ggtibble = "my_obj"` (or
   `ggtibble = my_obj`) on a chunk auto-sets the chunk label, `fig.cap`, and

R/as_gglist.R

@@ -0,0 +1,65 @@
+#' Convert an object to a `gglist`
+#'
+#' Promotes an input value to a `gglist`.  When the input includes a `gg`
+#' object that uses `ggforce::facet_wrap_paginate()` or
+#' `ggforce::facet_grid_paginate()`, the paginated plot is expanded into one
+#' `gglist` element per rendered page so subsequent calls to `print()`,
+#' `knit_print()`, or `ggsave()` render every page.  Inputs that already
+#' use a non-paginated facet (or no facet at all) pass through unchanged.
+#'
+#' For an input that is already a `gglist`, the value is returned unchanged
+#' so the method is a no-op when nothing needs to be coerced.  Call this
+#' yourself before rendering when you want paginated facets expanded — the
+#' render methods do not call it implicitly because page expansion is not
+#' always desired.
+#'
+#' @param x A `gg`, `gglist`, list of `gg` objects, `NULL`, or `labels`
+#'   object to convert.
+#' @param ... Not used.
+#' @return A `gglist` object.
+#' @examples
+#' p <- ggplot2::ggplot(mtcars, ggplot2::aes(mpg, wt)) + ggplot2::geom_point()
+#' as_gglist(p)
+#' @export
+as_gglist <- function(x, ...) {
+  UseMethod("as_gglist")
+}
+
+#' @export
+as_gglist.default <- function(x, ...) {
+  rlang::abort(
+    paste0("No `as_gglist()` method for class <", class(x)[1], ">")
+  )
+}
+
+#' @export
+as_gglist.gg <- function(x, ...) {
+  new_gglist(gg_to_pages(x))
+}
+
+#' @export
+as_gglist.list <- function(x, ...) {
+  expanded <- unlist(
+    lapply(x, function(el) {
+      if (inherits(el, "gg")) gg_to_pages(el) else list(el)
+    }),
+    recursive = FALSE
+  )
+  new_gglist(expanded)
+}
+
+#' @export
+as_gglist.gglist <- function(x, ...) {
+  x
+}
+
+#' @export
+as_gglist.labels <- function(x, ...) {
+  new_gglist(list(x))
+}
+
+#' @method as_gglist NULL
+#' @export
+`as_gglist.NULL` <- function(x, ...) {
+  new_gglist(list(NULL))
+}

R/pagination.R

@@ -0,0 +1,31 @@
+# Internal helpers used by `as_gglist()` to expand ggforce paginated facets.
+
+is_paginated <- function(plot) {
+  inherits(plot, "gg") &&
+    inherits(plot$facet, c("FacetWrapPaginate", "FacetGridPaginate"))
+}
+
+n_pages_for_plot <- function(plot) {
+  if (!is_paginated(plot)) {
+    return(1L)
+  }
+  rlang::check_installed("ggforce", reason = "to render paginated facets")
+  np <- ggforce::n_pages(plot)
+  if (is.null(np)) 1L else as.integer(np)
+}
+
+gg_to_pages <- function(plot) {
+  if (!is_paginated(plot)) {
+    return(list(plot))
+  }
+  np <- n_pages_for_plot(plot)
+  # `plot$facet` is a ggproto object (reference semantics); modifying its
+  # `params$page` field mutates the shared facet for every reference to it.
+  # Deep-clone the plot per page so the returned list elements render
+  # independently.
+  lapply(seq_len(np), function(i) {
+    p <- unserialize(serialize(plot, NULL))
+    p$facet$params$page <- i
+    p
+  })
+}

inst/WORDLIST

@@ -16,6 +16,7 @@ labelled
 pictex
 png
 ps
+renderable
 sprintf
 svg
 tex

man/as_gglist.Rd

@@ -0,0 +1,120 @@
+# Tests for as_gglist() and the ggforce paginated-facet expansion it performs.
+
+make_paginated_plot <- function() {
+  # 3 cyl levels, ncol=1, nrow=1 -> 3 pages
+  ggplot2::ggplot(mtcars, ggplot2::aes(mpg, wt)) +
+    ggplot2::geom_point() +
+    ggforce::facet_wrap_paginate(~ cyl, ncol = 1, nrow = 1)
+}
+
+make_plain_plot <- function() {
+  ggplot2::ggplot(mtcars, ggplot2::aes(mpg, wt)) +
+    ggplot2::geom_point()
+}
+
+# is_paginated ####
+
+test_that("is_paginated identifies paginated and non-paginated plots", {
+  expect_false(is_paginated(make_plain_plot()))
+  expect_false(is_paginated("not a plot"))
+  expect_false(is_paginated(NULL))
+  skip_if_not_installed("ggforce")
+  expect_true(is_paginated(make_paginated_plot()))
+})
+
+# n_pages_for_plot ####
+
+test_that("n_pages_for_plot returns 1 for non-paginated plots", {
+  expect_identical(n_pages_for_plot(make_plain_plot()), 1L)
+})
+
+test_that("n_pages_for_plot returns the actual page count for paginated plots", {
+  skip_if_not_installed("ggforce")
+  expect_identical(n_pages_for_plot(make_paginated_plot()), 3L)
+})
+
+# gg_to_pages ####
+
+test_that("gg_to_pages returns list(plot) for non-paginated plots", {
+  p <- make_plain_plot()
+  result <- gg_to_pages(p)
+  expect_length(result, 1)
+  expect_identical(result[[1]], p)
+})
+
+test_that("gg_to_pages expands paginated plot to one element per page", {
+  skip_if_not_installed("ggforce")
+  p <- make_paginated_plot()
+  result <- gg_to_pages(p)
+  expect_length(result, 3)
+  pages_used <- vapply(result, function(pl) pl$facet$params$page, integer(1))
+  expect_identical(pages_used, 1:3)
+})
+
+# as_gglist ####
+
+test_that("as_gglist.default errors", {
+  expect_error(as_gglist(1L), regexp = "No `as_gglist\\(\\)` method for class")
+})
+
+test_that("as_gglist.NULL wraps NULL in a length-1 gglist", {
+  result <- as_gglist(NULL)
+  expect_s3_class(result, "gglist")
+  expect_length(result, 1)
+  expect_null(result[[1]])
+})
+
+test_that("as_gglist.labels wraps a labels object", {
+  result <- as_gglist(ggplot2::labs(x = "foo"))
+  expect_s3_class(result, "gglist")
+  expect_length(result, 1)
+})
+
+test_that("as_gglist.gg wraps a non-paginated plot as a length-1 gglist", {
+  result <- as_gglist(make_plain_plot())
+  expect_s3_class(result, "gglist")
+  expect_length(result, 1)
+})
+
+test_that("as_gglist.gg expands a paginated plot to one element per page", {
+  skip_if_not_installed("ggforce")
+  result <- as_gglist(make_paginated_plot())
+  expect_s3_class(result, "gglist")
+  expect_length(result, 3)
+})
+
+test_that("as_gglist.list works with a list of plain plots", {
+  result <- as_gglist(list(make_plain_plot(), make_plain_plot()))
+  expect_s3_class(result, "gglist")
+  expect_length(result, 2)
+})
+
+test_that("as_gglist.list expands paginated elements inline", {
+  skip_if_not_installed("ggforce")
+  result <- as_gglist(list(make_plain_plot(), make_paginated_plot()))
+  expect_s3_class(result, "gglist")
+  expect_length(result, 4)
+})
+
+test_that("as_gglist.gglist is identity (idempotent for non-paginated)", {
+  g <- new_gglist(list(make_plain_plot(), make_plain_plot()))
+  expect_identical(as_gglist(g), g)
+})
+
+test_that("as_gglist.gglist is identity even when elements are paginated", {
+  skip_if_not_installed("ggforce")
+  g <- new_gglist(list(make_plain_plot(), make_paginated_plot()))
+  expect_identical(as_gglist(g), g)
+  expect_identical(as_gglist(as_gglist(g)), g)
+})
+
+# Render integration through as_gglist ####
+
+test_that("ggsave() saves every page when the gglist is first passed through as_gglist", {
+  skip_if_not_installed("ggforce")
+  withr::with_tempdir({
+    flat <- as_gglist(make_paginated_plot())
+    ggsave(filename = c("p1.png", "p2.png", "p3.png"), plot = flat, width = 4, height = 3)
+    expect_setequal(list.files(pattern = "\\.png$"), c("p1.png", "p2.png", "p3.png"))
+  })
+})