resolve merge conflict

Merge branch 'main' into sanitise_bins

# Conflicts:
#	man/ggplot2-ggproto.Rd

Author: teunbrand

DESCRIPTION

@@ -255,6 +255,7 @@ Collate:
     'stat-ellipse.R'
     'stat-function.R'
     'stat-identity.R'
+    'stat-manual.R'
     'stat-qq-line.R'
     'stat-qq.R'
     'stat-quantilemethods.R'

NAMESPACE

@@ -265,6 +265,7 @@ export(StatEcdf)
 export(StatEllipse)
 export(StatFunction)
 export(StatIdentity)
+export(StatManual)
 export(StatQq)
 export(StatQqLine)
 export(StatQuantile)
@@ -691,6 +692,7 @@ export(stat_ecdf)
 export(stat_ellipse)
 export(stat_function)
 export(stat_identity)
+export(stat_manual)
 export(stat_qq)
 export(stat_qq_line)
 export(stat_quantile)

NEWS.md

@@ -1,5 +1,6 @@
 # ggplot2 (development version)
 
+* New stat: `stat_manual()` for arbitrary computations (@teunbrand, #3501)
 * 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` 
@@ -237,6 +238,7 @@
   (@teunbrand, #4722, #6069).
 * `geom_abline()` clips to the panel range in the vertical direction too
   (@teunbrand, #6086).
+* Added `panel.widths` and `panel.heights` to `theme()` (#5338, @teunbrand).
 
 # ggplot2 3.5.1
 

R/facet-.R

@@ -263,6 +263,53 @@ Facet <- ggproto("Facet", NULL,
   },
   format_strip_labels = function(layout, params) {
     return()
+  },
+  set_panel_size = function(table, theme) {
+
+    new_widths  <- calc_element("panel.widths",  theme)
+    new_heights <- calc_element("panel.heights", theme)
+
+    if (is.null(new_widths) && is.null(new_heights)) {
+      return(table)
+    }
+
+    if (isTRUE(table$respect)) {
+      args <- !c(is.null(new_widths), is.null(new_heights))
+      args <- c("panel.widths", "panel.heights")[args]
+      cli::cli_warn(
+        "Aspect ratios are overruled by {.arg {args}} theme element{?s}."
+      )
+      table$respect <- FALSE
+    }
+
+    rows <- panel_rows(table)
+    cols <- panel_cols(table)
+
+    if (length(new_widths) == 1L && nrow(cols) > 1L) {
+      # Get total size of non-panel widths in between panels
+      extra <- setdiff(seq(min(cols$l), max(cols$r)), union(cols$l, cols$r))
+      extra <- unit(sum(width_cm(table$widths[extra])), "cm")
+      # Distribute width proportionally
+      relative   <- as.numeric(table$widths[cols$l]) # assumed to be simple units
+      new_widths <- (new_widths - extra) * (relative / sum(relative))
+    }
+    if (!is.null(new_widths)) {
+      table$widths[cols$l] <- rep(new_widths, length.out = nrow(cols))
+    }
+
+    if (length(new_heights) == 1L && nrow(rows) > 1L) {
+      # Get total size of non-panel heights in between panels
+      extra <- setdiff(seq(min(rows$t), max(rows$t)), union(rows$t, rows$b))
+      extra <- unit(sum(height_cm(table$heights[extra])), "cm")
+      # Distribute height proportionally
+      relative    <- as.numeric(table$heights[rows$t]) # assumed to be simple units
+      new_heights <- (new_heights - extra) * (relative / sum(relative))
+    }
+    if (!is.null(new_heights)) {
+      table$heights[rows$t] <- rep(new_heights, length.out = nrow(rows))
+    }
+
+    table
   }
 )
 

R/layout.R

@@ -94,6 +94,7 @@ Layout <- ggproto("Layout", NULL,
       theme,
       self$facet_params
     )
+    plot_table <- self$facet$set_panel_size(plot_table, theme)
 
     # Draw individual labels, then add to gtable
     labels <- self$coord$labels(
@@ -300,7 +301,6 @@ Layout <- ggproto("Layout", NULL,
   }
 )
 
-
 # Helpers -----------------------------------------------------------------
 
 # Function for applying scale method to multiple variables in a given

R/stat-manual.R

@@ -0,0 +1,131 @@
+
+#' Manually compute transformations
+#'
+#' `stat_manual()` takes a function that computes a data transformation for
+#' every group.
+#'
+#' @inheritParams layer
+#' @inheritParams geom_point
+#' @param fun Function that takes a data frame as input and returns a data
+#'   frame or data frame-like list as output. The default (`identity()`) returns
+#'   the data unchanged.
+#' @param args A list of arguments to pass to the function given in `fun`.
+#'
+#' @eval rd_aesthetics("stat", "manual")
+#' @section Aesthetics:
+#' Input aesthetics are determined by the `fun` argument. Output aesthetics must
+#' include those required by `geom`. Any aesthetic that is constant within a
+#' group will be preserved even if dropped by `fun`.
+#'
+#' @export
+#'
+#' @examples
+#' # A standard scatterplot
+#' p <- ggplot(mtcars, aes(disp, mpg, colour = factor(cyl))) +
+#'   geom_point()
+#'
+#' # The default just displays points as-is
+#' p + stat_manual()
+#'
+#' # Using a custom function
+#' make_hull <- function(data) {
+#'   hull <- chull(x = data$x, y = data$y)
+#'   data.frame(x = data$x[hull], y = data$y[hull])
+#' }
+#'
+#' p + stat_manual(
+#'   geom = "polygon",
+#'   fun  = make_hull,
+#'   fill = NA
+#' )
+#'
+#' # Using the `with` function with quoting
+#' p + stat_manual(
+#'   fun  = with,
+#'   args = list(expr = quote({
+#'     hull <- chull(x, y)
+#'     list(x = x[hull], y = y[hull])
+#'   })),
+#'   geom = "polygon", fill = NA
+#' )
+#'
+#' # Using the `transform` function with quoting
+#' p + stat_manual(
+#'   geom = "segment",
+#'   fun  = transform,
+#'   args = list(
+#'     xend = quote(mean(x)),
+#'     yend = quote(mean(y))
+#'   )
+#' )
+#'
+#' # Using dplyr verbs with `vars()`
+#' if (requireNamespace("dplyr", quietly = TRUE)) {
+#'
+#'   # Get centroids with `summarise()`
+#'   p + stat_manual(
+#'     size = 10, shape = 21,
+#'     fun  = dplyr::summarise,
+#'     args = vars(x = mean(x), y = mean(y))
+#'   )
+#'
+#'   # Connect to centroid with `mutate`
+#'   p + stat_manual(
+#'     geom = "segment",
+#'     fun  = dplyr::mutate,
+#'     args = vars(xend = mean(x), yend = mean(y))
+#'   )
+#'
+#'   # Computing hull with `reframe()`
+#'   p + stat_manual(
+#'     geom = "polygon", fill = NA,
+#'     fun  = dplyr::reframe,
+#'     args = vars(hull = chull(x, y), x = x[hull], y = y[hull])
+#'   )
+#' }
+stat_manual <- function(
+    mapping = NULL,
+    data = NULL,
+    geom = "point",
+    position = "identity",
+    ...,
+    fun = identity,
+    args = list(),
+    na.rm = FALSE,
+    show.legend = NA,
+    inherit.aes = TRUE) {
+
+  layer(
+    data = data,
+    mapping = mapping,
+    stat = StatManual,
+    geom = geom,
+    position = position,
+    show.legend = show.legend,
+    inherit.aes = inherit.aes,
+    params = list2(
+      na.rm = na.rm,
+      fun = fun,
+      args = args,
+      ...
+    )
+  )
+}
+
+#' @rdname ggplot2-ggproto
+#' @format NULL
+#' @usage NULL
+#' @export
+StatManual <- ggproto(
+  "StatManual", Stat,
+
+  setup_params = function(data, params) {
+    params$fun <- allow_lambda(params$fun)
+    check_function(params$fun, arg = "fun")
+    params
+  },
+
+  compute_group = function(data, scales, fun = identity, args = list()) {
+    as_gg_data_frame(inject(fun(data, !!!args)))
+  }
+)

R/theme-elements.R

@@ -639,6 +639,8 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) {
   panel.grid.minor.x  = el_def("element_line", "panel.grid.minor"),
   panel.grid.minor.y  = el_def("element_line", "panel.grid.minor"),
   panel.ontop         = el_def("logical"),
+  panel.widths        = el_def("unit"),
+  panel.heights       = el_def("unit"),
 
   strip.background    = el_def("element_rect", "rect"),
   strip.background.x  = el_def("element_rect", "strip.background"),

R/theme.R

@@ -143,6 +143,9 @@
 #'   and x axis grid lines are vertical. `panel.grid.*.*` inherits from
 #'   `panel.grid.*` which inherits from `panel.grid`, which in turn inherits
 #'   from `line`
+#' @param panel.widths,panel.heights Sizes for panels (`units`). Can be a
+#'   single unit to set the total size for the panel area, or a unit vector to
+#'   set the size of individual panels.
 #' @param panel.ontop option to place the panel (background, gridlines) over
 #'   the data layers (`logical`). Usually used with a transparent or blank
 #'   `panel.background`.
@@ -427,6 +430,8 @@ theme <- function(...,
                   panel.grid.minor.x,
                   panel.grid.minor.y,
                   panel.ontop,
+                  panel.widths,
+                  panel.heights,
                   plot.background,
                   plot.title,
                   plot.title.position,

_pkgdown.yml

@@ -68,6 +68,7 @@ reference:
   - stat_summary_bin
   - stat_unique
   - stat_sf_coordinates
+  - stat_manual
   - after_stat
 
 - subtitle: Position adjustment