diff --git a/NEWS.md b/NEWS.md index e119ab57e3..b20976c5cc 100644 --- a/NEWS.md +++ b/NEWS.md @@ -320,6 +320,8 @@ (@teunbrand, #5093). * (internal) When `validate_subclass()` fails to find a class directly, it tries to retrieve the class via constructor functions (@teunbrand). +* (internal) The ViewScale class has a `make_fixed_copy()` method to permit + copying trained position scales (#3441). # ggplot2 3.5.1 diff --git a/R/scale-view.R b/R/scale-view.R index cf9d4195d5..a926084cd8 100644 --- a/R/scale-view.R +++ b/R/scale-view.R @@ -150,5 +150,31 @@ ViewScale <- ggproto("ViewScale", NULL, } self$rescale(b) + }, + make_fixed_copy = function(self) { + breaks <- self$get_breaks() + minor <- self$get_breaks_minor() + transform <- self$scale$get_transformation() + + if (self$scale$is_discrete()) { + limits <- self$get_limits() + } else { + limits <- self$continuous_range + } + + if (!is.null(transform)) { + breaks <- transform$inverse(breaks) + minor <- transform$inverse(minor) + } + + ggproto( + NULL, self$scale, + breaks = breaks, + minor_breaks = minor, + limits = limits, + expand = c(0, 0, 0, 0), + continuous_limits = self$continuous_range, + train = function (...) NULL + ) } ) diff --git a/tests/testthat/test-scales.R b/tests/testthat/test-scales.R index 0a750e4821..5f14a7189c 100644 --- a/tests/testthat/test-scales.R +++ b/tests/testthat/test-scales.R @@ -748,6 +748,32 @@ test_that("discrete scales work with NAs in arbitrary positions", { }) +test_that("ViewScales can make fixed copies", { + + p1 <- ggplot(mpg, aes(drv, displ)) + + geom_boxplot() + + annotate("point", x = 5, y = 10) + + scale_x_discrete(labels = c("four-wheel", "forward", "reverse")) + + b1 <- ggplot_build(p1)$layout$panel_params[[1]] + + # We build a second plot with the first plot's scales + p2 <- ggplot(mpg, aes(drv, cyl)) + + geom_violin() + + annotate("point", x = 15, y = 100) + + b1$x$make_fixed_copy() + + b1$y$make_fixed_copy() + b2 <- ggplot_build(p2) + + # Breaks and labels should respect p1's limits + x <- get_guide_data(b2, "x") + expect_equal(x$x, 0.6:2.6 / diff(b1$x.range)) + expect_equal(x$.label, c("four-wheel", "forward", "reverse")) + + y <- get_guide_data(b2, "y") + expect_equal(y$y, rescale(seq(2.5, 10, by = 2.5), from = b1$y.range)) +}) + test_that("discrete scales can map to 2D structures", { p <- ggplot(mtcars, aes(disp, mpg, colour = factor(cyl))) +