Merge branch 'main' into amend_6070

Author: teunbrand

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: ggplot2
 Title: Create Elegant Data Visualisations Using the Grammar of Graphics
-Version: 3.5.1.9000
+Version: 3.5.2.9000
 Authors@R: c(
     person("Hadley", "Wickham", , "[email protected]", role = "aut",
            comment = c(ORCID = "0000-0003-4757-117X")),
@@ -31,15 +31,15 @@ URL: https://ggplot2.tidyverse.org, https://github.com/tidyverse/ggplot2
 BugReports: https://github.com/tidyverse/ggplot2/issues
 Depends:
     R (>= 4.0)
-Imports: 
+Imports:
     cli,
     grDevices,
     grid,
     gtable (>= 0.3.6),
     isoband,
     lifecycle (> 1.0.1),
     rlang (>= 1.1.0),
-    scales (>= 1.3.0),
+    scales (>= 1.4.0),
     stats,
     vctrs (>= 0.6.0),
     withr (>= 2.5.0)
@@ -70,9 +70,9 @@ Suggests:
     tibble,
     vdiffr (>= 1.0.6),
     xml2
-Enhances: 
+Enhances:
     sp
-VignetteBuilder: 
+VignetteBuilder:
     knitr
 Config/Needs/website: ggtext, tidyr, forcats, tidyverse/tidytemplate
 Config/testthat/edition: 3
@@ -81,7 +81,7 @@ Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.2
-Collate: 
+Collate:
     'ggproto.R'
     'ggplot-global.R'
     'aaa-.R'

NAMESPACE

@@ -470,22 +470,26 @@ export(guide_transform)
 export(guides)
 export(has_flipped_aes)
 export(is.Coord)
-export(is.coord)
 export(is.facet)
-export(is.geom)
 export(is.ggplot)
 export(is.ggproto)
-export(is.guide)
-export(is.guides)
-export(is.layer)
-export(is.mapping)
-export(is.margin)
-export(is.position)
-export(is.scale)
-export(is.stat)
 export(is.theme)
-export(is.theme_element)
 export(is.waiver)
+export(is_coord)
+export(is_facet)
+export(is_geom)
+export(is_ggplot)
+export(is_ggproto)
+export(is_guide)
+export(is_guides)
+export(is_layer)
+export(is_mapping)
+export(is_margin)
+export(is_position)
+export(is_scale)
+export(is_stat)
+export(is_theme)
+export(is_theme_element)
 export(label_both)
 export(label_bquote)
 export(label_context)

NEWS.md

@@ -111,7 +111,7 @@ aes <- function(x, y, ...) {
 
 #' @export
 #' @rdname is_tests
-is.mapping <- function(x) inherits(x, "uneval")
+is_mapping <- function(x) inherits(x, "uneval")
 
 # Wrap symbolic objects in quosures but pull out constants out of
 # quosures for backward-compatibility

R/aes.R

@@ -120,15 +120,15 @@ compute_bins <- function(x, scale = NULL, breaks = NULL, binwidth = NULL, bins =
                          center = NULL, boundary = NULL,
                          closed = c("right", "left")) {
 
-  range <- if (is.scale(scale)) scale$dimension() else range(x)
+  range <- if (is_scale(scale)) scale$dimension() else range(x)
   check_length(range, 2L)
 
   if (!is.null(breaks)) {
     breaks <- allow_lambda(breaks)
     if (is.function(breaks)) {
       breaks <- breaks(x)
     }
-    if (is.scale(scale) && !scale$is_discrete()) {
+    if (is_scale(scale) && !scale$is_discrete()) {
       breaks <- scale$transform(breaks)
     }
     check_numeric(breaks)

R/bin.R

@@ -225,17 +225,16 @@ Coord <- ggproto("Coord",
   }
 )
 
-
 #' @export
 #' @rdname is_tests
-is.coord <- function(x) inherits(x, "Coord")
+is_coord <- function(x) inherits(x, "Coord")
 
 #' @export
 #' @rdname is_tests
 #' @usage is.Coord(x) # Deprecated
 is.Coord <- function(x) {
-  deprecate_soft0("3.5.2", "is.Coord()", "is.coord()")
-  is.coord(x)
+  deprecate_soft0("3.5.2", "is.Coord()", "is_coord()")
+  is_coord(x)
 }
 
 # Renders an axis with the correct orientation or zeroGrob if no axis should be

R/coord-.R

@@ -166,7 +166,7 @@ view_scales_from_scale <- function(scale, coord_limits = NULL, expand = TRUE) {
 }
 
 panel_guides_grob <- function(guides, position, theme, labels = NULL) {
-  if (!is.guides(guides)) {
+  if (!is_guides(guides)) {
     return(zeroGrob())
   }
   pair <- guides$get_position(position)

R/coord-cartesian-.R

@@ -4,6 +4,7 @@
 #' @param end Position from 12 o'clock in radians where plot ends, to allow
 #'   for partial polar coordinates. The default, `NULL`, is set to
 #'   `start + 2 * pi`.
+#' @param thetalim,rlim Limits for the theta and r axes.
 #' @param expand If `TRUE`, the default, adds a small expansion factor to
 #'   the limits to prevent overlap between data and axes. If `FALSE`, limits
 #'   are taken directly from the scale.
@@ -40,9 +41,19 @@
 #' ggplot(mtcars, aes(disp, mpg)) +
 #'   geom_point() +
 #'   coord_radial(start = -0.4 * pi, end = 0.4 * pi, inner.radius = 0.3)
+#'
+#' # Similar with coord_cartesian(), you can set limits.
+#' ggplot(mtcars, aes(disp, mpg)) +
+#'   geom_point() +
+#'   coord_radial(
+#'     start = -0.4 * pi,
+#'     end = 0.4 * pi, inner.radius = 0.3,
+#'     thetalim = c(200, 300),
+#'     rlim = c(15, 30),
+#'   )
 coord_radial <- function(theta = "x",
                          start = 0, end = NULL,
-                         expand = TRUE,
+                         thetalim = NULL, rlim = NULL, expand = TRUE,
                          direction = deprecated(),
                          clip = "off",
                          r.axis.inside = NULL,
@@ -91,11 +102,22 @@ coord_radial <- function(theta = "x",
   arc <- switch(reverse, thetar = , theta = rev(arc), arc)
 
   r.axis.inside <- r.axis.inside %||% !(abs(arc[2] - arc[1]) >= 1.999 * pi)
+  if (isFALSE(r.axis.inside)) {
+    place <- in_arc(c(0, 0.5, 1, 1.5) * pi, arc)
+    if (!any(place)) {
+      cli::cli_warn(c(
+        "No appropriate placement found for outside {.field r.axis}.",
+        i = "Will use {.code r.axis.inside = TRUE} instead"
+      ))
+      r.axis.inside <- TRUE
+    }
+  }
 
   inner.radius <- c(inner.radius, 1) * 0.4
   inner.radius <- switch(reverse, thetar = , r = rev, identity)(inner.radius)
 
   ggproto(NULL, CoordRadial,
+    limits = list(theta = thetalim, r = rlim),
     theta = theta,
     r = r,
     arc = arc,
@@ -147,10 +169,20 @@ CoordRadial <- ggproto("CoordRadial", Coord,
   },
 
   setup_panel_params = function(self, scale_x, scale_y, params = list()) {
-
+    if (self$theta == "x") {
+      xlimits <- self$limits$theta
+      ylimits <- self$limits$r
+    } else {
+      xlimits <- self$limits$r
+      ylimits <- self$limits$theta
+    }
     params <- c(
-      view_scales_polar(scale_x, self$theta, expand = params$expand[c(4, 2)]),
-      view_scales_polar(scale_y, self$theta, expand = params$expand[c(3, 1)]),
+      view_scales_polar(scale_x, self$theta, xlimits,
+        expand = params$expand[c(4, 2)]
+      ),
+      view_scales_polar(scale_y, self$theta, ylimits,
+        expand = params$expand[c(3, 1)]
+      ),
       list(bbox = polar_bbox(self$arc, inner_radius = self$inner_radius),
            arc = self$arc, inner_radius = self$inner_radius)
     )
@@ -431,38 +463,31 @@ CoordRadial <- ggproto("CoordRadial", Coord,
 
   setup_params = function(self, data) {
     params <- ggproto_parent(Coord, self)$setup_params(data)
-    if (!isFALSE(self$r_axis_inside)) {
-      return(params)
-    }
-
-    place <- in_arc(c(0, 0.5, 1, 1.5) * pi, self$arc)
-    if (!any(place)) {
-      cli::cli_warn(c(
-        "No appropriate placement found for {.arg r_axis_inside}.",
-        i = "Axis will be placed at panel edge."
-      ))
-      params$r_axis_inside <- TRUE
-      return(params)
+    if (isFALSE(self$r_axis_inside)) {
+      place <- in_arc(c(0, 0.5, 1, 1.5) * pi, self$arc)
+      params$r_axis   <- if (any(place[c(1, 3)])) "left" else "bottom"
+      params$fake_arc <- switch(
+        which(place[c(1, 3, 2, 4)])[1],
+        c(0, 2), c(1, 3), c(0.5, 2.5), c(1.5, 3.5)
+      ) * pi
     }
-
-    params$r_axis   <- if (any(place[c(1, 3)])) "left" else "bottom"
-    params$fake_arc <- switch(
-      which(place[c(1, 3, 2, 4)])[1],
-      c(0, 2), c(1, 3), c(0.5, 2.5), c(1.5, 3.5)
-    ) * pi
     params
   }
 )
 
-view_scales_polar <- function(scale, theta = "x", expand = TRUE) {
+view_scales_polar <- function(scale, theta = "x", coord_limits = NULL, 
+                              expand = TRUE) {
 
   aesthetic <- scale$aesthetics[1]
   is_theta  <- theta == aesthetic
   name <- if (is_theta) "theta" else "r"
 
   expansion <- default_expansion(scale, expand = expand)
   limits <- scale$get_limits()
-  continuous_range <- expand_limits_scale(scale, expansion, limits)
+  continuous_range <- expand_limits_scale(
+    scale, expansion, limits,
+    coord_limits
+  )
 
   primary <- view_scale_primary(scale, limits, continuous_range)
   view_scales <- list(

R/coord-radial.R

@@ -9,8 +9,8 @@ NULL
 #' rendered.
 #'
 #' Extending facets can range from the simple modifications of current facets,
-#' to very laborious rewrites with a lot of [gtable()] manipulation.
-#' For some examples of both, please see the extension vignette.
+#' to very laborious rewrites with a lot of [`gtable()`][gtable::gtable()]
+#' manipulation. For some examples of both, please see the extension vignette.
 #'
 #' `Facet` subclasses, like other extendible ggproto classes, have a range
 #' of methods that can be modified. Some of these are required for all new
@@ -46,6 +46,10 @@ NULL
 #' the default behaviour of one or more of the following methods:
 #'
 #'   - `setup_params`:
+#'
+#'   - `setup_panel_params`: modifies the x and y ranges for each panel. This is
+#'     used to allow the `Facet` to interact with the `panel_params`.
+#'
 #'   - `init_scales`: Given a master scale for x and y, create panel
 #'   specific scales for each panel defined in the layout. The default is to
 #'   simply clone the master scale.
@@ -64,6 +68,10 @@ NULL
 #'   between the layer stack and the foreground defined by the Coord object
 #'   (usually empty). The default is, as above, to return an empty grob.
 #'
+#'   - `draw_panel_content`: Draws each panel for the facet. Should return a list
+#'     of grobs, one for each panel. The output is used by the `draw_panels`
+#'     method.
+#'
 #'   - `draw_labels`: Given the gtable returned by `draw_panels`,
 #'   add axis titles to the gtable. The default is to add one title at each side
 #'   depending on the position and existence of axes.
@@ -90,6 +98,7 @@ Facet <- ggproto("Facet", NULL,
   map_data = function(data, layout, params) {
     cli::cli_abort("Not implemented.")
   },
+  setup_panel_params = function(self, panel_params, coord, ...) panel_params,
   init_scales = function(layout, x_scale = NULL, y_scale = NULL, params) {
     scales <- list()
     if (!is.null(x_scale)) {
@@ -133,6 +142,34 @@ Facet <- ggproto("Facet", NULL,
   draw_front = function(data, layout, x_scales, y_scales, theme, params) {
     rep(list(zeroGrob()), vec_unique_count(layout$PANEL))
   },
+  draw_panel_content = function(self, panels, layout, x_scales, y_scales,
+                                ranges, coord, data, theme, params, ...) {
+    facet_bg <- self$draw_back(
+      data,
+      layout,
+      x_scales,
+      y_scales,
+      theme,
+      params
+    )
+    facet_fg <- self$draw_front(
+      data,
+      layout,
+      x_scales,
+      y_scales,
+      theme,
+      params
+    )
+
+    # Draw individual panels, then call `$draw_panels()` method to 
+    # assemble into gtable
+    lapply(seq_along(panels[[1]]), function(i) {
+      panel <- lapply(panels, `[[`, i)
+      panel <- c(facet_bg[i], panel, facet_fg[i])
+      panel <- coord$draw_panel(panel, ranges[[i]], theme)
+      ggname(paste("panel", i, sep = "-"), panel)
+    })
+  },
   draw_panels = function(self, panels, layout, x_scales = NULL, y_scales = NULL,
                          ranges, coord, data = NULL, theme, params) {
 
@@ -313,10 +350,6 @@ Facet <- ggproto("Facet", NULL,
   }
 )
 
-#' @export
-#' @rdname is_tests
-is.facet <- function(x) inherits(x, "Facet")
-
 # Helpers -----------------------------------------------------------------
 
 #' Quote faceting variables
@@ -378,6 +411,18 @@ vars <- function(...) {
   quos(...)
 }
 
+#' @export
+#' @rdname is_tests
+is_facet <- function(x) inherits(x, "Facet")
+
+#' @export
+#' @rdname is_tests
+#' @usage is.facet(x) # Deprecated
+is.facet <- function(x) {
+  deprecate_soft0("3.5.2", "is.facet()", "is_facet()")
+  is_facet(x)
+}
+
 #' Accessing a plot's facet strip labels
 #'
 #' This functions retrieves labels from facet strips with the labeller applied.
@@ -488,7 +533,7 @@ as_facets_list <- function(x) {
 }
 
 check_vars <- function(x) {
-  if (is.mapping(x)) {
+  if (is_mapping(x)) {
     cli::cli_abort("Please use {.fn vars} to supply facet variables.")
   }
   # Native pipe have higher precedence than + so any type of gg object can be

R/facet-.R

@@ -94,7 +94,7 @@ fortify.default <- function(model, data, ...) {
     "or an object coercible by {.fn fortify}, or a valid ",
     "{.cls data.frame}-like object coercible by {.fn as.data.frame}"
   )
-  if (is.mapping(model)) {
+  if (is_mapping(model)) {
     msg <- c(
       paste0(msg, ", not ", obj_type_friendly(model), "."),
       "i" = "Did you accidentally pass {.fn aes} to the {.arg data} argument?"