Merge branch 'main' into mass_to_suggests

Author: teunbrand

DESCRIPTION

@@ -151,7 +151,6 @@ Collate:
     'geom-density2d.R'
     'geom-dotplot.R'
     'geom-errorbar.R'
-    'geom-errorbarh.R'
     'geom-freqpoly.R'
     'geom-function.R'
     'geom-hex.R'

NEWS.md

@@ -2,6 +2,8 @@
 
 * `geom_errorbarh()` is deprecated in favour of 
   `geom_errorbar(orientation = "y")` (@teunbrand, #5961).
+* `geom_contour()` should be able to recognise a rotated grid of points 
+  (@teunbrand, #4320)
 * `geom_boxplot()` gains additional arguments to style the colour, linetype and
   linewidths of the box, whiskers, median line and staples (@teunbrand, #5126)
 * (internal) Using `after_scale()` in the `Geom*$default_aes()` field is now

R/geom-errorbar.R

@@ -23,6 +23,35 @@ geom_errorbar <- function(mapping = NULL, data = NULL,
   )
 }
 
+#' @export
+#' @rdname geom_linerange
+#' @note
+#' `geom_errorbarh()` is `r lifecycle::badge("deprecated")`. Use
+#' `geom_errorbar(orientation = "y")` instead.
+geom_errorbarh <- function(mapping = NULL, data = NULL,
+                           stat = "identity", position = "identity",
+                           ...,
+                           orientation = "y",
+                           na.rm = FALSE,
+                           show.legend = NA,
+                           inherit.aes = TRUE) {
+  deprecate_soft0(
+    "3.5.2", "geom_errobarh()", "geom_errorbar(orientation = \"y\")",
+    id = "no-more-errorbarh"
+  )
+  geom_errorbar(
+    mapping = mapping,
+    data = data,
+    stat = stat,
+    position = position,
+    ...,
+    orientation = orientation,
+    na.rm = na.rm,
+    show.legend = show.legend,
+    inherit.aes = inherit.aes
+  )
+}
+
 #' @rdname ggplot2-ggproto
 #' @format NULL
 #' @usage NULL
@@ -80,3 +109,18 @@ GeomErrorbar <- ggproto("GeomErrorbar", Geom,
 
   rename_size = TRUE
 )
+
+#' @rdname ggplot2-ggproto
+#' @format NULL
+#' @usage NULL
+#' @export
+GeomErrorbarh <- ggproto(
+  "GeomErrorbarh", GeomErrorbar,
+  setup_params = function(data, params) {
+    deprecate_soft0(
+      "3.5.2", "geom_errobarh()", "geom_errorbar(orientation = \"y\")",
+      id = "no-more-errorbarh"
+    )
+    GeomLinerange$setup_params(data, params)
+  }
+)

R/geom-errorbarh.R

@@ -11,8 +11,7 @@
 #'   `geom_pointrange()`.
 #' @seealso
 #'  [stat_summary()] for examples of these guys in use,
-#'  [geom_smooth()] for continuous analogue,
-#'  [geom_errorbarh()] for a horizontal error bar.
+#'  [geom_smooth()] for continuous analogue
 #' @export
 #' @inheritParams layer
 #' @inheritParams geom_bar

R/geom-linerange.R

@@ -104,6 +104,9 @@ StatContour <- ggproto("StatContour", Stat,
 
   compute_group = function(data, scales, z.range, bins = NULL, binwidth = NULL,
                            breaks = NULL, na.rm = FALSE) {
+    # Undo data rotation
+    rotation <- estimate_contour_angle(data$x, data$y)
+    data[c("x", "y")] <- rotate_xy(data$x, data$y, -rotation)
 
     breaks <- contour_breaks(z.range, bins, binwidth, breaks)
 
@@ -113,6 +116,8 @@ StatContour <- ggproto("StatContour", Stat,
     path_df$level <- as.numeric(path_df$level)
     path_df$nlevel <- rescale_max(path_df$level)
 
+    # Re-apply data rotation
+    path_df[c("x", "y")] <- rotate_xy(path_df$x, path_df$y, rotation)
     path_df
   }
 )
@@ -138,6 +143,11 @@ StatContourFilled <- ggproto("StatContourFilled", Stat,
   },
 
   compute_group = function(data, scales, z.range, bins = NULL, binwidth = NULL, breaks = NULL, na.rm = FALSE) {
+
+    # Undo data rotation
+    rotation <- estimate_contour_angle(data$x, data$y)
+    data[c("x", "y")] <- rotate_xy(data$x, data$y, -rotation)
+
     breaks <- contour_breaks(z.range, bins, binwidth, breaks)
 
     isobands <- withr::with_options(list(OutDec = "."), xyz_to_isobands(data, breaks))
@@ -149,6 +159,8 @@ StatContourFilled <- ggproto("StatContourFilled", Stat,
     path_df$level_high <- breaks[as.numeric(path_df$level) + 1]
     path_df$level_mid <- 0.5*(path_df$level_low + path_df$level_high)
     path_df$nlevel <- rescale_max(path_df$level_high)
+    # Re-apply data rotation
+    path_df[c("x", "y")] <- rotate_xy(path_df$x, path_df$y, rotation)
 
     path_df
   }
@@ -356,3 +368,49 @@ contour_deduplicate <- function(data, check = c("x", "y", "group", "PANEL")) {
   }
   data
 }
+
+estimate_contour_angle <- function(x, y) {
+
+  # Compute most frequent angle among first 20 points
+  all_angles <- atan2(diff(head(y, 20L)), diff(head(x, 20L)))
+  freq <- tabulate(match(all_angles, unique(all_angles)))
+  i <- which.max(freq)
+
+  # If this angle represents less than half of the angles, we probably
+  # have unordered data, in which case the approach above is invalid
+  if ((freq[i] / sum(freq)) < 0.5) {
+    # In such case, try approach with convex hull
+    hull <- grDevices::chull(x, y)
+    hull <- c(hull, hull[1])
+    # Find largest edge along hull
+    dx <- diff(x[hull])
+    dy <- diff(y[hull])
+    i <- which.max(sqrt(dx^2 + dy^2))
+    # Take angle of largest edge
+    angle <- atan2(dy[i], dx[i])
+  } else {
+    angle <- all_angles[i]
+  }
+
+  # No need to rotate contour data when angle is straight
+  straight <- abs(angle - c(-1, -0.5, 0, 0.5, 1) * pi) < sqrt(.Machine$double.eps)
+  if (any(straight)) {
+    return(0)
+  }
+  angle
+}
+
+rotate_xy <- function(x, y, angle) {
+  # Skip rotation if angle was straight
+  if (angle == 0) {
+    return(list(x = x, y = y))
+  }
+  cos <- cos(angle)
+  sin <- sin(angle)
+  # Using zapsmall to make `unique0` later recognise values that may have
+  # rounding errors.
+  list(
+    x = zapsmall(cos * x - sin * y, digits = 13),
+    y = zapsmall(sin * x + cos * y, digits = 13)
+  )
+}