diff --git a/NEWS.md b/NEWS.md index e512f0b707..8214635e8c 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). * Theme margins can have NA-units to inherit from parent elements. The new function `margin_part()` has NA-units as default (@teunbrand, #6115) * New `margin_auto()` specification for theme margins. diff --git a/R/coord-.R b/R/coord-.R index 6aa113d3ff..6b0470e39e 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) { @@ -185,11 +188,7 @@ Coord <- ggproto("Coord", is_free = function() FALSE, setup_params = function(self, data) { - list( - guide_default = guide_axis(), - guide_missing = guide_none(), - expand = parse_coord_expand(self$expand %||% TRUE) - ) + list(expand = parse_coord_expand(self$expand %||% TRUE)) }, setup_data = function(data, params = list()) { diff --git a/R/coord-cartesian-.R b/R/coord-cartesian-.R index 1b13d9c6c0..23e237583c 100644 --- a/R/coord-cartesian-.R +++ b/R/coord-cartesian-.R @@ -25,6 +25,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 @@ -64,11 +68,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 @@ -97,8 +102,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) }, @@ -109,14 +117,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-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/coord-radial.R b/R/coord-radial.R index b028822f0e..de3bac2d00 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 @@ -39,11 +43,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,34 +64,46 @@ 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(rotate.angle) check_number_decimal(start, allow_infinite = FALSE) 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) + + 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, - 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, + inner_radius = inner.radius, clip = clip ) } @@ -107,16 +124,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) @@ -200,10 +211,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) } @@ -284,10 +295,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,70 +321,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) - dir <- self$direction - 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, dir) - } - if (length(theta_min) > 0) { - theta_min <- theta_rescale(theta_min, theta_lim, arc, dir) - } - - theta_fine <- theta_rescale(seq(0, 1, length.out = 100), c(0, 1), arc, dir) - 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) { @@ -395,8 +345,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") @@ -540,6 +490,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 diff --git a/R/coord-sf.R b/R/coord-sf.R index 2a43d2e5ef..3f96ff6aaf 100644 --- a/R/coord-sf.R +++ b/R/coord-sf.R @@ -85,18 +85,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) @@ -259,21 +263,17 @@ 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( + 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()) { @@ -408,12 +408,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 @@ -536,7 +550,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.waiver(label_graticule) && is.waiver(label_axes)) { # if both `label_graticule` and `label_axes` are set to waive then we @@ -576,6 +591,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 diff --git a/R/coord-transform.R b/R/coord-transform.R index 1253529fdd..18230a1742 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,14 +163,8 @@ CoordTrans <- ggproto("CoordTrans", Coord, ) }, - render_bg = function(panel_params, theme) { - guide_grid( - theme, - panel_params$x.minor, - panel_params$x.major, - panel_params$y.minor, - panel_params$y.major - ) + render_bg = function(self, panel_params, theme) { + guide_grid(theme, panel_params, self) }, render_axis_h = function(panel_params, theme) { diff --git a/R/guide-axis-theta.R b/R/guide-axis-theta.R index dc4e1b405d..7f4c3c9246 100644 --- a/R/guide-axis-theta.R +++ b/R/guide-axis-theta.R @@ -61,26 +61,18 @@ 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 (is.unsorted(panel_params$inner_radius %||% NA)) { + opposite_value <- -opposite_value + } 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) 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 + ) } diff --git a/R/scale-.R b/R/scale-.R index 53c9f4ee66..4bf54328b3 100644 --- a/R/scale-.R +++ b/R/scale-.R @@ -128,20 +128,23 @@ continuous_scale <- function(aesthetics, scale_name = deprecated(), palette, nam } transform <- as.transform(transform) - limits <- allow_lambda(limits) - - if (!is.null(limits) && !is.function(limits)) { - limits <- transform$transform(limits) - } - check_continuous_limits(limits, call = call) # Convert formula to function if appropriate + limits <- allow_lambda(limits) breaks <- allow_lambda(breaks) labels <- allow_lambda(labels) rescaler <- allow_lambda(rescaler) 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) + } + } + check_continuous_limits(limits, call = call) + ggproto(NULL, super, call = call, @@ -321,9 +324,6 @@ binned_scale <- function(aesthetics, scale_name = deprecated(), palette, name = } transform <- as.transform(transform) - if (!is.null(limits) && !is.function(limits)) { - limits <- transform$transform(limits) - } # Convert formula input to function if appropriate limits <- allow_lambda(limits) @@ -332,6 +332,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, diff --git a/R/scale-expansion.R b/R/scale-expansion.R index 0edb01f1b8..a132f5cd22 100644 --- a/R/scale-expansion.R +++ b/R/scale-expansion.R @@ -206,8 +206,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/R/scale-view.R b/R/scale-view.R index 510f99f837..350d27e9c0 100644 --- a/R/scale-view.R +++ b/R/scale-view.R @@ -117,6 +117,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) @@ -127,6 +130,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()) }, diff --git a/man/coord_cartesian.Rd b/man/coord_cartesian.Rd index 20987083a5..15afad523a 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{ @@ -36,6 +37,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 8877019a91..a3d8d358b7 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}} @@ -28,6 +35,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 d1f46dc1ee..0d9d2d6f79 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{ @@ -38,6 +39,11 @@ Giving a logical vector will separately control the expansion for the four directions (top, left, bottom and right). The \code{expand} argument will be recycled to length 4 if necessary. Alternatively, can be a named logical vector to control a single direction, e.g. \code{expand = c(bottom = FALSE)}.} + +\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 7424d4107f..1fee9f59bb 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( @@ -179,6 +180,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 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/guide-axis/guide-axis-theta-with-angle-adapting-to-theta.svg b/tests/testthat/_snaps/guide-axis/guide-axis-theta-with-angle-adapting-to-theta.svg index b6cfa798fc..48b903c6f3 100644 --- a/tests/testthat/_snaps/guide-axis/guide-axis-theta-with-angle-adapting-to-theta.svg +++ b/tests/testthat/_snaps/guide-axis/guide-axis-theta-with-angle-adapting-to-theta.svg @@ -29,47 +29,52 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/guide-axis/stacked-radial-axes.svg b/tests/testthat/_snaps/guide-axis/stacked-radial-axes.svg index 18609a9a74..9b4cf580e7 100644 --- a/tests/testthat/_snaps/guide-axis/stacked-radial-axes.svg +++ b/tests/testthat/_snaps/guide-axis/stacked-radial-axes.svg @@ -29,16 +29,20 @@ - - - - - - - - - - + + + + + + + + + + + + + + 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 27b641f964..2b07d96b21 100644 --- a/tests/testthat/test-coord-polar.R +++ b/tests/testthat/test-coord-polar.R @@ -181,6 +181,23 @@ test_that("when both x and y are AsIs, they are not transformed", { }) +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 f3dd4a6b00..7621f5ed9c 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 70cdbb9d20..516d2fa9ec 100644 --- a/tests/testthat/test-coord_sf.R +++ b/tests/testthat/test-coord_sf.R @@ -388,6 +388,20 @@ test_that("coord_sf() throws error when limits are badly specified", { 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)) +}) + test_that("coord_sf() can render with empty graticules", { skip_if_not_installed("sf") diff --git a/tests/testthat/test-scale-expansion.R b/tests/testthat/test-scale-expansion.R index 378742de8c..41bd9430e7 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", {