diff --git a/NAMESPACE b/NAMESPACE index 28b49f80ad..c2dd0e3fe2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -309,6 +309,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) @@ -380,6 +382,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) diff --git a/R/geom-.r b/R/geom-.r index bca1b57ded..7c8fa47356 100644 --- a/R/geom-.r +++ b/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") } ) diff --git a/R/geom-bar.r b/R/geom-bar.r index 91d1767f3e..4a8309cffe 100644 --- a/R/geom-bar.r +++ b/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) } diff --git a/R/geom-boxplot.r b/R/geom-boxplot.r index 246a0a13f9..8ce8574114 100644 --- a/R/geom-boxplot.r +++ b/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,7 +202,7 @@ 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, @@ -198,8 +210,8 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, 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") ) diff --git a/R/geom-col.r b/R/geom-col.r index 7ebd51f8fc..be91cfc480 100644 --- a/R/geom-col.r +++ b/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) } diff --git a/R/geom-crossbar.r b/R/geom-crossbar.r index 0a901133d7..05fa058460 100644 --- a/R/geom-crossbar.r +++ b/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,6 +30,12 @@ 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) }, @@ -35,11 +43,13 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom, 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), diff --git a/R/geom-density.r b/R/geom-density.r index 5d96c3ac1a..093e3bf53e 100644 --- a/R/geom-density.r +++ b/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, ... ) ) diff --git a/R/geom-errorbar.r b/R/geom-errorbar.r index 9c0a4361c2..4840d75d10 100644 --- a/R/geom-errorbar.r +++ b/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) } ) diff --git a/R/geom-histogram.r b/R/geom-histogram.r index 2bdbe74315..0629d93a65 100644 --- a/R/geom-histogram.r +++ b/R/geom-histogram.r @@ -17,13 +17,15 @@ #' one change at a time. You may need to look at a few options to uncover #' the full story behind your data. #' +#' @eval rd_orientation() +#' #' @section Aesthetics: #' `geom_histogram()` uses the same aesthetics as [geom_bar()]; #' `geom_freqpoly()` uses the same aesthetics as [geom_line()]. #' #' @export #' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams geom_bar #' @param geom,stat Use to override the default connection between #' `geom_histogram()`/`geom_freqpoly()` and `stat_bin()`. #' @examples @@ -33,6 +35,9 @@ #' geom_histogram(binwidth = 0.01) #' ggplot(diamonds, aes(carat)) + #' geom_histogram(bins = 200) +#' # Map values to y to flip the orientation +#' ggplot(diamonds, aes(y = carat)) + +#' geom_histogram() #' #' # Rather than stacking histograms, it's easier to compare frequency #' # polygons @@ -92,6 +97,7 @@ geom_histogram <- function(mapping = NULL, data = NULL, binwidth = NULL, bins = NULL, na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE) { @@ -107,6 +113,7 @@ geom_histogram <- function(mapping = NULL, data = NULL, binwidth = binwidth, bins = bins, na.rm = na.rm, + orientation = orientation, pad = FALSE, ... ) diff --git a/R/geom-linerange.r b/R/geom-linerange.r index 861c8b0760..9676901c01 100644 --- a/R/geom-linerange.r +++ b/R/geom-linerange.r @@ -3,6 +3,8 @@ #' Various ways of representing a vertical interval defined by `x`, #' `ymin` and `ymax`. Each case draws a single graphical object. #' +#' @eval rd_orientation() +#' #' @eval rd_aesthetics("geom", "linerange") #' @param fatten A multiplicative factor used to increase the size of the #' middle bar in `geom_crossbar()` and the middle point in @@ -13,7 +15,7 @@ #' [geom_errorbarh()] for a horizontal error bar. #' @export #' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams geom_bar #' @examples #' # Create a simple example dataset #' df <- data.frame( @@ -30,6 +32,10 @@ #' p + geom_crossbar(aes(ymin = lower, ymax = upper), width = 0.2) #' p + geom_errorbar(aes(ymin = lower, ymax = upper), width = 0.2) #' +#' # Flip the orientation by changing mapping +#' ggplot(df, aes(resp, trt, colour = group)) + +#' geom_linerange(aes(xmin = lower, xmax = upper)) +#' #' # Draw lines connecting group means #' p + #' geom_line(aes(group = group)) + @@ -61,6 +67,7 @@ geom_linerange <- function(mapping = NULL, data = NULL, stat = "identity", position = "identity", ..., na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE) { layer( @@ -73,6 +80,7 @@ geom_linerange <- function(mapping = NULL, data = NULL, inherit.aes = inherit.aes, params = list( na.rm = na.rm, + orientation = orientation, ... ) ) @@ -87,10 +95,27 @@ GeomLinerange <- ggproto("GeomLinerange", Geom, draw_key = draw_key_vpath, - required_aes = c("x", "ymin", "ymax"), + required_aes = c("x|y", "ymin|xmin", "ymax|xmax"), + + setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params, range_is_orthogonal = TRUE) + if (!(params$flipped_aes || all(c("x", "ymin", "ymax") %in% names(data)))) { + stop("Either, `x`, `ymin`, and `ymax` or `y`, `xmin`, and `xmax` must be supplied", call. = FALSE) + } + params + }, + + extra_params = c("na.rm", "orientation"), + + setup_data = function(data, params) { + data$flipped_aes <- params$flipped_aes + data + }, - draw_panel = function(data, panel_params, coord) { + draw_panel = function(data, panel_params, coord, flipped_aes = FALSE) { + data <- flip_data(data, flipped_aes) data <- transform(data, xend = x, y = ymin, yend = ymax) + data <- flip_data(data, flipped_aes) ggname("geom_linerange", GeomSegment$draw_panel(data, panel_params, coord)) } ) diff --git a/R/geom-path.r b/R/geom-path.r index f703809708..0f02f2f045 100644 --- a/R/geom-path.r +++ b/R/geom-path.r @@ -9,9 +9,11 @@ #' An alternative parameterisation is [geom_segment()], where each line #' corresponds to a single case which provides the start and end coordinates. #' +#' @eval rd_orientation() +#' #' @eval rd_aesthetics("geom", "path") #' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams geom_bar #' @param lineend Line end style (round, butt, square). #' @param linejoin Line join style (round, mitre, bevel). #' @param linemitre Line mitre limit (number greater than 1). @@ -35,6 +37,9 @@ #' ggplot(economics_long, aes(date, value01, colour = variable)) + #' geom_line() #' +#' # You can get a timeseries that run vertically by setting the orientation +#' ggplot(economics, aes(unemploy, date)) + geom_line(orientation = "y") +#' #' # geom_step() is useful when you want to highlight exactly when #' # the y value changes #' recent <- economics[economics$date > as.Date("2013-01-01"), ] @@ -236,7 +241,7 @@ keep_mid_true <- function(x) { #' @export #' @rdname geom_path geom_line <- function(mapping = NULL, data = NULL, stat = "identity", - position = "identity", na.rm = FALSE, + position = "identity", na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE, ...) { layer( data = data, @@ -248,6 +253,7 @@ geom_line <- function(mapping = NULL, data = NULL, stat = "identity", inherit.aes = inherit.aes, params = list( na.rm = na.rm, + orientation = orientation, ... ) ) @@ -259,8 +265,18 @@ geom_line <- function(mapping = NULL, data = NULL, stat = "identity", #' @export #' @include geom-path.r GeomLine <- ggproto("GeomLine", GeomPath, + setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params, ambiguous = TRUE) + params + }, + + extra_params = c("na.rm", "orientation"), + setup_data = function(data, params) { - data[order(data$PANEL, data$group, data$x), ] + data$flipped_aes <- params$flipped_aes + data <- flip_data(data, params$flipped_aes) + data <- data[order(data$PANEL, data$group, data$x), ] + flip_data(data, params$flipped_aes) } ) diff --git a/R/geom-pointrange.r b/R/geom-pointrange.r index 6777aa0151..5b018c1253 100644 --- a/R/geom-pointrange.r +++ b/R/geom-pointrange.r @@ -5,6 +5,7 @@ geom_pointrange <- function(mapping = NULL, data = NULL, ..., fatten = 4, na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE) { layer( @@ -18,6 +19,7 @@ geom_pointrange <- function(mapping = NULL, data = NULL, params = list( fatten = fatten, na.rm = na.rm, + orientation = orientation, ... ) ) @@ -33,15 +35,25 @@ GeomPointrange <- ggproto("GeomPointrange", Geom, draw_key = draw_key_pointrange, - required_aes = c("x", "y", "ymin", "ymax"), + required_aes = c("x", "y", "ymin|xmin", "ymax|xmax"), - draw_panel = function(data, panel_params, coord, fatten = 4) { - if (is.null(data$y)) - return(GeomLinerange$draw_panel(data, panel_params, coord)) + setup_params = function(data, params) { + GeomLinerange$setup_params(data, params) + }, + + extra_params = c("na.rm", "orientation"), + + setup_data = function(data, params) { + GeomLinerange$setup_data(data, params) + }, + + draw_panel = function(data, panel_params, coord, fatten = 4, flipped_aes = FALSE) { + if (is.null(data[[flipped_names(flipped_aes)$y]])) + return(GeomLinerange$draw_panel(data, panel_params, coord, flipped_aes = flipped_aes)) ggname("geom_pointrange", gTree(children = gList( - GeomLinerange$draw_panel(data, panel_params, coord), + GeomLinerange$draw_panel(data, panel_params, coord, flipped_aes = flipped_aes), GeomPoint$draw_panel(transform(data, size = size * fatten), panel_params, coord) )) ) diff --git a/R/geom-ribbon.r b/R/geom-ribbon.r index 17df0ed118..4625cdc2bd 100644 --- a/R/geom-ribbon.r +++ b/R/geom-ribbon.r @@ -12,13 +12,15 @@ #' see the individual pattern as you move up the stack. See #' [position_stack()] for the details of stacking algorithm. #' +#' @eval rd_orientation() +#' #' @eval rd_aesthetics("geom", "ribbon") #' @seealso #' [geom_bar()] for discrete intervals (bars), #' [geom_linerange()] for discrete intervals (lines), #' [geom_polygon()] for general polygons #' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams geom_bar #' @export #' @examples #' # Generate data @@ -28,6 +30,9 @@ #' h + geom_ribbon(aes(ymin=0, ymax=level)) #' h + geom_area(aes(y = level)) #' +#' # Change orientation be switching the mapping +#' h + geom_area(aes(x = level, y = year)) +#' #' # Add aesthetic mappings #' h + #' geom_ribbon(aes(ymin = level - 1, ymax = level + 1), fill = "grey70") + @@ -36,6 +41,7 @@ geom_ribbon <- function(mapping = NULL, data = NULL, stat = "identity", position = "identity", ..., na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE) { layer( @@ -48,6 +54,7 @@ geom_ribbon <- function(mapping = NULL, data = NULL, inherit.aes = inherit.aes, params = list( na.rm = na.rm, + orientation = orientation, ... ) ) @@ -61,15 +68,26 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, default_aes = aes(colour = NA, fill = "grey20", size = 0.5, linetype = 1, alpha = NA), - required_aes = c("x", "ymin", "ymax"), + required_aes = c("x|y", "ymin|xmin", "ymax|xmax"), + + setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params, range_is_orthogonal = TRUE) + 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) + if (is.null(data$ymin) && is.null(data$ymax)) { - stop("Either ymin or ymax must be given as an aesthetic.", call. = FALSE) + stop("Either ", flipped_names(params$flipped_aes)$ymin, " or ", + flipped_names(params$flipped_aes)$ymax, " must be given as an aesthetic.", call. = FALSE) } data <- data[order(data$PANEL, data$group, data$x), , drop = FALSE] data$y <- data$ymin %||% data$ymax - data + flip_data(data, params$flipped_aes) }, draw_key = draw_key_polygon, @@ -78,7 +96,8 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, data }, - draw_group = function(data, panel_params, coord, na.rm = FALSE) { + draw_group = function(data, panel_params, coord, na.rm = FALSE, flipped_aes = FALSE) { + data <- flip_data(data, flipped_aes) if (na.rm) data <- data[stats::complete.cases(data[c("x", "ymin", "ymax")]), ] data <- data[order(data$group), ] @@ -106,6 +125,9 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, y = c(data$ymax, rev(data$ymin)), id = c(ids, rev(ids)) )) + + positions <- flip_data(positions, flipped_aes) + munched <- coord_munch(coord, positions, panel_params) ggname("geom_ribbon", polygonGrob( @@ -123,8 +145,8 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, #' @rdname geom_ribbon #' @export geom_area <- function(mapping = NULL, data = NULL, stat = "identity", - position = "stack", na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE, ...) { + position = "stack", na.rm = FALSE, orientation = NA, + show.legend = NA, inherit.aes = TRUE, ...) { layer( data = data, mapping = mapping, @@ -135,6 +157,7 @@ geom_area <- function(mapping = NULL, data = NULL, stat = "identity", inherit.aes = inherit.aes, params = list( na.rm = na.rm, + orientation = orientation, ... ) ) @@ -150,7 +173,15 @@ GeomArea <- ggproto("GeomArea", GeomRibbon, required_aes = c("x", "y"), + setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params, ambiguous = TRUE) + params + }, + setup_data = function(data, params) { - transform(data[order(data$PANEL, data$group, data$x), ], ymin = 0, ymax = y) + data$flipped_aes <- params$flipped_aes + data <- flip_data(data, params$flipped_aes) + data <- transform(data[order(data$PANEL, data$group, data$x), ], ymin = 0, ymax = y) + flip_data(data, params$flipped_aes) } ) diff --git a/R/geom-smooth.r b/R/geom-smooth.r index a4e224450f..05bd1a8f29 100644 --- a/R/geom-smooth.r +++ b/R/geom-smooth.r @@ -12,9 +12,11 @@ #' `glm()`, where the normal confidence interval is constructed on the link #' scale and then back-transformed to the response scale. #' +#' @eval rd_orientation() +#' #' @eval rd_aesthetics("geom", "smooth") #' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams geom_bar #' @param geom,stat Use to override the default connection between #' `geom_smooth()` and `stat_smooth()`. #' @seealso See individual modelling functions for more details: @@ -27,6 +29,11 @@ #' geom_point() + #' geom_smooth() #' +#' # If you need the fitting to be done along the y-axis set the orientation +#' ggplot(mpg, aes(displ, hwy)) + +#' geom_point() + +#' geom_smooth(orientation = "y") +#' #' # Use span to control the "wiggliness" of the default loess smoother. #' # The span is the fraction of points used to fit each local regression: #' # small numbers make a wigglier curve, larger numbers make a smoother curve. @@ -82,11 +89,13 @@ geom_smooth <- function(mapping = NULL, data = NULL, formula = NULL, se = TRUE, na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE) { params <- list( na.rm = na.rm, + orientation = orientation, se = se, ... ) @@ -112,6 +121,13 @@ geom_smooth <- function(mapping = NULL, data = NULL, #' @usage NULL #' @export GeomSmooth <- ggproto("GeomSmooth", Geom, + setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params, range_is_orthogonal = TRUE, ambiguous = TRUE) + params + }, + + extra_params = c("na.rm", "orientation"), + setup_data = function(data, params) { GeomLine$setup_data(data, params) }, @@ -123,14 +139,16 @@ GeomSmooth <- ggproto("GeomSmooth", Geom, # ribbon won't be drawn either in that case, keeping the overall # behavior predictable and sensible. The user will realize that they # need to set `se = TRUE` to obtain the ribbon and the legend key. - draw_group = function(data, panel_params, coord, se = FALSE) { + draw_group = function(data, panel_params, coord, se = FALSE, flipped_aes = FALSE) { ribbon <- transform(data, colour = NA) path <- transform(data, alpha = NA) - has_ribbon <- se && !is.null(data$ymax) && !is.null(data$ymin) + ymin = flipped_names(flipped_aes)$ymin + ymax = flipped_names(flipped_aes)$ymax + has_ribbon <- se && !is.null(data[[ymax]]) && !is.null(data[[ymin]]) gList( - if (has_ribbon) GeomRibbon$draw_group(ribbon, panel_params, coord), + if (has_ribbon) GeomRibbon$draw_group(ribbon, panel_params, coord, flipped_aes = flipped_aes), GeomLine$draw_panel(path, panel_params, coord) ) }, diff --git a/R/geom-violin.r b/R/geom-violin.r index 5a6be2add9..9a56f34639 100644 --- a/R/geom-violin.r +++ b/R/geom-violin.r @@ -5,9 +5,11 @@ #' violin plot is a mirrored density plot displayed in the same way as a #' boxplot. #' +#' @eval rd_orientation() +#' #' @eval rd_aesthetics("geom", "violin") #' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams geom_bar #' @param draw_quantiles If `not(NULL)` (default), draw horizontal lines #' at the given quantiles of the density estimate. #' @param trim If `TRUE` (default), trim the tails of the violins @@ -21,6 +23,10 @@ #' p <- ggplot(mtcars, aes(factor(cyl), mpg)) #' p + geom_violin() #' +#' # Orientation follows the discrete axis +#' ggplot(mtcars, aes(mpg, factor(cyl))) + +#' geom_violin() +#' #' \donttest{ #' p + geom_violin() + geom_jitter(height = 0, width = 0.1) #' @@ -75,6 +81,7 @@ geom_violin <- function(mapping = NULL, data = NULL, trim = TRUE, scale = "area", na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE) { layer( @@ -90,6 +97,7 @@ geom_violin <- function(mapping = NULL, data = NULL, scale = scale, draw_quantiles = draw_quantiles, na.rm = na.rm, + orientation = orientation, ... ) ) @@ -100,18 +108,28 @@ geom_violin <- function(mapping = NULL, data = NULL, #' @usage NULL #' @export GeomViolin <- ggproto("GeomViolin", Geom, + setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params, ambiguous = TRUE) + 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) - # ymin, ymax, xmin, and xmax define the bounding rectangle for each group - dapply(data, "group", transform, + data <- dapply(data, "group", transform, xmin = x - width / 2, xmax = x + width / 2 ) + flip_data(data, params$flipped_aes) }, - draw_group = function(self, data, ..., draw_quantiles = NULL) { + draw_group = function(self, data, ..., draw_quantiles = NULL, flipped_aes = FALSE) { + data <- flip_data(data, flipped_aes) # Find the points for the line to go all the way around data <- transform(data, xminv = x - violinwidth * (x - xmin), @@ -127,6 +145,7 @@ GeomViolin <- ggproto("GeomViolin", Geom, # Close the polygon: set first and last point the same # Needed for coord_polar and such newdata <- rbind(newdata, newdata[1,]) + newdata <- flip_data(newdata, flipped_aes) # Draw quantiles if requested, so long as there is non-zero y range if (length(draw_quantiles) > 0 & !scales::zero_range(range(data$y))) { @@ -142,6 +161,7 @@ GeomViolin <- ggproto("GeomViolin", Geom, aesthetics$alpha <- rep(1, nrow(quantiles)) both <- cbind(quantiles, aesthetics) both <- both[!is.na(both$group), , drop = FALSE] + both <- flip_data(both, flipped_aes) quantile_grob <- if (nrow(both) == 0) { zeroGrob() } else { diff --git a/R/ggplot-global.R b/R/ggplot-global.R index e9b871ae6c..2fa0604024 100644 --- a/R/ggplot-global.R +++ b/R/ggplot-global.R @@ -44,3 +44,9 @@ ggplot_global$all_aesthetics <- .all_aesthetics ) ggplot_global$base_to_ggplot <- .base_to_ggplot + +ggplot_global$x_aes <- c("x", "xmin", "xmax", "xend", "xintercept", + "xmin_final", "xmax_final", "xlower", "xmiddle", "xupper", "x0") + +ggplot_global$y_aes <- c("y", "ymin", "ymax", "yend", "yintercept", "ymin_final", + "ymax_final", "lower", "middle", "upper", "y0") diff --git a/R/position-dodge.r b/R/position-dodge.r index dd9f67fe52..4730a7fbf3 100644 --- a/R/position-dodge.r +++ b/R/position-dodge.r @@ -89,6 +89,8 @@ PositionDodge <- ggproto("PositionDodge", Position, width = NULL, preserve = "total", setup_params = function(self, data) { + flipped_aes <- has_flipped_aes(data) + data <- flip_data(data, flipped_aes) if (is.null(data$xmin) && is.null(data$xmax) && is.null(self$width)) { warning("Width not defined. Set with `position_dodge(width = ?)`", call. = FALSE) @@ -104,19 +106,22 @@ PositionDodge <- ggproto("PositionDodge", Position, list( width = self$width, - n = n + n = n, + flipped_aes = flipped_aes ) }, setup_data = function(self, data, params) { + data <- flip_data(data, params$flipped_aes) if (!"x" %in% names(data) && all(c("xmin", "xmax") %in% names(data))) { data$x <- (data$xmin + data$xmax) / 2 } - data + flip_data(data, params$flipped_aes) }, compute_panel = function(data, params, scales) { - collide( + data <- flip_data(data, params$flipped_aes) + collided <- collide( data, params$width, name = "position_dodge", @@ -124,6 +129,7 @@ PositionDodge <- ggproto("PositionDodge", Position, n = params$n, check.width = FALSE ) + flip_data(collided, params$flipped_aes) } ) diff --git a/R/position-dodge2.r b/R/position-dodge2.r index 2bab0ba4fc..8cb6cb6d77 100644 --- a/R/position-dodge2.r +++ b/R/position-dodge2.r @@ -24,6 +24,8 @@ PositionDodge2 <- ggproto("PositionDodge2", PositionDodge, reverse = FALSE, setup_params = function(self, data) { + flipped_aes <- has_flipped_aes(data) + data <- flip_data(data, flipped_aes) if (is.null(data$xmin) && is.null(data$xmax) && is.null(self$width)) { warning("Width not defined. Set with `position_dodge2(width = ?)`", call. = FALSE) @@ -48,12 +50,14 @@ PositionDodge2 <- ggproto("PositionDodge2", PositionDodge, width = self$width, n = n, padding = self$padding, - reverse = self$reverse + reverse = self$reverse, + flipped_aes = flipped_aes ) }, compute_panel = function(data, params, scales) { - collide2( + data <- flip_data(data, params$flipped_aes) + collided <- collide2( data, params$width, name = "position_dodge2", @@ -63,6 +67,7 @@ PositionDodge2 <- ggproto("PositionDodge2", PositionDodge, check.width = FALSE, reverse = params$reverse ) + flip_data(collided, params$flipped_aes) } ) diff --git a/R/position-jitterdodge.R b/R/position-jitterdodge.R index 494db5f9f8..eba442395c 100644 --- a/R/position-jitterdodge.R +++ b/R/position-jitterdodge.R @@ -43,6 +43,8 @@ PositionJitterdodge <- ggproto("PositionJitterdodge", Position, required_aes = c("x", "y"), setup_params = function(self, data) { + flipped_aes <- has_flipped_aes(data) + data <- flip_data(data, flipped_aes) width <- self$jitter.width %||% (resolution(data$x, zero = FALSE) * 0.4) # Adjust the x transformation based on the number of 'dodge' variables dodgecols <- intersect(c("fill", "colour", "linetype", "shape", "size", "alpha"), colnames(data)) @@ -56,17 +58,20 @@ PositionJitterdodge <- ggproto("PositionJitterdodge", Position, dodge.width = self$dodge.width, jitter.height = self$jitter.height, jitter.width = width / (ndodge + 2), - seed = self$seed + seed = self$seed, + flipped_aes = flipped_aes ) }, compute_panel = function(data, params, scales) { + data <- flip_data(data, params$flipped_aes) data <- collide(data, params$dodge.width, "position_jitterdodge", pos_dodge, check.width = FALSE) trans_x <- if (params$jitter.width > 0) function(x) jitter(x, amount = params$jitter.width) trans_y <- if (params$jitter.height > 0) function(x) jitter(x, amount = params$jitter.height) - with_seed_null(params$seed, transform_position(data, trans_x, trans_y)) + data <- with_seed_null(params$seed, transform_position(data, trans_x, trans_y)) + flip_data(data, params$flipped_aes) } ) diff --git a/R/position-stack.r b/R/position-stack.r index 7e42a8aef3..2775235a89 100644 --- a/R/position-stack.r +++ b/R/position-stack.r @@ -146,15 +146,19 @@ PositionStack <- ggproto("PositionStack", Position, reverse = FALSE, setup_params = function(self, data) { + flipped_aes <- has_flipped_aes(data) + data <- flip_data(data, flipped_aes) list( var = self$var %||% stack_var(data), fill = self$fill, vjust = self$vjust, - reverse = self$reverse + reverse = self$reverse, + flipped_aes = flipped_aes ) }, setup_data = function(self, data, params) { + data <- flip_data(data, params$flipped_aes) if (is.null(params$var)) { return(data) } @@ -164,14 +168,16 @@ PositionStack <- ggproto("PositionStack", Position, ymax = ifelse(data$ymax == 0, data$ymin, data$ymax) ) - remove_missing( + data <- remove_missing( data, vars = c("x", "xmin", "xmax", "y"), name = "position_stack" ) + flip_data(data, params$flip_data) }, compute_panel = function(data, params, scales) { + data <- flip_data(data, params$flipped_aes) if (is.null(params$var)) { return(data) } @@ -197,7 +203,8 @@ PositionStack <- ggproto("PositionStack", Position, ) } - rbind(neg, pos)[match(seq_len(nrow(data)), c(which(negative), which(!negative))),] + data <- rbind(neg, pos)[match(seq_len(nrow(data)), c(which(negative), which(!negative))),] + flip_data(data, params$flipped_aes) } ) diff --git a/R/stat-.r b/R/stat-.r index f1b1b77985..dc09bf99ba 100644 --- a/R/stat-.r +++ b/R/stat-.r @@ -144,7 +144,12 @@ Stat <- ggproto("Stat", }, aesthetics = function(self) { - c(union(self$required_aes, names(self$default_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)), "group") } ) diff --git a/R/stat-bin.r b/R/stat-bin.r index 591034bbfb..ca4e8163c0 100644 --- a/R/stat-bin.r +++ b/R/stat-bin.r @@ -51,6 +51,7 @@ stat_bin <- function(mapping = NULL, data = NULL, closed = c("right", "left"), pad = FALSE, na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE) { @@ -71,6 +72,7 @@ stat_bin <- function(mapping = NULL, data = NULL, closed = closed, pad = pad, na.rm = na.rm, + orientation = orientation, ... ) ) @@ -82,11 +84,21 @@ stat_bin <- function(mapping = NULL, data = NULL, #' @export StatBin <- ggproto("StatBin", Stat, setup_params = function(data, params) { - if (!is.null(data$y) || !is.null(params$y)) { - stop("stat_bin() must not be used with a y aesthetic.", call. = FALSE) + params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = FALSE) + + has_x <- !(is.null(data$x) && is.null(params$x)) + has_y <- !(is.null(data$y) && is.null(params$y)) + if (!has_x && !has_y) { + stop("stat_bin() requires an x or y aesthetic.", call. = FALSE) + } + if (has_x && has_y) { + stop("stat_bin() can only have an x or y aesthetic.", call. = FALSE) } - if (is.integer(data$x)) { - stop('StatBin requires a continuous x variable: the x variable is discrete. Perhaps you want stat="count"?', + + x <- flipped_names(params$flipped_aes)$x + if (is.integer(data[[x]])) { + stop('StatBin requires a continuous ', x, ' variable: the ', + x, ' variable is discrete. Perhaps you want stat="count"?', call. = FALSE) } @@ -119,34 +131,39 @@ StatBin <- ggproto("StatBin", Stat, params }, + extra_params = c("na.rm", "orientation"), + compute_group = function(data, scales, binwidth = NULL, bins = NULL, center = NULL, boundary = NULL, closed = c("right", "left"), pad = FALSE, - breaks = NULL, + breaks = NULL, flipped_aes = FALSE, # The following arguments are not used, but must # be listed so parameters are computed correctly origin = NULL, right = NULL, drop = NULL, width = NULL) { - + x <- flipped_names(flipped_aes)$x if (!is.null(breaks)) { - if (!scales$x$is_discrete()){ - breaks <- scales$x$transform(breaks) + if (!scales[[x]]$is_discrete()) { + breaks <- scales[[x]]$transform(breaks) } bins <- bin_breaks(breaks, closed) } else if (!is.null(binwidth)) { if (is.function(binwidth)) { - binwidth <- binwidth(data$x) + binwidth <- binwidth(data[[x]]) } - bins <- bin_breaks_width(scales$x$dimension(), binwidth, + bins <- bin_breaks_width(scales[[x]]$dimension(), binwidth, center = center, boundary = boundary, closed = closed) } else { - bins <- bin_breaks_bins(scales$x$dimension(), bins, center = center, + bins <- bin_breaks_bins(scales[[x]]$dimension(), bins, center = center, boundary = boundary, closed = closed) } - bin_vector(data$x, bins, weight = data$weight, pad = pad) + bins <- bin_vector(data[[x]], bins, weight = data$weight, pad = pad) + bins$flipped_aes <- flipped_aes + flip_data(bins, flipped_aes) }, - default_aes = aes(y = stat(count), weight = 1), - required_aes = c("x") + default_aes = aes(x = stat(count), y = stat(count), weight = 1), + + required_aes = "x|y" ) diff --git a/R/stat-boxplot.r b/R/stat-boxplot.r index 618d57e99c..ac8ab5dc27 100644 --- a/R/stat-boxplot.r +++ b/R/stat-boxplot.r @@ -18,6 +18,7 @@ stat_boxplot <- function(mapping = NULL, data = NULL, ..., coef = 1.5, na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE) { layer( @@ -30,6 +31,7 @@ stat_boxplot <- function(mapping = NULL, data = NULL, inherit.aes = inherit.aes, params = list( na.rm = na.rm, + orientation = orientation, coef = coef, ... ) @@ -42,9 +44,10 @@ stat_boxplot <- function(mapping = NULL, data = NULL, #' @usage NULL #' @export StatBoxplot <- ggproto("StatBoxplot", Stat, - required_aes = c("y"), + required_aes = c("y|x"), non_missing_aes = "weight", setup_data = function(data, params) { + data <- flip_data(data, params$flipped_aes) data$x <- data$x %||% 0 data <- remove_missing( data, @@ -52,22 +55,34 @@ StatBoxplot <- ggproto("StatBoxplot", Stat, vars = "x", name = "stat_boxplot" ) - data + flip_data(data, params$flipped_aes) }, setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = TRUE, group_has_equal = TRUE) + data <- flip_data(data, params$flipped_aes) + + has_x <- !(is.null(data$x) && is.null(params$x)) + has_y <- !(is.null(data$y) && is.null(params$y)) + if (!has_x && !has_y) { + stop("stat_boxplot() requires an x or y aesthetic.", call. = FALSE) + } + params$width <- params$width %||% (resolution(data$x %||% 0) * 0.75) if (is.double(data$x) && !has_groups(data) && any(data$x != data$x[1L])) { warning( - "Continuous x aesthetic -- did you forget aes(group=...)?", + "Continuous ", flipped_names(params$flipped_aes)$x, " aesthetic -- did you forget aes(group=...)?", call. = FALSE) } params }, - compute_group = function(data, scales, width = NULL, na.rm = FALSE, coef = 1.5) { + extra_params = c("na.rm", "orientation"), + + compute_group = function(data, scales, width = NULL, na.rm = FALSE, coef = 1.5, flipped_aes = FALSE) { + data <- flip_data(data, flipped_aes) qs <- c(0, 0.25, 0.5, 0.75, 1) if (!is.null(data$weight)) { @@ -103,6 +118,7 @@ StatBoxplot <- ggproto("StatBoxplot", Stat, df$x <- if (is.factor(data$x)) data$x[1] else mean(range(data$x)) df$width <- width df$relvarwidth <- sqrt(n) - df + df$flipped_aes <- flipped_aes + flip_data(df, flipped_aes) } ) diff --git a/R/stat-count.r b/R/stat-count.r index c08381d8c7..2276f56549 100644 --- a/R/stat-count.r +++ b/R/stat-count.r @@ -16,11 +16,13 @@ stat_count <- function(mapping = NULL, data = NULL, ..., width = NULL, na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE) { params <- list( na.rm = na.rm, + orientation = orientation, width = width, ... ) @@ -46,17 +48,29 @@ stat_count <- function(mapping = NULL, data = NULL, #' @export #' @include stat-.r StatCount <- ggproto("StatCount", Stat, - required_aes = "x", - default_aes = aes(y = stat(count), weight = 1), + required_aes = "x|y", + + default_aes = aes(x = stat(count), y = stat(count), weight = 1), setup_params = function(data, params) { - if (!is.null(data$y)) { - stop("stat_count() must not be used with a y aesthetic.", call. = FALSE) + params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = FALSE) + + has_x <- !(is.null(data$x) && is.null(params$x)) + has_y <- !(is.null(data$y) && is.null(params$y)) + if (!has_x && !has_y) { + stop("stat_count() requires an x or y aesthetic.", call. = FALSE) + } + if (has_x && has_y) { + stop("stat_count() can only have an x or y aesthetic.", call. = FALSE) } + params }, - compute_group = function(self, data, scales, width = NULL) { + extra_params = c("na.rm", "orientation"), + + compute_group = function(self, data, scales, width = NULL, flipped_aes = FALSE) { + data <- flip_data(data, flipped_aes) x <- data$x weight <- data$weight %||% rep(1, length(x)) width <- width %||% (resolution(x) * 0.9) @@ -64,11 +78,13 @@ StatCount <- ggproto("StatCount", Stat, count <- as.numeric(tapply(weight, x, sum, na.rm = TRUE)) count[is.na(count)] <- 0 - new_data_frame(list( + bars <- new_data_frame(list( count = count, prop = count / sum(abs(count)), x = sort(unique(x)), - width = width + width = width, + flipped_aes = flipped_aes ), n = length(count)) + flip_data(bars, flipped_aes) } ) diff --git a/R/stat-density.r b/R/stat-density.r index 6d18b8bb12..804d2c6e0c 100644 --- a/R/stat-density.r +++ b/R/stat-density.r @@ -35,6 +35,7 @@ stat_density <- function(mapping = NULL, data = NULL, n = 512, trim = FALSE, na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE) { @@ -53,6 +54,7 @@ stat_density <- function(mapping = NULL, data = NULL, n = n, trim = trim, na.rm = na.rm, + orientation = orientation, ... ) ) @@ -63,19 +65,37 @@ stat_density <- function(mapping = NULL, data = NULL, #' @usage NULL #' @export StatDensity <- ggproto("StatDensity", Stat, - required_aes = "x", - default_aes = aes(y = stat(density), fill = NA, weight = NULL), + required_aes = "x|y", + + default_aes = aes(x = stat(density), y = stat(density), fill = NA, weight = NULL), + + setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = FALSE, main_is_continuous = TRUE) + + has_x <- !(is.null(data$x) && is.null(params$x)) + has_y <- !(is.null(data$y) && is.null(params$y)) + if (!has_x && !has_y) { + stop("stat_density() requires an x or y aesthetic.", call. = FALSE) + } + + params + }, + + extra_params = c("na.rm", "orientation"), compute_group = function(data, scales, bw = "nrd0", adjust = 1, kernel = "gaussian", - n = 512, trim = FALSE, na.rm = FALSE) { + n = 512, trim = FALSE, na.rm = FALSE, flipped_aes = FALSE) { + data <- flip_data(data, flipped_aes) if (trim) { range <- range(data$x, na.rm = TRUE) } else { - range <- scales$x$dimension() + range <- scales[[flipped_names(flipped_aes)$x]]$dimension() } - compute_density(data$x, data$weight, from = range[1], to = range[2], - bw = bw, adjust = adjust, kernel = kernel, n = n) + density <- compute_density(data$x, data$weight, from = range[1], + to = range[2], bw = bw, adjust = adjust, kernel = kernel, n = n) + density$flipped_aes <- flipped_aes + flip_data(density, flipped_aes) } ) diff --git a/R/stat-smooth.r b/R/stat-smooth.r index a1cc84d762..31a7941bb2 100644 --- a/R/stat-smooth.r +++ b/R/stat-smooth.r @@ -50,6 +50,7 @@ stat_smooth <- function(mapping = NULL, data = NULL, level = 0.95, method.args = list(), na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE) { layer( @@ -68,6 +69,7 @@ stat_smooth <- function(mapping = NULL, data = NULL, fullrange = fullrange, level = level, na.rm = na.rm, + orientation = orientation, method.args = method.args, span = span, ... @@ -81,6 +83,7 @@ stat_smooth <- function(mapping = NULL, data = NULL, #' @export StatSmooth <- ggproto("StatSmooth", Stat, setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params, ambiguous = TRUE) msg <- character() if (is.null(params$method) || identical(params$method, "auto")) { # Use loess for small datasets, gam with a cubic regression basis for @@ -115,10 +118,13 @@ StatSmooth <- ggproto("StatSmooth", Stat, params }, + extra_params = c("na.rm", "orientation"), + compute_group = function(data, scales, method = NULL, formula = NULL, se = TRUE, n = 80, span = 0.75, fullrange = FALSE, xseq = NULL, level = 0.95, method.args = list(), - na.rm = FALSE) { + na.rm = FALSE, flipped_aes = NA) { + data <- flip_data(data, flipped_aes) if (length(unique(data$x)) < 2) { # Not enough data to perform fit return(new_data_frame()) @@ -163,7 +169,9 @@ StatSmooth <- ggproto("StatSmooth", Stat, base.args <- list(quote(formula), data = quote(data), weights = quote(weight)) model <- do.call(method, c(base.args, method.args)) - predictdf(model, xseq, se, level) + prediction <- predictdf(model, xseq, se, level) + prediction$flipped_aes <- flipped_aes + flip_data(prediction, flipped_aes) }, required_aes = c("x", "y") diff --git a/R/stat-summary-bin.R b/R/stat-summary-bin.R index 0aa8a2dcaa..811f598faa 100644 --- a/R/stat-summary-bin.R +++ b/R/stat-summary-bin.R @@ -5,16 +5,30 @@ stat_summary_bin <- function(mapping = NULL, data = NULL, geom = "pointrange", position = "identity", ..., fun.data = NULL, - fun.y = NULL, - fun.ymax = NULL, - fun.ymin = NULL, + fun = NULL, + fun.max = NULL, + fun.min = NULL, fun.args = list(), bins = 30, binwidth = NULL, breaks = NULL, na.rm = FALSE, + orientation = NA, show.legend = NA, - inherit.aes = TRUE) { + inherit.aes = TRUE, + fun.y, fun.ymin, fun.ymax) { + if (!missing(fun.y)) { + warn("`fun.y` is deprecated. Use `fun` instead.") + fun = fun %||% fun.y + } + if (!missing(fun.ymin)) { + warn("`fun.ymin` is deprecated. Use `fun.min` instead.") + fun.min = fun.min %||% fun.ymin + } + if (!missing(fun.ymax)) { + warn("`fun.ymax` is deprecated. Use `fun.max` instead.") + fun.max = fun.max %||% fun.ymax + } layer( data = data, mapping = mapping, @@ -25,14 +39,15 @@ stat_summary_bin <- function(mapping = NULL, data = NULL, inherit.aes = inherit.aes, params = list( fun.data = fun.data, - fun.y = fun.y, - fun.ymax = fun.ymax, - fun.ymin = fun.ymin, + fun = fun, + fun.max = fun.max, + fun.min = fun.min, fun.args = fun.args, bins = bins, binwidth = binwidth, breaks = breaks, na.rm = na.rm, + orientation = orientation, ... ) ) @@ -45,30 +60,38 @@ stat_summary_bin <- function(mapping = NULL, data = NULL, StatSummaryBin <- ggproto("StatSummaryBin", Stat, required_aes = c("x", "y"), - compute_group = function(data, scales, fun.data = NULL, fun.y = NULL, - fun.ymax = NULL, fun.ymin = NULL, fun.args = list(), - bins = 30, binwidth = NULL, breaks = NULL, - origin = NULL, right = FALSE, na.rm = FALSE) { - - fun <- make_summary_fun(fun.data, fun.y, fun.ymax, fun.ymin, fun.args) + extra_params = c("na.rm", "orientation"), + setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params, ambiguous = TRUE) + params + }, - breaks <- bin2d_breaks(scales$x, breaks, origin, binwidth, bins, right = right) + compute_group = function(data, scales, fun.data = NULL, fun = NULL, + fun.max = NULL, fun.min = NULL, fun.args = list(), + bins = 30, binwidth = NULL, breaks = NULL, + origin = NULL, right = FALSE, na.rm = FALSE, + flipped_aes = FALSE) { + data <- flip_data(data, flipped_aes) + fun <- make_summary_fun(fun.data, fun, fun.max, fun.min, fun.args) + x <- flipped_names(flipped_aes)$x + breaks <- bin2d_breaks(scales[[x]], breaks, origin, binwidth, bins, right = right) data$bin <- cut(data$x, breaks, include.lowest = TRUE, labels = FALSE) out <- dapply(data, "bin", fun) locs <- bin_loc(breaks, out$bin) out$x <- locs$mid - out$width <- if (scales$x$is_discrete()) 0.9 else locs$length - out + out$width <- if (scales[[x]]$is_discrete()) 0.9 else locs$length + out$flipped_aes <- flipped_aes + flip_data(out, flipped_aes) } ) -make_summary_fun <- function(fun.data, fun.y, fun.ymax, fun.ymin, fun.args) { +make_summary_fun <- function(fun.data, fun, fun.max, fun.min, fun.args) { force(fun.data) - force(fun.y) - force(fun.ymax) - force(fun.ymin) + force(fun) + force(fun.max) + force(fun.min) force(fun.args) if (!is.null(fun.data)) { @@ -77,7 +100,7 @@ make_summary_fun <- function(fun.data, fun.y, fun.ymax, fun.ymin, fun.args) { function(df) { do.call(fun.data, c(list(quote(df$y)), fun.args)) } - } else if (!is.null(fun.y) || !is.null(fun.ymax) || !is.null(fun.ymin)) { + } else if (!is.null(fun) || !is.null(fun.max) || !is.null(fun.min)) { # Three functions that take vectors as inputs call_f <- function(fun, x) { @@ -87,9 +110,9 @@ make_summary_fun <- function(fun.data, fun.y, fun.ymax, fun.ymin, fun.args) { function(df, ...) { new_data_frame(list( - ymin = call_f(fun.ymin, df$y), - y = call_f(fun.y, df$y), - ymax = call_f(fun.ymax, df$y) + ymin = call_f(fun.min, df$y), + y = call_f(fun, df$y), + ymax = call_f(fun.max, df$y) )) } } else { diff --git a/R/stat-summary.r b/R/stat-summary.r index 27ed095e3f..b4a43ebb8d 100644 --- a/R/stat-summary.r +++ b/R/stat-summary.r @@ -1,66 +1,84 @@ #' Summarise y values at unique/binned x #' -#' `stat_summary` operates on unique `x`; `stat_summary_bin` -#' operates on binned `x`. They are more flexible versions of +#' `stat_summary` operates on unique `x` or `y`; `stat_summary_bin` +#' operates on binned `x` or `y`. They are more flexible versions of #' [stat_bin()]: instead of just counting, they can compute any #' aggregate. #' +#' @eval rd_orientation() +#' #' @eval rd_aesthetics("stat", "summary") #' @seealso [geom_errorbar()], [geom_pointrange()], #' [geom_linerange()], [geom_crossbar()] for geoms to #' display summarised data #' @inheritParams stat_identity #' @section Summary functions: -#' You can either supply summary functions individually (`fun.y`, -#' `fun.ymax`, `fun.ymin`), or as a single function (`fun.data`): +#' You can either supply summary functions individually (`fun`, +#' `fun.max`, `fun.min`), or as a single function (`fun.data`): #' #' \describe{ #' \item{fun.data}{Complete summary function. Should take numeric vector as #' input and return data frame as output} -#' \item{fun.ymin}{ymin summary function (should take numeric vector and +#' \item{fun.min}{min summary function (should take numeric vector and #' return single number)} -#' \item{fun.y}{y summary function (should take numeric vector and return +#' \item{fun}{main summary function (should take numeric vector and return #' single number)} -#' \item{fun.ymax}{ymax summary function (should take numeric vector and +#' \item{fun.max}{max summary function (should take numeric vector and #' return single number)} #' } #' #' A simple vector function is easiest to work with as you can return a single #' number, but is somewhat less flexible. If your summary function computes -#' multiple values at once (e.g. ymin and ymax), use `fun.data`. +#' multiple values at once (e.g. min and max), use `fun.data`. +#' +#' `fun.data` will recieve data as if it was oriented along the x-axis and +#' should return a data.frame that corresponds to that orientation. The layer +#' will take care of flipping the input and output if it is oriented along the +#' y-axis. #' #' If no aggregation functions are supplied, will default to #' [mean_se()]. #' #' @param fun.data A function that is given the complete data and should #' return a data frame with variables `ymin`, `y`, and `ymax`. -#' @param fun.ymin,fun.y,fun.ymax Alternatively, supply three individual -#' functions that are each passed a vector of x's and should return a +#' @param fun.min,fun,fun.max Alternatively, supply three individual +#' functions that are each passed a vector of values and should return a #' single number. +#' @param fun.ymin,fun.y,fun.ymax Deprecated, use the versions specified above +#' instead. #' @param fun.args Optional additional arguments passed on to the functions. #' @export #' @examples #' d <- ggplot(mtcars, aes(cyl, mpg)) + geom_point() #' d + stat_summary(fun.data = "mean_cl_boot", colour = "red", size = 2) #' +#' # Orientation follows the discrete axis +#' ggplot(mtcars, aes(mpg, cyl)) + +#' geom_point() + +#' stat_summary(fun.data = "mean_cl_boot", colour = "red", size = 2) +#' #' # You can supply individual functions to summarise the value at #' # each x: -#' d + stat_summary(fun.y = "median", colour = "red", size = 2, geom = "point") -#' d + stat_summary(fun.y = "mean", colour = "red", size = 2, geom = "point") -#' d + aes(colour = factor(vs)) + stat_summary(fun.y = mean, geom="line") +#' d + stat_summary(fun = "median", colour = "red", size = 2, geom = "point") +#' d + stat_summary(fun = "mean", colour = "red", size = 2, geom = "point") +#' d + aes(colour = factor(vs)) + stat_summary(fun = mean, geom="line") #' -#' d + stat_summary(fun.y = mean, fun.ymin = min, fun.ymax = max, +#' d + stat_summary(fun = mean, fun.min = min, fun.max = max, #' colour = "red") #' #' d <- ggplot(diamonds, aes(cut)) #' d + geom_bar() -#' d + stat_summary_bin(aes(y = price), fun.y = "mean", geom = "bar") +#' d + stat_summary(aes(y = price), fun = "mean", geom = "bar") +#' +#' # Orientation of stat_summary_bin is ambiguous and must be specified directly +#' ggplot(diamonds, aes(carat, price)) + +#' stat_summary_bin(fun = "mean", geom = "bar", orientation = 'y') #' #' \donttest{ #' # Don't use ylim to zoom into a summary plot - this throws the #' # data away #' p <- ggplot(mtcars, aes(cyl, mpg)) + -#' stat_summary(fun.y = "mean", geom = "point") +#' stat_summary(fun = "mean", geom = "point") #' p #' p + ylim(15, 30) #' # Instead use coord_cartesian @@ -105,13 +123,27 @@ stat_summary <- function(mapping = NULL, data = NULL, geom = "pointrange", position = "identity", ..., fun.data = NULL, - fun.y = NULL, - fun.ymax = NULL, - fun.ymin = NULL, + fun = NULL, + fun.max = NULL, + fun.min = NULL, fun.args = list(), na.rm = FALSE, + orientation = NA, show.legend = NA, - inherit.aes = TRUE) { + inherit.aes = TRUE, + fun.y, fun.ymin, fun.ymax) { + if (!missing(fun.y)) { + warn("`fun.y` is deprecated. Use `fun` instead.") + fun = fun %||% fun.y + } + if (!missing(fun.ymin)) { + warn("`fun.ymin` is deprecated. Use `fun.min` instead.") + fun.min = fun.min %||% fun.ymin + } + if (!missing(fun.ymax)) { + warn("`fun.ymax` is deprecated. Use `fun.max` instead.") + fun.max = fun.max %||% fun.ymax + } layer( data = data, mapping = mapping, @@ -122,11 +154,12 @@ stat_summary <- function(mapping = NULL, data = NULL, inherit.aes = inherit.aes, params = list( fun.data = fun.data, - fun.y = fun.y, - fun.ymax = fun.ymax, - fun.ymin = fun.ymin, + fun = fun, + fun.max = fun.max, + fun.min = fun.min, fun.args = fun.args, na.rm = na.rm, + orientation = orientation, ... ) ) @@ -139,12 +172,20 @@ stat_summary <- function(mapping = NULL, data = NULL, StatSummary <- ggproto("StatSummary", Stat, required_aes = c("x", "y"), - compute_panel = function(data, scales, fun.data = NULL, fun.y = NULL, - fun.ymax = NULL, fun.ymin = NULL, fun.args = list(), - na.rm = FALSE) { + extra_params = c("na.rm", "orientation"), + setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params) + params + }, - fun <- make_summary_fun(fun.data, fun.y, fun.ymax, fun.ymin, fun.args) - summarise_by_x(data, fun) + compute_panel = function(data, scales, fun.data = NULL, fun = NULL, + fun.max = NULL, fun.min = NULL, fun.args = list(), + na.rm = FALSE, flipped_aes = FALSE) { + data <- flip_data(data, flipped_aes) + fun <- make_summary_fun(fun.data, fun, fun.max, fun.min, fun.args) + summarised <- summarise_by_x(data, fun) + summarised$flipped_aes <- flipped_aes + flip_data(summarised, flipped_aes) } ) diff --git a/R/stat-ydensity.r b/R/stat-ydensity.r index 978f60ad0c..b246c477fa 100644 --- a/R/stat-ydensity.r +++ b/R/stat-ydensity.r @@ -27,6 +27,7 @@ stat_ydensity <- function(mapping = NULL, data = NULL, trim = TRUE, scale = "area", na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE) { scale <- match.arg(scale, c("area", "count", "width")) @@ -60,8 +61,16 @@ StatYdensity <- ggproto("StatYdensity", Stat, required_aes = c("x", "y"), non_missing_aes = "weight", + setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = TRUE, group_has_equal = TRUE) + + params + }, + + extra_params = c("na.rm", "orientation"), + compute_group = function(data, scales, width = NULL, bw = "nrd0", adjust = 1, - kernel = "gaussian", trim = TRUE, na.rm = FALSE) { + kernel = "gaussian", trim = TRUE, na.rm = FALSE, flipped_aes = FALSE) { if (nrow(data) < 3) return(new_data_frame()) range <- range(data$y, na.rm = TRUE) modifier <- if (trim) 0 else 3 @@ -83,7 +92,8 @@ StatYdensity <- ggproto("StatYdensity", Stat, compute_panel = function(self, data, scales, width = NULL, bw = "nrd0", adjust = 1, kernel = "gaussian", trim = TRUE, na.rm = FALSE, - scale = "area") { + scale = "area", flipped_aes = FALSE) { + data <- flip_data(data, flipped_aes) data <- ggproto_parent(Stat, self)$compute_panel( data, scales, width = width, bw = bw, adjust = adjust, kernel = kernel, trim = trim, na.rm = na.rm @@ -100,7 +110,8 @@ StatYdensity <- ggproto("StatYdensity", Stat, # width: constant width (density scaled to a maximum of 1) width = data$scaled ) - data + data$flipped_aes <- flipped_aes + flip_data(data, flipped_aes) } ) diff --git a/R/utilities-help.r b/R/utilities-help.r index bff0a4fbe3..341fe257d1 100644 --- a/R/utilities-help.r +++ b/R/utilities-help.r @@ -21,6 +21,7 @@ rd_aesthetics <- function(type, name) { rd_aesthetics_item <- function(x) { req <- x$required_aes + req <- sub("|", "} \\emph{or} \\code{", req, fixed = TRUE) all <- union(req, sort(x$aesthetics())) ifelse(all %in% req, @@ -28,3 +29,19 @@ rd_aesthetics_item <- function(x) { paste0("\\code{", all, "}") ) } + +rd_orientation <- function() { + c( + "@section Orientation: ", + paste( + 'This geom treats each axis differently and, thus, can thus have two orientations.', + 'Often the orientation is easy to deduce 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 orientation is ambiguous and guessing may fail. In that', + 'case the orientation can be specified directly using the \\code{orientation} parameter,', + 'which can be either \\code{"x"} or \\code{"y"}. The value gives the axis that the geom', + 'should run along, \\code{"x"} being the default orientation you would expect for the geom.' + ) + ) +} diff --git a/R/utilities.r b/R/utilities.r index 6336ace4b8..6f5b1e9b5d 100644 --- a/R/utilities.r +++ b/R/utilities.r @@ -24,11 +24,23 @@ scales::alpha # @param name of object for error message # @keyword internal check_required_aesthetics <- function(required, present, name) { - missing_aes <- setdiff(required, present) - if (length(missing_aes) == 0) return() + if (is.null(required)) return() + + required <- strsplit(required, "|", fixed = TRUE) + if (any(vapply(required, length, integer(1)) > 1)) { + required <- lapply(required, rep_len, 2) + required <- list( + vapply(required, `[`, character(1), 1), + vapply(required, `[`, character(1), 2) + ) + } else { + required <- list(unlist(required)) + } + missing_aes <- lapply(required, setdiff, present) + if (any(vapply(missing_aes, length, integer(1)) == 0)) return() stop(name, " requires the following missing aesthetics: ", - paste(missing_aes, collapse = ", "), call. = FALSE) + paste(lapply(missing_aes, paste, collapse = ", "), collapse = " or "), call. = FALSE) } # Concatenate a named list for output @@ -388,3 +400,214 @@ parse_safe <- function(text) { } out } + +switch_orientation <- function(aesthetics) { + # We should have these as globals somewhere + x <- ggplot_global$x_aes + y <- ggplot_global$y_aes + x_aes <- match(aesthetics, x) + x_aes_pos <- which(!is.na(x_aes)) + y_aes <- match(aesthetics, y) + y_aes_pos <- which(!is.na(y_aes)) + if (length(x_aes_pos) > 0) { + aesthetics[x_aes_pos] <- y[x_aes[x_aes_pos]] + } + if (length(y_aes_pos) > 0) { + aesthetics[y_aes_pos] <- x[y_aes[y_aes_pos]] + } + aesthetics +} + +#' Utilities for working with bidirecitonal layers +#' +#' These functions are what underpins the ability of certain geoms to work +#' automatically in both directions. See the *Extending ggplot2* for how they +#' are used when implementing `Geom`, `Stat`, and `Position` classes. +#' +#' `has_flipped_aes()` is used to sniff out the orientation of the layer from +#' the data. It has a range of arguments that can be used to finetune the +#' sniffing based on what the data should look like. `flip_data()` will switch +#' the column names of the data so that it looks like x-oriented data. +#' `flipped_names()` provides a named list of aesthetic names that corresponds +#' to the orientation of the layer. +#' +#' @section Controlling the sniffing: +#' How the layer data should be interpreted depends on its specific features. +#' `has_flipped_aes()` contains a range of flags for defining what certain +#' features in the data correspond to: +#' +#' - `main_is_orthogonal`: This argument controls how the existence of only a `x` +#' or `y` aesthetic is understood. If `TRUE` then the exisiting aesthetic +#' would be then secondary axis. This behaviour is present in [stat_ydensity()] +#' and [stat_boxplot()]. If `FALSE` then the exisiting aesthetic is the main +#' axis as seen in e.g. [stat_bin()], [geom_count()], and [stat_density()]. +#' - `range_is_orthogonal`: This argument controls whether the existance of +#' range-like aesthetics (e.g. `xmin` and `xmax`) represents the main or +#' secondary axis. If `TRUE` then the range is given for the secondary axis as +#' seen in e.g. [geom_ribbon()] and [geom_linerange()]. `FALSE` is less +#' prevalent but can be seen in [geom_bar()] where it may encode the span of +#' each bar. +#' - `group_has_equal`: This argument controls whether to test for equality of +#' all `x` and `y` values inside each group and set the main axis to the one +#' where all is equal. This test is only performed if `TRUE`, and only after +#' less computationally heavy tests has come up empty handed. Examples are +#' [stat_boxplot()] and [stat_ydensity] +#' - `ambiguous`: This argument tells the function that the layer, while +#' bidirectional, doesn't treat each axis differently. It will circumvent any +#' data based guessing and only take hint from the `orientation` element in +#' `params`. If this is not present it will fall back to `FALSE`. Examples are +#' [geom_line()] and [geom_area()] +#' - `main_is_continuous`: This argument controls how the test for discreteness +#' in the scales should be interpreted. If `TRUE` then the main axis will be +#' the one which is not discrete-like. Conversely, if `FALSE` the main axis +#' will be the discrete-like one. Examples of `TRUE` is [stat_density()] and +#' [stat_bin()], while examples of `FALSE` is [stat_ydensity()] and +#' [stat_boxplot()] +#' +#' @param data The layer data +#' @param params The parameters of the `Stat`/`Geom`. Only the `orientation` +#' parameter will be used. +#' @param main_is_orthogonal If only `x` or `y` are present do they correspond +#' to the main orientation or the reverse. E.g. If `TRUE` and `y` is present +#' it is not flipped. If `NA` this check will be ignored. +#' @param range_is_orthogonal If `xmin`/`xmax` or `ymin`/`ymax` is present do +#' they correspond to the main orientation or reverse. If `NA` this check will +#' be ignored. +#' @param group_has_equal Is it expected that grouped data has either a single +#' `x` or `y` value that will correspond to the orientation. +#' @param ambiguous Is the layer ambiguous in its mapping by nature. If so, it +#' will only be flipped if `params$orientation == "y"` +#' @param main_is_continuous If there is a discrete and continuous axis, does +#' the continuous one correspond to the main orientation? +#' @param flip Logical. Is the layer flipped. +#' +#' @return `has_flipped_aes()` returns `TRUE` if it detects a layer in the other +#' orientation and `FALSE` otherwise. `flip_data()` will return the input +#' unchanged if `flip = FALSE` and the data with flipped aesthetic names if +#' `flip = TRUE`. `flipped_names()` returns a named list of strings. If +#' `flip = FALSE` the name of the element will correspond to the element, e.g. +#' `flipped_names(FALSE)$x == "x"` and if `flip = TRUE` it will correspond to +#' the flipped name, e.g. `flipped_names(FALSE)$x == "y"` +#' +#' @export +#' @keywords internal +#' @name bidirection +#' +has_flipped_aes <- function(data, params = list(), main_is_orthogonal = NA, + range_is_orthogonal = NA, group_has_equal = FALSE, + ambiguous = FALSE, main_is_continuous = FALSE) { + # Is orientation already encoded in data? + if (!is.null(data$flipped_aes)) { + return(data$flipped_aes[[1]]) + } + + # Is orientation requested in the params + if (!is.null(params$orientation) && !is.na(params$orientation)) { + return(params$orientation == "y") + } + + # Does a single x or y aesthetic corespond to a specific orientation + if (!is.na(main_is_orthogonal) && sum(c("x", "y") %in% names(data)) + sum(c("x", "y") %in% names(params)) == 1) { + return(("x" %in% names(data) || "x" %in% names(params)) == main_is_orthogonal) + } + + has_x <- !is.null(data$x) + has_y <- !is.null(data$y) + + # Does a provided range indicate an orientation + if (!is.na(range_is_orthogonal)) { + if (any(c("ymin", "ymax") %in% names(data))) { + return(!range_is_orthogonal) + } + if (any(c("xmin", "xmax") %in% names(data))) { + return(range_is_orthogonal) + } + } + + # If ambiguous orientation = NA will give FALSE + if (ambiguous && (is.null(params$orientation) || is.na(params$orientation))) { + return(FALSE) + } + + # Is there a single actual discrete position + y_is_int <- is.integer(data$y) + x_is_int <- is.integer(data$x) + if (xor(y_is_int, x_is_int)) { + return(y_is_int != main_is_continuous) + } + + # Does each group have a single x or y value + if (group_has_equal) { + if (has_x) { + x_groups <- vapply(split(data$x, data$group), function(x) length(unique(x)), integer(1)) + if (all(x_groups == 1)) { + return(FALSE) + } + } + if (has_y) { + y_groups <- vapply(split(data$y, data$group), function(x) length(unique(x)), integer(1)) + if (all(y_groups == 1)) { + return(TRUE) + } + } + } + + # give up early + if (!has_x && !has_y) { + return(FALSE) + } + + # Both true discrete. give up + if (y_is_int && x_is_int) { + return(FALSE) + } + # Is there a single discrete-like position + y_is_int <- if (has_y) isTRUE(all.equal(data$y, round(data$y))) else FALSE + x_is_int <- if (has_x) isTRUE(all.equal(data$x, round(data$x))) else FALSE + if (xor(y_is_int, x_is_int)) { + return(y_is_int != main_is_continuous) + } + # Is one of the axes a single value + if (all(data$x == 1)) { + return(main_is_continuous) + } + if (all(data$y == 1)) { + return(!main_is_continuous) + } + # If both are discrete like, which have most 0 or 1-spaced values + y_diff <- diff(sort(data$y)) + x_diff <- diff(sort(data$x)) + if (y_is_int && x_is_int) { + return((sum(x_diff <= 1) < sum(y_diff <= 1)) != main_is_continuous) + } + # If none are discrete is either regularly spaced + y_is_regular <- if (has_y) all((y_diff / min(y_diff)) %% 1 < .Machine$double.eps) else FALSE + x_is_regular <- if (has_x) all((x_diff / min(x_diff)) %% 1 < .Machine$double.eps) else FALSE + if (xor(y_is_regular, x_is_regular)) { + return(y_is_regular != main_is_continuous) + } + # default to no + FALSE +} +#' @rdname bidirection +#' @export +flip_data <- function(data, flip = NULL) { + flip <- flip %||% data$flipped_aes[1] %||% FALSE + if (flip) { + names(data) <- switch_orientation(names(data)) + } + data +} +#' @rdname bidirection +#' @export +flipped_names <- function(flip = FALSE) { + x_aes <- ggplot_global$x_aes + y_aes <- ggplot_global$y_aes + if (flip) { + ret <- as.list(c(y_aes, x_aes)) + } else { + ret <- as.list(c(x_aes, y_aes)) + } + names(ret) <- c(x_aes, y_aes) + ret +} diff --git a/man/bidirection.Rd b/man/bidirection.Rd new file mode 100644 index 0000000000..1542f5780a --- /dev/null +++ b/man/bidirection.Rd @@ -0,0 +1,101 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities.r +\name{bidirection} +\alias{bidirection} +\alias{has_flipped_aes} +\alias{flip_data} +\alias{flipped_names} +\title{Utilities for working with bidirecitonal layers} +\usage{ +has_flipped_aes(data, params = list(), main_is_orthogonal = NA, + range_is_orthogonal = NA, group_has_equal = FALSE, + ambiguous = FALSE, main_is_continuous = FALSE) + +flip_data(data, flip = NULL) + +flipped_names(flip = FALSE) +} +\arguments{ +\item{data}{The layer data} + +\item{params}{The parameters of the \code{Stat}/\code{Geom}. Only the \code{orientation} +parameter will be used.} + +\item{main_is_orthogonal}{If only \code{x} or \code{y} are present do they correspond +to the main orientation or the reverse. E.g. If \code{TRUE} and \code{y} is present +it is not flipped. If \code{NA} this check will be ignored.} + +\item{range_is_orthogonal}{If \code{xmin}/\code{xmax} or \code{ymin}/\code{ymax} is present do +they correspond to the main orientation or reverse. If \code{NA} this check will +be ignored.} + +\item{group_has_equal}{Is it expected that grouped data has either a single +\code{x} or \code{y} value that will correspond to the orientation.} + +\item{ambiguous}{Is the layer ambiguous in its mapping by nature. If so, it +will only be flipped if \code{params$orientation == "y"}} + +\item{main_is_continuous}{If there is a discrete and continuous axis, does +the continuous one correspond to the main orientation?} + +\item{flip}{Logical. Is the layer flipped.} +} +\value{ +\code{has_flipped_aes()} returns \code{TRUE} if it detects a layer in the other +orientation and \code{FALSE} otherwise. \code{flip_data()} will return the input +unchanged if \code{flip = FALSE} and the data with flipped aesthetic names if +\code{flip = TRUE}. \code{flipped_names()} returns a named list of strings. If +\code{flip = FALSE} the name of the element will correspond to the element, e.g. +\code{flipped_names(FALSE)$x == "x"} and if \code{flip = TRUE} it will correspond to +the flipped name, e.g. \code{flipped_names(FALSE)$x == "y"} +} +\description{ +These functions are what underpins the ability of certain geoms to work +automatically in both directions. See the \emph{Extending ggplot2} for how they +are used when implementing \code{Geom}, \code{Stat}, and \code{Position} classes. +} +\details{ +\code{has_flipped_aes()} is used to sniff out the orientation of the layer from +the data. It has a range of arguments that can be used to finetune the +sniffing based on what the data should look like. \code{flip_data()} will switch +the column names of the data so that it looks like x-oriented data. +\code{flipped_names()} provides a named list of aesthetic names that corresponds +to the orientation of the layer. +} +\section{Controlling the sniffing}{ + +How the layer data should be interpreted depends on its specific features. +\code{has_flipped_aes()} contains a range of flags for defining what certain +features in the data correspond to: +\itemize{ +\item \code{main_is_orthogonal}: This argument controls how the existence of only a \code{x} +or \code{y} aesthetic is understood. If \code{TRUE} then the exisiting aesthetic +would be then secondary axis. This behaviour is present in \code{\link[=stat_ydensity]{stat_ydensity()}} +and \code{\link[=stat_boxplot]{stat_boxplot()}}. If \code{FALSE} then the exisiting aesthetic is the main +axis as seen in e.g. \code{\link[=stat_bin]{stat_bin()}}, \code{\link[=geom_count]{geom_count()}}, and \code{\link[=stat_density]{stat_density()}}. +\item \code{range_is_orthogonal}: This argument controls whether the existance of +range-like aesthetics (e.g. \code{xmin} and \code{xmax}) represents the main or +secondary axis. If \code{TRUE} then the range is given for the secondary axis as +seen in e.g. \code{\link[=geom_ribbon]{geom_ribbon()}} and \code{\link[=geom_linerange]{geom_linerange()}}. \code{FALSE} is less +prevalent but can be seen in \code{\link[=geom_bar]{geom_bar()}} where it may encode the span of +each bar. +\item \code{group_has_equal}: This argument controls whether to test for equality of +all \code{x} and \code{y} values inside each group and set the main axis to the one +where all is equal. This test is only performed if \code{TRUE}, and only after +less computationally heavy tests has come up empty handed. Examples are +\code{\link[=stat_boxplot]{stat_boxplot()}} and \link{stat_ydensity} +\item \code{ambiguous}: This argument tells the function that the layer, while +bidirectional, doesn't treat each axis differently. It will circumvent any +data based guessing and only take hint from the \code{orientation} element in +\code{params}. If this is not present it will fall back to \code{FALSE}. Examples are +\code{\link[=geom_line]{geom_line()}} and \code{\link[=geom_area]{geom_area()}} +\item \code{main_is_continuous}: This argument controls how the test for discreteness +in the scales should be interpreted. If \code{TRUE} then the main axis will be +the one which is not discrete-like. Conversely, if \code{FALSE} the main axis +will be the discrete-like one. Examples of \code{TRUE} is \code{\link[=stat_density]{stat_density()}} and +\code{\link[=stat_bin]{stat_bin()}}, while examples of \code{FALSE} is \code{\link[=stat_ydensity]{stat_ydensity()}} and +\code{\link[=stat_boxplot]{stat_boxplot()}} +} +} + +\keyword{internal} diff --git a/man/geom_bar.Rd b/man/geom_bar.Rd index d6245de4a9..aa3d2737e8 100644 --- a/man/geom_bar.Rd +++ b/man/geom_bar.Rd @@ -8,7 +8,8 @@ \usage{ geom_bar(mapping = NULL, data = NULL, stat = "count", position = "stack", ..., width = NULL, binwidth = NULL, - na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) + na.rm = FALSE, orientation = NA, show.legend = NA, + inherit.aes = TRUE) geom_col(mapping = NULL, data = NULL, position = "stack", ..., width = NULL, na.rm = FALSE, show.legend = NA, @@ -16,7 +17,7 @@ geom_col(mapping = NULL, data = NULL, position = "stack", ..., stat_count(mapping = NULL, data = NULL, geom = "bar", position = "stack", ..., width = NULL, na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) + orientation = NA, show.legend = NA, inherit.aes = TRUE) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[=aes]{aes()}} or @@ -56,6 +57,11 @@ you use it you'll get an warning telling to you use \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} +\item{orientation}{The orientation of the layer. The default (\code{NA}) +automatically determines the orientation from the aesthetic mapping. In the +rare event that this fails it can be given explicitly by setting \code{orientation} +to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} + \item{show.legend}{logical. Should this layer be included in the legends? \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. @@ -91,6 +97,11 @@ side-to-side, use \code{\link[=position_dodge]{position_dodge()}} or \code{\link \code{\link[=position_fill]{position_fill()}} shows relative proportions at each \code{x} by stacking the bars and then standardising each bar to have the same height. } +\section{Orientation}{ + +This geom treats each axis differently and, thus, can thus have two orientations. Often the orientation is easy to deduce 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 orientation is ambiguous and guessing may fail. In that case the orientation can be specified directly using the \code{orientation} parameter, which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom should run along, \code{"x"} being the default orientation you would expect for the geom. +} + \section{Aesthetics}{ \code{geom_bar()} understands the following aesthetics (required aesthetics are in bold): @@ -123,9 +134,10 @@ Learn more about setting these aesthetics in \code{vignette("ggplot2-specs")}. \code{stat_count()} understands the following aesthetics (required aesthetics are in bold): \itemize{ -\item \strong{\code{x}} +\item \strong{\code{x} \emph{or} \code{y}} \item \code{group} \item \code{weight} +\item \code{x} \item \code{y} } Learn more about setting these aesthetics in \code{vignette("ggplot2-specs")}. @@ -147,17 +159,18 @@ g <- ggplot(mpg, aes(class)) 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() diff --git a/man/geom_boxplot.Rd b/man/geom_boxplot.Rd index 19b56385ec..32d492425c 100644 --- a/man/geom_boxplot.Rd +++ b/man/geom_boxplot.Rd @@ -10,11 +10,11 @@ geom_boxplot(mapping = NULL, data = NULL, stat = "boxplot", outlier.color = 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, na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) + orientation = NA, show.legend = NA, inherit.aes = TRUE) stat_boxplot(mapping = NULL, data = NULL, geom = "boxplot", position = "dodge2", ..., coef = 1.5, na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) + orientation = NA, show.legend = NA, inherit.aes = TRUE) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[=aes]{aes()}} or @@ -73,6 +73,11 @@ weighted, using the \code{weight} aesthetic).} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} +\item{orientation}{The orientation of the layer. The default (\code{NA}) +automatically determines the orientation from the aesthetic mapping. In the +rare event that this fails it can be given explicitly by setting \code{orientation} +to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} + \item{show.legend}{logical. Should this layer be included in the legends? \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. @@ -94,6 +99,11 @@ The boxplot compactly displays the distribution of a continuous variable. It visualises five summary statistics (the median, two hinges and two whiskers), and all "outlying" points individually. } +\section{Orientation}{ + +This geom treats each axis differently and, thus, can thus have two orientations. Often the orientation is easy to deduce 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 orientation is ambiguous and guessing may fail. In that case the orientation can be specified directly using the \code{orientation} parameter, which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom should run along, \code{"x"} being the default orientation you would expect for the geom. +} + \section{Summary statistics}{ The lower and upper hinges correspond to the first and third quartiles @@ -118,20 +128,32 @@ See McGill et al. (1978) for more details. \code{geom_boxplot()} understands the following aesthetics (required aesthetics are in bold): \itemize{ -\item \strong{\code{x}} -\item \strong{\code{lower}} -\item \strong{\code{upper}} -\item \strong{\code{middle}} -\item \strong{\code{ymin}} -\item \strong{\code{ymax}} +\item \strong{\code{x} \emph{or} \code{y}} +\item \strong{\code{lower} \emph{or} \code{xlower}} +\item \strong{\code{upper} \emph{or} \code{xupper}} +\item \strong{\code{middle} \emph{or} \code{xmiddle}} +\item \strong{\code{ymin} \emph{or} \code{xmin}} +\item \strong{\code{ymax} \emph{or} \code{xmax}} \item \code{alpha} \item \code{colour} \item \code{fill} \item \code{group} \item \code{linetype} +\item \code{lower} +\item \code{middle} \item \code{shape} \item \code{size} +\item \code{upper} \item \code{weight} +\item \code{x} +\item \code{xlower} +\item \code{xmax} +\item \code{xmiddle} +\item \code{xmin} +\item \code{xupper} +\item \code{y} +\item \code{ymax} +\item \code{ymin} } Learn more about setting these aesthetics in \code{vignette("ggplot2-specs")}. } @@ -153,7 +175,8 @@ Learn more about setting these aesthetics in \code{vignette("ggplot2-specs")}. \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) diff --git a/man/geom_density.Rd b/man/geom_density.Rd index 3ccef5179d..4aa678c18f 100644 --- a/man/geom_density.Rd +++ b/man/geom_density.Rd @@ -6,13 +6,13 @@ \title{Smoothed density estimates} \usage{ geom_density(mapping = NULL, data = NULL, stat = "density", - position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) + position = "identity", ..., na.rm = FALSE, orientation = NA, + show.legend = NA, inherit.aes = TRUE) stat_density(mapping = NULL, data = NULL, geom = "area", position = "stack", ..., bw = "nrd0", adjust = 1, kernel = "gaussian", n = 512, trim = FALSE, na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) + orientation = NA, show.legend = NA, inherit.aes = TRUE) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[=aes]{aes()}} or @@ -46,6 +46,11 @@ to the paired geom/stat.} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} +\item{orientation}{The orientation of the layer. The default (\code{NA}) +automatically determines the orientation from the aesthetic mapping. In the +rare event that this fails it can be given explicitly by setting \code{orientation} +to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} + \item{show.legend}{logical. Should this layer be included in the legends? \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. @@ -87,6 +92,11 @@ Computes and draws kernel density estimate, which is a smoothed version of the histogram. This is a useful alternative to the histogram for continuous data that comes from an underlying smooth distribution. } +\section{Orientation}{ + +This geom treats each axis differently and, thus, can thus have two orientations. Often the orientation is easy to deduce 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 orientation is ambiguous and guessing may fail. In that case the orientation can be specified directly using the \code{orientation} parameter, which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom should run along, \code{"x"} being the default orientation you would expect for the geom. +} + \section{Aesthetics}{ \code{geom_density()} understands the following aesthetics (required aesthetics are in bold): @@ -119,6 +129,9 @@ plots} \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) diff --git a/man/geom_histogram.Rd b/man/geom_histogram.Rd index 1cf44f65cf..228c06c73a 100644 --- a/man/geom_histogram.Rd +++ b/man/geom_histogram.Rd @@ -13,13 +13,14 @@ geom_freqpoly(mapping = NULL, data = NULL, stat = "bin", geom_histogram(mapping = NULL, data = NULL, stat = "bin", position = "stack", ..., binwidth = NULL, bins = NULL, - na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) + na.rm = FALSE, orientation = NA, show.legend = NA, + inherit.aes = TRUE) stat_bin(mapping = NULL, data = NULL, geom = "bar", position = "stack", ..., binwidth = NULL, bins = NULL, center = NULL, boundary = NULL, breaks = NULL, closed = c("right", "left"), pad = FALSE, na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) + orientation = NA, show.legend = NA, inherit.aes = TRUE) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[=aes]{aes()}} or @@ -79,6 +80,11 @@ bin width of a time variable is the number of seconds.} \item{bins}{Number of bins. Overridden by \code{binwidth}. Defaults to 30.} +\item{orientation}{The orientation of the layer. The default (\code{NA}) +automatically determines the orientation from the aesthetic mapping. In the +rare event that this fails it can be given explicitly by setting \code{orientation} +to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} + \item{geom, stat}{Use to override the default connection between \code{geom_histogram()}/\code{geom_freqpoly()} and \code{stat_bin()}.} @@ -121,6 +127,11 @@ different number of bins. You can also experiment modifying the \code{binwidth} one change at a time. You may need to look at a few options to uncover the full story behind your data. } +\section{Orientation}{ + +This geom treats each axis differently and, thus, can thus have two orientations. Often the orientation is easy to deduce 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 orientation is ambiguous and guessing may fail. In that case the orientation can be specified directly using the \code{orientation} parameter, which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom should run along, \code{"x"} being the default orientation you would expect for the geom. +} + \section{Aesthetics}{ \code{geom_histogram()} uses the same aesthetics as \code{\link[=geom_bar]{geom_bar()}}; @@ -144,6 +155,9 @@ ggplot(diamonds, aes(carat)) + geom_histogram(binwidth = 0.01) ggplot(diamonds, aes(carat)) + geom_histogram(bins = 200) +# Map values to y to flip the orientation +ggplot(diamonds, aes(y = carat)) + + geom_histogram() # Rather than stacking histograms, it's easier to compare frequency # polygons diff --git a/man/geom_linerange.Rd b/man/geom_linerange.Rd index fcb57f367f..9e18cdfe89 100644 --- a/man/geom_linerange.Rd +++ b/man/geom_linerange.Rd @@ -10,19 +10,19 @@ \usage{ geom_crossbar(mapping = NULL, data = NULL, stat = "identity", position = "identity", ..., fatten = 2.5, na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) + orientation = NA, show.legend = NA, inherit.aes = TRUE) geom_errorbar(mapping = NULL, data = NULL, stat = "identity", - position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) + position = "identity", ..., na.rm = FALSE, orientation = NA, + show.legend = NA, inherit.aes = TRUE) geom_linerange(mapping = NULL, data = NULL, stat = "identity", - position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) + position = "identity", ..., na.rm = FALSE, orientation = NA, + show.legend = NA, inherit.aes = TRUE) geom_pointrange(mapping = NULL, data = NULL, stat = "identity", position = "identity", ..., fatten = 4, na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) + orientation = NA, show.legend = NA, inherit.aes = TRUE) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[=aes]{aes()}} or @@ -63,6 +63,11 @@ middle bar in \code{geom_crossbar()} and the middle point in \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} +\item{orientation}{The orientation of the layer. The default (\code{NA}) +automatically determines the orientation from the aesthetic mapping. In the +rare event that this fails it can be given explicitly by setting \code{orientation} +to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} + \item{show.legend}{logical. Should this layer be included in the legends? \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. @@ -78,18 +83,29 @@ the default plot specification, e.g. \code{\link[=borders]{borders()}}.} Various ways of representing a vertical interval defined by \code{x}, \code{ymin} and \code{ymax}. Each case draws a single graphical object. } +\section{Orientation}{ + +This geom treats each axis differently and, thus, can thus have two orientations. Often the orientation is easy to deduce 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 orientation is ambiguous and guessing may fail. In that case the orientation can be specified directly using the \code{orientation} parameter, which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom should run along, \code{"x"} being the default orientation you would expect for the geom. +} + \section{Aesthetics}{ \code{geom_linerange()} understands the following aesthetics (required aesthetics are in bold): \itemize{ -\item \strong{\code{x}} -\item \strong{\code{ymin}} -\item \strong{\code{ymax}} +\item \strong{\code{x} \emph{or} \code{y}} +\item \strong{\code{ymin} \emph{or} \code{xmin}} +\item \strong{\code{ymax} \emph{or} \code{xmax}} \item \code{alpha} \item \code{colour} \item \code{group} \item \code{linetype} \item \code{size} +\item \code{x} +\item \code{xmax} +\item \code{xmin} +\item \code{y} +\item \code{ymax} +\item \code{ymin} } Learn more about setting these aesthetics in \code{vignette("ggplot2-specs")}. } @@ -110,6 +126,10 @@ p + geom_pointrange(aes(ymin = lower, ymax = upper)) p + geom_crossbar(aes(ymin = lower, ymax = upper), width = 0.2) p + geom_errorbar(aes(ymin = lower, ymax = upper), width = 0.2) +# Flip the orientation by changing mapping +ggplot(df, aes(resp, trt, colour = group)) + + geom_linerange(aes(xmin = lower, xmax = upper)) + # Draw lines connecting group means p + geom_line(aes(group = group)) + diff --git a/man/geom_path.Rd b/man/geom_path.Rd index 87042c73f0..5685b91c23 100644 --- a/man/geom_path.Rd +++ b/man/geom_path.Rd @@ -12,8 +12,8 @@ geom_path(mapping = NULL, data = NULL, stat = "identity", inherit.aes = TRUE) geom_line(mapping = NULL, data = NULL, stat = "identity", - position = "identity", na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE, ...) + position = "identity", na.rm = FALSE, orientation = NA, + show.legend = NA, inherit.aes = TRUE, ...) geom_step(mapping = NULL, data = NULL, stat = "identity", position = "identity", direction = "hv", na.rm = FALSE, @@ -73,6 +73,11 @@ rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link[=borders]{borders()}}.} +\item{orientation}{The orientation of the layer. The default (\code{NA}) +automatically determines the orientation from the aesthetic mapping. In the +rare event that this fails it can be given explicitly by setting \code{orientation} +to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} + \item{direction}{direction of stairs: 'vh' for vertical then horizontal, 'hv' for horizontal then vertical, or 'mid' for step half-way between adjacent x-values.} @@ -88,6 +93,11 @@ connected together. An alternative parameterisation is \code{\link[=geom_segment]{geom_segment()}}, where each line corresponds to a single case which provides the start and end coordinates. } +\section{Orientation}{ + +This geom treats each axis differently and, thus, can thus have two orientations. Often the orientation is easy to deduce 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 orientation is ambiguous and guessing may fail. In that case the orientation can be specified directly using the \code{orientation} parameter, which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom should run along, \code{"x"} being the default orientation you would expect for the geom. +} + \section{Aesthetics}{ \code{geom_path()} understands the following aesthetics (required aesthetics are in bold): @@ -122,6 +132,9 @@ ggplot(economics, aes(date, unemploy)) + geom_line() ggplot(economics_long, aes(date, value01, colour = variable)) + geom_line() +# You can get a timeseries that run vertically by setting the orientation +ggplot(economics, aes(unemploy, date)) + geom_line(orientation = "y") + # geom_step() is useful when you want to highlight exactly when # the y value changes recent <- economics[economics$date > as.Date("2013-01-01"), ] diff --git a/man/geom_ribbon.Rd b/man/geom_ribbon.Rd index f5142578ec..06b5b619d0 100644 --- a/man/geom_ribbon.Rd +++ b/man/geom_ribbon.Rd @@ -6,12 +6,12 @@ \title{Ribbons and area plots} \usage{ geom_ribbon(mapping = NULL, data = NULL, stat = "identity", - position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) + position = "identity", ..., na.rm = FALSE, orientation = NA, + show.legend = NA, inherit.aes = TRUE) geom_area(mapping = NULL, data = NULL, stat = "identity", - position = "stack", na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE, ...) + position = "stack", na.rm = FALSE, orientation = NA, + show.legend = NA, inherit.aes = TRUE, ...) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[=aes]{aes()}} or @@ -48,6 +48,11 @@ to the paired geom/stat.} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} +\item{orientation}{The orientation of the layer. The default (\code{NA}) +automatically determines the orientation from the aesthetic mapping. In the +rare event that this fails it can be given explicitly by setting \code{orientation} +to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} + \item{show.legend}{logical. Should this layer be included in the legends? \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. @@ -73,19 +78,30 @@ components is stacked is very important, as it becomes increasing hard to see the individual pattern as you move up the stack. See \code{\link[=position_stack]{position_stack()}} for the details of stacking algorithm. } +\section{Orientation}{ + +This geom treats each axis differently and, thus, can thus have two orientations. Often the orientation is easy to deduce 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 orientation is ambiguous and guessing may fail. In that case the orientation can be specified directly using the \code{orientation} parameter, which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom should run along, \code{"x"} being the default orientation you would expect for the geom. +} + \section{Aesthetics}{ \code{geom_ribbon()} understands the following aesthetics (required aesthetics are in bold): \itemize{ -\item \strong{\code{x}} -\item \strong{\code{ymin}} -\item \strong{\code{ymax}} +\item \strong{\code{x} \emph{or} \code{y}} +\item \strong{\code{ymin} \emph{or} \code{xmin}} +\item \strong{\code{ymax} \emph{or} \code{xmax}} \item \code{alpha} \item \code{colour} \item \code{fill} \item \code{group} \item \code{linetype} \item \code{size} +\item \code{x} +\item \code{xmax} +\item \code{xmin} +\item \code{y} +\item \code{ymax} +\item \code{ymin} } Learn more about setting these aesthetics in \code{vignette("ggplot2-specs")}. } @@ -98,6 +114,9 @@ h <- ggplot(huron, aes(year)) h + geom_ribbon(aes(ymin=0, ymax=level)) h + geom_area(aes(y = level)) +# Change orientation be switching the mapping +h + geom_area(aes(x = level, y = year)) + # Add aesthetic mappings h + geom_ribbon(aes(ymin = level - 1, ymax = level + 1), fill = "grey70") + diff --git a/man/geom_smooth.Rd b/man/geom_smooth.Rd index 540207b2db..7b7d67cfa1 100644 --- a/man/geom_smooth.Rd +++ b/man/geom_smooth.Rd @@ -7,13 +7,14 @@ \usage{ geom_smooth(mapping = NULL, data = NULL, stat = "smooth", position = "identity", ..., method = NULL, formula = NULL, - se = TRUE, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) + se = TRUE, na.rm = FALSE, orientation = NA, show.legend = NA, + inherit.aes = TRUE) stat_smooth(mapping = NULL, data = NULL, geom = "smooth", position = "identity", ..., method = NULL, formula = NULL, se = TRUE, n = 80, span = 0.75, fullrange = FALSE, level = 0.95, method.args = list(), na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) + orientation = NA, show.legend = NA, inherit.aes = TRUE) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[=aes]{aes()}} or @@ -72,6 +73,11 @@ observations and \code{formula = y ~ s(x, bs = "cs")} otherwise.} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} +\item{orientation}{The orientation of the layer. The default (\code{NA}) +automatically determines the orientation from the aesthetic mapping. In the +rare event that this fails it can be given explicitly by setting \code{orientation} +to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} + \item{show.legend}{logical. Should this layer be included in the legends? \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. @@ -114,6 +120,11 @@ exceptions are \code{loess()}, which uses a t-based approximation, and \code{glm()}, where the normal confidence interval is constructed on the link scale and then back-transformed to the response scale. } +\section{Orientation}{ + +This geom treats each axis differently and, thus, can thus have two orientations. Often the orientation is easy to deduce 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 orientation is ambiguous and guessing may fail. In that case the orientation can be specified directly using the \code{orientation} parameter, which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom should run along, \code{"x"} being the default orientation you would expect for the geom. +} + \section{Aesthetics}{ \code{geom_smooth()} understands the following aesthetics (required aesthetics are in bold): @@ -148,6 +159,11 @@ ggplot(mpg, aes(displ, hwy)) + geom_point() + geom_smooth() +# If you need the fitting to be done along the y-axis set the orientation +ggplot(mpg, aes(displ, hwy)) + + geom_point() + + geom_smooth(orientation = "y") + # Use span to control the "wiggliness" of the default loess smoother. # The span is the fraction of points used to fit each local regression: # small numbers make a wigglier curve, larger numbers make a smoother curve. diff --git a/man/geom_violin.Rd b/man/geom_violin.Rd index 247949f78d..a290448257 100644 --- a/man/geom_violin.Rd +++ b/man/geom_violin.Rd @@ -7,13 +7,13 @@ \usage{ geom_violin(mapping = NULL, data = NULL, stat = "ydensity", position = "dodge", ..., draw_quantiles = NULL, trim = TRUE, - scale = "area", na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) + scale = "area", na.rm = FALSE, orientation = NA, + show.legend = NA, inherit.aes = TRUE) stat_ydensity(mapping = NULL, data = NULL, geom = "violin", position = "dodge", ..., bw = "nrd0", adjust = 1, kernel = "gaussian", trim = TRUE, scale = "area", na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) + orientation = NA, show.legend = NA, inherit.aes = TRUE) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[=aes]{aes()}} or @@ -57,6 +57,11 @@ observations. If "width", all violins have the same maximum width.} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} +\item{orientation}{The orientation of the layer. The default (\code{NA}) +automatically determines the orientation from the aesthetic mapping. In the +rare event that this fails it can be given explicitly by setting \code{orientation} +to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} + \item{show.legend}{logical. Should this layer be included in the legends? \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. @@ -88,6 +93,11 @@ blend of \code{\link[=geom_boxplot]{geom_boxplot()}} and \code{\link[=geom_densi violin plot is a mirrored density plot displayed in the same way as a boxplot. } +\section{Orientation}{ + +This geom treats each axis differently and, thus, can thus have two orientations. Often the orientation is easy to deduce 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 orientation is ambiguous and guessing may fail. In that case the orientation can be specified directly using the \code{orientation} parameter, which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom should run along, \code{"x"} being the default orientation you would expect for the geom. +} + \section{Aesthetics}{ \code{geom_violin()} understands the following aesthetics (required aesthetics are in bold): @@ -122,6 +132,10 @@ or to a constant maximum width} p <- ggplot(mtcars, aes(factor(cyl), mpg)) p + geom_violin() +# Orientation follows the discrete axis +ggplot(mtcars, aes(mpg, factor(cyl))) + + geom_violin() + \donttest{ p + geom_violin() + geom_jitter(height = 0, width = 0.1) diff --git a/man/stat_summary.Rd b/man/stat_summary.Rd index 3acd3a2588..6480650e9d 100644 --- a/man/stat_summary.Rd +++ b/man/stat_summary.Rd @@ -6,15 +6,16 @@ \title{Summarise y values at unique/binned x} \usage{ stat_summary_bin(mapping = NULL, data = NULL, geom = "pointrange", - position = "identity", ..., fun.data = NULL, fun.y = NULL, - fun.ymax = NULL, fun.ymin = NULL, fun.args = list(), bins = 30, - binwidth = NULL, breaks = NULL, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) + position = "identity", ..., fun.data = NULL, fun = NULL, + fun.max = NULL, fun.min = NULL, fun.args = list(), bins = 30, + binwidth = NULL, breaks = NULL, na.rm = FALSE, orientation = NA, + show.legend = NA, inherit.aes = TRUE, fun.y, fun.ymin, fun.ymax) stat_summary(mapping = NULL, data = NULL, geom = "pointrange", - position = "identity", ..., fun.data = NULL, fun.y = NULL, - fun.ymax = NULL, fun.ymin = NULL, fun.args = list(), - na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) + position = "identity", ..., fun.data = NULL, fun = NULL, + fun.max = NULL, fun.min = NULL, fun.args = list(), na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE, fun.y, + fun.ymin, fun.ymax) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[=aes]{aes()}} or @@ -51,8 +52,8 @@ to the paired geom/stat.} \item{fun.data}{A function that is given the complete data and should return a data frame with variables \code{ymin}, \code{y}, and \code{ymax}.} -\item{fun.ymin, fun.y, fun.ymax}{Alternatively, supply three individual -functions that are each passed a vector of x's and should return a +\item{fun.min, fun, fun.max}{Alternatively, supply three individual +functions that are each passed a vector of values and should return a single number.} \item{fun.args}{Optional additional arguments passed on to the functions.} @@ -79,6 +80,11 @@ and \code{boundary}.} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} +\item{orientation}{The orientation of the layer. The default (\code{NA}) +automatically determines the orientation from the aesthetic mapping. In the +rare event that this fails it can be given explicitly by setting \code{orientation} +to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} + \item{show.legend}{logical. Should this layer be included in the legends? \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. @@ -89,13 +95,21 @@ display.} rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link[=borders]{borders()}}.} + +\item{fun.ymin, fun.y, fun.ymax}{Deprecated, use the versions specified above +instead.} } \description{ -\code{stat_summary} operates on unique \code{x}; \code{stat_summary_bin} -operates on binned \code{x}. They are more flexible versions of +\code{stat_summary} operates on unique \code{x} or \code{y}; \code{stat_summary_bin} +operates on binned \code{x} or \code{y}. They are more flexible versions of \code{\link[=stat_bin]{stat_bin()}}: instead of just counting, they can compute any aggregate. } +\section{Orientation}{ + +This geom treats each axis differently and, thus, can thus have two orientations. Often the orientation is easy to deduce 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 orientation is ambiguous and guessing may fail. In that case the orientation can be specified directly using the \code{orientation} parameter, which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom should run along, \code{"x"} being the default orientation you would expect for the geom. +} + \section{Aesthetics}{ \code{stat_summary()} understands the following aesthetics (required aesthetics are in bold): @@ -109,23 +123,28 @@ Learn more about setting these aesthetics in \code{vignette("ggplot2-specs")}. \section{Summary functions}{ -You can either supply summary functions individually (\code{fun.y}, -\code{fun.ymax}, \code{fun.ymin}), or as a single function (\code{fun.data}): +You can either supply summary functions individually (\code{fun}, +\code{fun.max}, \code{fun.min}), or as a single function (\code{fun.data}): \describe{ \item{fun.data}{Complete summary function. Should take numeric vector as input and return data frame as output} -\item{fun.ymin}{ymin summary function (should take numeric vector and +\item{fun.min}{min summary function (should take numeric vector and return single number)} -\item{fun.y}{y summary function (should take numeric vector and return +\item{fun}{main summary function (should take numeric vector and return single number)} -\item{fun.ymax}{ymax summary function (should take numeric vector and +\item{fun.max}{max summary function (should take numeric vector and return single number)} } A simple vector function is easiest to work with as you can return a single number, but is somewhat less flexible. If your summary function computes -multiple values at once (e.g. ymin and ymax), use \code{fun.data}. +multiple values at once (e.g. min and max), use \code{fun.data}. + +\code{fun.data} will recieve data as if it was oriented along the x-axis and +should return a data.frame that corresponds to that orientation. The layer +will take care of flipping the input and output if it is oriented along the +y-axis. If no aggregation functions are supplied, will default to \code{\link[=mean_se]{mean_se()}}. @@ -135,24 +154,33 @@ If no aggregation functions are supplied, will default to d <- ggplot(mtcars, aes(cyl, mpg)) + geom_point() d + stat_summary(fun.data = "mean_cl_boot", colour = "red", size = 2) +# Orientation follows the discrete axis +ggplot(mtcars, aes(mpg, cyl)) + + geom_point() + + stat_summary(fun.data = "mean_cl_boot", colour = "red", size = 2) + # You can supply individual functions to summarise the value at # each x: -d + stat_summary(fun.y = "median", colour = "red", size = 2, geom = "point") -d + stat_summary(fun.y = "mean", colour = "red", size = 2, geom = "point") -d + aes(colour = factor(vs)) + stat_summary(fun.y = mean, geom="line") +d + stat_summary(fun = "median", colour = "red", size = 2, geom = "point") +d + stat_summary(fun = "mean", colour = "red", size = 2, geom = "point") +d + aes(colour = factor(vs)) + stat_summary(fun = mean, geom="line") -d + stat_summary(fun.y = mean, fun.ymin = min, fun.ymax = max, +d + stat_summary(fun = mean, fun.min = min, fun.max = max, colour = "red") d <- ggplot(diamonds, aes(cut)) d + geom_bar() -d + stat_summary_bin(aes(y = price), fun.y = "mean", geom = "bar") +d + stat_summary(aes(y = price), fun = "mean", geom = "bar") + +# Orientation of stat_summary_bin is ambiguous and must be specified directly +ggplot(diamonds, aes(carat, price)) + + stat_summary_bin(fun = "mean", geom = "bar", orientation = 'y') \donttest{ # Don't use ylim to zoom into a summary plot - this throws the # data away p <- ggplot(mtcars, aes(cyl, mpg)) + - stat_summary(fun.y = "mean", geom = "point") + stat_summary(fun = "mean", geom = "point") p p + ylim(15, 30) # Instead use coord_cartesian diff --git a/tests/testthat/test-geom-bar.R b/tests/testthat/test-geom-bar.R index b71febb4e4..fa3f6bd7a3 100644 --- a/tests/testthat/test-geom-bar.R +++ b/tests/testthat/test-geom-bar.R @@ -10,3 +10,19 @@ test_that("geom_bar removes bars with parts outside the plot limits", { "Removed 1 rows containing missing values" ) }) + +test_that("geom_bar works in both directions", { + dat <- data_frame(x = c("a", "b", "b", "c", "c", "c")) + + p <- ggplot(dat, aes(x)) + geom_bar() + x <- layer_data(p) + expect_false(x$flipped_aes[1]) + + p <- ggplot(dat, aes(y = x)) + geom_bar() + y <- layer_data(p) + expect_true(y$flipped_aes[1]) + + x$flipped_aes <- NULL + y$flipped_aes <- NULL + expect_identical(x, flip_data(y, TRUE)) +}) diff --git a/tests/testthat/test-geom-boxplot.R b/tests/testthat/test-geom-boxplot.R index 99ae3ab511..ca484f77cf 100644 --- a/tests/testthat/test-geom-boxplot.R +++ b/tests/testthat/test-geom-boxplot.R @@ -12,6 +12,22 @@ test_that("geom_boxplot range includes all outliers", { expect_true(maxy >= max(dat$y)) }) +test_that("geom_boxplot works in both directions", { + dat <- data_frame(x = 1, y = c(-(1:20) ^ 3, (1:20) ^ 3) ) + + p <- ggplot(dat, aes(x, y)) + geom_boxplot() + x <- layer_data(p) + expect_false(x$flipped_aes[1]) + + p <- ggplot(dat, aes(y, x)) + geom_boxplot() + y <- layer_data(p) + expect_true(y$flipped_aes[1]) + + x$flipped_aes <- NULL + y$flipped_aes <- NULL + expect_identical(x, flip_data(y, TRUE)) +}) + test_that("geom_boxplot for continuous x gives warning if more than one x (#992)", { dat <- expand.grid(x = 1:2, y = c(-(1:5) ^ 3, (1:5) ^ 3) ) diff --git a/tests/testthat/test-geom-col.R b/tests/testthat/test-geom-col.R index ed10be1883..7d8b0548f1 100644 --- a/tests/testthat/test-geom-col.R +++ b/tests/testthat/test-geom-col.R @@ -14,3 +14,19 @@ test_that("geom_col removes columns with parts outside the plot limits", { "Removed 1 rows containing missing values" ) }) + +test_that("geom_col works in both directions", { + dat <- data_frame(x = c("a", "b", "c"), y = c(1.2, 2.5, 3.1)) + + p <- ggplot(dat, aes(x, y)) + geom_col() + x <- layer_data(p) + expect_false(x$flipped_aes[1]) + + p <- ggplot(dat, aes(y, x)) + geom_col() + y <- layer_data(p) + expect_true(y$flipped_aes[1]) + + x$flipped_aes <- NULL + y$flipped_aes <- NULL + expect_identical(x, flip_data(y, TRUE)[,names(x)]) +}) diff --git a/tests/testthat/test-geom-ribbon.R b/tests/testthat/test-geom-ribbon.R index ecd0f9a40c..b8e01b7484 100644 --- a/tests/testthat/test-geom-ribbon.R +++ b/tests/testthat/test-geom-ribbon.R @@ -8,3 +8,21 @@ test_that("NAs are not dropped from the data", { expect_equal(layer_data(p)$ymin, c(0, 0, NA, 0, 0)) }) + +test_that("geom_ribbon works in both directions", { + dat <- data_frame(x = seq_len(5), + ymin = c(1, 2, 1.5, 1.8, 1), + ymax = c(4, 6, 5, 4.5, 5.2)) + + p <- ggplot(dat, aes(x, ymin = ymin, ymax = ymax)) + geom_ribbon() + x <- layer_data(p) + expect_false(x$flipped_aes[1]) + + p <- ggplot(dat, aes(y = x, xmin = ymin, xmax = ymax)) + geom_ribbon() + y <- layer_data(p) + expect_true(y$flipped_aes[1]) + + x$flipped_aes <- NULL + y$flipped_aes <- NULL + expect_identical(x, flip_data(y, TRUE)[,names(x)]) +}) diff --git a/tests/testthat/test-geom-smooth.R b/tests/testthat/test-geom-smooth.R index e84f8dae6a..14c00b8279 100644 --- a/tests/testthat/test-geom-smooth.R +++ b/tests/testthat/test-geom-smooth.R @@ -9,6 +9,20 @@ test_that("data is ordered by x", { expect_equal(layer_data(ps)[c("x", "y")], df[order(df$x), ]) }) +test_that("geom_smooth works in both directions", { + p <- ggplot(mpg, aes(displ, hwy)) + geom_smooth() + x <- layer_data(p) + expect_false(x$flipped_aes[1]) + + p <- ggplot(mpg, aes(hwy, displ)) + geom_smooth(orientation = "y") + y <- layer_data(p) + expect_true(y$flipped_aes[1]) + + x$flipped_aes <- NULL + y$flipped_aes <- NULL + expect_identical(x, flip_data(y, TRUE)[,names(x)]) +}) + test_that("default smoothing methods for small and large data sets work", { # test small data set set.seed(6531) diff --git a/tests/testthat/test-geom-violin.R b/tests/testthat/test-geom-violin.R index 4c4a3d10ff..1dd50a542c 100644 --- a/tests/testthat/test-geom-violin.R +++ b/tests/testthat/test-geom-violin.R @@ -16,6 +16,20 @@ test_that("range is expanded", { expect_equal(layer_scales(p, 2)$y$dimension(), c(0 - expand_b, 2 + expand_b)) }) +test_that("geom_violin works in both directions", { + p <- ggplot(mpg) + geom_violin(aes(drv, hwy)) + x <- layer_data(p) + expect_false(x$flipped_aes[1]) + + p <- ggplot(mpg) + geom_violin(aes(hwy, drv)) + y <- layer_data(p) + expect_true(y$flipped_aes[1]) + + x$flipped_aes <- NULL + y$flipped_aes <- NULL + expect_identical(x, flip_data(y, TRUE)[,names(x)]) +}) + # create_quantile_segment_frame ------------------------------------------------- test_that("create_quantile_segment_frame functions for 3 quantiles", { diff --git a/tests/testthat/test-stat-bin.R b/tests/testthat/test-stat-bin.R index c76520a4c6..818bb41135 100644 --- a/tests/testthat/test-stat-bin.R +++ b/tests/testthat/test-stat-bin.R @@ -4,7 +4,7 @@ test_that("stat_bin throws error when y aesthetic is present", { dat <- data_frame(x = c("a", "b", "c"), y = c(1, 5, 10)) expect_error(ggplot_build(ggplot(dat, aes(x, y)) + stat_bin()), - "must not be used with a y aesthetic.") + "can only have an x or y aesthetic.") expect_error( ggplot_build(ggplot(dat, aes(x)) + stat_bin(y = 5)), @@ -12,6 +12,20 @@ test_that("stat_bin throws error when y aesthetic is present", { ) }) +test_that("stat_bin works in both directions", { + p <- ggplot(mpg, aes(hwy)) + stat_bin() + x <- layer_data(p) + expect_false(x$flipped_aes[1]) + + p <- ggplot(mpg, aes(y = hwy)) + stat_bin() + y <- layer_data(p) + expect_true(y$flipped_aes[1]) + + x$flipped_aes <- NULL + y$flipped_aes <- NULL + expect_identical(x, flip_data(y, TRUE)[,names(x)]) +}) + test_that("bins specifies the number of bins", { df <- data_frame(x = 1:10) out <- function(x, ...) { @@ -144,7 +158,7 @@ test_that("stat_count throws error when y aesthetic present", { expect_error( ggplot_build(ggplot(dat, aes(x, y)) + stat_count()), - "must not be used with a y aesthetic.") + "can only have an x or y aesthetic.") expect_error( ggplot_build(ggplot(dat, aes(x)) + stat_count(y = 5)), diff --git a/tests/testthat/test-stat-density.R b/tests/testthat/test-stat-density.R index 9c4791e337..4a26927a0c 100644 --- a/tests/testthat/test-stat-density.R +++ b/tests/testthat/test-stat-density.R @@ -5,6 +5,20 @@ test_that("compute_density succeeds when variance is zero", { expect_equal(dens$n, rep(10, 512)) }) +test_that("stat_density works in both directions", { + p <- ggplot(mpg, aes(hwy)) + stat_density() + x <- layer_data(p) + expect_false(x$flipped_aes[1]) + + p <- ggplot(mpg, aes(y = hwy)) + stat_density() + y <- layer_data(p) + expect_true(y$flipped_aes[1]) + + x$flipped_aes <- NULL + y$flipped_aes <- NULL + expect_identical(x, flip_data(y, TRUE)[,names(x)]) +}) + test_that("compute_density returns useful df and throws warning when <2 values", { expect_warning(dens <- compute_density(1, NULL, from = 0, to = 0)) diff --git a/tests/testthat/test-stats.r b/tests/testthat/test-stats.r index 2374b9ee57..019d752fde 100644 --- a/tests/testthat/test-stats.r +++ b/tests/testthat/test-stats.r @@ -13,6 +13,6 @@ test_that("plot succeeds even if some computation fails", { }) test_that("error message is thrown when aesthetics are missing", { - p <- ggplot(mtcars) + stat_bin() - expect_error(ggplot_build(p), "x$") + p <- ggplot(mtcars) + stat_sum() + expect_error(ggplot_build(p), "x, y$") }) diff --git a/vignettes/extending-ggplot2.Rmd b/vignettes/extending-ggplot2.Rmd index a90aea4fb2..6719ee2639 100644 --- a/vignettes/extending-ggplot2.Rmd +++ b/vignettes/extending-ggplot2.Rmd @@ -489,6 +489,52 @@ This doesn't allow you to use different geoms with the stat, but that seems appr 1. Compare and contrast `GeomPolygon` with `GeomSimplePolygon`. +## Geoms and Stats with multiple orientation +Some layers have a specific orientation. `geom_bar()` e.g. have the bars along one axis, `geom_line()` will sort the input by one axis, etc. The original approach to using these geoms in the other orientation was to add `coord_flip()` to the plot to switch the position of the x and y axes. Following ggplot2 v3.3 all the geoms will natively work in both orientations without `coord_flip()`. The mechanism is that the layer will try to guess the orientation from the mapped data, or take direction from the user using the `orientation` parameter. To replicate this functionality in new stats and geoms there's a few steps to take. We wll look at the boxplot layer as an example instead of creating a new from scratch. + +### Omnidirectional stats +The actual guessing of orientation will happen in `setup_params()` using the `has_flipped_aes()` helper: + +```{r} +StatBoxplot$setup_params +``` + +Following this is a call to `flip_data()` which will make sure the data is in horizontal orientation. The rest of the code can then simply assume that the data is in a specific orientation. The same thing happens in `setup_data()`: + +```{r} +StatBoxplot$setup_data +``` + +The data is flipped (if needed), manipulated, and flipped back as it is returned. + +During the computation, this sandwiching between `flip_data()` is used as well, but right before the data is returned it will also get a `flipped_aes` column denoting if the data is flipped or not. This allow the +stat to communicate to the geom that orientation has already been determined. + +### Omnidirecitonal geoms +The setup for geoms is pretty much the same, with a few twists. `has_flipped_aes()` is also used in `setup_params()`, where it will usually be picked up from the `flipped_aes` column given by the stat. In `setup_data()` you will often see that `flipped_aes` is reassigned, to make sure it exist prior to position adjustment. This is needed if the geom is used together with a stat that doesn't handle orientation (often `stat_identity()`): + +```{r} +GeomBoxplot$setup_data +``` + +In the `draw_*()` method you will once again sandwich any data manipulation between `flip_data()` calls. It is important to make sure that the data is flipped back prior to creating the grob or calling draw methods from other geoms. + +### Dealing with required aesthetics +Omnidirectional layers usually have two different sets of required aesthetics. Which set is used is often how it knows the orientation. To handle this gracefully the `required_aes` field of `Stat` and `Geom` classes understands the `|` (or) operator. Looking at `GeomBoxplot` we can see how it is used: + +```{r} +GeomBoxplot$required_aes +``` + +This tells ggplot2 that either all the aesthetics before `|` are required or all the aesthetics after are required. + +### Ambiguous layers +Some layers will not have a clear interpretation of their data in terms of orientation. A classic example is `geom_line()` which just by convention runs along the x-axis. There is nothing in the data itself that indicates that. For these geoms the user must indicate a flipped orientation by setting `orientation = "y"`. The stat or geom will then call `has_flipped_aes()` with `ambiguous = TRUE` to cancel any guessing based on data format. As an example we can see the `setup_params()` method of `GeomLine`: + +```{r} +GeomLine$setup_params +``` + ## Creating your own theme If you're going to create your own complete theme, there are a few things you need to know: