auto-detect slabinterval orientation, towards #257

DESCRIPTION

@@ -19,7 +19,7 @@ Imports:
     plyr,
     dplyr (>= 0.8.0),
     tidyr (>= 1.0.0),
-    ggplot2 (>= 3.1.0),
+    ggplot2 (>= 3.3.0),
     coda,
     purrr (>= 0.2.3),
     rlang (>= 0.3.0),

NAMESPACE

@@ -264,6 +264,7 @@ importFrom(ggplot2,.pt)
 importFrom(ggplot2,.stroke)
 importFrom(ggplot2,GeomPolygon)
 importFrom(ggplot2,GeomSegment)
+importFrom(ggplot2,has_flipped_aes)
 importFrom(grDevices,nclass.FD)
 importFrom(grDevices,nclass.Sturges)
 importFrom(grDevices,nclass.scott)

R/draw_key_slabinterval.R

@@ -49,7 +49,9 @@ draw_key_interval_ = function(self, data, key_data, params, size) {
   if(params$show_interval && any(!is.na(data[c("colour","alpha","size","linetype","interval_colour","interval_alpha","interval_size","interval_linetype")]))) {
     i_key_data = self$override_interval_aesthetics(key_data, params$interval_size_domain, params$interval_size_range)
     line_key = switch(params$orientation,
+      y = ,
       horizontal = draw_key_path,
+      x = ,
       vertical = draw_key_vpath
     )
     line_key(i_key_data, params, size)

R/geom.R

@@ -42,6 +42,25 @@ add_default_computed_aesthetics = function(l, default_mapping) {
   )
 }
 
+# detects the orientation of the geometry
+#' @importFrom ggplot2 has_flipped_aes
+get_flipped_aes = function(data, params, ...) {
+  params$orientation =
+    if (params$orientation %in% c("horizontal", "y")) "y"
+    else if (params$orientation %in% c("vertical", "x")) "x"
+    else if (is.na(params$orientation)) NA
+    else stop("Unknown orientation: ", deparse0(params$orientation))
+
+  has_flipped_aes(data, params, ...)
+}
+
+# detects the orientation of the geometry
+get_orientation = function(flipped_aes) {
+  if (flipped_aes) "y"
+  else "x"
+}
+
+
 # defines "orientation" variables in the environment of the calling
 # function (for convenience): these are variables (typically aesthetics)
 # that differ depending on whether the geom's orientation is horizontal
@@ -50,7 +69,7 @@ globalVariables(c("height", "y", "ymin", "ymax", "yend", "x", "xmin", "xmax", "x
 define_orientation_variables = function(orientation) {
   f = parent.frame()
 
-  if (orientation == "horizontal") {
+  if (orientation == "horizontal" || orientation == "y") {
     f$height = "height"
 
     f$y = "y"
@@ -64,7 +83,7 @@ define_orientation_variables = function(orientation) {
     f$xmax = "xmax"
     f$xend = "xend"
     f$x.range = "x.range"
-  } else if (orientation == "vertical") {
+  } else if (orientation == "vertical" || orientation == "x") {
     f$height = "width"
 
     f$y = "x"

R/geom_dotsinterval.R

@@ -202,7 +202,12 @@ draw_slabs_dots = function(self, s_data, panel_params, coord,
   }
   # Swap axes if using coord_flip
   if (inherits(coord, "CoordFlip")) {
-    orientation = ifelse(orientation == "horizontal", "vertical", "horizontal")
+    orientation = switch(orientation,
+      y = ,
+      horizontal = "x",
+      x = ,
+      vertical = "y"
+    )
     define_orientation_variables(orientation)
   }
   s_data = coord$transform(s_data, panel_params)

R/geom_interval.R

@@ -72,7 +72,7 @@ geom_interval = function(
   ...,
 
   side = "both",
-  orientation = "vertical",
+  orientation = NA,
   interval_size_range = c(1, 6),
   show_slab = FALSE,
   show_point = FALSE
@@ -114,7 +114,7 @@ GeomInterval = ggproto("GeomInterval", GeomSlabinterval,
 
   default_params = defaults(list(
     side = "both",
-    orientation = "vertical",
+    orientation = NA,
     interval_size_range = c(1, 6),
     show_slab = FALSE,
     show_point = FALSE

R/geom_pointinterval.R

@@ -74,7 +74,7 @@ geom_pointinterval = function(
   ...,
 
   side = "both",
-  orientation = "vertical",
+  orientation = NA,
   show_slab = FALSE,
 
   show.legend = c(size = FALSE)
@@ -115,7 +115,7 @@ GeomPointinterval = ggproto("GeomPointinterval", GeomSlabinterval,
 
   default_params = defaults(list(
     side = "both",
-    orientation = "vertical",
+    orientation = NA,
     show_slab = FALSE
   ), GeomSlabinterval$default_params),
 

R/geom_slabinterval.R

@@ -236,11 +236,16 @@ get_line_size = function(i_data, size_domain, size_range) {
 #' @param scale What proportion of the region allocated to this geom to use to draw the slab. If `scale = 1`,
 #' slabs that use the maximum range will just touch each other. Default is `0.9` to leave some space.
 #' @param orientation Whether this geom is drawn horizontally (`"horizontal"`) or
-#' vertically (`"vertical"`). When horizontal (resp. vertical), the geom uses the `y` (resp. `x`)
-#' aesthetic to identify different groups, then for each group uses the `x` (resp. `y`) aesthetic and the
-#' `thickness` aesthetic to draw a function as an slab, and draws points and intervals horizontally
-#' (resp. vertically) using the `xmin`, `x`, and `xmax` (resp. `ymin`, `y`, and `ymax`)
-#' aesthetics.
+#' vertically (`"vertical"`). The default, `NA`, automatically detects the orientation based on how the
+#' aesthetics are assigned, and should generally do an okay job at this. When horizontal (resp. vertical),
+#' the geom uses the `y` (resp. `x`) aesthetic to identify different groups, then for each group uses
+#' the `x` (resp. `y`) aesthetic and the `thickness` aesthetic to draw a function as an slab, and draws
+#' points and intervals horizontally (resp. vertically) using the `xmin`, `x`, and `xmax` (resp.
+#' `ymin`, `y`, and `ymax`) aesthetics. For compatibility with the base
+#' ggplot naming scheme for `orientation`, `"x"` can be used as an alias for `"vertical"` and `"y"` as an alias for
+#' `"horizontal"` (tidybayes had an `orientation` parameter before ggplot did, and I think the tidybayes naming
+#' scheme is more intuitive: `"x"` and `"y"` are not orientations and their mapping to orientations is, in my
+#' opinion, backwards; but the base ggplot naming scheme is allowed for compatibility).
 #' @param justification Justification of the interval relative to the slab, where `0` indicates bottom/left
 #' justification and `1` indicates top/right justification (depending on `orientation`). If `justification`
 #' is `NULL` (the default), then it is set automatically based on the value of `side`: when `side` is
@@ -304,7 +309,7 @@ geom_slabinterval = function(
   # amongst other things
   side = c("topright", "top", "right", "bottomleft", "bottom", "left", "both"),
   scale = 0.9,
-  orientation = c("vertical", "horizontal"),
+  orientation = NA,
   justification = NULL,
   normalize = c("all", "panels", "xy", "groups", "none"),
   interval_size_domain = c(1, 6),
@@ -319,7 +324,6 @@ geom_slabinterval = function(
   inherit.aes = TRUE
 ) {
   side = match.arg(side)
-  orientation = match.arg(orientation)
   normalize = match.arg(normalize)
 
   layer_geom_slabinterval(
@@ -470,7 +474,7 @@ GeomSlabinterval = ggproto("GeomSlabinterval", Geom,
   default_params = list(
     side = "topright",
     scale = 0.9,
-    orientation = "vertical",
+    orientation = NA,
     justification = NULL,
     normalize = "all",
     interval_size_domain = c(1, 6),
@@ -484,11 +488,27 @@ GeomSlabinterval = ggproto("GeomSlabinterval", Geom,
 
   default_datatype = "slab",
 
-  setup_data = function(self, data, params) {
+  setup_params = function(self, data, params) {
     params = defaults(params, self$default_params)
 
+    # detect orientation
+    params$flipped_aes = get_flipped_aes(data, params,
+      main_is_orthogonal = TRUE, range_is_orthogonal = TRUE, group_has_equal = TRUE, main_is_optional = TRUE
+    )
+    params$orientation = get_orientation(params$flipped_aes)
+
+    params
+  },
+
+  setup_data = function(self, data, params) {
+    #set up orientation
+    data$flipped_aes = params$flipped_aes
     define_orientation_variables(params$orientation)
 
+    # when we are missing a main aesthetic (e.g. the y aes in a horizontal orientation),
+    # fill it in with 0 so that we can still draw stuff
+    data[[y]] = data[[y]] %||% 0
+
     data$datatype = data$datatype %||% self$default_datatype
 
     # normalize functions according to how we want to scale them

R/stat_dist_slabinterval.R

@@ -222,7 +222,7 @@ stat_dist_slabinterval = function(
   slab_type = c("pdf", "cdf", "ccdf"),
   p_limits = c(.001, .999),
 
-  orientation = c("vertical", "horizontal"),
+  orientation = NA,
   limits = NULL,
   n = 501,
   .width = c(.66, .95),
@@ -235,7 +235,6 @@ stat_dist_slabinterval = function(
   show.legend = c(size = FALSE),
   inherit.aes = TRUE
 ) {
-  orientation = match.arg(orientation)
   slab_type = match.arg(slab_type)
 
   layer(
@@ -315,6 +314,15 @@ StatDistSlabinterval = ggproto("StatDistSlabinterval", StatSlabinterval,
   ), StatSlabinterval$default_params),
 
   setup_params = function(self, data, params) {
+    params = defaults(params, self$default_params)
+
+    # detect orientation -- this must be done before calling up to StatSlabInterval
+    # since auto-detection here is different (main_is_orthogonal needs to be FALSE)
+    params$flipped_aes = get_flipped_aes(data, params,
+      main_is_orthogonal = FALSE, range_is_orthogonal = TRUE, group_has_equal = TRUE, main_is_optional = TRUE
+    )
+    params$orientation = get_orientation(params$flipped_aes)
+
     params = ggproto_parent(StatSlabinterval, self)$setup_params(data, params)
 
     params$limits_args = list(

R/stat_dotsinterval.R

@@ -8,11 +8,13 @@
 
 #' @importFrom stats ppoints
 dots_sample_slab_function = function(
-  df, input, limits = NULL, quantiles = NA, orientation = "vertical",
+  df, input, limits = NULL, quantiles = NA, orientation = NA,
   trans = scales::identity_trans(), ...
 ) {
   x = switch(orientation,
+    y = ,
     horizontal = "x",
+    x = ,
     vertical = "y"
   )
 
@@ -234,6 +236,17 @@ StatDistDotsinterval = ggproto("StatDistDotsinterval", StatDistSlabinterval,
   ), StatDistSlabinterval$default_params),
 
   setup_params = function(self, data, params) {
+    params = defaults(params, self$default_params)
+
+    # detect orientation -- this must be done before calling up to StatSlabInterval
+    # since auto-detection here is different (main_is_orthogonal needs to be FALSE)
+    params$flipped_aes = get_flipped_aes(data, params,
+      main_is_orthogonal = FALSE, range_is_orthogonal = TRUE, group_has_equal = TRUE, main_is_optional = TRUE
+    )
+    params$orientation = get_orientation(params$flipped_aes)
+
+    # we use setup_params from StatSlabinterval instead of StatDistSlabinterval
+    # because StatDistSlabinterval does some limits calculations that are not relevant here
     params = ggproto_parent(StatSlabinterval, self)$setup_params(data, params)
 
     params$slab_args = list(
@@ -290,5 +303,3 @@ StatDistDots$default_aes$size = NULL
 stat_dist_dotsh = function(..., orientation = "horizontal") {
   stat_dist_dots(..., orientation = orientation)
 }
-
-

R/stat_interval.R

@@ -51,7 +51,7 @@ stat_interval = function(
   position = "identity",
   ...,
 
-  orientation = "vertical",
+  orientation = NA,
   interval_function = NULL,
   interval_args = list(),
   point_interval = median_qi,

R/stat_pointinterval.R

@@ -57,7 +57,7 @@ stat_pointinterval = function(
   position = "identity",
   ...,
 
-  orientation = "vertical",
+  orientation = NA,
   interval_function = NULL,
   interval_args = list(),
   point_interval = median_qi,

R/stat_sample_slabinterval.R

@@ -26,11 +26,13 @@ weighted_ecdf = function(x, weights = NULL) {
 #' @importFrom rlang missing_arg
 #' @importFrom stats ecdf
 sample_slab_function = function(
-  df, input, slab_type = "pdf", limits = NULL, n = 501, orientation = "vertical",
+  df, input, slab_type = "pdf", limits = NULL, n = 501, orientation = NA,
   adjust = 1, trim = TRUE, breaks = "Sturges", outline_bars = FALSE, trans = scales::identity_trans(), ...
 ) {
   x = switch(orientation,
+    y = ,
     horizontal = "x",
+    x = ,
     vertical = "y"
   )
 
@@ -194,7 +196,7 @@ stat_sample_slabinterval = function(
   breaks = "Sturges",
   outline_bars = FALSE,
 
-  orientation = c("vertical", "horizontal"),
+  orientation = NA,
   limits = NULL,
   n = 501,
   interval_function = NULL,
@@ -207,7 +209,6 @@ stat_sample_slabinterval = function(
   show.legend = c(size = FALSE),
   inherit.aes = TRUE
 ) {
-  orientation = match.arg(orientation)
   slab_type = match.arg(slab_type)
 
   layer(

R/stat_slabinterval.R

@@ -76,7 +76,7 @@ stat_slabinterval = function(
   position = "identity",
   ...,
 
-  orientation = c("vertical", "horizontal"),
+  orientation = NA,
 
   limits_function = NULL,
   limits_args = list(),
@@ -99,7 +99,6 @@ stat_slabinterval = function(
   show.legend = c(size = FALSE),
   inherit.aes = TRUE
 ) {
-  orientation = match.arg(orientation)
 
   layer(
     data = data,
@@ -146,7 +145,7 @@ StatSlabinterval = ggproto("StatSlabinterval", Stat,
   ),
 
   default_params = list(
-    orientation = "vertical",
+    orientation = NA,
 
     limits_function = NULL,
     limits_args = list(),
@@ -167,6 +166,30 @@ StatSlabinterval = ggproto("StatSlabinterval", Stat,
     na.rm = FALSE
   ),
 
+  setup_params = function(self, data, params) {
+    params = defaults(params, self$default_params)
+
+    # detect orientation
+    params$flipped_aes = get_flipped_aes(data, params,
+      main_is_orthogonal = TRUE, range_is_orthogonal = TRUE, group_has_equal = TRUE, main_is_optional = TRUE
+    )
+    params$orientation = get_orientation(params$flipped_aes)
+
+    params
+  },
+
+  setup_data = function(self, data, params) {
+    #set up orientation
+    data$flipped_aes = params$flipped_aes
+    define_orientation_variables(params$orientation)
+
+    # when we are missing a main aesthetic (e.g. the y aes in a horizontal orientation),
+    # fill it in with 0 so that we can still draw stuff
+    data[[y]] = data[[y]] %||% 0
+
+    data
+  },
+
   compute_panel = function(self, data, scales,
     orientation = self$default_params$orientation,