From 446144b628dff224a2ed7cae46ec9c8444562399 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Mon, 26 Jun 2023 20:02:30 +0200
Subject: [PATCH 1/5] Early return for key-only

---
 R/guides-.R | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/R/guides-.R b/R/guides-.R
index f8273d07e6..784c04c333 100644
--- a/R/guides-.R
+++ b/R/guides-.R
@@ -244,7 +244,7 @@ Guides <- ggproto(
   #      arrange all guide grobs
 
   build = function(self, scales, layers, default_mapping,
-                   position, theme, labels) {
+                   position, theme, labels, get_key = FALSE) {
 
     position  <- legend_position(position)
     no_guides <- zeroGrob()
@@ -279,6 +279,10 @@ Guides <- ggproto(
 
     # Merge and process layers
     guides$merge()
+    if (isTRUE(get_key)) {
+      return(lapply(guides$params, `[[`, "key"))
+    }
+
     guides$process_layers(layers)
     if (length(guides$guides) == 0) {
       return(no_guides)

From ea54e7a312d56234e03e73fe1dfc3e727a56444a Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Mon, 26 Jun 2023 20:42:30 +0200
Subject: [PATCH 2/5] Add `guide_data()`

---
 NAMESPACE         |   1 +
 R/guides-.R       | 130 ++++++++++++++++++++++++++++++++++++++++++++++
 man/guide_data.Rd |  50 ++++++++++++++++++
 3 files changed, 181 insertions(+)
 create mode 100644 man/guide_data.Rd

diff --git a/NAMESPACE b/NAMESPACE
index eb67c79182..61be3dafa6 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -422,6 +422,7 @@ export(guide_colorbar)
 export(guide_colorsteps)
 export(guide_colourbar)
 export(guide_coloursteps)
+export(guide_data)
 export(guide_gengrob)
 export(guide_geom)
 export(guide_legend)
diff --git a/R/guides-.R b/R/guides-.R
index 784c04c333..2e58b067a0 100644
--- a/R/guides-.R
+++ b/R/guides-.R
@@ -646,3 +646,133 @@ validate_guide <- function(guide) {
   }
   cli::cli_abort("Unknown guide: {guide}")
 }
+
+# Data accessor -----------------------------------------------------------
+
+#' Extract tick information from guides
+#'
+#' `guide_data()` builds a plot and extracts information from guide keys. This
+#' information typically contains positions, values and/or labels, depending
+#' on which aesthetic is queried or guide is used.
+#'
+#' @param plot A `ggplot` or `ggplot_build` object.
+#' @param aesthetic A string that describes a single aesthetic for which to
+#'   extract guide information. For example: `"colour"`, `"size"`, `"x"` or
+#'   `"y.sec"`.
+#' @param i,j An integer giving a row (i) and column (j) number of a facet for
+#'   which to return position guide information.
+#'
+#' @return A `data.frame` containing information extracted from the guide key,
+#'   a `list` when the coord doesn't support position axes, or `NULL` when no
+#'   such information could be found.
+#' @export
+#' @keywords internal
+#'
+#' @examples
+#' # A standard plot
+#' p <- ggplot(mtcars) +
+#'   aes(mpg, disp, colour = drat, size = drat) +
+#'   geom_point() +
+#'   facet_wrap(vars(cyl), scales = "free_x")
+#'
+#' # Guide information for legends
+#' guide_data(p, "size")
+#'
+#' # Note that legend guides can be merged
+#' merged <- p + guides(colour = "legend")
+#' guide_data(merged, "size")
+#'
+#' # Guide information for positions
+#' guide_data(p, "x", i = 1, j = 2)
+#'
+#' # Coord polar doesn't support proper guides, so we get a list
+#' polar <- p + coord_polar()
+#' guide_data(theta, "theta", i = 1, j = 2)
+guide_data <- function(plot = last_plot(), aesthetic, i = 1L, j = 1L) {
+
+  # Only handles a single aesthetic
+  check_string(aesthetic, allow_empty = FALSE)
+
+  if (!inherits(plot, "ggplot_built")) {
+    plot <- ggplot_build(plot)
+  }
+  if (aesthetic %in% c("x", "y", "x.sec", "y.sec", "theta", "r")) {
+    ans <- guide_data_position(plot, aesthetic, i = i, j = j)
+  } else {
+    ans <- guide_data_legend(plot, aesthetic)
+  }
+  ans
+}
+
+
+guide_data_legend <- function(plot, aesthetic, ...) {
+  data  <- plot$plot
+  theme <- plot_theme(data)
+
+  # Resolve guide position
+  position <- calc_element("legend.position", theme) %||% "right"
+  if (length(position) == 2) {
+    position <- "manual"
+  }
+  if (position == "none") {
+    return(NULL)
+  }
+
+  # Build guides to get keys
+  keys <- data$guides$build(
+    data$scales, position = position, theme = theme,
+    labels = data$labels, get_key = TRUE
+  )
+
+  # Might be zeroGrob if no guides were to be drawn
+  if (inherits(keys, "zeroGrob")) {
+    return(NULL)
+  }
+
+  # Find key with aesthetic
+  idx <- vapply(keys, function(key) aesthetic %in% colnames(key), logical(1))
+  if (sum(idx) == 0) {
+    return(NULL)
+  }
+  if (sum(idx) == 1L) {
+    return(keys[[which(idx)]])
+  }
+  keys[idx]
+}
+
+guide_data_position <- function(plot, aesthetic, i = 1L, j = 1L) {
+  check_number_whole(i)
+  check_number_whole(j)
+
+  # Select only the panel parameters for the relevant panel
+  layout <- plot$layout$layout
+  select <- layout[layout$ROW == i & layout$COL == j, , drop = FALSE]
+  if (nrow(select) < 1) {
+    return(NULL)
+  }
+  panel_params <- plot$layout$panel_params[select$PANEL]
+
+  # Copy layout with just the one set of panel parameters
+  layout <- ggproto(NULL, plot$layout, panel_params = panel_params)
+
+  # Setup guides
+  layout$setup_panel_guides(plot$plot$guides, plot$plot$layers)
+  guides <- layout$panel_params[[1]]$guides
+  if (is.null(guides)) {
+    # Probably an older coord that doesn't support ggproto guides
+    params <- layout$panel_params[[1]]
+    idx <- paste(aesthetic, c("major", "minor", "labels", "range"), sep = ".")
+    params <- params[intersect(names(params), idx)]
+    return(layout$panel_params[[1]][idx])
+  }
+
+  # Check if we have a guide
+  guide <- guides$get_guide(aesthetic)
+  if (inherits(guide, "GuideNone")) {
+    return(NULL)
+  }
+
+  # Get guide's key
+  guides$get_params(aesthetic)$key
+}
+
diff --git a/man/guide_data.Rd b/man/guide_data.Rd
new file mode 100644
index 0000000000..f460735cd3
--- /dev/null
+++ b/man/guide_data.Rd
@@ -0,0 +1,50 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/guides-.R
+\name{guide_data}
+\alias{guide_data}
+\title{Extract tick information from guides}
+\usage{
+guide_data(plot = last_plot(), aesthetic, i = 1L, j = 1L)
+}
+\arguments{
+\item{plot}{A \code{ggplot} or \code{ggplot_build} object.}
+
+\item{aesthetic}{A string that describes a single aesthetic for which to
+extract guide information. For example: \code{"colour"}, \code{"size"}, \code{"x"} or
+\code{"y.sec"}.}
+
+\item{i, j}{An integer giving a row (i) and column (j) number of a facet for
+which to return position guide information.}
+}
+\value{
+A \code{data.frame} containing information extracted from the guide key,
+a \code{list} when the coord doesn't support position axes, or \code{NULL} when no
+such information could be found.
+}
+\description{
+\code{guide_data()} builds a plot and extracts information from guide keys. This
+information typically contains positions, values and/or labels, depending
+on which aesthetic is queried or guide is used.
+}
+\examples{
+# A standard plot
+p <- ggplot(mtcars) +
+  aes(mpg, disp, colour = drat, size = drat) +
+  geom_point() +
+  facet_wrap(vars(cyl), scales = "free_x")
+
+# Guide information for legends
+guide_data(p, "size")
+
+# Note that legend guides can be merged
+merged <- p + guides(colour = "legend")
+guide_data(merged, "size")
+
+# Guide information for positions
+guide_data(p, "x", i = 1, j = 2)
+
+# Coord polar doesn't support proper guides, so we get a list
+polar <- p + coord_polar()
+guide_data(theta, "theta", i = 1, j = 2)
+}
+\keyword{internal}

From bbb693542b92759ee8b2c7344acc4403ac63221c Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Mon, 26 Jun 2023 20:42:42 +0200
Subject: [PATCH 3/5] Add tests

---
 tests/testthat/test-guides.R | 49 ++++++++++++++++++++++++++++++++++++
 1 file changed, 49 insertions(+)

diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R
index 4ef7174f99..921008ee43 100644
--- a/tests/testthat/test-guides.R
+++ b/tests/testthat/test-guides.R
@@ -311,6 +311,55 @@ test_that("guide_coloursteps and guide_bins return ordered breaks", {
   expect_true(all(diff(key$.value) < 0))
 })
 
+test_that("guide_data retrieves keys appropriately", {
+
+  p <- ggplot(mtcars, aes(mpg, disp, colour = drat, size = drat, fill = wt)) +
+    geom_point(shape = 21) +
+    facet_wrap(vars(cyl), scales = "free_x") +
+    guides(colour = "legend")
+  b <- ggplot_build(p)
+
+  # Test facetted panel
+  test <- guide_data(b, "x", i = 1, j = 2)
+  expect_equal(test$.label, c("18", "19", "20", "21"))
+
+  # Test plain legend
+  test <- guide_data(b, "fill")
+  expect_equal(test$.label, c("2", "3", "4", "5"))
+
+  # Test merged legend
+  test <- guide_data(b, "colour")
+  expect_true(all(c("colour", "size") %in% colnames(test)))
+
+  # Unmapped data
+  expect_null(guide_data(b, "shape"))
+
+  # Non-existent panels
+  expect_null(guide_data(b, "x", i = 2, j = 2))
+
+  expect_error(guide_data(b, 1), "must be a single string")
+  expect_error(guide_data(b, "x", i = "a"), "must be a whole number")
+})
+
+test_that("guide_data retrieves keys from exotic coords", {
+
+  p <- ggplot(mtcars, aes(mpg, disp)) + geom_point()
+
+  # Sanity check
+  test <- guide_data(p + coord_cartesian(), "x")
+  expect_equal(test$.label, c("10", "15", "20", "25", "30", "35"))
+
+  # We're not testing the formatting, so just testing output shape
+  test <- guide_data(p + coord_sf(crs = 3347), "y")
+  expect_equal(nrow(test), 5)
+  expect_true(all(c("x", ".value", ".label", "x") %in% colnames(test)))
+
+  # For coords that don't use guide system, we expect a list
+  test <- guide_data(p + coord_polar(), "theta")
+  expect_true(is.list(test) && !is.data.frame(test))
+  expect_equal(test$theta.labels, c("15", "20", "25", "30"))
+})
+
 # Visual tests ------------------------------------------------------------
 
 test_that("axis guides are drawn correctly", {

From 98d6831dca045796d945ea6c89d2aa1b71422ca0 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Mon, 26 Jun 2023 20:44:34 +0200
Subject: [PATCH 4/5] Add news bullet

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

diff --git a/NEWS.md b/NEWS.md
index 7a9eb66130..a226073a13 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -54,6 +54,8 @@
     * `guide_coloursteps()` and `guide_bins()` sort breaks (#5152).
     * `guide_axis()` gains a `cap` argument that can be used to trim the
       axis line to extreme breaks (#4907).
+    * The `guide_data()` function can be used to extract position and label
+      information from the plot (#5004).
 
 * `geom_label()` now uses the `angle` aesthetic (@teunbrand, #2785)
 * 'lines' units in `geom_label()`, often used in the `label.padding` argument, 

From 2b86fea3f5dc6a1b3b521101e39fc77b34276817 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Mon, 26 Jun 2023 21:02:49 +0200
Subject: [PATCH 5/5] Fix example

---
 R/guides-.R       | 2 +-
 man/guide_data.Rd | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/R/guides-.R b/R/guides-.R
index 2e58b067a0..50f08ab8b9 100644
--- a/R/guides-.R
+++ b/R/guides-.R
@@ -687,7 +687,7 @@ validate_guide <- function(guide) {
 #'
 #' # Coord polar doesn't support proper guides, so we get a list
 #' polar <- p + coord_polar()
-#' guide_data(theta, "theta", i = 1, j = 2)
+#' guide_data(polar, "theta", i = 1, j = 2)
 guide_data <- function(plot = last_plot(), aesthetic, i = 1L, j = 1L) {
 
   # Only handles a single aesthetic
diff --git a/man/guide_data.Rd b/man/guide_data.Rd
index f460735cd3..69a72c2191 100644
--- a/man/guide_data.Rd
+++ b/man/guide_data.Rd
@@ -45,6 +45,6 @@ guide_data(p, "x", i = 1, j = 2)
 
 # Coord polar doesn't support proper guides, so we get a list
 polar <- p + coord_polar()
-guide_data(theta, "theta", i = 1, j = 2)
+guide_data(polar, "theta", i = 1, j = 2)
 }
 \keyword{internal}