From 04c98047604bedaa924ec8f4cee3a056c20ad589 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Wed, 28 Aug 2024 16:17:13 +0200 Subject: [PATCH 01/17] remove vestigial code --- R/coord-.R | 5 +---- R/coord-sf.R | 4 ---- 2 files changed, 1 insertion(+), 8 deletions(-) diff --git a/R/coord-.R b/R/coord-.R index 57cf351f92..8a6ddf872d 100644 --- a/R/coord-.R +++ b/R/coord-.R @@ -185,10 +185,7 @@ Coord <- ggproto("Coord", is_free = function() FALSE, setup_params = function(data) { - list( - guide_default = guide_axis(), - guide_missing = guide_none() - ) + list() }, setup_data = function(data, params = list()) { diff --git a/R/coord-sf.R b/R/coord-sf.R index a14b3c718c..4831790632 100644 --- a/R/coord-sf.R +++ b/R/coord-sf.R @@ -259,10 +259,6 @@ CoordSf <- ggproto("CoordSf", CoordCartesian, # Rescale graticule for panel grid sf::st_geometry(graticule) <- sf_rescale01(sf::st_geometry(graticule), x_range, y_range) - graticule$x_start <- rescale(graticule$x_start, from = x_range) - graticule$x_end <- rescale(graticule$x_end, from = x_range) - graticule$y_start <- rescale(graticule$y_start, from = y_range) - graticule$y_end <- rescale(graticule$y_end, from = y_range) list2( x_range = x_range, From 24ccc94a5ae8c5898d7d776c6295b23bb7713478 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 30 Aug 2024 12:08:04 +0200 Subject: [PATCH 02/17] reverse mechanism for cartesian coords --- R/coord-.R | 3 +++ R/coord-cartesian-.R | 10 +++++++--- R/coord-fixed.R | 4 +++- R/scale-view.R | 3 +++ 4 files changed, 16 insertions(+), 4 deletions(-) diff --git a/R/coord-.R b/R/coord-.R index 8a6ddf872d..0c321a8257 100644 --- a/R/coord-.R +++ b/R/coord-.R @@ -59,6 +59,9 @@ Coord <- ggproto("Coord", # "on" = yes, "off" = no clip = "on", + # Should any of the scales be reversed? + reverse = "none", + aspect = function(ranges) NULL, labels = function(self, labels, panel_params) { diff --git a/R/coord-cartesian-.R b/R/coord-cartesian-.R index 74f46433db..81d90e0d51 100644 --- a/R/coord-cartesian-.R +++ b/R/coord-cartesian-.R @@ -60,11 +60,12 @@ #' # displayed bigger #' d + coord_cartesian(xlim = c(0, 1)) coord_cartesian <- function(xlim = NULL, ylim = NULL, expand = TRUE, - default = FALSE, clip = "on") { + default = FALSE, clip = "on", reverse = "none") { check_coord_limits(xlim) check_coord_limits(ylim) ggproto(NULL, CoordCartesian, limits = list(x = xlim, y = ylim), + reverse = reverse, expand = expand, default = default, clip = clip @@ -93,8 +94,11 @@ CoordCartesian <- ggproto("CoordCartesian", Coord, self$range(panel_params) }, - transform = function(data, panel_params) { - data <- transform_position(data, panel_params$x$rescale, panel_params$y$rescale) + transform = function(self, data, panel_params) { + reverse <- self$reverse %||% "none" + x <- panel_params$x[[switch(reverse, xy = , x = "reverse", "rescale")]] + y <- panel_params$y[[switch(reverse, xy = , y = "reverse", "rescale")]] + data <- transform_position(data, x, y) transform_position(data, squish_infinite, squish_infinite) }, diff --git a/R/coord-fixed.R b/R/coord-fixed.R index a942fbb28b..d48824cfc4 100644 --- a/R/coord-fixed.R +++ b/R/coord-fixed.R @@ -22,13 +22,15 @@ #' p + coord_fixed(xlim = c(15, 30)) #' #' # Resize the plot to see that the specified aspect ratio is maintained -coord_fixed <- function(ratio = 1, xlim = NULL, ylim = NULL, expand = TRUE, clip = "on") { +coord_fixed <- function(ratio = 1, xlim = NULL, ylim = NULL, expand = TRUE, + clip = "on", reverse = "none") { check_coord_limits(xlim) check_coord_limits(ylim) ggproto(NULL, CoordFixed, limits = list(x = xlim, y = ylim), ratio = ratio, expand = expand, + reverse = reverse, clip = clip ) } diff --git a/R/scale-view.R b/R/scale-view.R index de78ebffb6..b46e073bdb 100644 --- a/R/scale-view.R +++ b/R/scale-view.R @@ -134,6 +134,9 @@ ViewScale <- ggproto("ViewScale", NULL, rescale = function(self, x) { self$scale$rescale(x, self$limits, self$continuous_range) }, + reverse = function(self, x) { + self$scale$rescale(x, rev(self$limits), rev(self$continuous_range)) + }, map = function(self, x) { if (self$is_discrete()) { self$scale$map(x, self$limits) From 06f9eda6cbcda5573a303d8bb8f261c80a5ca51e Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 30 Aug 2024 12:08:35 +0200 Subject: [PATCH 03/17] reverse mechanism for sf coord --- R/coord-sf.R | 44 ++++++++++++++++++++++++++++++++------------ 1 file changed, 32 insertions(+), 12 deletions(-) diff --git a/R/coord-sf.R b/R/coord-sf.R index 4831790632..11e18bb585 100644 --- a/R/coord-sf.R +++ b/R/coord-sf.R @@ -83,18 +83,22 @@ CoordSf <- ggproto("CoordSf", CoordCartesian, source_crs <- panel_params$default_crs target_crs <- panel_params$crs + # CoordSf doesn't use the viewscale rescaling, so we just flip ranges + reverse <- self$reverse %||% "none" + x_range <- switch(reverse, xy = , x = rev, identity)(panel_params$x_range) + y_range <- switch(reverse, xy = , y = rev, identity)(panel_params$y_range) + # normalize geometry data, it should already be in the correct crs here data[[ geom_column(data) ]] <- sf_rescale01( data[[ geom_column(data) ]], - panel_params$x_range, - panel_params$y_range + x_range, y_range ) # transform and normalize regular position data data <- transform_position( sf_transform_xy(data, target_crs, source_crs), - function(x) rescale(x, from = panel_params$x_range), - function(x) rescale(x, from = panel_params$y_range) + function(x) rescale(x, from = x_range), + function(x) rescale(x, from = y_range) ) transform_position(data, squish_infinite, squish_infinite) @@ -257,17 +261,17 @@ CoordSf <- ggproto("CoordSf", CoordCartesian, ) ) - # Rescale graticule for panel grid - sf::st_geometry(graticule) <- sf_rescale01(sf::st_geometry(graticule), x_range, y_range) - - list2( + panel_params <- list2( x_range = x_range, y_range = y_range, - graticule = graticule, crs = params$crs, default_crs = params$default_crs, !!!viewscales ) + + # Rescale graticule for panel grid + panel_params$graticule <- self$transform(graticule, panel_params) + panel_params }, train_panel_guides = function(self, panel_params, layers, params = list()) { @@ -402,12 +406,26 @@ sf_transform_xy <- function(data, target_crs, source_crs, authority_compliant = ## helper functions to normalize geometry and position data # normalize geometry data (variable x is geometry column) +# this is a wrapper for `sf::st_normalize()`, but deals with empty input and +# reversed ranges too sf_rescale01 <- function(x, x_range, y_range) { if (is.null(x)) { return(x) } - - sf::st_normalize(x, c(x_range[1], y_range[1], x_range[2], y_range[2])) + mult <- cbind(1, 1) + if (isTRUE(x_range[1] > x_range[2])) { + x_range <- sort(x_range) + mult[1] <- -1 + } + if (isTRUE(y_range[1] > y_range[2])) { + y_range <- sort(y_range) + mult[2] <- -1 + } + x <- sf::st_normalize(x, c(x_range[1], y_range[1], x_range[2], y_range[2])) + if (all(mult == 1)) { + return(x) + } + x * mult + pmax(-mult, 0) } # different limits methods @@ -530,7 +548,8 @@ coord_sf <- function(xlim = NULL, ylim = NULL, expand = TRUE, datum = sf::st_crs(4326), label_graticule = waiver(), label_axes = waiver(), lims_method = "cross", - ndiscr = 100, default = FALSE, clip = "on") { + ndiscr = 100, default = FALSE, clip = "on", + reverse = "none") { if (is.waive(label_graticule) && is.waive(label_axes)) { # if both `label_graticule` and `label_axes` are set to waive then we @@ -574,6 +593,7 @@ coord_sf <- function(xlim = NULL, ylim = NULL, expand = TRUE, label_axes = label_axes, label_graticule = label_graticule, ndiscr = ndiscr, + reverse = reverse, expand = expand, default = default, clip = clip From 8169fc42a51d0b89f25ad3270dbf26cb7426816a Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 30 Aug 2024 15:01:17 +0200 Subject: [PATCH 04/17] simplify `guide_axis_theta()` decor stuff --- R/guide-axis-theta.R | 23 ++++++----------------- 1 file changed, 6 insertions(+), 17 deletions(-) diff --git a/R/guide-axis-theta.R b/R/guide-axis-theta.R index 2e4f7a6cef..e1ea809dbe 100644 --- a/R/guide-axis-theta.R +++ b/R/guide-axis-theta.R @@ -61,26 +61,15 @@ guide_axis_theta <- function(title = waiver(), theme = NULL, angle = waiver(), GuideAxisTheta <- ggproto( "GuideAxisTheta", GuideAxis, - extract_decor = function(scale, aesthetic, key, cap = "none", position, ...) { - # For theta position, we pretend we're left/right because that will put - # the correct opposite aesthetic as the line coordinates. - position <- switch(position, theta = "left", theta.sec = "right", position) - - GuideAxis$extract_decor( - scale = scale, aesthetic = aesthetic, - position = position, key = key, cap = cap - ) - }, - transform = function(params, coord, panel_params) { + opposite_var <- setdiff(c("x", "y"), params$aesthetic) + opposite_value <- switch(params$position, top = , right = , theta.sec = -Inf, Inf) if (nrow(params$key) > 0) { - opposite <- setdiff(c("x", "y"), params$aesthetic) - params$key[[opposite]] <- switch(params$position, - theta.sec = -Inf, - top = -Inf, - right = -Inf, - Inf) + params$key[[opposite_var]] <- opposite_value + } + if (nrow(params$decor) > 0) { + params$decor[[opposite_var]] <- opposite_value } params <- GuideAxis$transform(params, coord, panel_params) From f0332ca48898bedb3f5f3667c3143b266a3a5a1e Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 30 Aug 2024 15:03:23 +0200 Subject: [PATCH 05/17] replace `direction` with `reverse = "theta"` --- R/coord-radial.R | 57 ++++++++++++++++++++++++------------------------ 1 file changed, 29 insertions(+), 28 deletions(-) diff --git a/R/coord-radial.R b/R/coord-radial.R index 2f44e1ae4b..7aa5bfd834 100644 --- a/R/coord-radial.R +++ b/R/coord-radial.R @@ -39,11 +39,12 @@ coord_radial <- function(theta = "x", start = 0, end = NULL, expand = TRUE, - direction = 1, + direction = deprecated(), clip = "off", r.axis.inside = NULL, rotate.angle = FALSE, inner.radius = 0, + reverse = "none", r_axis_inside = deprecated(), rotate_angle = deprecated()) { @@ -59,12 +60,19 @@ coord_radial <- function(theta = "x", ) rotate.angle <- rotate_angle } + if (lifecycle::is_present(direction)) { + deprecate_warn0( + "3.5.2", "coord_radial(direction)", "coord_radial(reverse)" + ) + reverse <- switch(reverse, "r" = "thetar", "theta") + } theta <- arg_match0(theta, c("x", "y")) r <- if (theta == "x") "y" else "x" if (!is.numeric(r.axis.inside)) { check_bool(r.axis.inside, allow_null = TRUE) } + reverse <- arg_match0(reverse, c("theta", "thetar", "r", "none")) check_bool(expand) check_bool(rotate.angle) @@ -72,19 +80,21 @@ coord_radial <- function(theta = "x", check_number_decimal(end, allow_infinite = FALSE, allow_null = TRUE) check_number_decimal(inner.radius, min = 0, max = 1, allow_infinite = FALSE) - end <- end %||% (start + 2 * pi) - if (start > end) { - n_rotate <- ((start - end) %/% (2 * pi)) + 1 - start <- start - n_rotate * 2 * pi + arc <- c(start, end %||% (start + 2 * pi)) + if (arc[1] > arc[2]) { + n_rotate <- ((arc[1] - arc[2]) %/% (2 * pi)) + 1 + arc[1] <- arc[1] - n_rotate * 2 * pi } - r.axis.inside <- r.axis.inside %||% !(abs(end - start) >= 1.999 * pi) + arc <- switch(reverse, thetar = , theta = rev(arc), arc) + + r.axis.inside <- r.axis.inside %||% !(abs(arc[2] - arc[1]) >= 1.999 * pi) ggproto(NULL, CoordRadial, theta = theta, r = r, - arc = c(start, end), + arc = arc, expand = expand, - direction = sign(direction), + reverse = reverse, r_axis_inside = r.axis.inside, rotate_angle = rotate.angle, inner_radius = c(inner.radius, 1) * 0.4, @@ -108,16 +118,10 @@ CoordRadial <- ggproto("CoordRadial", Coord, arc <- details$arc %||% c(0, 2 * pi) if (self$theta == "x") { r <- rescale(y, from = details$r.range, to = self$inner_radius / 0.4) - theta <- theta_rescale_no_clip( - x, details$theta.range, - arc, self$direction - ) + theta <- theta_rescale_no_clip(x, details$theta.range, arc) } else { r <- rescale(x, from = details$r.range, to = self$inner_radius / 0.4) - theta <- theta_rescale_no_clip( - y, details$theta.range, - arc, self$direction - ) + theta <- theta_rescale_no_clip(y, details$theta.range, arc) } dist_polar(r, theta) @@ -201,10 +205,10 @@ CoordRadial <- ggproto("CoordRadial", Coord, r_position <- c("left", "right") # If both opposite direction and opposite position, don't flip - if (xor(self$direction == -1, opposite_r)) { + if (xor(self$reverse %in% c("thetar", "theta"), opposite_r)) { r_position <- rev(r_position) } - arc <- rad2deg(panel_params$axis_rotation) * self$direction + arc <- rad2deg(panel_params$axis_rotation) if (opposite_r) { arc <- rev(arc) } @@ -281,10 +285,7 @@ CoordRadial <- ggproto("CoordRadial", Coord, arc <- panel_params$arc %||% c(0, 2 * pi) data$r <- r_rescale(data$r, panel_params$r.range, panel_params$inner_radius) - data$theta <- theta_rescale( - data$theta, panel_params$theta.range, - arc, self$direction - ) + data$theta <- theta_rescale(data$theta, panel_params$theta.range, arc) data$x <- rescale(data$r * sin(data$theta) + 0.5, from = bbox$x) data$y <- rescale(data$r * cos(data$theta) + 0.5, from = bbox$y) @@ -313,7 +314,6 @@ CoordRadial <- ggproto("CoordRadial", Coord, bbox <- panel_params$bbox %||% list(x = c(0, 1), y = c(0, 1)) arc <- panel_params$arc %||% c(0, 2 * pi) - dir <- self$direction inner_radius <- panel_params$inner_radius theta_lim <- panel_params$theta.range @@ -321,13 +321,13 @@ CoordRadial <- ggproto("CoordRadial", Coord, theta_min <- setdiff(panel_params$theta.minor, theta_maj) if (length(theta_maj) > 0) { - theta_maj <- theta_rescale(theta_maj, theta_lim, arc, dir) + theta_maj <- theta_rescale(theta_maj, theta_lim, arc) } if (length(theta_min) > 0) { - theta_min <- theta_rescale(theta_min, theta_lim, arc, dir) + theta_min <- theta_rescale(theta_min, theta_lim, arc) } - theta_fine <- theta_rescale(seq(0, 1, length.out = 100), c(0, 1), arc, dir) + theta_fine <- theta_rescale(seq(0, 1, length.out = 100), c(0, 1), arc) r_fine <- r_rescale(panel_params$r.major, panel_params$r.range, panel_params$inner_radius) @@ -392,8 +392,8 @@ CoordRadial <- ggproto("CoordRadial", Coord, bbox <- panel_params$bbox dir <- self$direction rot <- panel_params$axis_rotation - rot <- if (dir == 1) rot else rev(rot) - rot <- dir * rad2deg(-rot) + rot <- switch(self$reverse, thetar = , theta = rev(rot), rot) + rot <- rad2deg(-rot) left <- panel_guides_grob(panel_params$guides, position = "left", theme) left <- rotate_r_axis(left, rot[1], bbox, "left") @@ -537,6 +537,7 @@ polar_bbox <- function(arc, margin = c(0.05, 0.05, 0.05, 0.05), if (abs(diff(arc)) >= 2 * pi) { return(list(x = c(0, 1), y = c(0, 1))) } + arc <- sort(arc) # X and Y position of the sector arc ends xmax <- 0.5 * sin(arc) + 0.5 From fbc098fe892ed8ed97735b5b6e47281ac7843d3c Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 30 Aug 2024 15:03:48 +0200 Subject: [PATCH 06/17] swap `inner_radius` when `reverse = "r"` --- R/coord-radial.R | 5 ++++- R/guide-axis-theta.R | 3 +++ 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/R/coord-radial.R b/R/coord-radial.R index 7aa5bfd834..bce7c865e8 100644 --- a/R/coord-radial.R +++ b/R/coord-radial.R @@ -89,6 +89,9 @@ coord_radial <- function(theta = "x", r.axis.inside <- r.axis.inside %||% !(abs(arc[2] - arc[1]) >= 1.999 * pi) + inner.radius <- c(inner.radius, 1) * 0.4 + inner.radius <- switch(reverse, thetar = , r = rev, identity)(inner.radius) + ggproto(NULL, CoordRadial, theta = theta, r = r, @@ -97,7 +100,7 @@ coord_radial <- function(theta = "x", reverse = reverse, r_axis_inside = r.axis.inside, rotate_angle = rotate.angle, - inner_radius = c(inner.radius, 1) * 0.4, + inner_radius = inner.radius, clip = clip ) } diff --git a/R/guide-axis-theta.R b/R/guide-axis-theta.R index e1ea809dbe..5817f49d85 100644 --- a/R/guide-axis-theta.R +++ b/R/guide-axis-theta.R @@ -65,6 +65,9 @@ GuideAxisTheta <- ggproto( opposite_var <- setdiff(c("x", "y"), params$aesthetic) opposite_value <- switch(params$position, top = , right = , theta.sec = -Inf, Inf) + if (is.unsorted(panel_params$inner_radius %||% NA)) { + opposite_value <- -opposite_value + } if (nrow(params$key) > 0) { params$key[[opposite_var]] <- opposite_value } From 7958b0b6565bc7d4073cb56910f48e83f65b2430 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 30 Aug 2024 15:21:50 +0200 Subject: [PATCH 07/17] reverse for coord_transform --- R/coord-transform.R | 22 ++++++++++++++++++---- 1 file changed, 18 insertions(+), 4 deletions(-) diff --git a/R/coord-transform.R b/R/coord-transform.R index 83ffd7b9ee..501ec7349d 100644 --- a/R/coord-transform.R +++ b/R/coord-transform.R @@ -78,7 +78,8 @@ #' plot + coord_trans(x = "sqrt") #' } coord_trans <- function(x = "identity", y = "identity", xlim = NULL, ylim = NULL, - limx = deprecated(), limy = deprecated(), clip = "on", expand = TRUE) { + limx = deprecated(), limy = deprecated(), clip = "on", + expand = TRUE, reverse = "none") { if (lifecycle::is_present(limx)) { deprecate_warn0("3.3.0", "coord_trans(limx)", "coord_trans(xlim)") xlim <- limx @@ -99,6 +100,7 @@ coord_trans <- function(x = "identity", y = "identity", xlim = NULL, ylim = NULL trans = list(x = x, y = y), limits = list(x = xlim, y = ylim), expand = expand, + reverse = reverse, clip = clip ) } @@ -132,14 +134,17 @@ CoordTrans <- ggproto("CoordTrans", Coord, transform = function(self, data, panel_params) { # trans_x() and trans_y() needs to keep Inf values because this can be called # in guide_transform.axis() + reverse <- self$reverse %||% "none" + x_range <- switch(reverse, xy = , x = rev, identity)(panel_params$x.range) + y_range <- switch(reverse, xy = , y = rev, identity)(panel_params$y.range) trans_x <- function(data) { idx <- !is.infinite(data) - data[idx] <- transform_value(self$trans$x, data[idx], panel_params$x.range) + data[idx] <- transform_value(self$trans$x, data[idx], x_range) data } trans_y <- function(data) { idx <- !is.infinite(data) - data[idx] <- transform_value(self$trans$y, data[idx], panel_params$y.range) + data[idx] <- transform_value(self$trans$y, data[idx], y_range) data } @@ -158,7 +163,16 @@ CoordTrans <- ggproto("CoordTrans", Coord, ) }, - render_bg = function(panel_params, theme) { + render_bg = function(self, panel_params, theme) { + if (self$reverse %in% c("x", "xy")) { + panel_params$x.minor <- 1 - panel_params$x.minor + panel_params$x.major <- 1 - panel_params$x.major + } + if (self$reverse %in% c("y", "xy")) { + panel_params$y.minor <- 1 - panel_params$y.minor + panel_params$y.major <- 1 - panel_params$y.major + } + guide_grid( theme, panel_params$x.minor, From 2af9b1bc3227e0b3e589bca84420d1647be276e7 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 2 Sep 2024 10:33:52 +0200 Subject: [PATCH 08/17] rewrite `guide_grid()` to work with coord transforms --- R/guides-grid.R | 74 ++++++++++++++++++++++++++++++++----------------- 1 file changed, 48 insertions(+), 26 deletions(-) diff --git a/R/guides-grid.R b/R/guides-grid.R index 9ae79a19a9..6b8f116a24 100644 --- a/R/guides-grid.R +++ b/R/guides-grid.R @@ -3,32 +3,54 @@ # be converted to `'native'` units by polylineGrob() downstream # # Any minor lines coinciding with major lines will be removed -guide_grid <- function(theme, x.minor, x.major, y.minor, y.major) { +guide_grid <- function(theme, panel_params, coord, square = TRUE) { - x.minor <- setdiff(x.minor, x.major) - y.minor <- setdiff(y.minor, y.major) + x_major <- panel_params$x$mapped_breaks() + x_minor <- setdiff(panel_params$x$mapped_breaks_minor(), x_major) - ggname("grill", grobTree( - element_render(theme, "panel.background"), - if (length(y.minor) > 0) element_render( - theme, "panel.grid.minor.y", - x = rep(0:1, length(y.minor)), y = rep(y.minor, each = 2), - id.lengths = rep(2, length(y.minor)) - ), - if (length(x.minor) > 0) element_render( - theme, "panel.grid.minor.x", - x = rep(x.minor, each = 2), y = rep(0:1, length(x.minor)), - id.lengths = rep(2, length(x.minor)) - ), - if (length(y.major) > 0) element_render( - theme, "panel.grid.major.y", - x = rep(0:1, length(y.major)), y = rep(y.major, each = 2), - id.lengths = rep(2, length(y.major)) - ), - if (length(x.major) > 0) element_render( - theme, "panel.grid.major.x", - x = rep(x.major, each = 2), y = rep(0:1, length(x.major)), - id.lengths = rep(2, length(x.major)) - ) - )) + y_major <- panel_params$y$mapped_breaks() + y_minor <- setdiff(panel_params$y$mapped_breaks_minor(), y_major) + + transform <- if (isTRUE(square)) { + function(x) coord$transform(x, panel_params) + } else { + function(x) coord_munch(coord, x, panel_params) + } + + grill <- Map( + f = breaks_as_grid, + var = list(y_minor, x_minor, y_major, x_major), + type = c("minor.y", "minor.x", "major.y", "major.x"), + MoreArgs = list(theme = theme, transform = transform) + ) + grill <- compact(grill) + + background <- element_render(theme, "panel.background") + if (!isTRUE(square) && !is.zero(background)) { + gp <- background$gp + background <- data_frame0(x = c(1, 1, -1, -1), y = c(1, -1, -1, 1)) * Inf + background <- coord_munch(coord, background, panel_params, is_closed = TRUE) + background <- polygonGrob(x = background$x, y = background$y, gp = gp) + } + + ggname("grill", inject(grobTree(background, !!!grill))) +} + +breaks_as_grid <- function(var, type, transform, theme) { + n <- length(var) + if (n < 1) { + return(NULL) + } + df <- data_frame0( + var = rep(var, each = 2), + alt = rep(c(-Inf, Inf), n), + group = rep(seq_along(var), each = 2) + ) + colnames(df)[1:2] <- + switch(type, major.y = , minor.y = c("y", "x"), c("x", "y")) + df <- transform(df) + element_render( + theme, paste0("panel.grid.", type), x = df$x, y = df$y, + id.lengths = vec_unrep(df$group)$times + ) } From 1397518959a515af24addaffb8f25b7dc99d1be8 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 2 Sep 2024 10:34:13 +0200 Subject: [PATCH 09/17] new ViewScale methods for mapped (but not rescaled) breaks --- R/scale-view.R | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/R/scale-view.R b/R/scale-view.R index b46e073bdb..acbe82b136 100644 --- a/R/scale-view.R +++ b/R/scale-view.R @@ -147,6 +147,16 @@ ViewScale <- ggproto("ViewScale", NULL, make_title = function(self, title) { self$scale$make_title(title) }, + mapped_breaks = function(self) { + self$map(self$get_breaks()) + }, + mapped_breaks_minor = function(self) { + b <- self$get_breaks_minor() + if (is.null(b)) { + return(NULL) + } + self$map(b) + }, break_positions = function(self) { self$rescale(self$get_breaks()) }, From ff205a47df5ba8a5808ec4abc1798a30b62f3a37 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 2 Sep 2024 10:35:56 +0200 Subject: [PATCH 10/17] adopt new `guide_grid()` --- R/coord-cartesian-.R | 10 ++----- R/coord-radial.R | 67 ++++---------------------------------------- R/coord-transform.R | 17 +---------- 3 files changed, 8 insertions(+), 86 deletions(-) diff --git a/R/coord-cartesian-.R b/R/coord-cartesian-.R index 81d90e0d51..2562ac1cdf 100644 --- a/R/coord-cartesian-.R +++ b/R/coord-cartesian-.R @@ -109,14 +109,8 @@ CoordCartesian <- ggproto("CoordCartesian", Coord, ) }, - render_bg = function(panel_params, theme) { - guide_grid( - theme, - panel_params$x$break_positions_minor(), - panel_params$x$break_positions(), - panel_params$y$break_positions_minor(), - panel_params$y$break_positions() - ) + render_bg = function(self, panel_params, theme) { + guide_grid(theme, panel_params, self) }, render_axis_h = function(panel_params, theme) { diff --git a/R/coord-radial.R b/R/coord-radial.R index bce7c865e8..b0f1f777d7 100644 --- a/R/coord-radial.R +++ b/R/coord-radial.R @@ -314,69 +314,12 @@ CoordRadial <- ggproto("CoordRadial", Coord, }, render_bg = function(self, panel_params, theme) { - - bbox <- panel_params$bbox %||% list(x = c(0, 1), y = c(0, 1)) - arc <- panel_params$arc %||% c(0, 2 * pi) - inner_radius <- panel_params$inner_radius - - theta_lim <- panel_params$theta.range - theta_maj <- panel_params$theta.major - theta_min <- setdiff(panel_params$theta.minor, theta_maj) - - if (length(theta_maj) > 0) { - theta_maj <- theta_rescale(theta_maj, theta_lim, arc) - } - if (length(theta_min) > 0) { - theta_min <- theta_rescale(theta_min, theta_lim, arc) - } - - theta_fine <- theta_rescale(seq(0, 1, length.out = 100), c(0, 1), arc) - r_fine <- r_rescale(panel_params$r.major, panel_params$r.range, - panel_params$inner_radius) - - # This gets the proper theme element for theta and r grid lines: - # panel.grid.major.x or .y - grid_elems <- paste( - c("panel.grid.major.", "panel.grid.minor.", "panel.grid.major."), - c(self$theta, self$theta, self$r), sep = "" + panel_params <- switch( + self$theta, + x = rename(panel_params, c(theta = "x", r = "y")), + y = rename(panel_params, c(theta = "y", r = "x")) ) - grid_elems <- lapply(grid_elems, calc_element, theme = theme) - majortheta <- paste("panel.grid.major.", self$theta, sep = "") - minortheta <- paste("panel.grid.minor.", self$theta, sep = "") - majorr <- paste("panel.grid.major.", self$r, sep = "") - - bg_element <- calc_element("panel.background", theme) - if (!inherits(bg_element, "element_blank")) { - background <- data_frame0( - x = c(Inf, Inf, -Inf, -Inf), - y = c(Inf, -Inf, -Inf, Inf) - ) - background <- coord_munch(self, background, panel_params, is_closed = TRUE) - bg_gp <- gg_par( - lwd = bg_element$linewidth, - col = bg_element$colour, fill = bg_element$fill, - lty = bg_element$linetype - ) - background <- polygonGrob( - x = background$x, y = background$y, - gp = bg_gp - ) - } else { - background <- zeroGrob() - } - - ggname("grill", grobTree( - background, - theta_grid(theta_maj, grid_elems[[1]], inner_radius, bbox), - theta_grid(theta_min, grid_elems[[2]], inner_radius, bbox), - element_render( - theme, majorr, name = "radius", - x = rescale(outer(sin(theta_fine), r_fine) + 0.5, from = bbox$x), - y = rescale(outer(cos(theta_fine), r_fine) + 0.5, from = bbox$y), - id.lengths = rep(length(theta_fine), length(r_fine)), - default.units = "native" - ) - )) + guide_grid(theme, panel_params, self, square = FALSE) }, render_fg = function(self, panel_params, theme) { diff --git a/R/coord-transform.R b/R/coord-transform.R index 501ec7349d..c88d9400cd 100644 --- a/R/coord-transform.R +++ b/R/coord-transform.R @@ -164,22 +164,7 @@ CoordTrans <- ggproto("CoordTrans", Coord, }, render_bg = function(self, panel_params, theme) { - if (self$reverse %in% c("x", "xy")) { - panel_params$x.minor <- 1 - panel_params$x.minor - panel_params$x.major <- 1 - panel_params$x.major - } - if (self$reverse %in% c("y", "xy")) { - panel_params$y.minor <- 1 - panel_params$y.minor - panel_params$y.major <- 1 - panel_params$y.major - } - - guide_grid( - theme, - panel_params$x.minor, - panel_params$x.major, - panel_params$y.minor, - panel_params$y.major - ) + guide_grid(theme, panel_params, self) }, render_axis_h = function(panel_params, theme) { From 50e8aca6dd446a48112ba855409bde3a879fc1ec Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 2 Sep 2024 10:36:20 +0200 Subject: [PATCH 11/17] accept that `coord_radial()` now renders minor r gridlines --- .../bottom-half-circle-with-rotated-text.svg | 22 ++--- ...with-axes-placed-at-90-and-225-degrees.svg | 23 ++--- .../inner-radius-with-all-axes.svg | 33 ++++--- .../coord-polar/partial-with-all-axes.svg | 34 ++++---- ...xis-theta-with-angle-adapting-to-theta.svg | 87 ++++++++++--------- .../_snaps/guides/stacked-radial-axes.svg | 24 ++--- 6 files changed, 122 insertions(+), 101 deletions(-) diff --git a/tests/testthat/_snaps/coord-polar/bottom-half-circle-with-rotated-text.svg b/tests/testthat/_snaps/coord-polar/bottom-half-circle-with-rotated-text.svg index caa297b3f5..c01f91abbc 100644 --- a/tests/testthat/_snaps/coord-polar/bottom-half-circle-with-rotated-text.svg +++ b/tests/testthat/_snaps/coord-polar/bottom-half-circle-with-rotated-text.svg @@ -29,17 +29,17 @@ - - - - - - - - - - - + + + + + + + + + + + cat strawberry cake diff --git a/tests/testthat/_snaps/coord-polar/full-circle-with-axes-placed-at-90-and-225-degrees.svg b/tests/testthat/_snaps/coord-polar/full-circle-with-axes-placed-at-90-and-225-degrees.svg index 59e7973b41..497db8dcf4 100644 --- a/tests/testthat/_snaps/coord-polar/full-circle-with-axes-placed-at-90-and-225-degrees.svg +++ b/tests/testthat/_snaps/coord-polar/full-circle-with-axes-placed-at-90-and-225-degrees.svg @@ -29,16 +29,19 @@ - - - - - - - - - - + + + + + + + + + + + + + 0 diff --git a/tests/testthat/_snaps/coord-polar/inner-radius-with-all-axes.svg b/tests/testthat/_snaps/coord-polar/inner-radius-with-all-axes.svg index 212100c87c..b75d829d47 100644 --- a/tests/testthat/_snaps/coord-polar/inner-radius-with-all-axes.svg +++ b/tests/testthat/_snaps/coord-polar/inner-radius-with-all-axes.svg @@ -29,20 +29,25 @@ - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/coord-polar/partial-with-all-axes.svg b/tests/testthat/_snaps/coord-polar/partial-with-all-axes.svg index bc58f6429b..03d06791cf 100644 --- a/tests/testthat/_snaps/coord-polar/partial-with-all-axes.svg +++ b/tests/testthat/_snaps/coord-polar/partial-with-all-axes.svg @@ -29,21 +29,25 @@ - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/guides/guide-axis-theta-with-angle-adapting-to-theta.svg b/tests/testthat/_snaps/guides/guide-axis-theta-with-angle-adapting-to-theta.svg index b6cfa798fc..48b903c6f3 100644 --- a/tests/testthat/_snaps/guides/guide-axis-theta-with-angle-adapting-to-theta.svg +++ b/tests/testthat/_snaps/guides/guide-axis-theta-with-angle-adapting-to-theta.svg @@ -29,47 +29,52 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/guides/stacked-radial-axes.svg b/tests/testthat/_snaps/guides/stacked-radial-axes.svg index 18609a9a74..9b4cf580e7 100644 --- a/tests/testthat/_snaps/guides/stacked-radial-axes.svg +++ b/tests/testthat/_snaps/guides/stacked-radial-axes.svg @@ -29,16 +29,20 @@ - - - - - - - - - - + + + + + + + + + + + + + + From 7d0c52b3043575642298eed0cb9f82946929cf36 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 2 Sep 2024 10:47:02 +0200 Subject: [PATCH 12/17] document --- R/coord-cartesian-.R | 4 ++++ R/coord-radial.R | 6 +++++- man/coord_cartesian.Rd | 8 +++++++- man/coord_fixed.Rd | 14 +++++++++++++- man/coord_polar.Rd | 10 ++++++++-- man/coord_trans.Rd | 8 +++++++- man/ggsf.Rd | 8 +++++++- 7 files changed, 51 insertions(+), 7 deletions(-) diff --git a/R/coord-cartesian-.R b/R/coord-cartesian-.R index 2562ac1cdf..bf85d52607 100644 --- a/R/coord-cartesian-.R +++ b/R/coord-cartesian-.R @@ -21,6 +21,10 @@ #' limits are set via `xlim` and `ylim` and some data points fall outside those #' limits, then those data points may show up in places such as the axes, the #' legend, the plot title, or the plot margins. +#' @param reverse A string giving which directions to reverse. `"none"` +#' (default) keeps directions as is. `"x"` and `"y"` can be used to reverse +#' their respective directions. `"xy"` can be used to reverse both +#' directions. #' @export #' @examples #' # There are two ways of zooming the plot display: with scales or diff --git a/R/coord-radial.R b/R/coord-radial.R index b0f1f777d7..8f15b72dcd 100644 --- a/R/coord-radial.R +++ b/R/coord-radial.R @@ -19,7 +19,11 @@ #' in accordance with the computed `theta` position. If `FALSE` (default), #' no such transformation is performed. Can be useful to rotate text geoms in #' alignment with the coordinates. -#' @param inner.radius A `numeric` between 0 and 1 setting the size of a inner.radius hole. +#' @param inner.radius A `numeric` between 0 and 1 setting the size of a +#' inner radius hole. +#' @param reverse A string giving which directions to reverse. `"none"` +#' (default) keep directions as is. `"theta"` reverses the angle and `"r"` +#' reverses the radius. `"thetar"` reverses both the angle and the radius. #' @param r_axis_inside,rotate_angle `r lifecycle::badge("deprecated")` #' #' @note diff --git a/man/coord_cartesian.Rd b/man/coord_cartesian.Rd index 5c39f4d288..7fd0b3b1d8 100644 --- a/man/coord_cartesian.Rd +++ b/man/coord_cartesian.Rd @@ -9,7 +9,8 @@ coord_cartesian( ylim = NULL, expand = TRUE, default = FALSE, - clip = "on" + clip = "on", + reverse = "none" ) } \arguments{ @@ -32,6 +33,11 @@ drawing of data points anywhere on the plot, including in the plot margins. If limits are set via \code{xlim} and \code{ylim} and some data points fall outside those limits, then those data points may show up in places such as the axes, the legend, the plot title, or the plot margins.} + +\item{reverse}{A string giving which directions to reverse. \code{"none"} +(default) keeps directions as is. \code{"x"} and \code{"y"} can be used to reverse +their respective directions. \code{"xy"} can be used to reverse both +directions.} } \description{ The Cartesian coordinate system is the most familiar, and common, type of diff --git a/man/coord_fixed.Rd b/man/coord_fixed.Rd index fc8c052506..abb5826c7d 100644 --- a/man/coord_fixed.Rd +++ b/man/coord_fixed.Rd @@ -5,7 +5,14 @@ \alias{coord_equal} \title{Cartesian coordinates with fixed "aspect ratio"} \usage{ -coord_fixed(ratio = 1, xlim = NULL, ylim = NULL, expand = TRUE, clip = "on") +coord_fixed( + ratio = 1, + xlim = NULL, + ylim = NULL, + expand = TRUE, + clip = "on", + reverse = "none" +) } \arguments{ \item{ratio}{aspect ratio, expressed as \code{y / x}} @@ -24,6 +31,11 @@ drawing of data points anywhere on the plot, including in the plot margins. If limits are set via \code{xlim} and \code{ylim} and some data points fall outside those limits, then those data points may show up in places such as the axes, the legend, the plot title, or the plot margins.} + +\item{reverse}{A string giving which directions to reverse. \code{"none"} +(default) keeps directions as is. \code{"x"} and \code{"y"} can be used to reverse +their respective directions. \code{"xy"} can be used to reverse both +directions.} } \description{ A fixed scale coordinate system forces a specified ratio between the diff --git a/man/coord_polar.Rd b/man/coord_polar.Rd index aadbd9b00f..12957c2fd9 100644 --- a/man/coord_polar.Rd +++ b/man/coord_polar.Rd @@ -12,11 +12,12 @@ coord_radial( start = 0, end = NULL, expand = TRUE, - direction = 1, + direction = deprecated(), clip = "off", r.axis.inside = NULL, rotate.angle = FALSE, inner.radius = 0, + reverse = "none", r_axis_inside = deprecated(), rotate_angle = deprecated() ) @@ -57,7 +58,12 @@ in accordance with the computed \code{theta} position. If \code{FALSE} (default) no such transformation is performed. Can be useful to rotate text geoms in alignment with the coordinates.} -\item{inner.radius}{A \code{numeric} between 0 and 1 setting the size of a inner.radius hole.} +\item{inner.radius}{A \code{numeric} between 0 and 1 setting the size of a +inner radius hole.} + +\item{reverse}{A string giving which directions to reverse. \code{"none"} +(default) keep directions as is. \code{"theta"} reverses the angle and \code{"r"} +reverses the radius. \code{"thetar"} reverses both the angle and the radius.} \item{r_axis_inside, rotate_angle}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}} } diff --git a/man/coord_trans.Rd b/man/coord_trans.Rd index bea5b54716..f65badca4d 100644 --- a/man/coord_trans.Rd +++ b/man/coord_trans.Rd @@ -12,7 +12,8 @@ coord_trans( limx = deprecated(), limy = deprecated(), clip = "on", - expand = TRUE + expand = TRUE, + reverse = "none" ) } \arguments{ @@ -34,6 +35,11 @@ legend, the plot title, or the plot margins.} \item{expand}{If \code{TRUE}, the default, adds a small expansion factor to the limits to ensure that data and axes don't overlap. If \code{FALSE}, limits are taken exactly from the data or \code{xlim}/\code{ylim}.} + +\item{reverse}{A string giving which directions to reverse. \code{"none"} +(default) keeps directions as is. \code{"x"} and \code{"y"} can be used to reverse +their respective directions. \code{"xy"} can be used to reverse both +directions.} } \description{ \code{coord_trans()} is different to scale transformations in that it occurs after diff --git a/man/ggsf.Rd b/man/ggsf.Rd index c4ec76bed1..b117c59c12 100644 --- a/man/ggsf.Rd +++ b/man/ggsf.Rd @@ -25,7 +25,8 @@ coord_sf( lims_method = "cross", ndiscr = 100, default = FALSE, - clip = "on" + clip = "on", + reverse = "none" ) geom_sf( @@ -175,6 +176,11 @@ limits are set via \code{xlim} and \code{ylim} and some data points fall outside limits, then those data points may show up in places such as the axes, the legend, the plot title, or the plot margins.} +\item{reverse}{A string giving which directions to reverse. \code{"none"} +(default) keeps directions as is. \code{"x"} and \code{"y"} can be used to reverse +their respective directions. \code{"xy"} can be used to reverse both +directions.} + \item{mapping}{Set of aesthetic mappings created by \code{\link[=aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot From faf7d4eb5f3d7a1c5ddde86cfe8c62c0aa649b96 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 2 Sep 2024 11:05:11 +0200 Subject: [PATCH 13/17] internally sort ranges --- R/scale-expansion.R | 4 ++-- tests/testthat/test-scale-expansion.R | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/scale-expansion.R b/R/scale-expansion.R index e3392fc5bf..555df82a2a 100644 --- a/R/scale-expansion.R +++ b/R/scale-expansion.R @@ -193,8 +193,8 @@ expand_limits_continuous_trans <- function(limits, expand = expansion(0, 0), continuous_range <- ifelse(is.finite(final_scale_limits), final_scale_limits, limits) list( - continuous_range_coord = continuous_range_coord, - continuous_range = continuous_range + continuous_range_coord = sort(continuous_range_coord), + continuous_range = sort(continuous_range) ) } diff --git a/tests/testthat/test-scale-expansion.R b/tests/testthat/test-scale-expansion.R index 26d25abfdc..3fe2a72dfd 100644 --- a/tests/testthat/test-scale-expansion.R +++ b/tests/testthat/test-scale-expansion.R @@ -65,7 +65,7 @@ test_that("expand_limits_discrete() can override limits with an empty range", { test_that("expand_limits_discrete() can override limits with a discrete range", { expect_identical(expand_limits_discrete(c("one", "two"), coord_limits = c(NA, NA)), c(1, 2)) expect_identical(expand_limits_discrete(c("one", "two"), coord_limits = c(NA, 3)), c(1, 3)) - expect_identical(expand_limits_discrete(c("one", "two"), coord_limits = c(3, NA)), c(3, 2)) + expect_identical(expand_limits_discrete(c("one", "two"), coord_limits = c(3, NA)), c(2, 3)) }) test_that("expand_limits_discrete() can override limits with a continuous range", { @@ -106,7 +106,7 @@ test_that("expand_limits_continuous_trans() works with inverted transformations" ) expect_identical(limit_info$continuous_range, c(0, 3)) - expect_identical(limit_info$continuous_range_coord, c(0, -3)) + expect_identical(limit_info$continuous_range_coord, c(-3, 0)) }) test_that("expand_limits_scale_discrete() begrudgingly handles numeric limits", { From f12ec125a0bce235d00d828ca5d9dd57ad62a78d Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 2 Sep 2024 11:22:36 +0200 Subject: [PATCH 14/17] add tests --- tests/testthat/test-coord-cartesian.R | 13 +++++++++++++ tests/testthat/test-coord-polar.R | 17 +++++++++++++++++ tests/testthat/test-coord-transform.R | 14 ++++++++++++++ tests/testthat/test-coord_sf.R | 14 ++++++++++++++ 4 files changed, 58 insertions(+) diff --git a/tests/testthat/test-coord-cartesian.R b/tests/testthat/test-coord-cartesian.R index 23bed331ae..5bb16c4cd1 100644 --- a/tests/testthat/test-coord-cartesian.R +++ b/tests/testthat/test-coord-cartesian.R @@ -22,6 +22,19 @@ test_that("cartesian coords throws error when limits are badly specified", { expect_snapshot_error(ggplot() + coord_cartesian(ylim=1:3)) }) +test_that("cartesian coords can be reversed", { + p <- ggplot(data_frame0(x = c(0, 2), y = c(0, 2))) + + aes(x = x, y = y) + + geom_point() + + coord_cartesian( + xlim = c(-1, 3), ylim = c(-1, 3), expand = FALSE, + reverse = "xy" + ) + grob <- layer_grob(p)[[1]] + expect_equal(as.numeric(grob$x), c(0.75, 0.25)) + expect_equal(as.numeric(grob$y), c(0.75, 0.25)) +}) + # Visual tests ------------------------------------------------------------ diff --git a/tests/testthat/test-coord-polar.R b/tests/testthat/test-coord-polar.R index da49368108..47f0f8a199 100644 --- a/tests/testthat/test-coord-polar.R +++ b/tests/testthat/test-coord-polar.R @@ -156,6 +156,23 @@ test_that("bounding box calculations are sensible", { }) +test_that("radial coords can be reversed", { + p <- ggplot(data_frame0(x = c(0, 2), y = c(0, 2))) + + aes(x = x, y = y) + + geom_point() + + scale_x_continuous(limits = c(-1, 3), expand = c(0, 0)) + + scale_y_continuous(limits = c(-1, 3), expand = c(0, 0)) + fwd <- coord_radial(start = 0.5 * pi, end = 1.5 * pi, reverse = "none") + rev <- coord_radial(start = 0.5 * pi, end = 1.5 * pi, reverse = "thetar") + + fwd <- layer_grob(p + fwd)[[1]] + rev <- layer_grob(p + rev)[[1]] + + expect_equal(as.numeric(fwd$x), rev(as.numeric(rev$x))) + expect_equal(as.numeric(fwd$y), rev(as.numeric(rev$y))) +}) + + # Visual tests ------------------------------------------------------------ #TODO: Once {vdiffr} supports non-rectangular clipping paths, we should add a diff --git a/tests/testthat/test-coord-transform.R b/tests/testthat/test-coord-transform.R index abb05a3cae..b0642a48e6 100644 --- a/tests/testthat/test-coord-transform.R +++ b/tests/testthat/test-coord-transform.R @@ -131,3 +131,17 @@ test_that("coord_trans() throws error when limits are badly specified", { # throws error when limit's length is different than two expect_snapshot_error(ggplot() + coord_trans(ylim=1:3)) }) + +test_that("transformed coords can be reversed", { + p <- ggplot(data_frame0(x = c(1, 100), y = c(1, 100))) + + aes(x = x, y = y) + + geom_point() + + coord_trans( + x = "log10", y = "log10", + xlim = c(0.1, 1000), ylim = c(0.1, 1000), expand = FALSE, + reverse = "xy" + ) + grob <- layer_grob(p)[[1]] + expect_equal(as.numeric(grob$x), c(0.75, 0.25)) + expect_equal(as.numeric(grob$y), c(0.75, 0.25)) +}) diff --git a/tests/testthat/test-coord_sf.R b/tests/testthat/test-coord_sf.R index 12a667be5b..78990f718a 100644 --- a/tests/testthat/test-coord_sf.R +++ b/tests/testthat/test-coord_sf.R @@ -371,3 +371,17 @@ test_that("coord_sf() throws error when limits are badly specified", { # throws error when limit's length is different than two expect_snapshot_error(ggplot() + coord_sf(ylim=1:3)) }) + +test_that("sf coords can be reversed", { + skip_if_not_installed("sf") + + p <- ggplot(sf::st_multipoint(cbind(c(0, 2), c(0, 2)))) + + geom_sf() + + coord_sf( + xlim = c(-1, 3), ylim = c(-1, 3), expand = FALSE, + reverse = "xy" + ) + grob <- layer_grob(p)[[1]] + expect_equal(as.numeric(grob$x), c(0.75, 0.25)) + expect_equal(as.numeric(grob$y), c(0.75, 0.25)) +}) From e87e63c928c61763abf539528d1bf82170c0c565 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 2 Sep 2024 11:38:02 +0200 Subject: [PATCH 15/17] scales sort limits upon construction --- R/scale-.R | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) diff --git a/R/scale-.R b/R/scale-.R index fd0bbd444f..ed97e86c95 100644 --- a/R/scale-.R +++ b/R/scale-.R @@ -128,9 +128,6 @@ continuous_scale <- function(aesthetics, scale_name = deprecated(), palette, nam } transform <- as.transform(transform) - if (!is.null(limits) && !is.function(limits)) { - limits <- transform$transform(limits) - } # Convert formula to function if appropriate limits <- allow_lambda(limits) @@ -140,6 +137,13 @@ continuous_scale <- function(aesthetics, scale_name = deprecated(), palette, nam oob <- allow_lambda(oob) minor_breaks <- allow_lambda(minor_breaks) + if (!is.null(limits) && !is.function(limits)) { + limits <- transform$transform(limits) + if (!anyNA(limits)) { + limits <- sort(limits) + } + } + ggproto(NULL, super, call = call, @@ -319,9 +323,6 @@ binned_scale <- function(aesthetics, scale_name = deprecated(), palette, name = } transform <- as.transform(transform) - if (!is.null(limits)) { - limits <- transform$transform(limits) - } # Convert formula input to function if appropriate limits <- allow_lambda(limits) @@ -330,6 +331,13 @@ binned_scale <- function(aesthetics, scale_name = deprecated(), palette, name = rescaler <- allow_lambda(rescaler) oob <- allow_lambda(oob) + if (!is.null(limits) && !is.function(limits)) { + limits <- transform$transform(limits) + if (!anyNA(limits)) { + limits <- sort(limits) + } + } + ggproto(NULL, super, call = call, From 1403eac93dc72fb329d8e8f3a92630e0d60eeb48 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 2 Sep 2024 11:39:14 +0200 Subject: [PATCH 16/17] add news bullet --- NEWS.md | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/NEWS.md b/NEWS.md index 8c5ca3c555..738892480a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,12 @@ # ggplot2 (development version) +* Reversal of a dimension, typically 'x' or 'y', is now controlled by the + `reverse` argument in `coord_cartesian()`, `coord_fixed()`, `coord_radial()` + and `coord_sf()`. In `coord_radial()`, this replaces the older `direction` + argument (#4021, @teunbrand). +* `coord_radial()` displays minor gridlines now (@teunbrand). +* (internal) `continuous_scale()` and `binned_scale()` sort the `limits` + argument internally (@teunbrand). * (Breaking) The defaults for all geoms can be set at one in the theme. (@teunbrand based on pioneering work by @dpseidel, #2239) * A new `theme(geom)` argument is used to track these defaults. From 0df09518e7e4a256a4d2017f4cd59a1472fa59a5 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 2 Sep 2024 12:24:07 +0200 Subject: [PATCH 17/17] fix merge misstep --- R/coord-.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/coord-.R b/R/coord-.R index 6c397d52df..81769e187c 100644 --- a/R/coord-.R +++ b/R/coord-.R @@ -187,7 +187,7 @@ Coord <- ggproto("Coord", # Will generally have to return FALSE for coordinate systems that enforce a fixed aspect ratio. is_free = function() FALSE, - setup_params = function(data) { + setup_params = function(self, data) { list(expand = parse_coord_expand(self$expand %||% TRUE)) },