Removing direction constraint from geoms (tidyverse#3506)

Author: thomasp85

NAMESPACE

@@ -316,6 +316,8 @@ export(facet_grid)
 export(facet_null)
 export(facet_wrap)
 export(find_panel)
+export(flip_data)
+export(flipped_names)
 export(fortify)
 export(geom_abline)
 export(geom_area)
@@ -390,6 +392,7 @@ export(guide_none)
 export(guide_train)
 export(guide_transform)
 export(guides)
+export(has_flipped_aes)
 export(is.Coord)
 export(is.facet)
 export(is.ggplot)

R/geom-.r

@@ -153,7 +153,12 @@ Geom <- ggproto("Geom",
   },
 
   aesthetics = function(self) {
-    c(union(self$required_aes, names(self$default_aes)), self$optional_aes, "group")
+    if (is.null(self$required_aes)) {
+      required_aes <- NULL
+    } else {
+      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,8 @@
 #' [position_fill()] shows relative proportions at each `x` by stacking the bars
 #' and then standardising each bar to have the same height.
 #'
+#' @eval rd_orientation()
+#'
 #' @eval rd_aesthetics("geom", "bar")
 #' @eval rd_aesthetics("geom", "col")
 #' @eval rd_aesthetics("stat", "count")
@@ -29,6 +31,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"`. See the *Orientation* section for more detail.
 #' @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
@@ -43,17 +49,18 @@
 #' g + geom_bar()
 #' # Total engine displacement of each class
 #' g + geom_bar(aes(weight = displ))
+#' # Map class to y instead to flip the orientation
+#' ggplot(mpg) + geom_bar(aes(y = class))
 #'
 #' # Bar charts are automatically stacked when multiple bars are placed
 #' # at the same location. The order of the fill is designed to match
 #' # the legend
 #' g + geom_bar(aes(fill = drv))
 #'
-#' # If you need to flip the order (because you've flipped the plot)
+#' # If you need to flip the order (because you've flipped the orientation)
 #' # call position_stack() explicitly:
-#' g +
+#' ggplot(mpg, aes(y = class)) +
 #'  geom_bar(aes(fill = drv), position = position_stack(reverse = TRUE)) +
-#'  coord_flip() +
 #'  theme(legend.position = "top")
 #'
 #' # To show (e.g.) means, you need geom_col()
@@ -77,6 +84,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 +107,7 @@ geom_bar <- function(mapping = NULL, data = NULL,
     params = list(
       width = width,
       na.rm = na.rm,
+      orientation = orientation,
       ...
     )
   )
@@ -117,16 +126,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.
 #'
+#' @eval rd_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
@@ -60,7 +62,8 @@
 #' @examples
 #' p <- ggplot(mpg, aes(class, hwy))
 #' p + geom_boxplot()
-#' p + geom_boxplot() + coord_flip()
+#' # Orientation follows the discrete axis
+#' ggplot(mpg, aes(hwy, class)) + geom_boxplot()
 #'
 #' p + geom_boxplot(notch = TRUE)
 #' p + geom_boxplot(varwidth = TRUE)
@@ -116,6 +119,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 +152,7 @@ geom_boxplot <- function(mapping = NULL, data = NULL,
       notchwidth = notchwidth,
       varwidth = varwidth,
       na.rm = na.rm,
+      orientation = orientation,
       ...
     )
   )
@@ -161,9 +166,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 +185,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 +202,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 +238,7 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
       ),
       common
     ), n = 2)
+    whiskers <- flip_data(whiskers, flipped_aes)
 
     box <- new_data_frame(c(
       list(
@@ -241,6 +254,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 +268,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 +278,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 +287,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|xmax")
 )

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,18 +4,23 @@
 #' the histogram. This is a useful alternative to the histogram for continuous
 #' data that comes from an underlying smooth distribution.
 #'
+#' @eval rd_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
 #' @examples
 #' ggplot(diamonds, aes(carat)) +
 #'   geom_density()
+#' # Map the values to y to flip the orientation
+#' ggplot(diamonds, aes(y = carat)) +
+#'   geom_density()
 #'
 #' ggplot(diamonds, aes(carat)) +
 #'   geom_density(adjust = 1/5)
@@ -49,6 +54,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 +68,7 @@ geom_density <- function(mapping = NULL, data = NULL,
     inherit.aes = inherit.aes,
     params = list(
       na.rm = na.rm,
+      orientation = orientation,
       ...
     )
   )