From 08a7aabddac32371400caf6ea12b458f180b6920 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Fri, 31 May 2024 16:24:46 +0200
Subject: [PATCH 1/5] new format_strip_labels method

---
 R/facet-.R      |  3 +++
 R/facet-grid-.R | 27 +++++++++++++++++++++++++++
 R/facet-wrap.R  | 16 ++++++++++++++++
 3 files changed, 46 insertions(+)

diff --git a/R/facet-.R b/R/facet-.R
index abdd373d05..b0844d227a 100644
--- a/R/facet-.R
+++ b/R/facet-.R
@@ -175,6 +175,9 @@ Facet <- ggproto("Facet", NULL,
   },
   vars = function() {
     character(0)
+  },
+  format_strip_labels = function(layout, params) {
+    return()
   }
 )
 
diff --git a/R/facet-grid-.R b/R/facet-grid-.R
index 0854b5299b..31a271a850 100644
--- a/R/facet-grid-.R
+++ b/R/facet-grid-.R
@@ -506,6 +506,33 @@ FacetGrid <- ggproto("FacetGrid", Facet,
   },
   vars = function(self) {
     names(c(self$params$rows, self$params$cols))
+  },
+
+  format_strip_labels = function(layout, params) {
+
+    labeller <- match.fun(params$labeller)
+
+    cols <- intersect(names(layout), names(params$cols))
+    if (length(cols) > 0) {
+      col_vars <- unique0(layout[cols])
+      attr(col_vars, "type")  <- "cols"
+      attr(col_vars, "facet") <- "grid"
+      cols <- data_frame0(!!!labeller(col_vars))
+    } else {
+      cols <- NULL
+    }
+
+    rows <- intersect(names(layout), names(params$rows))
+    if (length(rows) > 0) {
+      row_vars <- unique0(layout[rows])
+      attr(row_vars, "type")  <- "rows"
+      attr(row_vars, "facet") <- "grid"
+      rows <- data_frame0(!!!labeller(row_vars))
+    } else {
+      rows <- NULL
+    }
+
+    list(cols = cols, rows = rows)
   }
 )
 
diff --git a/R/facet-wrap.R b/R/facet-wrap.R
index 720e2e8e37..8e609df713 100644
--- a/R/facet-wrap.R
+++ b/R/facet-wrap.R
@@ -481,6 +481,22 @@ FacetWrap <- ggproto("FacetWrap", Facet,
   },
   vars = function(self) {
     names(self$params$facets)
+  },
+
+  format_strip_labels = function(layout, params) {
+    if (length(params$facets) == 0) {
+      labels <- data_frame0("(all)" = "(all)", .size = 1)
+    } else {
+      labels <- layout[intersect(names(params$facets), names(layout))]
+    }
+    if (empty(labels)) {
+      return(NULL)
+    }
+    attr(labels, "facet") <- "wrap"
+    attr(labels, "type") <- switch(params$strip.position, left = , right = "rows", "cols")
+
+    labeller <- match.fun(params$labeller)
+    list(facets = data_frame0(!!!labeller(labels)))
   }
 )
 

From c65055292938df116b3b52177d60556801d59e1b Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Fri, 31 May 2024 16:25:15 +0200
Subject: [PATCH 2/5] use new method

---
 R/facet-.R      |  2 +-
 R/facet-grid-.R | 12 +++---------
 R/facet-wrap.R  | 13 ++-----------
 3 files changed, 6 insertions(+), 21 deletions(-)

diff --git a/R/facet-.R b/R/facet-.R
index b0844d227a..e24a94927a 100644
--- a/R/facet-.R
+++ b/R/facet-.R
@@ -700,7 +700,7 @@ render_axes <- function(x = NULL, y = NULL, coord, theme, transpose = FALSE) {
 #'
 #' @keywords internal
 #' @export
-render_strips <- function(x = NULL, y = NULL, labeller, theme) {
+render_strips <- function(x = NULL, y = NULL, labeller = identity, theme) {
   list(
     x = build_strip(x, labeller, theme, TRUE),
     y = build_strip(y, labeller, theme, FALSE)
diff --git a/R/facet-grid-.R b/R/facet-grid-.R
index 31a271a850..fda111f751 100644
--- a/R/facet-grid-.R
+++ b/R/facet-grid-.R
@@ -335,7 +335,7 @@ FacetGrid <- ggproto("FacetGrid", Facet,
     }
     data
   },
-  draw_panels = function(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) {
+  draw_panels = function(self, panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) {
     if ((params$free$x || params$free$y) && !coord$is_free()) {
       cli::cli_abort("{.fn {snake_class(coord)}} doesn't support free scales.")
     }
@@ -362,14 +362,8 @@ FacetGrid <- ggproto("FacetGrid", Facet,
     ranges <- censor_labels(ranges, layout, params$axis_labels)
     axes <- render_axes(ranges[cols], ranges[rows], coord, theme, transpose = TRUE)
 
-    col_vars <- unique0(layout[names(params$cols)])
-    row_vars <- unique0(layout[names(params$rows)])
-    # Adding labels metadata, useful for labellers
-    attr(col_vars, "type") <- "cols"
-    attr(col_vars, "facet") <- "grid"
-    attr(row_vars, "type") <- "rows"
-    attr(row_vars, "facet") <- "grid"
-    strips <- render_strips(col_vars, row_vars, params$labeller, theme)
+    strips <- self$format_strip_labels(layout, params)
+    strips <- render_strips(strips$cols, strips$rows, theme = theme)
 
     aspect_ratio <- theme$aspect.ratio
     if (!is.null(aspect_ratio) && (params$space_free$x || params$space_free$y)) {
diff --git a/R/facet-wrap.R b/R/facet-wrap.R
index 8e609df713..31be9a0443 100644
--- a/R/facet-wrap.R
+++ b/R/facet-wrap.R
@@ -293,17 +293,8 @@ FacetWrap <- ggproto("FacetWrap", Facet,
     ranges <- censor_labels(ranges, layout, params$axis_labels)
     axes <- render_axes(ranges, ranges, coord, theme, transpose = TRUE)
 
-    if (length(params$facets) == 0) {
-      # Add a dummy label
-      labels_df <- data_frame0("(all)" = "(all)", .size = 1)
-    } else {
-      labels_df <- layout[names(params$facets)]
-    }
-    attr(labels_df, "facet") <- "wrap"
-    strips <- render_strips(
-      structure(labels_df, type = "rows"),
-      structure(labels_df, type = "cols"),
-      params$labeller, theme)
+    strips <- self$format_strip_labels(layout, params)
+    strips <- render_strips(strips$facets, strips$facets, theme = theme)
 
     # If user hasn't set aspect ratio, ask the coordinate system if
     # it wants to specify one

From abcea2b278ebd4b51df0baa2b3104ce1e8a2b678 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Fri, 31 May 2024 16:28:30 +0200
Subject: [PATCH 3/5] new accessor function

---
 NAMESPACE               |  1 +
 R/facet-.R              | 25 +++++++++++++++++++++++++
 man/get_strip_labels.Rd | 28 ++++++++++++++++++++++++++++
 man/render_strips.Rd    |  2 +-
 4 files changed, 55 insertions(+), 1 deletion(-)
 create mode 100644 man/get_strip_labels.Rd

diff --git a/NAMESPACE b/NAMESPACE
index 9068973de0..cc6be3d571 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -427,6 +427,7 @@ export(get_last_plot)
 export(get_layer_data)
 export(get_layer_grob)
 export(get_panel_scales)
+export(get_strip_labels)
 export(get_theme)
 export(gg_dep)
 export(gg_par)
diff --git a/R/facet-.R b/R/facet-.R
index e24a94927a..af16584659 100644
--- a/R/facet-.R
+++ b/R/facet-.R
@@ -242,6 +242,31 @@ vars <- function(...) {
   quos(...)
 }
 
+#' Accessing a plot's facet strip labels
+#'
+#' This functions retrieves labels from facet strips with the labeller applied.
+#'
+#' @param plot A ggplot or build ggplot object.
+#'
+#' @return `NULL` if there are no labels, otherwise a list of data.frames
+#'   containing the labels.
+#' @export
+#' @keywords internal
+#'
+#' @examples
+#' # Basic plot
+#' p <- ggplot(mpg, aes(displ, hwy)) +
+#'   geom_point()
+#'
+#' get_strip_labels(p) # empty facets
+#' get_strip_labels(p + facet_wrap(year ~ cyl))
+#' get_strip_labels(p + facet_grid(year ~ cyl))
+get_strip_labels <- function(plot = get_last_plot()) {
+  plot   <- ggplot_build(plot)
+  layout <- plot$layout$layout
+  params <- plot$layout$facet_params
+  plot$plot$facet$format_strip_labels(layout, params)
+}
 
 #' Is this object a faceting specification?
 #'
diff --git a/man/get_strip_labels.Rd b/man/get_strip_labels.Rd
new file mode 100644
index 0000000000..10c3c3c01b
--- /dev/null
+++ b/man/get_strip_labels.Rd
@@ -0,0 +1,28 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/facet-.R
+\name{get_strip_labels}
+\alias{get_strip_labels}
+\title{Accessing a plot's facet strip labels}
+\usage{
+get_strip_labels(plot = get_last_plot())
+}
+\arguments{
+\item{plot}{A ggplot or build ggplot object.}
+}
+\value{
+\code{NULL} if there are no labels, otherwise a list of data.frames
+containing the labels.
+}
+\description{
+This functions retrieves labels from facet strips with the labeller applied.
+}
+\examples{
+# Basic plot
+p <- ggplot(mpg, aes(displ, hwy)) +
+  geom_point()
+
+get_strip_labels(p) # empty facets
+get_strip_labels(p + facet_wrap(year ~ cyl))
+get_strip_labels(p + facet_grid(year ~ cyl))
+}
+\keyword{internal}
diff --git a/man/render_strips.Rd b/man/render_strips.Rd
index b62a836c8d..468caf6899 100644
--- a/man/render_strips.Rd
+++ b/man/render_strips.Rd
@@ -4,7 +4,7 @@
 \alias{render_strips}
 \title{Render panel strips}
 \usage{
-render_strips(x = NULL, y = NULL, labeller, theme)
+render_strips(x = NULL, y = NULL, labeller = identity, theme)
 }
 \arguments{
 \item{x, y}{A data.frame with a column for each variable and a row for each

From 2e5ff706360e8a3b4848c69a446c7ee9d4ef2f52 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Fri, 31 May 2024 16:33:22 +0200
Subject: [PATCH 4/5] add test

---
 tests/testthat/test-facet-strips.R | 18 ++++++++++++++++++
 1 file changed, 18 insertions(+)

diff --git a/tests/testthat/test-facet-strips.R b/tests/testthat/test-facet-strips.R
index 1ee8792e99..3ed1915a7f 100644
--- a/tests/testthat/test-facet-strips.R
+++ b/tests/testthat/test-facet-strips.R
@@ -193,3 +193,21 @@ test_that("strip clipping can be set from the theme", {
   expect_equal(strip$x$top[[1]]$layout$clip, "off")
 })
 
+test_that("strip labels can be accessed", {
+
+  expect_null(get_strip_labels(ggplot()))
+
+  expect_equal(
+    get_strip_labels(ggplot() + facet_wrap(vars("X", "Y"))),
+    list(facets = data_frame0(`"X"` = "X", `"Y"` = "Y"))
+  )
+
+  expect_equal(
+    get_strip_labels(ggplot() + facet_grid(vars("X"), vars("Y"))),
+    list(
+      cols = data_frame0(`"Y"` = "Y"),
+      rows = data_frame0(`"X"` = "X")
+    )
+  )
+})
+

From db599f9a41be57c1482d4a9553c3db17e27f3b1e Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Fri, 31 May 2024 16:48:16 +0200
Subject: [PATCH 5/5] add news bullet

---
 NEWS.md | 1 +
 1 file changed, 1 insertion(+)

diff --git a/NEWS.md b/NEWS.md
index de3e87cee3..21629a4be1 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,6 @@
 # ggplot2 (development version)
 
+* New function `get_strip_labels()` to retrieve facet labels (@teunbrand, #4979)
 * The `arrow.fill` parameter is now applied to more line-based functions: 
   `geom_path()`, `geom_line()`, `geom_step()` `geom_function()`, line 
    geometries in `geom_sf()` and `element_line()`.