Merge branch 'main' into rect_key

Author: teunbrand

DESCRIPTION

@@ -35,7 +35,7 @@ Imports:
     cli,
     grDevices,
     grid,
-    gtable (>= 0.1.1),
+    gtable (>= 0.3.6),
     isoband,
     lifecycle (> 1.0.1),
     rlang (>= 1.1.0),
@@ -247,6 +247,7 @@ Collate:
     'stat-bindot.R'
     'stat-binhex.R'
     'stat-boxplot.R'
+    'stat-connect.R'
     'stat-contour.R'
     'stat-count.R'
     'stat-density-2d.R'

NAMESPACE

@@ -13,6 +13,8 @@ S3method("[[",ggproto)
 S3method("[[<-",uneval)
 S3method(.DollarNames,ggproto)
 S3method(as.data.frame,mapped_discrete)
+S3method(as.gtable,ggplot)
+S3method(as.gtable,ggplot_built)
 S3method(as.list,ggproto)
 S3method(autolayer,default)
 S3method(autoplot,default)
@@ -257,6 +259,7 @@ export(StatBin2d)
 export(StatBindot)
 export(StatBinhex)
 export(StatBoxplot)
+export(StatConnect)
 export(StatContour)
 export(StatContourFilled)
 export(StatCount)
@@ -684,6 +687,7 @@ export(stat_bin_2d)
 export(stat_bin_hex)
 export(stat_binhex)
 export(stat_boxplot)
+export(stat_connect)
 export(stat_contour)
 export(stat_contour_filled)
 export(stat_count)

NEWS.md

@@ -1,5 +1,9 @@
 # ggplot2 (development version)
 
+* `position_fill()` avoids stacking observations of zero (@teunbrand, #6338)
+* New `layer(layout)` argument to interact with facets (@teunbrand, #3062)
+* New `stat_connect()` to connect points via steps or other shapes 
+  (@teunbrand, #6228)
 * Fixed regression with incorrectly drawn gridlines when using `coord_flip()` 
   (@teunbrand, #6293).
 * Deprecated functions and arguments prior to ggplot2 3.0.0 throw errors instead 
@@ -249,8 +253,8 @@
   and (non-text) margins inherit from (@teunbrand, #5622).
 * `geom_ribbon()` can have varying `fill` or `alpha` in linear coordinate
   systems (@teunbrand, #4690).
-* `geom_tile()` computes default widths and heights per panel instead of
-  per layer (@teunbrand, #5740).
+* `geom_tile()` and `position_jitter()` computes default widths and heights 
+  per panel instead of per layer (@teunbrand, #5740, #3722).
 * The `fill` of the `panel.border` theme setting is ignored and forced to be
   transparent (#5782).
 * `stat_align()` skips computation when there is only 1 group and therefore
@@ -321,6 +325,8 @@
   (@teunbrand, #3669). 
 * Added `scale_{x/y}_time(date_breaks, date_minor_breaks, date_labels)` 
   (@teunbrand, #4335).
+* (internal) `legend.key.width` and `legend.key.height` calculations are no
+  longer precomputed before guides are drawn (@teunbrand, #6339)
 * `ggsave()` can write a multi-page pdf file when provided with a list of plots 
   (@teunbrand, #5093).
 * (internal) When `validate_subclass()` fails to find a class directly, it tries 
@@ -329,6 +335,11 @@
   copying trained position scales (#3441).
 * `draw_key_rect()` replaces a `NA` fill by the `colour` aesthetic and 
   `draw_key_polygon()` has 0 linewidth as internal default (@teunbrand, #5385).
+* Improved consistency of curve direction in `geom_curve()` (@teunbrand, #5069)
+* `linetype = NA` is now interpreted to mean 'no line' instead of raising errors
+  (@teunbrand, #6269).
+* The default colour and fill scales have a new `palette` argument 
+  (@teunbrand, #6064).
 
 # ggplot2 3.5.1
 

R/facet-.R

@@ -872,3 +872,95 @@ censor_labels <- function(ranges, layout, labels) {
   }
   ranges
 }
+
+map_facet_data <- function(data, layout, params) {
+
+  if (empty(data)) {
+    return(vec_cbind(data %|W|% NULL, PANEL = integer(0)))
+  }
+
+  vars <- params$facet %||% c(params$rows, params$cols)
+
+  if (length(vars) == 0) {
+    data$PANEL <- layout$PANEL
+    return(data)
+  }
+
+  grid_layout <- all(c("rows", "cols") %in% names(params))
+  layer_layout <- attr(data, "layout")
+  if (identical(layer_layout, "fixed")) {
+    n <- vec_size(data)
+    data <- vec_rep(data, vec_size(layout))
+    data$PANEL <- vec_rep_each(layout$PANEL, n)
+    return(data)
+  }
+
+  # Compute faceting values
+  facet_vals <- eval_facets(vars, data, params$.possible_columns)
+
+  include_margins <- !isFALSE(params$margin %||% FALSE) &&
+    nrow(facet_vals) == nrow(data) && grid_layout
+  if (include_margins) {
+    # Margins are computed on evaluated faceting values (#1864).
+    facet_vals <- reshape_add_margins(
+      vec_cbind(facet_vals, .index = seq_len(nrow(facet_vals))),
+      list(intersect(names(params$rows), names(facet_vals)),
+           intersect(names(params$cols), names(facet_vals))),
+      params$margins %||% FALSE
+    )
+    # Apply recycling on original data to fit margins
+    # We're using base subsetting here because `data` might have a superclass
+    # that isn't handled well by vctrs::vec_slice
+    data <- data[facet_vals$.index, , drop = FALSE]
+    facet_vals$.index <- NULL
+  }
+
+  # If we need to fix rows or columns, we make the corresponding faceting
+  # variables missing on purpose
+  if (grid_layout) {
+    if (identical(layer_layout, "fixed_rows")) {
+      facet_vals <- facet_vals[setdiff(names(facet_vals), names(params$cols))]
+    }
+    if (identical(layer_layout, "fixed_cols")) {
+      facet_vals <- facet_vals[setdiff(names(facet_vals), names(params$rows))]
+    }
+  }
+
+  # If any faceting variables are missing, add them in by
+  # duplicating the data
+  missing_facets <- setdiff(names(vars), names(facet_vals))
+  if (length(missing_facets) > 0) {
+
+    to_add <- unique0(layout[missing_facets])
+
+    data_rep  <- rep.int(seq_len(nrow(data)), nrow(to_add))
+    facet_rep <- rep(seq_len(nrow(to_add)), each = nrow(data))
+
+    data <- unrowname(data[data_rep, , drop = FALSE])
+    facet_vals <- unrowname(vec_cbind(
+      unrowname(facet_vals[data_rep, , drop = FALSE]),
+      unrowname(to_add[facet_rep, , drop = FALSE])
+    ))
+  }
+
+  if (nrow(facet_vals) < 1) {
+    # Add PANEL variable
+    data$PANEL <- NO_PANEL
+    return(data)
+  }
+
+  facet_vals[] <- lapply(facet_vals, as_unordered_factor)
+  facet_vals[] <- lapply(facet_vals, addNA, ifany = TRUE)
+  layout[] <- lapply(layout, as_unordered_factor)
+
+  # Add PANEL variable
+  keys <- join_keys(facet_vals, layout, by = names(vars))
+  data$PANEL <- layout$PANEL[match(keys$x, keys$y)]
+
+  # Filter panels when layer_layout is an integer
+  if (is_integerish(layer_layout)) {
+    data <- vec_slice(data, data$PANEL %in% layer_layout)
+  }
+
+  data
+}

R/facet-grid-.R

@@ -69,6 +69,17 @@ NULL
 #'   labels and the interior axes get none. When `"all_x"` or `"all_y"`, only
 #'   draws the labels at the interior axes in the x- or y-direction
 #'   respectively.
+#'
+#' @section Layer layout:
+#' The [`layer(layout)`][layer()] argument in context of `facet_grid()` can take
+#' the following values:
+#' * `NULL` (default) to use the faceting variables to assign panels.
+#' * An integer vector to include selected panels. Panel numbers not included in
+#'   the integer vector are excluded.
+#' * `"fixed"` to repeat data across every panel.
+#' * `"fixed_rows"` to repeat data across rows.
+#' * `"fixed_cols"` to repeat data across columns.
+#'
 #' @export
 #' @seealso
 #' The `r link_book("facet grid section", "facet#facet-grid")`
@@ -282,69 +293,8 @@ FacetGrid <- ggproto("FacetGrid", Facet,
 
     panels
   },
-  map_data = function(data, layout, params) {
-    if (empty(data)) {
-      return(vec_cbind(data %|W|% NULL, PANEL = integer(0)))
-    }
-
-    rows <- params$rows
-    cols <- params$cols
-    vars <- c(names(rows), names(cols))
-
-    if (length(vars) == 0) {
-      data$PANEL <- layout$PANEL
-      return(data)
-    }
-
-    # Compute faceting values
-    facet_vals <- eval_facets(c(rows, cols), data, params$.possible_columns)
-    if (nrow(facet_vals) == nrow(data)) {
-      # Margins are computed on evaluated faceting values (#1864).
-      facet_vals <- reshape_add_margins(
-        # We add an index column to track data recycling
-        vec_cbind(facet_vals, .index = seq_len(nrow(facet_vals))),
-        list(intersect(names(rows), names(facet_vals)),
-             intersect(names(cols), names(facet_vals))),
-        params$margins
-      )
-      # Apply recycling on original data to fit margins
-      # We're using base subsetting here because `data` might have a superclass
-      # that isn't handled well by vctrs::vec_slice
-      data <- data[facet_vals$.index, , drop = FALSE]
-      facet_vals$.index <- NULL
-    }
 
-    # If any faceting variables are missing, add them in by
-    # duplicating the data
-    missing_facets <- setdiff(vars, names(facet_vals))
-    if (length(missing_facets) > 0) {
-      to_add <- unique0(layout[missing_facets])
-
-      data_rep <- rep.int(seq_len(nrow(data)), nrow(to_add))
-      facet_rep <- rep(seq_len(nrow(to_add)), each = nrow(data))
-
-      data <- unrowname(data[data_rep, , drop = FALSE])
-      facet_vals <- unrowname(vec_cbind(
-        unrowname(facet_vals[data_rep, ,  drop = FALSE]),
-        unrowname(to_add[facet_rep, , drop = FALSE]))
-      )
-    }
-
-    # Add PANEL variable
-    if (nrow(facet_vals) == 0) {
-      # Special case of no faceting
-      data$PANEL <- NO_PANEL
-    } else {
-      facet_vals[] <- lapply(facet_vals[], as_unordered_factor)
-      facet_vals[] <- lapply(facet_vals[], addNA, ifany = TRUE)
-      layout[] <- lapply(layout[], as_unordered_factor)
-
-      keys <- join_keys(facet_vals, layout, by = vars)
-
-      data$PANEL <- layout$PANEL[match(keys$x, keys$y)]
-    }
-    data
-  },
+  map_data = map_facet_data,
 
   attach_axes = function(table, layout, ranges, coord, theme, params) {
 

R/facet-null.R

@@ -6,6 +6,9 @@ NULL
 #' @inheritParams facet_grid
 #' @keywords internal
 #' @export
+#' @section Layer layout:
+#' The [`layer(layout)`][layer()] argument in context of `facet_null()` is
+#' completely ignored.
 #' @examples
 #' # facet_null is the default faceting specification if you
 #' # don't override it with facet_grid or facet_wrap

R/facet-wrap.R

@@ -45,6 +45,15 @@ NULL
 #'   the exterior axes get labels, and the interior axes get none. When
 #'   `"all_x"` or `"all_y"`, only draws the labels at the interior axes in the
 #'   x- or y-direction respectively.
+#'
+#' @section Layer layout:
+#' The [`layer(layout)`][layer()] argument in context of `facet_wrap()` can take
+#' the following values:
+#' * `NULL` (default) to use the faceting variables to assign panels.
+#' * An integer vector to include selected panels. Panel numbers not included in
+#'   the integer vector are excluded.
+#' * `"fixed"` to repeat data across every panel.
+#'
 #' @inheritParams facet_grid
 #' @seealso
 #' The `r link_book("facet wrap section", "facet#sec-facet-wrap")`
@@ -247,42 +256,8 @@ FacetWrap <- ggproto("FacetWrap", Facet,
 
     panels
   },
-  map_data = function(data, layout, params) {
-    if (empty(data)) {
-      return(vec_cbind(data %|W|% NULL, PANEL = integer(0)))
-    }
-
-    vars <- params$facets
-
-    if (length(vars) == 0) {
-      data$PANEL <- layout$PANEL
-      return(data)
-    }
-
-    facet_vals <- eval_facets(vars, data, params$.possible_columns)
-    facet_vals[] <- lapply(facet_vals[], as_unordered_factor)
-    layout[] <- lapply(layout[], as_unordered_factor)
 
-    missing_facets <- setdiff(names(vars), names(facet_vals))
-    if (length(missing_facets) > 0) {
-
-      to_add <- unique0(layout[missing_facets])
-
-      data_rep <- rep.int(seq_len(nrow(data)), nrow(to_add))
-      facet_rep <- rep(seq_len(nrow(to_add)), each = nrow(data))
-
-      data <- data[data_rep, , drop = FALSE]
-      facet_vals <- vec_cbind(
-        facet_vals[data_rep, ,  drop = FALSE],
-        to_add[facet_rep, , drop = FALSE]
-      )
-    }
-
-    keys <- join_keys(facet_vals, layout, by = names(vars))
-
-    data$PANEL <- layout$PANEL[match(keys$x, keys$y)]
-    data
-  },
+  map_data = map_facet_data,
 
   attach_axes = function(table, layout, ranges, coord, theme, params) {
 

R/geom-curve.R

@@ -55,6 +55,15 @@ GeomCurve <- ggproto("GeomCurve", GeomSegment,
 
     trans <- coord$transform(data, panel_params)
 
+    flip <- flip_curve(trans, coord, panel_params)
+    if (flip) {
+      trans <- rename(trans, c(x = "xend", xend = "x", y = "yend", yend = "y"))
+      if (!is.null(arrow)) {
+        # Flip end where arrow appears (2 = last, 1 = first, 3 = both)
+        arrow$ends <- match(arrow$ends, c(2, 1, 3))
+      }
+    }
+
     arrow.fill <- arrow.fill %||% trans$colour
 
     curveGrob(
@@ -72,3 +81,41 @@ GeomCurve <- ggproto("GeomCurve", GeomSegment,
     )
   }
 )
+
+# Helper function for determining whether curves should swap segment ends to
+# keep curvature consistent over transformations
+flip_curve <- function(data, coord, params) {
+  flip <- FALSE
+
+  # Figure implicit flipping transformations in coords
+  if (inherits(coord, "CoordFlip")) {
+    flip <- !flip
+  } else if (inherits(coord, "CoordTrans")) {
+    if (identical(coord$trans$x$name, "reverse")) {
+      flip <- !flip
+    }
+    if (identical(coord$trans$y$name, "reverse")) {
+      flip <- !flip
+    }
+  }
+
+  # We don't flip when none or both directions are reversed
+  if ((coord$reverse %||% "none") %in% c("x", "y")) {
+    flip <- !flip
+  }
+
+  # Check scales for reverse transforms
+  # Note that polar coords do not have x/y scales, but these are unsupported
+  # anyway
+  fn <- params$x$get_transformation
+  if (is.function(fn) && identical(fn()$name, "reverse")) {
+    flip <- !flip
+  }
+
+  fn <- params$y$get_transformation
+  if (is.function(fn) && identical(fn()$name, "reverse")) {
+    flip <- !flip
+  }
+
+  flip
+}