Removing direction constraint from geoms

R/geom-.r

@@ -153,7 +153,8 @@ Geom <- ggproto("Geom",
   },
 
   aesthetics = function(self) {
-    c(union(self$required_aes, names(self$default_aes)), self$optional_aes, "group")
+    required_aes <- unlist(strsplit(self$required_aes, '|', fixed = TRUE))
+    c(union(required_aes, names(self$default_aes)), self$optional_aes, "group")
   }
 
 )

R/geom-bar.r

@@ -19,6 +19,16 @@
 #' [position_fill()] shows relative proportions at each `x` by stacking the bars
 #' and then standardising each bar to have the same height.
 #'
+#' @section Orientation:
+#' This geom treats each axis differently and can thus have two orientations.
+#' Often the orientation is easily deducable from a combination of the given
+#' mappings and the types of positional scales in use. Thus, ggplot2 will by
+#' default try to guess which orientation the layer should have. Under rare
+#' circumstances the orinetation is ambiguous and guessing may fail. In that
+#' case the orientation can be given directly using the `orientation` parameter,
+#' which can be either `"x"` or `"y"`. The value gives the axis that the geom
+#' runs along, `"x"` being the default orientation you would expect for the geom.
+#'
 #' @eval rd_aesthetics("geom", "bar")
 #' @eval rd_aesthetics("geom", "col")
 #' @eval rd_aesthetics("stat", "count")
@@ -29,6 +39,10 @@
 #' @export
 #' @inheritParams layer
 #' @inheritParams geom_point
+#' @param orientation The orientation of the layer. The default (`NA`)
+#' automatically determines the orientation from the aesthetic mapping. In the
+#' rare event that this fails it can be given explicitly by setting `orientation`
+#' to either `"x"` or `"y"`.
 #' @param width Bar width. By default, set to 90\% of the resolution of the data.
 #' @param binwidth `geom_bar()` no longer has a binwidth argument - if
 #'   you use it you'll get an warning telling to you use
@@ -77,6 +91,7 @@ geom_bar <- function(mapping = NULL, data = NULL,
                      width = NULL,
                      binwidth = NULL,
                      na.rm = FALSE,
+                     orientation = NA,
                      show.legend = NA,
                      inherit.aes = TRUE) {
 
@@ -99,6 +114,7 @@ geom_bar <- function(mapping = NULL, data = NULL,
     params = list(
       width = width,
       na.rm = na.rm,
+      orientation = orientation,
       ...
     )
   )
@@ -117,16 +133,26 @@ GeomBar <- ggproto("GeomBar", GeomRect,
   # limits, not just those for which x and y are outside the limits
   non_missing_aes = c("xmin", "xmax", "ymin", "ymax"),
 
+  setup_params = function(data, params) {
+    params$flipped_aes <- has_flipped_aes(data, params, range_is_orthogonal = FALSE)
+    params
+  },
+
+  extra_params = c("na.rm", "orientation"),
+
   setup_data = function(data, params) {
+    data$flipped_aes <- params$flipped_aes
+    data <- flip_data(data, params$flipped_aes)
     data$width <- data$width %||%
       params$width %||% (resolution(data$x, FALSE) * 0.9)
-    transform(data,
+    data <- transform(data,
       ymin = pmin(y, 0), ymax = pmax(y, 0),
       xmin = x - width / 2, xmax = x + width / 2, width = NULL
     )
+    flip_data(data, params$flipped_aes)
   },
 
-  draw_panel = function(self, data, panel_params, coord, width = NULL) {
+  draw_panel = function(self, data, panel_params, coord, width = NULL, flipped_aes = FALSE) {
     # Hack to ensure that width is detected as a parameter
     ggproto_parent(GeomRect, self)$draw_panel(data, panel_params, coord)
   }

R/geom-boxplot.r

@@ -4,6 +4,8 @@
 #' It visualises five summary statistics (the median, two hinges
 #' and two whiskers), and all "outlying" points individually.
 #'
+#' @inheritSection geom_bar Orientation
+#'
 #' @section Summary statistics:
 #' The lower and upper hinges correspond to the first and third quartiles
 #' (the 25th and 75th percentiles). This differs slightly from the method used
@@ -28,7 +30,7 @@
 #'   [geom_violin()] for a richer display of the distribution, and
 #'   [geom_jitter()] for a useful technique for small data.
 #' @inheritParams layer
-#' @inheritParams geom_point
+#' @inheritParams geom_bar
 #' @param geom,stat Use to override the default connection between
 #'   `geom_boxplot` and `stat_boxplot`.
 #' @param outlier.colour,outlier.color,outlier.fill,outlier.shape,outlier.size,outlier.stroke,outlier.alpha
@@ -116,6 +118,7 @@ geom_boxplot <- function(mapping = NULL, data = NULL,
                          notchwidth = 0.5,
                          varwidth = FALSE,
                          na.rm = FALSE,
+                         orientation = NA,
                          show.legend = NA,
                          inherit.aes = TRUE) {
 
@@ -148,6 +151,7 @@ geom_boxplot <- function(mapping = NULL, data = NULL,
       notchwidth = notchwidth,
       varwidth = varwidth,
       na.rm = na.rm,
+      orientation = orientation,
       ...
     )
   )
@@ -161,9 +165,16 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
 
   # need to declare `width` here in case this geom is used with a stat that
   # doesn't have a `width` parameter (e.g., `stat_identity`).
-  extra_params = c("na.rm", "width"),
+  extra_params = c("na.rm", "width", "orientation"),
+
+  setup_params = function(data, params) {
+    params$flipped_aes <- has_flipped_aes(data, params)
+    params
+  },
 
   setup_data = function(data, params) {
+    data$flipped_aes <- params$flipped_aes
+    data <- flip_data(data, params$flipped_aes)
     data$width <- data$width %||%
       params$width %||% (resolution(data$x, FALSE) * 0.9)
 
@@ -173,8 +184,8 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
         out_max <- vapply(data$outliers, max, numeric(1))
       })
 
-      data$ymin_final <- pmin(out_min, data$ymin)
-      data$ymax_final <- pmax(out_max, data$ymax)
+      data$ymin_final  <- pmin(out_min, data$ymin)
+      data$ymax_final  <- pmax(out_max, data$ymax)
     }
 
     # if `varwidth` not requested or not available, don't use it
@@ -190,16 +201,16 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
     data$width <- NULL
     if (!is.null(data$relvarwidth)) data$relvarwidth <- NULL
 
-    data
+    flip_data(data, params$flipped_aes)
   },
 
   draw_group = function(data, panel_params, coord, fatten = 2,
                         outlier.colour = NULL, outlier.fill = NULL,
                         outlier.shape = 19,
                         outlier.size = 1.5, outlier.stroke = 0.5,
                         outlier.alpha = NULL,
-                        notch = FALSE, notchwidth = 0.5, varwidth = FALSE) {
-
+                        notch = FALSE, notchwidth = 0.5, varwidth = FALSE, flipped_aes = FALSE) {
+    data <- flip_data(data, flipped_aes)
     # this may occur when using geom_boxplot(stat = "identity")
     if (nrow(data) != 1) {
       stop(
@@ -226,6 +237,7 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
       ),
       common
     ), n = 2)
+    whiskers <- flip_data(whiskers, flipped_aes)
 
     box <- new_data_frame(c(
       list(
@@ -241,6 +253,7 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
       ),
       common
     ))
+    box <- flip_data(box, flipped_aes)
 
     if (!is.null(data$outliers) && length(data$outliers[[1]] >= 1)) {
       outliers <- new_data_frame(list(
@@ -254,6 +267,8 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
         fill = NA,
         alpha = outlier.alpha %||% data$alpha[1]
       ), n = length(data$outliers[[1]]))
+      outliers <- flip_data(outliers, flipped_aes)
+
       outliers_grob <- GeomPoint$draw_panel(outliers, panel_params, coord)
     } else {
       outliers_grob <- NULL
@@ -262,7 +277,7 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
     ggname("geom_boxplot", grobTree(
       outliers_grob,
       GeomSegment$draw_panel(whiskers, panel_params, coord),
-      GeomCrossbar$draw_panel(box, fatten = fatten, panel_params, coord)
+      GeomCrossbar$draw_panel(box, fatten = fatten, panel_params, coord, flipped_aes = flipped_aes)
     ))
   },
 
@@ -271,5 +286,5 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
   default_aes = aes(weight = 1, colour = "grey20", fill = "white", size = 0.5,
     alpha = NA, shape = 19, linetype = "solid"),
 
-  required_aes = c("x", "lower", "upper", "middle", "ymin", "ymax")
+  required_aes = c("x|y", "lower|xlower", "upper|xupper", "middle|xmiddle", "ymin|xmin", "ymax|ymin")
 )

R/geom-col.r

@@ -37,16 +37,26 @@ GeomCol <- ggproto("GeomCol", GeomRect,
   # limits, not just those for which x and y are outside the limits
   non_missing_aes = c("xmin", "xmax", "ymin", "ymax"),
 
+  setup_params = function(data, params) {
+    params$flipped_aes <- has_flipped_aes(data, params)
+    params
+  },
+
+  extra_params = c("na.rm", "orientation"),
+
   setup_data = function(data, params) {
+    data$flipped_aes <- params$flipped_aes
+    data <- flip_data(data, params$flipped_aes)
     data$width <- data$width %||%
       params$width %||% (resolution(data$x, FALSE) * 0.9)
-    transform(data,
-      ymin = pmin(y, 0), ymax = pmax(y, 0),
-      xmin = x - width / 2, xmax = x + width / 2, width = NULL
+    data <- transform(data,
+                      ymin = pmin(y, 0), ymax = pmax(y, 0),
+                      xmin = x - width / 2, xmax = x + width / 2, width = NULL
     )
+    flip_data(data, params$flipped_aes)
   },
 
-  draw_panel = function(self, data, panel_params, coord, width = NULL) {
+  draw_panel = function(self, data, panel_params, coord, width = NULL, flipped_aes = FALSE) {
     # Hack to ensure that width is detected as a parameter
     ggproto_parent(GeomRect, self)$draw_panel(data, panel_params, coord)
   }

R/geom-crossbar.r

@@ -5,6 +5,7 @@ geom_crossbar <- function(mapping = NULL, data = NULL,
                           ...,
                           fatten = 2.5,
                           na.rm = FALSE,
+                          orientation = NA,
                           show.legend = NA,
                           inherit.aes = TRUE) {
   layer(
@@ -18,6 +19,7 @@ geom_crossbar <- function(mapping = NULL, data = NULL,
     params = list(
       fatten = fatten,
       na.rm = na.rm,
+      orientation = orientation,
       ...
     )
   )
@@ -28,18 +30,26 @@ geom_crossbar <- function(mapping = NULL, data = NULL,
 #' @usage NULL
 #' @export
 GeomCrossbar <- ggproto("GeomCrossbar", Geom,
+  setup_params = function(data, params) {
+    GeomErrorbar$setup_params(data, params)
+  },
+
+  extra_params = c("na.rm", "orientation"),
+
   setup_data = function(data, params) {
     GeomErrorbar$setup_data(data, params)
   },
 
   default_aes = aes(colour = "black", fill = NA, size = 0.5, linetype = 1,
     alpha = NA),
 
-  required_aes = c("x", "y", "ymin", "ymax"),
+  required_aes = c("x", "y", "ymin|xmin", "ymax|xmax"),
 
   draw_key = draw_key_crossbar,
 
-  draw_panel = function(data, panel_params, coord, fatten = 2.5, width = NULL) {
+  draw_panel = function(data, panel_params, coord, fatten = 2.5, width = NULL, flipped_aes = FALSE) {
+    data <- flip_data(data, flipped_aes)
+
     middle <- transform(data, x = xmin, xend = xmax, yend = y, size = size * fatten, alpha = NA)
 
     has_notch <- !is.null(data$ynotchlower) && !is.null(data$ynotchupper) &&
@@ -85,6 +95,8 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom,
         group = rep(seq_len(nrow(data)), 5) # each bar forms it's own group
       ))
     }
+    box <- flip_data(box, flipped_aes)
+    middle <- flip_data(middle, flipped_aes)
 
     ggname("geom_crossbar", gTree(children = gList(
       GeomPolygon$draw_panel(box, panel_params, coord),

R/geom-density.r

@@ -4,12 +4,14 @@
 #' the histogram. This is a useful alternative to the histogram for continuous
 #' data that comes from an underlying smooth distribution.
 #'
+#' @inheritSection geom_bar Orientation
+#'
 #' @eval rd_aesthetics("geom", "density")
 #' @seealso See [geom_histogram()], [geom_freqpoly()] for
 #'   other methods of displaying continuous distribution.
 #'   See [geom_violin()] for a compact density display.
 #' @inheritParams layer
-#' @inheritParams geom_point
+#' @inheritParams geom_bar
 #' @param geom,stat Use to override the default connection between
 #'   `geom_density` and `stat_density`.
 #' @export
@@ -49,6 +51,7 @@ geom_density <- function(mapping = NULL, data = NULL,
                          stat = "density", position = "identity",
                          ...,
                          na.rm = FALSE,
+                         orientation = NA,
                          show.legend = NA,
                          inherit.aes = TRUE) {
 
@@ -62,6 +65,7 @@ geom_density <- function(mapping = NULL, data = NULL,
     inherit.aes = inherit.aes,
     params = list(
       na.rm = na.rm,
+      orientation = orientation,
       ...
     )
   )

R/geom-errorbar.r

@@ -4,6 +4,7 @@ geom_errorbar <- function(mapping = NULL, data = NULL,
                           stat = "identity", position = "identity",
                           ...,
                           na.rm = FALSE,
+                          orientation = NA,
                           show.legend = NA,
                           inherit.aes = TRUE) {
   layer(
@@ -16,6 +17,7 @@ geom_errorbar <- function(mapping = NULL, data = NULL,
     inherit.aes = inherit.aes,
     params = list(
       na.rm = na.rm,
+      orientation = orientation,
       ...
     )
   )
@@ -31,27 +33,40 @@ GeomErrorbar <- ggproto("GeomErrorbar", Geom,
 
   draw_key = draw_key_path,
 
-  required_aes = c("x", "ymin", "ymax"),
+  required_aes = c("x|y", "ymin|xmin", "ymax|xmax"),
+
+  setup_params = function(data, params) {
+    GeomLinerange$setup_params(data, params)
+  },
+
+  extra_params = c("na.rm", "orientation"),
 
   setup_data = function(data, params) {
+    data$flipped_aes <- params$flipped_aes
+    data <- flip_data(data, params$flipped_aes)
     data$width <- data$width %||%
       params$width %||% (resolution(data$x, FALSE) * 0.9)
-
-    transform(data,
+    data <- transform(data,
       xmin = x - width / 2, xmax = x + width / 2, width = NULL
     )
+    flip_data(data, params$flipped_aes)
   },
 
-  draw_panel = function(data, panel_params, coord, width = NULL) {
-    GeomPath$draw_panel(new_data_frame(list(
-      x = as.vector(rbind(data$xmin, data$xmax, NA, data$x,    data$x,    NA, data$xmin, data$xmax)),
-      y = as.vector(rbind(data$ymax, data$ymax, NA, data$ymax, data$ymin, NA, data$ymin, data$ymin)),
+  draw_panel = function(data, panel_params, coord, width = NULL, flipped_aes = FALSE) {
+    data <- flip_data(data, flipped_aes)
+    x <- as.vector(rbind(data$xmin, data$xmax, NA, data$x,    data$x,    NA, data$xmin, data$xmax))
+    y <- as.vector(rbind(data$ymax, data$ymax, NA, data$ymax, data$ymin, NA, data$ymin, data$ymin))
+    data <- new_data_frame(list(
+      x = x,
+      y = y,
       colour = rep(data$colour, each = 8),
       alpha = rep(data$alpha, each = 8),
       size = rep(data$size, each = 8),
       linetype = rep(data$linetype, each = 8),
       group = rep(1:(nrow(data)), each = 8),
       row.names = 1:(nrow(data) * 8)
-    )), panel_params, coord)
+    ))
+    data <- flip_data(data, flipped_aes)
+    GeomPath$draw_panel(data, panel_params, coord)
   }
 )