From 676f596036e30a97669917e4b799af0776190ec3 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 28 Aug 2019 09:20:41 +0200 Subject: [PATCH 01/49] cursory study on geom_bar and geom_histogram --- R/bin.R | 19 +++++++++++-------- R/geom-bar.r | 20 ++++++++++++++++---- R/stat-bin.r | 31 ++++++++++++++++++------------- R/stat-count.r | 23 +++++++++++++++-------- 4 files changed, 60 insertions(+), 33 deletions(-) diff --git a/R/bin.R b/R/bin.R index 55d898c846..c0832c2adc 100644 --- a/R/bin.R +++ b/R/bin.R @@ -118,11 +118,11 @@ bin_breaks_bins <- function(x_range, bins = 30, center = NULL, # Compute bins ------------------------------------------------------------ -bin_vector <- function(x, bins, weight = NULL, pad = FALSE) { +bin_vector <- function(x, bins, weight = NULL, pad = FALSE, main_aes = "x") { stopifnot(is_bins(bins)) if (all(is.na(x))) { - return(bin_out(length(x), NA, NA, xmin = NA, xmax = NA)) + return(bin_out(length(x), NA, NA, min = NA, max = NA, main_aes = main_aes)) } if (is.null(weight)) { @@ -157,21 +157,24 @@ bin_vector <- function(x, bins, weight = NULL, pad = FALSE) { bin_x <- c(bin_x, NA) } - bin_out(bin_count, bin_x, bin_widths) + bin_out(bin_count, bin_x, bin_widths, main_aes = main_aes) } bin_out <- function(count = integer(0), x = numeric(0), width = numeric(0), - xmin = x - width / 2, xmax = x + width / 2) { + min = x - width / 2, max = x + width / 2, main_aes = "x") { density <- count / width / sum(abs(count)) - new_data_frame(list( + bins <- new_data_frame(list( count = count, x = x, - xmin = xmin, - xmax = xmax, + xmin = min, + xmax = max, width = width, density = density, ncount = count / max(abs(count)), - ndensity = density / max(abs(density)) + ndensity = density / max(abs(density)), + main_aes = main_aes ), n = length(count)) + names(bins)[c(2, 3, 4)] <- paste0(main_aes, c('', 'min', 'max')) + bins } diff --git a/R/geom-bar.r b/R/geom-bar.r index 91d1767f3e..74d82422fb 100644 --- a/R/geom-bar.r +++ b/R/geom-bar.r @@ -118,11 +118,18 @@ GeomBar <- ggproto("GeomBar", GeomRect, non_missing_aes = c("xmin", "xmax", "ymin", "ymax"), setup_data = function(data, params) { + params$main_aes <- detect_direction(data) 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 + params$width %||% (resolution(data[[params$main_aes]], FALSE) * 0.9) + switch(params$main_aes, + x = transform(data, + ymin = pmin(y, 0), ymax = pmax(y, 0), + xmin = x - width / 2, xmax = x + width / 2, width = NULL + ), + y = transform(data, + xmin = pmin(x, 0), xmax = pmax(x, 0), + ymin = y - width / 2, ymax = y + width / 2, width = NULL + ) ) }, @@ -131,3 +138,8 @@ GeomBar <- ggproto("GeomBar", GeomRect, ggproto_parent(GeomRect, self)$draw_panel(data, panel_params, coord) } ) + +detect_direction <- function(data) { + if (!is.null(data$main_aes)) return(data$main_aes[1]) + if (any(c("ymin", "ymax") %in% names(data))) "y" else "x" +} diff --git a/R/stat-bin.r b/R/stat-bin.r index 591034bbfb..003f1679b8 100644 --- a/R/stat-bin.r +++ b/R/stat-bin.r @@ -82,11 +82,17 @@ 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$main_aes <- "x" + if (is.null(data$x) && is.null(params$x)) { + if (is.null(data$y) && is.null(params$y)) { + stop("stat_bin() requires either an x or y aesthetic.", call. = FALSE) + } else { + params$main_aes <- "y" + } } - if (is.integer(data$x)) { - stop('StatBin requires a continuous x variable: the x variable is discrete. Perhaps you want stat="count"?', + if (is.integer(data[[params$main_aes]])) { + stop('StatBin requires a continuous ', params$main_aes, ' variable: the ', + params$main_aes, ' variable is discrete. Perhaps you want stat="count"?', call. = FALSE) } @@ -122,31 +128,30 @@ StatBin <- ggproto("StatBin", Stat, compute_group = function(data, scales, binwidth = NULL, bins = NULL, center = NULL, boundary = NULL, closed = c("right", "left"), pad = FALSE, - breaks = NULL, + breaks = NULL, main_aes = 'x', # The following arguments are not used, but must # be listed so parameters are computed correctly origin = NULL, right = NULL, drop = NULL, width = NULL) { if (!is.null(breaks)) { - if (!scales$x$is_discrete()){ - breaks <- scales$x$transform(breaks) + if (!scales[[main_aes]]$is_discrete()) { + breaks <- scales[[main_aes]]$transform(breaks) } bins <- bin_breaks(breaks, closed) } else if (!is.null(binwidth)) { if (is.function(binwidth)) { - binwidth <- binwidth(data$x) + binwidth <- binwidth(data[[main_aes]]) } - bins <- bin_breaks_width(scales$x$dimension(), binwidth, + bins <- bin_breaks_width(scales[[main_aes]]$dimension(), binwidth, center = center, boundary = boundary, closed = closed) } else { - bins <- bin_breaks_bins(scales$x$dimension(), bins, center = center, + bins <- bin_breaks_bins(scales[[main_aes]]$dimension(), bins, center = center, boundary = boundary, closed = closed) } - bin_vector(data$x, bins, weight = data$weight, pad = pad) + bin_vector(data[[main_aes]], bins, weight = data$weight, pad = pad, main_aes = main_aes) }, - default_aes = aes(y = stat(count), weight = 1), - required_aes = c("x") + default_aes = aes(x = stat(count), y = stat(count), weight = 1) ) diff --git a/R/stat-count.r b/R/stat-count.r index c08381d8c7..43b4993c70 100644 --- a/R/stat-count.r +++ b/R/stat-count.r @@ -46,29 +46,36 @@ 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), + 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$main_aes <- "x" + if (is.null(data$x) && is.null(params$x)) { + if (is.null(data$y) && is.null(params$y)) { + stop("stat_bin() requires either an x or y aesthetic.", call. = FALSE) + } else { + params$main_aes <- "y" + } } params }, - compute_group = function(self, data, scales, width = NULL) { - x <- data$x + compute_group = function(self, data, scales, width = NULL, main_aes = "x") { + x <- data[[main_aes]] weight <- data$weight %||% rep(1, length(x)) width <- width %||% (resolution(x) * 0.9) 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, + main_aes = main_aes ), n = length(count)) + names(bars)[3] <- main_aes + bars } ) From 35514a78cd12e85039cb73f6127f6e40b1e3960d Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 28 Aug 2019 10:10:53 +0200 Subject: [PATCH 02/49] Make direction detection much more granualated --- R/geom-bar.r | 36 +++++++++++++++++++++++++++++++++++- 1 file changed, 35 insertions(+), 1 deletion(-) diff --git a/R/geom-bar.r b/R/geom-bar.r index 74d82422fb..cb25fa9d70 100644 --- a/R/geom-bar.r +++ b/R/geom-bar.r @@ -141,5 +141,39 @@ GeomBar <- ggproto("GeomBar", GeomRect, detect_direction <- function(data) { if (!is.null(data$main_aes)) return(data$main_aes[1]) - if (any(c("ymin", "ymax") %in% names(data))) "y" else "x" + + if (any(c("ymin", "ymax") %in% names(data))) { + return("y") + } + if (any(c("ymin", "ymax") %in% names(data))) { + return("x") + } + y_is_int <- all(data$y == round(data$y)) + x_is_int <- all(data$x == round(data$x)) + if (xor(y_is_int, x_is_int)) { + if (x_is_int) { + return("x") + } else { + return("y") + } + } + y_diff <- diff(unique(sort(data$y))) + x_diff <- diff(unique(sort(data$x))) + if (y_is_int && x_is_int) { + if (sum(x_diff == 1) >= sum(y_diff == 1)) { + return("x") + } else { + return("y") + } + } + y_is_regular <- all((y_diff / min(y_diff)) %% 1 < .Machine$double.eps) + x_is_regular <- all((x_diff / min(x_diff)) %% 1 < .Machine$double.eps) + if (xor(y_is_regular, x_is_regular)) { + if (x_is_regular) { + return("x") + } else { + return("y") + } + } + "x" } From 9902e68834a3198788beb59955f92d8a862149f4 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 28 Aug 2019 10:11:25 +0200 Subject: [PATCH 03/49] fix geom_col... There are some ambiguities here that should get discussed --- R/geom-col.r | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/R/geom-col.r b/R/geom-col.r index 7ebd51f8fc..cf9c3b36e8 100644 --- a/R/geom-col.r +++ b/R/geom-col.r @@ -38,11 +38,18 @@ GeomCol <- ggproto("GeomCol", GeomRect, non_missing_aes = c("xmin", "xmax", "ymin", "ymax"), setup_data = function(data, params) { + params$main_aes <- detect_direction(data) 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 + params$width %||% (resolution(data[[params$main_aes]], FALSE) * 0.9) + switch(params$main_aes, + x = transform(data, + ymin = pmin(y, 0), ymax = pmax(y, 0), + xmin = x - width / 2, xmax = x + width / 2, width = NULL + ), + y = transform(data, + xmin = pmin(x, 0), xmax = pmax(x, 0), + ymin = y - width / 2, ymax = y + width / 2, width = NULL + ) ) }, From 697f9a6912bc25ef601f4c1ee9467129def5d626 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 28 Aug 2019 12:19:17 +0200 Subject: [PATCH 04/49] refine direction detection --- R/geom-bar.r | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/R/geom-bar.r b/R/geom-bar.r index cb25fa9d70..cb16e8fc97 100644 --- a/R/geom-bar.r +++ b/R/geom-bar.r @@ -143,10 +143,18 @@ detect_direction <- function(data) { if (!is.null(data$main_aes)) return(data$main_aes[1]) if (any(c("ymin", "ymax") %in% names(data))) { - return("y") + if ("y" %in% names(data)) { + return("y") + } else { + return("x") + } } - if (any(c("ymin", "ymax") %in% names(data))) { - return("x") + if (any(c("xmin", "xmax") %in% names(data))) { + if ("x" %in% names(data)) { + return("x") + } else { + return("y") + } } y_is_int <- all(data$y == round(data$y)) x_is_int <- all(data$x == round(data$x)) From 0a8c8cfe17bd19b62ca70cb7cb7545b899cfe8bd Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 28 Aug 2019 12:19:38 +0200 Subject: [PATCH 05/49] add geom_ribbon, geom_area, and geom_density --- R/geom-ribbon.r | 49 +++++++++++++++++++++++++++++++++--------------- R/stat-density.r | 40 +++++++++++++++++++++++++++------------ 2 files changed, 62 insertions(+), 27 deletions(-) diff --git a/R/geom-ribbon.r b/R/geom-ribbon.r index 17df0ed118..9b85393c23 100644 --- a/R/geom-ribbon.r +++ b/R/geom-ribbon.r @@ -58,17 +58,23 @@ geom_ribbon <- function(mapping = NULL, data = NULL, #' @usage NULL #' @export GeomRibbon <- ggproto("GeomRibbon", Geom, - default_aes = aes(colour = NA, fill = "grey20", size = 0.5, linetype = 1, - alpha = NA), + default_aes = aes(x = NULL, xmin = NULL, xmax = NULL, y = NULL, ymin = NULL, + ymax = NULL, colour = NA, fill = "grey20", size = 0.5, + linetype = 1, alpha = NA), - required_aes = c("x", "ymin", "ymax"), + #required_aes = c("x", "ymin", "ymax"), setup_data = function(data, params) { - if (is.null(data$ymin) && is.null(data$ymax)) { - stop("Either ymin or ymax must be given as an aesthetic.", call. = FALSE) + data$main_aes <- detect_direction(data) + sub_aes <- if (data$main_aes[1] == "x") "y" else "x" + min <- paste0(sub_aes, "min") + max <- paste0(sub_aes, "max") + + if (is.null(data[[min]]) && is.null(data[[max]])) { + stop("Either ", min, " or ", max, " 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 <- data[order(data$PANEL, data$group, data[[data$main_aes[1]]]), , drop = FALSE] + data[[sub_aes]] <- data[[min]] %||% data[[max]] data }, @@ -79,7 +85,9 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, }, draw_group = function(data, panel_params, coord, na.rm = FALSE) { - if (na.rm) data <- data[stats::complete.cases(data[c("x", "ymin", "ymax")]), ] + main_aes <- data$main_aes[1] + aes_def <- if (main_aes == "x") c("x", "ymin", "ymax") else c("y", "xmin", "xmax") + if (na.rm) data <- data[stats::complete.cases(data[aes_def]), ] data <- data[order(data$group), ] # Check that aesthetics are constant @@ -96,16 +104,23 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, # has distinct polygon numbers for sequences of non-NA values and NA # for NA values in the original data. Example: c(NA, 2, 2, 2, NA, NA, # 4, 4, 4, NA) - missing_pos <- !stats::complete.cases(data[c("x", "ymin", "ymax")]) + missing_pos <- !stats::complete.cases(data[aes_def]) ids <- cumsum(missing_pos) + 1 ids[missing_pos] <- NA data <- unclass(data) #for faster indexing - positions <- new_data_frame(list( - x = c(data$x, rev(data$x)), - y = c(data$ymax, rev(data$ymin)), - id = c(ids, rev(ids)) - )) + positions <- switch(main_aes, + x = new_data_frame(list( + x = c(data$x, rev(data$x)), + y = c(data$ymax, rev(data$ymin)), + id = c(ids, rev(ids)) + )), + y = new_data_frame(list( + x = c(data$xmax, rev(data$xmin)), + y = c(data$y, rev(data$y)), + id = c(ids, rev(ids)) + )) + ) munched <- coord_munch(coord, positions, panel_params) ggname("geom_ribbon", polygonGrob( @@ -151,6 +166,10 @@ GeomArea <- ggproto("GeomArea", GeomRibbon, required_aes = c("x", "y"), setup_data = function(data, params) { - transform(data[order(data$PANEL, data$group, data$x), ], ymin = 0, ymax = y) + data$main_aes <- detect_direction(data) + switch(data$main_aes[1], + x = transform(data[order(data$PANEL, data$group, data$x), ], ymin = 0, ymax = y), + y = transform(data[order(data$PANEL, data$group, data$y), ], xmin = 0, xmax = x) + ) } ) diff --git a/R/stat-density.r b/R/stat-density.r index 6d18b8bb12..6a34466c7f 100644 --- a/R/stat-density.r +++ b/R/stat-density.r @@ -63,25 +63,36 @@ 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), + default_aes = aes(x = stat(density), y = stat(density), fill = NA, weight = NULL), + + setup_params = function(data, params) { + params$main_aes <- "x" + if (is.null(data$x) && is.null(params$x)) { + if (is.null(data$y) && is.null(params$y)) { + stop("stat_bin() requires either an x or y aesthetic.", call. = FALSE) + } else { + params$main_aes <- "y" + } + } + params + }, 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, main_aes = "x") { if (trim) { - range <- range(data$x, na.rm = TRUE) + range <- range(data[[main_aes]], na.rm = TRUE) } else { - range <- scales$x$dimension() + range <- scales[[main_aes]]$dimension() } - compute_density(data$x, data$weight, from = range[1], to = range[2], - bw = bw, adjust = adjust, kernel = kernel, n = n) + compute_density(data[[main_aes]], data$weight, from = range[1], to = range[2], + bw = bw, adjust = adjust, kernel = kernel, n = n, main_aes = main_aes) } ) compute_density <- function(x, w, from, to, bw = "nrd0", adjust = 1, - kernel = "gaussian", n = 512) { + kernel = "gaussian", n = 512, main_aes = "x") { nx <- length(x) if (is.null(w)) { w <- rep(1 / nx, nx) @@ -92,25 +103,30 @@ compute_density <- function(x, w, from, to, bw = "nrd0", adjust = 1, # if less than 2 points return data frame of NAs and a warning if (nx < 2) { warning("Groups with fewer than two data points have been dropped.", call. = FALSE) - return(new_data_frame(list( + density <- new_data_frame(list( x = NA_real_, density = NA_real_, scaled = NA_real_, ndensity = NA_real_, count = NA_real_, n = NA_integer_ - ), n = 1)) + ), n = 1) + names(density)[1] <- main_aes + return(density) } dens <- stats::density(x, weights = w, bw = bw, adjust = adjust, kernel = kernel, n = n, from = from, to = to) - new_data_frame(list( + density <- new_data_frame(list( x = dens$x, density = dens$y, scaled = dens$y / max(dens$y, na.rm = TRUE), ndensity = dens$y / max(dens$y, na.rm = TRUE), count = dens$y * nx, - n = nx + n = nx, + main_aes = main_aes ), n = length(dens$x)) + names(density)[1] <- main_aes + return(density) } From fd3fa77a49210cfbfe61033c11b53163261743d9 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 28 Aug 2019 14:57:15 +0200 Subject: [PATCH 06/49] Add errorbar --- R/geom-errorbar.r | 36 ++++++++++++++++++++++++++++-------- 1 file changed, 28 insertions(+), 8 deletions(-) diff --git a/R/geom-errorbar.r b/R/geom-errorbar.r index 9c0a4361c2..ee2af288cc 100644 --- a/R/geom-errorbar.r +++ b/R/geom-errorbar.r @@ -26,26 +26,46 @@ geom_errorbar <- function(mapping = NULL, data = NULL, #' @usage NULL #' @export GeomErrorbar <- ggproto("GeomErrorbar", Geom, - default_aes = aes(colour = "black", size = 0.5, linetype = 1, width = 0.5, + default_aes = aes(x = NULL, y = NULL, xmin = NULL, xmax = NULL, ymin = NULL, + ymax = NULL, colour = "black", size = 0.5, linetype = 1, width = 0.5, alpha = NA), draw_key = draw_key_path, - required_aes = c("x", "ymin", "ymax"), - setup_data = function(data, params) { + if (all(c("y", "xmin", "xmax") %in% names(data))) { + main_aes <- "y" + } else if (all(c("x", "ymin", "ymax") %in% names(data))) { + main_aes <- "x" + } else { + stop("Either, `x`, `ymin`, and `ymax` or `y`, `xmin`, and `xmax` must be supplied", call. = FALSE) + } + data$main_aes <- main_aes data$width <- data$width %||% - params$width %||% (resolution(data$x, FALSE) * 0.9) + params$width %||% (resolution(data[[main_aes]], FALSE) * 0.9) - transform(data, - xmin = x - width / 2, xmax = x + width / 2, width = NULL + switch(main_aes, + x = transform(data, + xmin = x - width / 2, xmax = x + width / 2, width = NULL + ), + y = transform(data, + ymin = y - width / 2, ymax = y + width / 2, width = NULL + ) ) + }, draw_panel = function(data, panel_params, coord, width = NULL) { + if (data$main_aes[1] == "x") { + 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)) + } else { + x = as.vector(rbind(data$xmax, data$xmax, NA, data$xmax, data$xmin, NA, data$xmin, data$xmin)) + y = as.vector(rbind(data$ymin, data$ymax, NA, data$y, data$y, NA, data$ymin, data$ymax)) + } 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)), + x = x, + y = y, colour = rep(data$colour, each = 8), alpha = rep(data$alpha, each = 8), size = rep(data$size, each = 8), From 771042aaaf4a337492e3371b415eb35426e9905d Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Thu, 29 Aug 2019 08:35:26 +0200 Subject: [PATCH 07/49] Fix warning --- R/stat-count.r | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/stat-count.r b/R/stat-count.r index 43b4993c70..6901ff3fa7 100644 --- a/R/stat-count.r +++ b/R/stat-count.r @@ -52,7 +52,7 @@ StatCount <- ggproto("StatCount", Stat, params$main_aes <- "x" if (is.null(data$x) && is.null(params$x)) { if (is.null(data$y) && is.null(params$y)) { - stop("stat_bin() requires either an x or y aesthetic.", call. = FALSE) + stop("stat_count() requires either an x or y aesthetic.", call. = FALSE) } else { params$main_aes <- "y" } From a1bc13624254810975ffec1d222d87e8caf093f4 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Thu, 29 Aug 2019 09:03:28 +0200 Subject: [PATCH 08/49] Add crossbar --- R/geom-crossbar.r | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/R/geom-crossbar.r b/R/geom-crossbar.r index 0a901133d7..92b6c114d1 100644 --- a/R/geom-crossbar.r +++ b/R/geom-crossbar.r @@ -32,14 +32,20 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom, GeomErrorbar$setup_data(data, params) }, - default_aes = aes(colour = "black", fill = NA, size = 0.5, linetype = 1, + default_aes = aes(x = NULL, y = NULL, xmin = NULL, xmax = NULL, ymin = NULL, + ymax = NULL, colour = "black", fill = NA, size = 0.5, linetype = 1, alpha = NA), - required_aes = c("x", "y", "ymin", "ymax"), - draw_key = draw_key_crossbar, draw_panel = function(data, panel_params, coord, fatten = 2.5, width = NULL) { + main_aes <- data$main_aes[1] %||% "x" + if (main_aes == "y") { + data <- transform(data, x = y, y = x, xmin = ymin, ymin = xmin, xmax = ymax, ymax = xmax) + if (!is.null(data$xnotchlower) && !is.null(data$xnotchupper)) { + data <- transform(data, ynotchlower = xnotchlower, ynotchupper = xnotchupper) + } + } 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,7 +91,10 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom, group = rep(seq_len(nrow(data)), 5) # each bar forms it's own group )) } - + if (main_aes == "y") { + box <- transform(box, x = y, y = x) + middle <- transform(middle, x = y, xend = yend, y = x, yend = xend) + } ggname("geom_crossbar", gTree(children = gList( GeomPolygon$draw_panel(box, panel_params, coord), GeomSegment$draw_panel(middle, panel_params, coord) From 15298523d87721fcb8ebd607a9a43d2dff184a76 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Thu, 29 Aug 2019 10:29:51 +0200 Subject: [PATCH 09/49] clean up --- R/bin.R | 15 +++++------ R/geom-bar.r | 47 --------------------------------- R/geom-ribbon.r | 41 ++++++++++++----------------- R/stat-bin.r | 5 +++- R/stat-density.r | 17 ++++++------ R/utilities.r | 68 ++++++++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 103 insertions(+), 90 deletions(-) diff --git a/R/bin.R b/R/bin.R index c0832c2adc..8ce9a9d8ac 100644 --- a/R/bin.R +++ b/R/bin.R @@ -118,11 +118,11 @@ bin_breaks_bins <- function(x_range, bins = 30, center = NULL, # Compute bins ------------------------------------------------------------ -bin_vector <- function(x, bins, weight = NULL, pad = FALSE, main_aes = "x") { +bin_vector <- function(x, bins, weight = NULL, pad = FALSE) { stopifnot(is_bins(bins)) if (all(is.na(x))) { - return(bin_out(length(x), NA, NA, min = NA, max = NA, main_aes = main_aes)) + return(bin_out(length(x), NA, NA, min = NA, max = NA)) } if (is.null(weight)) { @@ -157,14 +157,14 @@ bin_vector <- function(x, bins, weight = NULL, pad = FALSE, main_aes = "x") { bin_x <- c(bin_x, NA) } - bin_out(bin_count, bin_x, bin_widths, main_aes = main_aes) + bin_out(bin_count, bin_x, bin_widths) } bin_out <- function(count = integer(0), x = numeric(0), width = numeric(0), - min = x - width / 2, max = x + width / 2, main_aes = "x") { + min = x - width / 2, max = x + width / 2) { density <- count / width / sum(abs(count)) - bins <- new_data_frame(list( + new_data_frame(list( count = count, x = x, xmin = min, @@ -172,9 +172,6 @@ bin_out <- function(count = integer(0), x = numeric(0), width = numeric(0), width = width, density = density, ncount = count / max(abs(count)), - ndensity = density / max(abs(density)), - main_aes = main_aes + ndensity = density / max(abs(density)) ), n = length(count)) - names(bins)[c(2, 3, 4)] <- paste0(main_aes, c('', 'min', 'max')) - bins } diff --git a/R/geom-bar.r b/R/geom-bar.r index cb16e8fc97..f34881770c 100644 --- a/R/geom-bar.r +++ b/R/geom-bar.r @@ -138,50 +138,3 @@ GeomBar <- ggproto("GeomBar", GeomRect, ggproto_parent(GeomRect, self)$draw_panel(data, panel_params, coord) } ) - -detect_direction <- function(data) { - if (!is.null(data$main_aes)) return(data$main_aes[1]) - - if (any(c("ymin", "ymax") %in% names(data))) { - if ("y" %in% names(data)) { - return("y") - } else { - return("x") - } - } - if (any(c("xmin", "xmax") %in% names(data))) { - if ("x" %in% names(data)) { - return("x") - } else { - return("y") - } - } - y_is_int <- all(data$y == round(data$y)) - x_is_int <- all(data$x == round(data$x)) - if (xor(y_is_int, x_is_int)) { - if (x_is_int) { - return("x") - } else { - return("y") - } - } - y_diff <- diff(unique(sort(data$y))) - x_diff <- diff(unique(sort(data$x))) - if (y_is_int && x_is_int) { - if (sum(x_diff == 1) >= sum(y_diff == 1)) { - return("x") - } else { - return("y") - } - } - y_is_regular <- all((y_diff / min(y_diff)) %% 1 < .Machine$double.eps) - x_is_regular <- all((x_diff / min(x_diff)) %% 1 < .Machine$double.eps) - if (xor(y_is_regular, x_is_regular)) { - if (x_is_regular) { - return("x") - } else { - return("y") - } - } - "x" -} diff --git a/R/geom-ribbon.r b/R/geom-ribbon.r index 9b85393c23..bccce905bd 100644 --- a/R/geom-ribbon.r +++ b/R/geom-ribbon.r @@ -62,19 +62,16 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, ymax = NULL, colour = NA, fill = "grey20", size = 0.5, linetype = 1, alpha = NA), - #required_aes = c("x", "ymin", "ymax"), - setup_data = function(data, params) { data$main_aes <- detect_direction(data) - sub_aes <- if (data$main_aes[1] == "x") "y" else "x" - min <- paste0(sub_aes, "min") - max <- paste0(sub_aes, "max") + vars <- c(main = "x", sub = "y", min = "ymin", max = "ymax") + if (data$main_aes[1] == "x") vars <- switch_position(vars) - if (is.null(data[[min]]) && is.null(data[[max]])) { - stop("Either ", min, " or ", max, " must be given as an aesthetic.", call. = FALSE) + if (is.null(data[[vars["min"]]]) && is.null(data[[vars["max"]]])) { + stop("Either ", vars["min"], " or ", vars["max"], " must be given as an aesthetic.", call. = FALSE) } - data <- data[order(data$PANEL, data$group, data[[data$main_aes[1]]]), , drop = FALSE] - data[[sub_aes]] <- data[[min]] %||% data[[max]] + data <- data[order(data$PANEL, data$group, data[[vars["main"]]]), , drop = FALSE] + data[[vars["sub"]]] <- data[[vars["min"]]] %||% data[[vars["max"]]] data }, @@ -86,8 +83,8 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, draw_group = function(data, panel_params, coord, na.rm = FALSE) { main_aes <- data$main_aes[1] - aes_def <- if (main_aes == "x") c("x", "ymin", "ymax") else c("y", "xmin", "xmax") - if (na.rm) data <- data[stats::complete.cases(data[aes_def]), ] + if (main_aes == "y") names(data) <- switch_position(names(data)) + if (na.rm) data <- data[stats::complete.cases(data[c("x", "ymin", "ymax")]), ] data <- data[order(data$group), ] # Check that aesthetics are constant @@ -104,23 +101,19 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, # has distinct polygon numbers for sequences of non-NA values and NA # for NA values in the original data. Example: c(NA, 2, 2, 2, NA, NA, # 4, 4, 4, NA) - missing_pos <- !stats::complete.cases(data[aes_def]) + missing_pos <- !stats::complete.cases(data[c("x", "ymin", "ymax")]) ids <- cumsum(missing_pos) + 1 ids[missing_pos] <- NA data <- unclass(data) #for faster indexing - positions <- switch(main_aes, - x = new_data_frame(list( - x = c(data$x, rev(data$x)), - y = c(data$ymax, rev(data$ymin)), - id = c(ids, rev(ids)) - )), - y = new_data_frame(list( - x = c(data$xmax, rev(data$xmin)), - y = c(data$y, rev(data$y)), - id = c(ids, rev(ids)) - )) - ) + positions <- new_data_frame(list( + x = c(data$x, rev(data$x)), + y = c(data$ymax, rev(data$ymin)), + id = c(ids, rev(ids)) + )) + + if (main_aes == "y") names(positions) <- switch_position(names(positions)) + munched <- coord_munch(coord, positions, panel_params) ggname("geom_ribbon", polygonGrob( diff --git a/R/stat-bin.r b/R/stat-bin.r index 003f1679b8..6a9b315a76 100644 --- a/R/stat-bin.r +++ b/R/stat-bin.r @@ -149,7 +149,10 @@ StatBin <- ggproto("StatBin", Stat, bins <- bin_breaks_bins(scales[[main_aes]]$dimension(), bins, center = center, boundary = boundary, closed = closed) } - bin_vector(data[[main_aes]], bins, weight = data$weight, pad = pad, main_aes = main_aes) + bins <- bin_vector(data[[main_aes]], bins, weight = data$weight, pad = pad) + bins$main_aes <- main_aes + if (main_aes == "y") names(bins) <- switch_position(names(bins)) + bins }, default_aes = aes(x = stat(count), y = stat(count), weight = 1) diff --git a/R/stat-density.r b/R/stat-density.r index 6a34466c7f..1c2fcff197 100644 --- a/R/stat-density.r +++ b/R/stat-density.r @@ -85,14 +85,17 @@ StatDensity <- ggproto("StatDensity", Stat, range <- scales[[main_aes]]$dimension() } - compute_density(data[[main_aes]], data$weight, from = range[1], to = range[2], - bw = bw, adjust = adjust, kernel = kernel, n = n, main_aes = main_aes) + density <- compute_density(data[[main_aes]], data$weight, from = range[1], + to = range[2], bw = bw, adjust = adjust, kernel = kernel, n = n) + density$main_aes <- main_aes + if (main_aes == "y") names(density) <- switch_position(names(density)) + density } ) compute_density <- function(x, w, from, to, bw = "nrd0", adjust = 1, - kernel = "gaussian", n = 512, main_aes = "x") { + kernel = "gaussian", n = 512) { nx <- length(x) if (is.null(w)) { w <- rep(1 / nx, nx) @@ -111,22 +114,18 @@ compute_density <- function(x, w, from, to, bw = "nrd0", adjust = 1, count = NA_real_, n = NA_integer_ ), n = 1) - names(density)[1] <- main_aes return(density) } dens <- stats::density(x, weights = w, bw = bw, adjust = adjust, kernel = kernel, n = n, from = from, to = to) - density <- new_data_frame(list( + new_data_frame(list( x = dens$x, density = dens$y, scaled = dens$y / max(dens$y, na.rm = TRUE), ndensity = dens$y / max(dens$y, na.rm = TRUE), count = dens$y * nx, - n = nx, - main_aes = main_aes + n = nx ), n = length(dens$x)) - names(density)[1] <- main_aes - return(density) } diff --git a/R/utilities.r b/R/utilities.r index 6336ace4b8..839e18d5fd 100644 --- a/R/utilities.r +++ b/R/utilities.r @@ -388,3 +388,71 @@ parse_safe <- function(text) { } out } + +# Sniff out the intended direction based on the mapped aesthetics, returning as +# soon as possible to make minimal work +detect_direction <- function(data) { + if (!is.null(data$main_aes)) return(data$main_aes[1]) + + if (any(c("ymin", "ymax") %in% names(data))) { + if ("y" %in% names(data)) { + return("y") + } else { + return("x") + } + } + if (any(c("xmin", "xmax") %in% names(data))) { + if ("x" %in% names(data)) { + return("x") + } else { + return("y") + } + } + y_is_int <- all(data$y == round(data$y)) + x_is_int <- all(data$x == round(data$x)) + if (xor(y_is_int, x_is_int)) { + if (x_is_int) { + return("x") + } else { + return("y") + } + } + y_diff <- diff(unique(sort(data$y))) + x_diff <- diff(unique(sort(data$x))) + if (y_is_int && x_is_int) { + if (sum(x_diff == 1) >= sum(y_diff == 1)) { + return("x") + } else { + return("y") + } + } + y_is_regular <- all((y_diff / min(y_diff)) %% 1 < .Machine$double.eps) + x_is_regular <- all((x_diff / min(x_diff)) %% 1 < .Machine$double.eps) + if (xor(y_is_regular, x_is_regular)) { + if (x_is_regular) { + return("x") + } else { + return("y") + } + } + "x" +} + +# Switch x and y variables in a data frame +switch_position <- function(aesthetics) { + # We should have these as globals somewhere + x <- c("x", "xmin", "xmax", "xend", "xintercept", "xmin_final", "xmax_final", "xlower", "xmiddle", "xupper", "x0") + y <- c("y", "ymin", "ymax", "yend", "yintercept", "ymin_final", "ymax_final", "lower", "middle", "upper", "y0") + 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 +} + From 91f0319be2c3b75735ab73bdd838ef37cec937fe Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Thu, 29 Aug 2019 10:36:29 +0200 Subject: [PATCH 10/49] undo last changes --- R/bin.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/bin.R b/R/bin.R index 8ce9a9d8ac..55d898c846 100644 --- a/R/bin.R +++ b/R/bin.R @@ -122,7 +122,7 @@ bin_vector <- function(x, bins, weight = NULL, pad = FALSE) { stopifnot(is_bins(bins)) if (all(is.na(x))) { - return(bin_out(length(x), NA, NA, min = NA, max = NA)) + return(bin_out(length(x), NA, NA, xmin = NA, xmax = NA)) } if (is.null(weight)) { @@ -161,14 +161,14 @@ bin_vector <- function(x, bins, weight = NULL, pad = FALSE) { } bin_out <- function(count = integer(0), x = numeric(0), width = numeric(0), - min = x - width / 2, max = x + width / 2) { + xmin = x - width / 2, xmax = x + width / 2) { density <- count / width / sum(abs(count)) new_data_frame(list( count = count, x = x, - xmin = min, - xmax = max, + xmin = xmin, + xmax = xmax, width = width, density = density, ncount = count / max(abs(count)), From 1584dfd1d6202e1906ecceda523908cb40b82935 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Thu, 29 Aug 2019 10:43:45 +0200 Subject: [PATCH 11/49] more alignment of approaches --- R/geom-crossbar.r | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/R/geom-crossbar.r b/R/geom-crossbar.r index 92b6c114d1..59e3524925 100644 --- a/R/geom-crossbar.r +++ b/R/geom-crossbar.r @@ -40,12 +40,7 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom, draw_panel = function(data, panel_params, coord, fatten = 2.5, width = NULL) { main_aes <- data$main_aes[1] %||% "x" - if (main_aes == "y") { - data <- transform(data, x = y, y = x, xmin = ymin, ymin = xmin, xmax = ymax, ymax = xmax) - if (!is.null(data$xnotchlower) && !is.null(data$xnotchupper)) { - data <- transform(data, ynotchlower = xnotchlower, ynotchupper = xnotchupper) - } - } + if (main_aes == "y") names(data) <- switch_position(names(data)) middle <- transform(data, x = xmin, xend = xmax, yend = y, size = size * fatten, alpha = NA) has_notch <- !is.null(data$ynotchlower) && !is.null(data$ynotchupper) && @@ -92,8 +87,8 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom, )) } if (main_aes == "y") { - box <- transform(box, x = y, y = x) - middle <- transform(middle, x = y, xend = yend, y = x, yend = xend) + names(box) <- switch_position(names(box)) + names(middle) <- switch_position(names(middle)) } ggname("geom_crossbar", gTree(children = gList( GeomPolygon$draw_panel(box, panel_params, coord), From a47b1e034129068708e621531de6ec6e53fe3d93 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Thu, 29 Aug 2019 11:01:38 +0200 Subject: [PATCH 12/49] Add boxplot --- R/geom-boxplot.r | 40 ++++++++++++++++++++++++++-------------- R/stat-boxplot.r | 36 ++++++++++++++++++++++++++++++------ 2 files changed, 56 insertions(+), 20 deletions(-) diff --git a/R/geom-boxplot.r b/R/geom-boxplot.r index 246a0a13f9..c0392ccbc2 100644 --- a/R/geom-boxplot.r +++ b/R/geom-boxplot.r @@ -164,8 +164,14 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, extra_params = c("na.rm", "width"), setup_data = function(data, params) { + main_aes <- detect_direction(data) + vars <- c(main = "x", mmin = "xmin", mmax = "xmax", sub = "y", smin = "ymin", + smax = "ymax", smin_final = "ymin_final", smax_final = "ymax_final") + if (main_aes == "y") vars <- switch_position(vars) + + data$main_aes <- main_aes data$width <- data$width %||% - params$width %||% (resolution(data$x, FALSE) * 0.9) + params$width %||% (resolution(data[[vars["main"]]], FALSE) * 0.9) if (!is.null(data$outliers)) { suppressWarnings({ @@ -173,19 +179,19 @@ 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[[vars["smin_final"]]] <- pmin(out_min, data[[vars["smin"]]]) + data[[vars["smax_final"]]] <- pmax(out_max, data[[vars["smax"]]]) } # if `varwidth` not requested or not available, don't use it if (is.null(params) || is.null(params$varwidth) || !params$varwidth || is.null(data$relvarwidth)) { - data$xmin <- data$x - data$width / 2 - data$xmax <- data$x + data$width / 2 + data[[vars["mmin"]]] <- data[[vars["main"]]] - data$width / 2 + data[[vars["mmax"]]] <- data[[vars["main"]]] + data$width / 2 } else { # make `relvarwidth` relative to the size of the largest group data$relvarwidth <- data$relvarwidth / max(data$relvarwidth) - data$xmin <- data$x - data$relvarwidth * data$width / 2 - data$xmax <- data$x + data$relvarwidth * data$width / 2 + data[[vars["mmin"]]] <- data[[vars["main"]]] - data$relvarwidth * data$width / 2 + data[[vars["mmax"]]] <- data[[vars["main"]]] + data$relvarwidth * data$width / 2 } data$width <- NULL if (!is.null(data$relvarwidth)) data$relvarwidth <- NULL @@ -199,7 +205,8 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, outlier.size = 1.5, outlier.stroke = 0.5, outlier.alpha = NULL, notch = FALSE, notchwidth = 0.5, varwidth = FALSE) { - + main_aes <- data$main_aes[1] + if (main_aes == "y") names(data) <- switch_position(names(data)) # this may occur when using geom_boxplot(stat = "identity") if (nrow(data) != 1) { stop( @@ -237,11 +244,15 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, ynotchlower = ifelse(notch, data$notchlower, NA), ynotchupper = ifelse(notch, data$notchupper, NA), notchwidth = notchwidth, - alpha = data$alpha + alpha = data$alpha, + main_aes = main_aes ), common )) - + if (main_aes == "y") { + names(whiskers) <- switch_position(names(whiskers)) + names(box) <- switch_position(names(box)) + } if (!is.null(data$outliers) && length(data$outliers[[1]] >= 1)) { outliers <- new_data_frame(list( y = data$outliers[[1]], @@ -254,6 +265,7 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, fill = NA, alpha = outlier.alpha %||% data$alpha[1] ), n = length(data$outliers[[1]])) + if (main_aes == "y") names(outliers) <- switch_position(names(outliers)) outliers_grob <- GeomPoint$draw_panel(outliers, panel_params, coord) } else { outliers_grob <- NULL @@ -268,8 +280,8 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, draw_key = draw_key_boxplot, - 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") + default_aes = aes(x = NULL, ymin = NULL, ymax = NULL, y = NULL, xmin = NULL, + xmax = NULL, lower = NULL, upper = NULL, middle = NULL, xlower = NULL, + xupper = NULL, xmiddle = NULL, weight = 1, colour = "grey20", fill = "white", size = 0.5, + alpha = NA, shape = 19, linetype = "solid") ) diff --git a/R/stat-boxplot.r b/R/stat-boxplot.r index 618d57e99c..3d31951de0 100644 --- a/R/stat-boxplot.r +++ b/R/stat-boxplot.r @@ -45,29 +45,51 @@ StatBoxplot <- ggproto("StatBoxplot", Stat, required_aes = c("y"), non_missing_aes = "weight", setup_data = function(data, params) { - data$x <- data$x %||% 0 + data[[params$main_aes]] <- data[[params$main_aes]] %||% 0 data <- remove_missing( data, na.rm = FALSE, - vars = "x", + vars = params$main_aes, name = "stat_boxplot" ) data }, setup_params = function(data, params) { - params$width <- params$width %||% (resolution(data$x %||% 0) * 0.75) + if (is.null(data$x)) { + params$main_aes <- "x" + } else if (is.null(data$y)) { + params$main_aes <- "y" + } else { + x_groups <- vapply(split(data$x, data$group), function(x) length(unique(x)), integer(1)) + if (all(x_groups == 1)) { + params$main_aes <- "x" + } else { + y_groups <- vapply(split(data$y, data$group), function(x) length(unique(x)), integer(1)) + if (all(y_groups == 1)) { + params$main_aes <- "y" + } else { + params$main_aes <- detect_direction(data) + } + } + } + + if (is.null(data$x) && is.null(params$x) && is.null(data$y) && is.null(params$y)) { + stop("stat_boxplot() requires either an x or y aesthetic.", call. = FALSE) + } + params$width <- params$width %||% (resolution(data[[params$main_aes]] %||% 0) * 0.75) - if (is.double(data$x) && !has_groups(data) && any(data$x != data$x[1L])) { + if (is.double(data[[params$main_aes]]) && !has_groups(data) && any(data[[params$main_aes]] != data[[params$main_aes]][1L])) { warning( - "Continuous x aesthetic -- did you forget aes(group=...)?", + "Continuous ", params$main_aes, " aesthetic -- did you forget aes(group=...)?", call. = FALSE) } params }, - compute_group = function(data, scales, width = NULL, na.rm = FALSE, coef = 1.5) { + compute_group = function(data, scales, width = NULL, na.rm = FALSE, coef = 1.5, main_aes = "x") { + if (main_aes == "y") names(data) <- switch_position(names(data)) qs <- c(0, 0.25, 0.5, 0.75, 1) if (!is.null(data$weight)) { @@ -103,6 +125,8 @@ 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$main_aes <- main_aes + if (main_aes == "y") names(df) <- switch_position(names(df)) df } ) From dd21a62dda20d8aa6f1554a8371726a8b7191dcf Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Thu, 29 Aug 2019 11:16:05 +0200 Subject: [PATCH 13/49] add linerange and pointrange --- R/geom-linerange.r | 22 +++++++++++++++++++--- R/geom-pointrange.r | 11 ++++++++--- 2 files changed, 27 insertions(+), 6 deletions(-) diff --git a/R/geom-linerange.r b/R/geom-linerange.r index 861c8b0760..0fc2907cd9 100644 --- a/R/geom-linerange.r +++ b/R/geom-linerange.r @@ -83,14 +83,30 @@ geom_linerange <- function(mapping = NULL, data = NULL, #' @usage NULL #' @export GeomLinerange <- ggproto("GeomLinerange", Geom, - default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA), + default_aes = aes(x = NULL, y = NULL, xmin = NULL, xmax = NULL, ymin = NULL, + ymax = NULL, colour = "black", size = 0.5, linetype = 1, alpha = NA), draw_key = draw_key_vpath, - required_aes = c("x", "ymin", "ymax"), + setup_data = function(data, params) { + if (all(c("y", "xmin", "xmax") %in% names(data))) { + main_aes <- "y" + } else if (all(c("x", "ymin", "ymax") %in% names(data))) { + main_aes <- "x" + } else { + stop("Either, `x`, `ymin`, and `ymax` or `y`, `xmin`, and `xmax` must be supplied", call. = FALSE) + } + data$main_aes <- main_aes + + data + }, draw_panel = function(data, panel_params, coord) { - data <- transform(data, xend = x, y = ymin, yend = ymax) + main_aes <- data$main_aes[1] + data <- switch(main_aes, + x = transform(data, xend = x, y = ymin, yend = ymax), + y = transform(data, yend = y, x = xmin, xend = xmax) + ) ggname("geom_linerange", GeomSegment$draw_panel(data, panel_params, coord)) } ) diff --git a/R/geom-pointrange.r b/R/geom-pointrange.r index 6777aa0151..9c938554fe 100644 --- a/R/geom-pointrange.r +++ b/R/geom-pointrange.r @@ -28,15 +28,20 @@ geom_pointrange <- function(mapping = NULL, data = NULL, #' @usage NULL #' @export GeomPointrange <- ggproto("GeomPointrange", Geom, - default_aes = aes(colour = "black", size = 0.5, linetype = 1, shape = 19, + default_aes = aes(x = NULL, y = NULL, xmin = NULL, xmax = NULL, ymin = NULL, + ymax = NULL, colour = "black", size = 0.5, linetype = 1, shape = 19, fill = NA, alpha = NA, stroke = 1), draw_key = draw_key_pointrange, - required_aes = c("x", "y", "ymin", "ymax"), + setup_data = function(data, params) { + GeomLinerange$setup_data(data, params) + }, draw_panel = function(data, panel_params, coord, fatten = 4) { - if (is.null(data$y)) + main_aes <- data$main_aes[1] + sub_aes <- if (main_aes == "x") "y" else "x" + if (is.null(data[[sub_aes]])) return(GeomLinerange$draw_panel(data, panel_params, coord)) ggname("geom_pointrange", From 4dbd9ad36042792a0833458a4aaa9a54f0b4afcb Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Thu, 29 Aug 2019 11:43:07 +0200 Subject: [PATCH 14/49] add violin --- R/geom-violin.r | 20 ++++++++++++++++---- R/stat-ydensity.r | 23 +++++++++++++++++++++-- 2 files changed, 37 insertions(+), 6 deletions(-) diff --git a/R/geom-violin.r b/R/geom-violin.r index 5a6be2add9..3c9ce07697 100644 --- a/R/geom-violin.r +++ b/R/geom-violin.r @@ -101,17 +101,27 @@ geom_violin <- function(mapping = NULL, data = NULL, #' @export GeomViolin <- ggproto("GeomViolin", Geom, setup_data = function(data, params) { + main_aes <- detect_direction(data) + data$main_aes <- main_aes data$width <- data$width %||% - params$width %||% (resolution(data$x, FALSE) * 0.9) + params$width %||% (resolution(data[[main_aes]], FALSE) * 0.9) # ymin, ymax, xmin, and xmax define the bounding rectangle for each group - dapply(data, "group", transform, - xmin = x - width / 2, - xmax = x + width / 2 + switch(main_aes, + x = dapply(data, "group", transform, + xmin = x - width / 2, + xmax = x + width / 2 + ), + y = dapply(data, "group", transform, + ymin = y - width / 2, + ymax = y + width / 2 + ) ) }, draw_group = function(self, data, ..., draw_quantiles = NULL) { + main_aes <- data$main_aes[1] + if (main_aes == "y") names(data) <- switch_position(names(data)) # Find the points for the line to go all the way around data <- transform(data, xminv = x - violinwidth * (x - xmin), @@ -127,6 +137,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,]) + if (main_aes == "y") names(newdata) <- switch_position(names(newdata)) # 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 +153,7 @@ GeomViolin <- ggproto("GeomViolin", Geom, aesthetics$alpha <- rep(1, nrow(quantiles)) both <- cbind(quantiles, aesthetics) both <- both[!is.na(both$group), , drop = FALSE] + if (main_aes == "y") names(both) <- switch_position(names(both)) quantile_grob <- if (nrow(both) == 0) { zeroGrob() } else { diff --git a/R/stat-ydensity.r b/R/stat-ydensity.r index 978f60ad0c..35319650b0 100644 --- a/R/stat-ydensity.r +++ b/R/stat-ydensity.r @@ -60,8 +60,24 @@ StatYdensity <- ggproto("StatYdensity", Stat, required_aes = c("x", "y"), non_missing_aes = "weight", + setup_params = function(data, params) { + x_groups <- vapply(split(data$x, data$group), function(x) length(unique(x)), integer(1)) + if (all(x_groups == 1)) { + params$main_aes <- "x" + } else { + y_groups <- vapply(split(data$y, data$group), function(x) length(unique(x)), integer(1)) + if (all(y_groups == 1)) { + params$main_aes <- "y" + } else { + params$main_aes <- detect_direction(data) + } + } + + params + }, + 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, main_aes = "x") { if (nrow(data) < 3) return(new_data_frame()) range <- range(data$y, na.rm = TRUE) modifier <- if (trim) 0 else 3 @@ -83,7 +99,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", main_aes = "x") { + if (main_aes == "y") names(data) <- switch_position(names(data)) data <- ggproto_parent(Stat, self)$compute_panel( data, scales, width = width, bw = bw, adjust = adjust, kernel = kernel, trim = trim, na.rm = na.rm @@ -100,6 +117,8 @@ StatYdensity <- ggproto("StatYdensity", Stat, # width: constant width (density scaled to a maximum of 1) width = data$scaled ) + if (main_aes == "y") names(data) <- switch_position(names(data)) + data$main_aes <- main_aes data } From a13ae074e4a4ab19d2f4372a7a851344e8f02ab4 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Thu, 29 Aug 2019 14:39:16 +0200 Subject: [PATCH 15/49] add dodge --- R/position-dodge.r | 21 +++++++++++++++------ 1 file changed, 15 insertions(+), 6 deletions(-) diff --git a/R/position-dodge.r b/R/position-dodge.r index dd9f67fe52..e0fdca506c 100644 --- a/R/position-dodge.r +++ b/R/position-dodge.r @@ -89,7 +89,10 @@ PositionDodge <- ggproto("PositionDodge", Position, width = NULL, preserve = "total", setup_params = function(self, data) { - if (is.null(data$xmin) && is.null(data$xmax) && is.null(self$width)) { + main_aes <- detect_direction(data) + vars <- c(main = "x", min = "xmin", max = "xmax") + if (main_aes == "y") vars <- switch_position(vars) + if (is.null(data[[vars["min"]]]) && is.null(data[[vars["max"]]]) && is.null(self$width)) { warning("Width not defined. Set with `position_dodge(width = ?)`", call. = FALSE) } @@ -98,25 +101,29 @@ PositionDodge <- ggproto("PositionDodge", Position, n <- NULL } else { panels <- unname(split(data, data$PANEL)) - ns <- vapply(panels, function(panel) max(table(panel$xmin)), double(1)) + ns <- vapply(panels, function(panel) max(table(panel[[vars["min"]]])), double(1)) n <- max(ns) } list( width = self$width, - n = n + n = n, + main_aes = main_aes, + vars = vars ) }, setup_data = function(self, data, params) { - if (!"x" %in% names(data) && all(c("xmin", "xmax") %in% names(data))) { - data$x <- (data$xmin + data$xmax) / 2 + if (!params$vars["main"] %in% names(data) && + all(params$vars[c("min", "max")] %in% names(data))) { + data[[vars["main"]]] <- (data[[vars["min"]]] + data[[vars["max"]]]) / 2 } data }, compute_panel = function(data, params, scales) { - collide( + if (params$main_aes == "y") names(data) <- switch_position(names(data)) + collided <- collide( data, params$width, name = "position_dodge", @@ -124,6 +131,8 @@ PositionDodge <- ggproto("PositionDodge", Position, n = params$n, check.width = FALSE ) + if (params$main_aes == "y") names(collided) <- switch_position(names(collided)) + collided } ) From acb29d8f733294ee00d4de1883c79a97efc4b8a0 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Mon, 2 Sep 2019 11:24:06 +0200 Subject: [PATCH 16/49] Align approach across stats/geoms/positions --- R/geom-bar.r | 24 ++++++++++---------- R/geom-boxplot.r | 48 ++++++++++++++++++++-------------------- R/geom-col.r | 24 ++++++++++---------- R/geom-crossbar.r | 17 +++++++++------ R/geom-errorbar.r | 45 +++++++++++++++----------------------- R/geom-linerange.r | 23 +++++++------------- R/geom-pointrange.r | 14 +++++------- R/geom-ribbon.r | 35 +++++++++++++++--------------- R/geom-violin.r | 32 ++++++++++++--------------- R/ggplot-global.R | 6 +++++ R/position-dodge.r | 25 ++++++++++----------- R/stat-bin.r | 39 +++++++++++++++------------------ R/stat-boxplot.r | 33 ++++++++++++++-------------- R/stat-count.r | 21 ++++++++---------- R/stat-density.r | 25 ++++++++++----------- R/stat-ydensity.r | 17 +++++++-------- R/utilities.r | 53 ++++++++++++++++++++++++++++++--------------- 17 files changed, 236 insertions(+), 245 deletions(-) diff --git a/R/geom-bar.r b/R/geom-bar.r index f34881770c..585cb7a805 100644 --- a/R/geom-bar.r +++ b/R/geom-bar.r @@ -117,23 +117,23 @@ 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) + params + }, + setup_data = function(data, params) { - params$main_aes <- detect_direction(data) + data <- flip_data(data, params$flipped_aes) data$width <- data$width %||% - params$width %||% (resolution(data[[params$main_aes]], FALSE) * 0.9) - switch(params$main_aes, - x = transform(data, - ymin = pmin(y, 0), ymax = pmax(y, 0), - xmin = x - width / 2, xmax = x + width / 2, width = NULL - ), - y = transform(data, - xmin = pmin(x, 0), xmax = pmax(x, 0), - ymin = y - width / 2, ymax = y + width / 2, width = NULL - ) + params$width %||% (resolution(data$x, FALSE) * 0.9) + 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 c0392ccbc2..a449730d8e 100644 --- a/R/geom-boxplot.r +++ b/R/geom-boxplot.r @@ -163,15 +163,15 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, # doesn't have a `width` parameter (e.g., `stat_identity`). extra_params = c("na.rm", "width"), - setup_data = function(data, params) { - main_aes <- detect_direction(data) - vars <- c(main = "x", mmin = "xmin", mmax = "xmax", sub = "y", smin = "ymin", - smax = "ymax", smin_final = "ymin_final", smax_final = "ymax_final") - if (main_aes == "y") vars <- switch_position(vars) + setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params) + params + }, - data$main_aes <- main_aes + setup_data = function(data, params) { + data <- flip_data(data, params$flipped_aes) data$width <- data$width %||% - params$width %||% (resolution(data[[vars["main"]]], FALSE) * 0.9) + params$width %||% (resolution(data$x, FALSE) * 0.9) if (!is.null(data$outliers)) { suppressWarnings({ @@ -179,24 +179,24 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, out_max <- vapply(data$outliers, max, numeric(1)) }) - data[[vars["smin_final"]]] <- pmin(out_min, data[[vars["smin"]]]) - data[[vars["smax_final"]]] <- pmax(out_max, data[[vars["smax"]]]) + 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 if (is.null(params) || is.null(params$varwidth) || !params$varwidth || is.null(data$relvarwidth)) { - data[[vars["mmin"]]] <- data[[vars["main"]]] - data$width / 2 - data[[vars["mmax"]]] <- data[[vars["main"]]] + data$width / 2 + data$xmin <- data$x - data$width / 2 + data$xmax <- data$x + data$width / 2 } else { # make `relvarwidth` relative to the size of the largest group data$relvarwidth <- data$relvarwidth / max(data$relvarwidth) - data[[vars["mmin"]]] <- data[[vars["main"]]] - data$relvarwidth * data$width / 2 - data[[vars["mmax"]]] <- data[[vars["main"]]] + data$relvarwidth * data$width / 2 + data$xmin <- data$x - data$relvarwidth * data$width / 2 + data$xmax <- data$x + data$relvarwidth * data$width / 2 } 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, @@ -204,9 +204,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) { - main_aes <- data$main_aes[1] - if (main_aes == "y") names(data) <- switch_position(names(data)) + 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( @@ -233,6 +232,7 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, ), common ), n = 2) + whiskers <- flip_data(whiskers, fliped_aes) box <- new_data_frame(c( list( @@ -244,15 +244,12 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, ynotchlower = ifelse(notch, data$notchlower, NA), ynotchupper = ifelse(notch, data$notchupper, NA), notchwidth = notchwidth, - alpha = data$alpha, - main_aes = main_aes + alpha = data$alpha ), common )) - if (main_aes == "y") { - names(whiskers) <- switch_position(names(whiskers)) - names(box) <- switch_position(names(box)) - } + box <- flip_data(box, flipped_aes) + if (!is.null(data$outliers) && length(data$outliers[[1]] >= 1)) { outliers <- new_data_frame(list( y = data$outliers[[1]], @@ -265,7 +262,8 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, fill = NA, alpha = outlier.alpha %||% data$alpha[1] ), n = length(data$outliers[[1]])) - if (main_aes == "y") names(outliers) <- switch_position(names(outliers)) + outliers <- flip_data(outliers, flipped_aes) + outliers_grob <- GeomPoint$draw_panel(outliers, panel_params, coord) } else { outliers_grob <- NULL @@ -274,7 +272,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) )) }, diff --git a/R/geom-col.r b/R/geom-col.r index cf9c3b36e8..53cc8648d0 100644 --- a/R/geom-col.r +++ b/R/geom-col.r @@ -37,23 +37,23 @@ 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 + }, + setup_data = function(data, params) { - params$main_aes <- detect_direction(data) + data <- flip_data(data, params$flipped_aes) data$width <- data$width %||% - params$width %||% (resolution(data[[params$main_aes]], FALSE) * 0.9) - switch(params$main_aes, - x = transform(data, - ymin = pmin(y, 0), ymax = pmax(y, 0), - xmin = x - width / 2, xmax = x + width / 2, width = NULL - ), - y = transform(data, - xmin = pmin(x, 0), xmax = pmax(x, 0), - ymin = y - width / 2, ymax = y + width / 2, width = NULL - ) + params$width %||% (resolution(data$x, FALSE) * 0.9) + 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 59e3524925..2fee79b4d8 100644 --- a/R/geom-crossbar.r +++ b/R/geom-crossbar.r @@ -28,6 +28,10 @@ geom_crossbar <- function(mapping = NULL, data = NULL, #' @usage NULL #' @export GeomCrossbar <- ggproto("GeomCrossbar", Geom, + setup_params = function(data, params) { + GeomErrorbar$setup_params(data, params) + }, + setup_data = function(data, params) { GeomErrorbar$setup_data(data, params) }, @@ -38,9 +42,9 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom, draw_key = draw_key_crossbar, - draw_panel = function(data, panel_params, coord, fatten = 2.5, width = NULL) { - main_aes <- data$main_aes[1] %||% "x" - if (main_aes == "y") names(data) <- switch_position(names(data)) + 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) && @@ -54,6 +58,7 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom, middle$x <- middle$x + notchindent middle$xend <- middle$xend - notchindent + middle <- flip_data(middle, flipped_aes) box <- new_data_frame(list( x = c( @@ -86,10 +91,8 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom, group = rep(seq_len(nrow(data)), 5) # each bar forms it's own group )) } - if (main_aes == "y") { - names(box) <- switch_position(names(box)) - names(middle) <- switch_position(names(middle)) - } + box <- flip_data(box, flipped_aes) + ggname("geom_crossbar", gTree(children = gList( GeomPolygon$draw_panel(box, panel_params, coord), GeomSegment$draw_panel(middle, panel_params, coord) diff --git a/R/geom-errorbar.r b/R/geom-errorbar.r index ee2af288cc..ae9b3b0ba0 100644 --- a/R/geom-errorbar.r +++ b/R/geom-errorbar.r @@ -32,38 +32,25 @@ GeomErrorbar <- ggproto("GeomErrorbar", Geom, draw_key = draw_key_path, + setup_params = function(data, params) { + GeomLinerange$setup_params(data, params) + }, + setup_data = function(data, params) { - if (all(c("y", "xmin", "xmax") %in% names(data))) { - main_aes <- "y" - } else if (all(c("x", "ymin", "ymax") %in% names(data))) { - main_aes <- "x" - } else { - stop("Either, `x`, `ymin`, and `ymax` or `y`, `xmin`, and `xmax` must be supplied", call. = FALSE) - } - data$main_aes <- main_aes + data <- flip_data(data, params$flipped_aes) data$width <- data$width %||% - params$width %||% (resolution(data[[main_aes]], FALSE) * 0.9) - - switch(main_aes, - x = transform(data, - xmin = x - width / 2, xmax = x + width / 2, width = NULL - ), - y = transform(data, - ymin = y - width / 2, ymax = y + width / 2, width = NULL - ) + params$width %||% (resolution(data$x, FALSE) * 0.9) + 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) { - if (data$main_aes[1] == "x") { - 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)) - } else { - x = as.vector(rbind(data$xmax, data$xmax, NA, data$xmax, data$xmin, NA, data$xmin, data$xmin)) - y = as.vector(rbind(data$ymin, data$ymax, NA, data$y, data$y, NA, data$ymin, data$ymax)) - } - GeomPath$draw_panel(new_data_frame(list( + 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), @@ -72,6 +59,8 @@ GeomErrorbar <- ggproto("GeomErrorbar", Geom, 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-linerange.r b/R/geom-linerange.r index 0fc2907cd9..ad09f5cffd 100644 --- a/R/geom-linerange.r +++ b/R/geom-linerange.r @@ -88,25 +88,18 @@ GeomLinerange <- ggproto("GeomLinerange", Geom, draw_key = draw_key_vpath, - setup_data = function(data, params) { - if (all(c("y", "xmin", "xmax") %in% names(data))) { - main_aes <- "y" - } else if (all(c("x", "ymin", "ymax") %in% names(data))) { - main_aes <- "x" - } else { + setup_params = function(data, params) { + params$flipped_aes <- all(c("y", "xmin", "xmax") %in% names(data)) + 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) } - data$main_aes <- main_aes - - data + params }, - draw_panel = function(data, panel_params, coord) { - main_aes <- data$main_aes[1] - data <- switch(main_aes, - x = transform(data, xend = x, y = ymin, yend = ymax), - y = transform(data, yend = y, x = xmin, xend = xmax) - ) + 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-pointrange.r b/R/geom-pointrange.r index 9c938554fe..6125a69fa9 100644 --- a/R/geom-pointrange.r +++ b/R/geom-pointrange.r @@ -34,19 +34,17 @@ GeomPointrange <- ggproto("GeomPointrange", Geom, draw_key = draw_key_pointrange, - setup_data = function(data, params) { - GeomLinerange$setup_data(data, params) + setup_params = function(data, params) { + GeomLinerange$setup_params(data, params) }, - draw_panel = function(data, panel_params, coord, fatten = 4) { - main_aes <- data$main_aes[1] - sub_aes <- if (main_aes == "x") "y" else "x" - if (is.null(data[[sub_aes]])) - return(GeomLinerange$draw_panel(data, panel_params, coord)) + 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 bccce905bd..127ee02959 100644 --- a/R/geom-ribbon.r +++ b/R/geom-ribbon.r @@ -62,17 +62,21 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, ymax = NULL, colour = NA, fill = "grey20", size = 0.5, linetype = 1, alpha = NA), + setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params) + params + }, + setup_data = function(data, params) { - data$main_aes <- detect_direction(data) - vars <- c(main = "x", sub = "y", min = "ymin", max = "ymax") - if (data$main_aes[1] == "x") vars <- switch_position(vars) + data <- flip_data(data, params$flipped_aes) - if (is.null(data[[vars["min"]]]) && is.null(data[[vars["max"]]])) { - stop("Either ", vars["min"], " or ", vars["max"], " must be given as an aesthetic.", call. = FALSE) + if (is.null(data$ymin) && is.null(data$ymax)) { + 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[[vars["main"]]]), , drop = FALSE] - data[[vars["sub"]]] <- data[[vars["min"]]] %||% data[[vars["max"]]] - data + data <- data[order(data$PANEL, data$group, data$x), , drop = FALSE] + data$y <- data$ymin %||% data$ymax + flip_data(data, params$flipped_aes) }, draw_key = draw_key_polygon, @@ -81,9 +85,8 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, data }, - draw_group = function(data, panel_params, coord, na.rm = FALSE) { - main_aes <- data$main_aes[1] - if (main_aes == "y") names(data) <- switch_position(names(data)) + 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), ] @@ -112,7 +115,7 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, id = c(ids, rev(ids)) )) - if (main_aes == "y") names(positions) <- switch_position(names(positions)) + positions <- flip_data(positions, flipped_aes) munched <- coord_munch(coord, positions, panel_params) @@ -159,10 +162,8 @@ GeomArea <- ggproto("GeomArea", GeomRibbon, required_aes = c("x", "y"), setup_data = function(data, params) { - data$main_aes <- detect_direction(data) - switch(data$main_aes[1], - x = transform(data[order(data$PANEL, data$group, data$x), ], ymin = 0, ymax = y), - y = transform(data[order(data$PANEL, data$group, data$y), ], xmin = 0, xmax = x) - ) + 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-violin.r b/R/geom-violin.r index 3c9ce07697..d2bffb78f0 100644 --- a/R/geom-violin.r +++ b/R/geom-violin.r @@ -100,28 +100,24 @@ 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) + params + }, setup_data = function(data, params) { - main_aes <- detect_direction(data) - data$main_aes <- main_aes + data <- flip_data(data, params$flipped_aes) data$width <- data$width %||% - params$width %||% (resolution(data[[main_aes]], FALSE) * 0.9) - + params$width %||% (resolution(data$x, FALSE) * 0.9) # ymin, ymax, xmin, and xmax define the bounding rectangle for each group - switch(main_aes, - x = dapply(data, "group", transform, - xmin = x - width / 2, - xmax = x + width / 2 - ), - y = dapply(data, "group", transform, - ymin = y - width / 2, - ymax = y + width / 2 - ) + 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) { - main_aes <- data$main_aes[1] - if (main_aes == "y") names(data) <- switch_position(names(data)) + 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), @@ -137,7 +133,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,]) - if (main_aes == "y") names(newdata) <- switch_position(names(newdata)) + 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))) { @@ -153,7 +149,7 @@ GeomViolin <- ggproto("GeomViolin", Geom, aesthetics$alpha <- rep(1, nrow(quantiles)) both <- cbind(quantiles, aesthetics) both <- both[!is.na(both$group), , drop = FALSE] - if (main_aes == "y") names(both) <- switch_position(names(both)) + 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 e0fdca506c..7f1970ada2 100644 --- a/R/position-dodge.r +++ b/R/position-dodge.r @@ -89,10 +89,9 @@ PositionDodge <- ggproto("PositionDodge", Position, width = NULL, preserve = "total", setup_params = function(self, data) { - main_aes <- detect_direction(data) - vars <- c(main = "x", min = "xmin", max = "xmax") - if (main_aes == "y") vars <- switch_position(vars) - if (is.null(data[[vars["min"]]]) && is.null(data[[vars["max"]]]) && is.null(self$width)) { + flipped_aes <- has_flipped_aes(data, params) + 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) } @@ -101,28 +100,27 @@ PositionDodge <- ggproto("PositionDodge", Position, n <- NULL } else { panels <- unname(split(data, data$PANEL)) - ns <- vapply(panels, function(panel) max(table(panel[[vars["min"]]])), double(1)) + ns <- vapply(panels, function(panel) max(table(panel$xmin)), double(1)) n <- max(ns) } list( width = self$width, n = n, - main_aes = main_aes, - vars = vars + flipped_aes = flipped_aes ) }, setup_data = function(self, data, params) { - if (!params$vars["main"] %in% names(data) && - all(params$vars[c("min", "max")] %in% names(data))) { - data[[vars["main"]]] <- (data[[vars["min"]]] + data[[vars["max"]]]) / 2 + 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) { - if (params$main_aes == "y") names(data) <- switch_position(names(data)) + data <- flip_data(data, params$flipped_aes) collided <- collide( data, params$width, @@ -131,8 +129,7 @@ PositionDodge <- ggproto("PositionDodge", Position, n = params$n, check.width = FALSE ) - if (params$main_aes == "y") names(collided) <- switch_position(names(collided)) - collided + flip_data(collided, params$flipped_aes) } ) diff --git a/R/stat-bin.r b/R/stat-bin.r index 6a9b315a76..33fadc90fe 100644 --- a/R/stat-bin.r +++ b/R/stat-bin.r @@ -82,17 +82,15 @@ stat_bin <- function(mapping = NULL, data = NULL, #' @export StatBin <- ggproto("StatBin", Stat, setup_params = function(data, params) { - params$main_aes <- "x" - if (is.null(data$x) && is.null(params$x)) { - if (is.null(data$y) && is.null(params$y)) { - stop("stat_bin() requires either an x or y aesthetic.", call. = FALSE) - } else { - params$main_aes <- "y" - } + params$flipped_aes <- is.null(data$x) && is.null(params$x) + + if (is.null(data$x) && is.null(params$x) && is.null(data$y) && is.null(params$y)) { + stop("stat_bin() requires either an x or y aesthetic.", call. = FALSE) } - if (is.integer(data[[params$main_aes]])) { - stop('StatBin requires a continuous ', params$main_aes, ' variable: the ', - params$main_aes, ' 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) } @@ -128,31 +126,30 @@ StatBin <- ggproto("StatBin", Stat, compute_group = function(data, scales, binwidth = NULL, bins = NULL, center = NULL, boundary = NULL, closed = c("right", "left"), pad = FALSE, - breaks = NULL, main_aes = 'x', + 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[[main_aes]]$is_discrete()) { - breaks <- scales[[main_aes]]$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[[main_aes]]) + binwidth <- binwidth(data[[x]]) } - bins <- bin_breaks_width(scales[[main_aes]]$dimension(), binwidth, + bins <- bin_breaks_width(scales[[x]]$dimension(), binwidth, center = center, boundary = boundary, closed = closed) } else { - bins <- bin_breaks_bins(scales[[main_aes]]$dimension(), bins, center = center, + bins <- bin_breaks_bins(scales[[x]]$dimension(), bins, center = center, boundary = boundary, closed = closed) } - bins <- bin_vector(data[[main_aes]], bins, weight = data$weight, pad = pad) - bins$main_aes <- main_aes - if (main_aes == "y") names(bins) <- switch_position(names(bins)) - bins + bins <- bin_vector(data[[x]], bins, weight = data$weight, pad = pad) + bins$flipped_aes <- flipped_aes + flip_data(bins, flipped_aes) }, default_aes = aes(x = stat(count), y = stat(count), weight = 1) diff --git a/R/stat-boxplot.r b/R/stat-boxplot.r index 3d31951de0..82b58a0b2c 100644 --- a/R/stat-boxplot.r +++ b/R/stat-boxplot.r @@ -45,51 +45,53 @@ StatBoxplot <- ggproto("StatBoxplot", Stat, required_aes = c("y"), non_missing_aes = "weight", setup_data = function(data, params) { - data[[params$main_aes]] <- data[[params$main_aes]] %||% 0 + data <- flip_data(data, params$flipped_aes) + data$x <- data$x %||% 0 data <- remove_missing( data, na.rm = FALSE, - vars = params$main_aes, + vars = "x", name = "stat_boxplot" ) - data + flip_data(data, params$flipped_aes) }, setup_params = function(data, params) { if (is.null(data$x)) { - params$main_aes <- "x" + params$flipped_aes <- FALSE } else if (is.null(data$y)) { - params$main_aes <- "y" + params$flipped_aes <- TRUE } else { x_groups <- vapply(split(data$x, data$group), function(x) length(unique(x)), integer(1)) if (all(x_groups == 1)) { - params$main_aes <- "x" + params$flipped_aes <- FALSE } else { y_groups <- vapply(split(data$y, data$group), function(x) length(unique(x)), integer(1)) if (all(y_groups == 1)) { - params$main_aes <- "y" + params$flipped_aes <- TRUE } else { - params$main_aes <- detect_direction(data) + params$flipped_aes <- flipped_aes(data) } } } + data <- flip_data(data, params$flipped_aes) if (is.null(data$x) && is.null(params$x) && is.null(data$y) && is.null(params$y)) { stop("stat_boxplot() requires either an x or y aesthetic.", call. = FALSE) } - params$width <- params$width %||% (resolution(data[[params$main_aes]] %||% 0) * 0.75) + params$width <- params$width %||% (resolution(data$x %||% 0) * 0.75) - if (is.double(data[[params$main_aes]]) && !has_groups(data) && any(data[[params$main_aes]] != data[[params$main_aes]][1L])) { + if (is.double(data$x) && !has_groups(data) && any(data$x != data$x[1L])) { warning( - "Continuous ", params$main_aes, " 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, main_aes = "x") { - if (main_aes == "y") names(data) <- switch_position(names(data)) + 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)) { @@ -125,8 +127,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$main_aes <- main_aes - if (main_aes == "y") names(df) <- switch_position(names(df)) - df + df$flipped_aes <- flipped_aes + flip_data(df, flipped_aes) } ) diff --git a/R/stat-count.r b/R/stat-count.r index 6901ff3fa7..85f11b5046 100644 --- a/R/stat-count.r +++ b/R/stat-count.r @@ -49,19 +49,17 @@ StatCount <- ggproto("StatCount", Stat, default_aes = aes(x = stat(count), y = stat(count), weight = 1), setup_params = function(data, params) { - params$main_aes <- "x" - if (is.null(data$x) && is.null(params$x)) { - if (is.null(data$y) && is.null(params$y)) { - stop("stat_count() requires either an x or y aesthetic.", call. = FALSE) - } else { - params$main_aes <- "y" - } + params$flipped_aes <- is.null(data$x) && is.null(params$x) + + if (is.null(data$x) && is.null(params$x) && is.null(data$y) && is.null(params$y)) { + stop("stat_count() requires either an x or y aesthetic.", call. = FALSE) } params }, - compute_group = function(self, data, scales, width = NULL, main_aes = "x") { - x <- data[[main_aes]] + 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) @@ -73,9 +71,8 @@ StatCount <- ggproto("StatCount", Stat, prop = count / sum(abs(count)), x = sort(unique(x)), width = width, - main_aes = main_aes + flipped_aes = flipped_aes ), n = length(count)) - names(bars)[3] <- main_aes - bars + flip_data(bars, flipped_aes) } ) diff --git a/R/stat-density.r b/R/stat-density.r index 1c2fcff197..c53b5e1c36 100644 --- a/R/stat-density.r +++ b/R/stat-density.r @@ -66,30 +66,27 @@ StatDensity <- ggproto("StatDensity", Stat, default_aes = aes(x = stat(density), y = stat(density), fill = NA, weight = NULL), setup_params = function(data, params) { - params$main_aes <- "x" - if (is.null(data$x) && is.null(params$x)) { - if (is.null(data$y) && is.null(params$y)) { - stop("stat_bin() requires either an x or y aesthetic.", call. = FALSE) - } else { - params$main_aes <- "y" - } + params$flipped_aes <- is.null(data$x) && is.null(params$x) + + if (is.null(data$x) && is.null(params$x) && is.null(data$y) && is.null(params$y)) { + stop("stat_density() requires either an x or y aesthetic.", call. = FALSE) } params }, compute_group = function(data, scales, bw = "nrd0", adjust = 1, kernel = "gaussian", - n = 512, trim = FALSE, na.rm = FALSE, main_aes = "x") { + n = 512, trim = FALSE, na.rm = FALSE, flipped_aes = FALSE) { + data <- flip_data(data, flipped_aes) if (trim) { - range <- range(data[[main_aes]], na.rm = TRUE) + range <- range(data$x, na.rm = TRUE) } else { - range <- scales[[main_aes]]$dimension() + range <- scales[[flipped_names(flipped_aes)$x]]$dimension() } - density <- compute_density(data[[main_aes]], data$weight, from = range[1], + density <- compute_density(data$x, data$weight, from = range[1], to = range[2], bw = bw, adjust = adjust, kernel = kernel, n = n) - density$main_aes <- main_aes - if (main_aes == "y") names(density) <- switch_position(names(density)) - density + density$flipped_aes <- flipped_aes + flip_data(density, flipped_aes) } ) diff --git a/R/stat-ydensity.r b/R/stat-ydensity.r index 35319650b0..be46ed7be9 100644 --- a/R/stat-ydensity.r +++ b/R/stat-ydensity.r @@ -63,13 +63,13 @@ StatYdensity <- ggproto("StatYdensity", Stat, setup_params = function(data, params) { x_groups <- vapply(split(data$x, data$group), function(x) length(unique(x)), integer(1)) if (all(x_groups == 1)) { - params$main_aes <- "x" + params$flipped_aes <- FALSE } else { y_groups <- vapply(split(data$y, data$group), function(x) length(unique(x)), integer(1)) if (all(y_groups == 1)) { - params$main_aes <- "y" + params$flipped_aes <- TRUE } else { - params$main_aes <- detect_direction(data) + params$flipped_aes <- has_flipped_aes(data, params) } } @@ -77,7 +77,7 @@ StatYdensity <- ggproto("StatYdensity", Stat, }, compute_group = function(data, scales, width = NULL, bw = "nrd0", adjust = 1, - kernel = "gaussian", trim = TRUE, na.rm = FALSE, main_aes = "x") { + 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 @@ -99,8 +99,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", main_aes = "x") { - if (main_aes == "y") names(data) <- switch_position(names(data)) + 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 @@ -117,9 +117,8 @@ StatYdensity <- ggproto("StatYdensity", Stat, # width: constant width (density scaled to a maximum of 1) width = data$scaled ) - if (main_aes == "y") names(data) <- switch_position(names(data)) - data$main_aes <- main_aes - data + data$flipped_aes <- flipped_aes + flip_data(data, flipped_aes) } ) diff --git a/R/utilities.r b/R/utilities.r index 839e18d5fd..abf8cea2cc 100644 --- a/R/utilities.r +++ b/R/utilities.r @@ -391,58 +391,62 @@ parse_safe <- function(text) { # Sniff out the intended direction based on the mapped aesthetics, returning as # soon as possible to make minimal work -detect_direction <- function(data) { - if (!is.null(data$main_aes)) return(data$main_aes[1]) +has_flipped_aes <- function(data, params = list()) { + if (!is.null(data$flipped_aes)) return(data$flipped_aes[1]) + + if (!is.null(params$orientation) && !is.na(params$orientation)) { + return(params$orientation == "y") + } if (any(c("ymin", "ymax") %in% names(data))) { if ("y" %in% names(data)) { - return("y") + return(TRUE) } else { - return("x") + return(FALSE) } } if (any(c("xmin", "xmax") %in% names(data))) { if ("x" %in% names(data)) { - return("x") + return(FALSE) } else { - return("y") + return(TRUE) } } y_is_int <- all(data$y == round(data$y)) x_is_int <- all(data$x == round(data$x)) if (xor(y_is_int, x_is_int)) { if (x_is_int) { - return("x") + return(FALSE) } else { - return("y") + return(TRUE) } } y_diff <- diff(unique(sort(data$y))) x_diff <- diff(unique(sort(data$x))) if (y_is_int && x_is_int) { if (sum(x_diff == 1) >= sum(y_diff == 1)) { - return("x") + return(FALSE) } else { - return("y") + return(TRUE) } } y_is_regular <- all((y_diff / min(y_diff)) %% 1 < .Machine$double.eps) x_is_regular <- all((x_diff / min(x_diff)) %% 1 < .Machine$double.eps) if (xor(y_is_regular, x_is_regular)) { if (x_is_regular) { - return("x") + return(FALSE) } else { - return("y") + return(TRUE) } } - "x" + FALSE } # Switch x and y variables in a data frame -switch_position <- function(aesthetics) { +switch_orientation <- function(aesthetics) { # We should have these as globals somewhere - x <- c("x", "xmin", "xmax", "xend", "xintercept", "xmin_final", "xmax_final", "xlower", "xmiddle", "xupper", "x0") - y <- c("y", "ymin", "ymax", "yend", "yintercept", "ymin_final", "ymax_final", "lower", "middle", "upper", "y0") + 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) @@ -455,4 +459,19 @@ switch_position <- function(aesthetics) { } aesthetics } - +flipped_names <- function(flip = FALSE) { + if (flip) { + ret <- as.list(ggplot_global$y_aes) + } else { + ret <- as.list(ggplot_global$x_aes) + } + names(ret) <- ggplot_global$x_aes + ret +} +flip_data <- function(data, flip = NULL) { + flip <- flip %||% data$flipped_aes[1] %||% FALSE + if (flip) { + names(data) <- switch_orientation(names(data)) + } + data +} From 6ef79c5d9318c3faf839f0d03c4c0d9ee7422092 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Mon, 2 Sep 2019 13:51:16 +0200 Subject: [PATCH 17/49] Add remaining positions --- R/position-dodge2.r | 9 +++++++-- R/position-jitterdodge.R | 9 +++++++-- R/position-stack.r | 13 ++++++++++--- 3 files changed, 24 insertions(+), 7 deletions(-) diff --git a/R/position-dodge2.r b/R/position-dodge2.r index 2bab0ba4fc..87c1ac06ad 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, params) + 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) } ) From 6147ec8c3ba8eaafe6d6ed00b2ed84a547cba33a Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Mon, 2 Sep 2019 13:51:32 +0200 Subject: [PATCH 18/49] fix crossbar/boxplot issues --- R/geom-boxplot.r | 2 +- R/geom-crossbar.r | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/geom-boxplot.r b/R/geom-boxplot.r index a449730d8e..4554025559 100644 --- a/R/geom-boxplot.r +++ b/R/geom-boxplot.r @@ -232,7 +232,7 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, ), common ), n = 2) - whiskers <- flip_data(whiskers, fliped_aes) + whiskers <- flip_data(whiskers, flipped_aes) box <- new_data_frame(c( list( diff --git a/R/geom-crossbar.r b/R/geom-crossbar.r index 2fee79b4d8..56157b83b6 100644 --- a/R/geom-crossbar.r +++ b/R/geom-crossbar.r @@ -58,7 +58,6 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom, middle$x <- middle$x + notchindent middle$xend <- middle$xend - notchindent - middle <- flip_data(middle, flipped_aes) box <- new_data_frame(list( x = c( @@ -92,6 +91,7 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom, )) } 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), From f964e8fcf54338c5cd3b596a071bb8235219a241 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Thu, 12 Sep 2019 11:14:39 +0200 Subject: [PATCH 19/49] imporved sniffing - allow geoms/stats to indicate features --- R/utilities.r | 75 +++++++++++++++++++++++++++++++-------------------- 1 file changed, 46 insertions(+), 29 deletions(-) diff --git a/R/utilities.r b/R/utilities.r index abf8cea2cc..fb3356aada 100644 --- a/R/utilities.r +++ b/R/utilities.r @@ -391,54 +391,68 @@ parse_safe <- function(text) { # Sniff out the intended direction based on the mapped aesthetics, returning as # soon as possible to make minimal work -has_flipped_aes <- function(data, params = list()) { - if (!is.null(data$flipped_aes)) return(data$flipped_aes[1]) +has_flipped_aes <- function(data, params = list(), main_is_orthogonal = NA, range_is_orthogonal = NA, group_has_equal = FALSE, ambiguous = 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") } - if (any(c("ymin", "ymax") %in% names(data))) { - if ("y" %in% names(data)) { - return(TRUE) - } else { - return(FALSE) - } + # 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) } - if (any(c("xmin", "xmax") %in% names(data))) { - if ("x" %in% names(data)) { + + # Does each group have a single x or y value + if (group_has_equal) { + x_groups <- vapply(split(data$x, data$group), function(x) length(unique(x)), integer(1)) + if (all(x_groups == 1)) { return(FALSE) - } else { + } + y_groups <- vapply(split(data$y, data$group), function(x) length(unique(x)), integer(1)) + if (all(y_groups == 1)) { return(TRUE) } } + + # 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.na(params$orientation)) { + return(FALSE) + } + + # Is there a single discrete-like position y_is_int <- all(data$y == round(data$y)) x_is_int <- all(data$x == round(data$x)) if (xor(y_is_int, x_is_int)) { - if (x_is_int) { - return(FALSE) - } else { - return(TRUE) - } + return(y_is_int) } + # If both are discrete like, which have most 1-spaced values y_diff <- diff(unique(sort(data$y))) x_diff <- diff(unique(sort(data$x))) if (y_is_int && x_is_int) { - if (sum(x_diff == 1) >= sum(y_diff == 1)) { - return(FALSE) - } else { - return(TRUE) - } + return(sum(x_diff == 1) < sum(y_diff == 1)) } + # If none are discrete is either regularly spaced y_is_regular <- all((y_diff / min(y_diff)) %% 1 < .Machine$double.eps) x_is_regular <- all((x_diff / min(x_diff)) %% 1 < .Machine$double.eps) if (xor(y_is_regular, x_is_regular)) { - if (x_is_regular) { - return(FALSE) - } else { - return(TRUE) - } + return(y_is_regular) } + # default to no FALSE } @@ -459,13 +473,16 @@ switch_orientation <- function(aesthetics) { } aesthetics } + flipped_names <- function(flip = FALSE) { + x_aes <- ggplot_global$x_aes + y_aes <- ggplot_global$y_aes if (flip) { - ret <- as.list(ggplot_global$y_aes) + ret <- as.list(c(y_aes, x_aes)) } else { - ret <- as.list(ggplot_global$x_aes) + ret <- as.list(c(x_aes, y_aes)) } - names(ret) <- ggplot_global$x_aes + names(ret) <- c(x_aes, y_aes) ret } flip_data <- function(data, flip = NULL) { From f379f87f8f0a788066a05c1e103fd15f90b6e82e Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Thu, 12 Sep 2019 11:27:46 +0200 Subject: [PATCH 20/49] Add orientation parameter to stats and geoms --- R/geom-bar.r | 7 ++++++- R/geom-boxplot.r | 5 ++++- R/geom-col.r | 3 +++ R/geom-crossbar.r | 4 ++++ R/geom-density.r | 2 ++ R/geom-errorbar.r | 5 +++++ R/geom-histogram.r | 2 ++ R/geom-linerange.r | 13 +++++++++++-- R/geom-pointrange.r | 8 ++++++++ R/geom-ribbon.r | 11 +++++++++-- R/geom-violin.r | 8 +++++++- R/stat-bin.r | 6 +++++- R/stat-boxplot.r | 24 ++++++------------------ R/stat-count.r | 6 +++++- R/stat-density.r | 6 +++++- R/stat-ydensity.r | 15 ++++----------- 16 files changed, 86 insertions(+), 39 deletions(-) diff --git a/R/geom-bar.r b/R/geom-bar.r index 585cb7a805..aee2d443e7 100644 --- a/R/geom-bar.r +++ b/R/geom-bar.r @@ -77,6 +77,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 +100,7 @@ geom_bar <- function(mapping = NULL, data = NULL, params = list( width = width, na.rm = na.rm, + orientation = orientation, ... ) ) @@ -118,11 +120,14 @@ GeomBar <- ggproto("GeomBar", GeomRect, non_missing_aes = c("xmin", "xmax", "ymin", "ymax"), setup_params = function(data, params) { - params$flipped_aes <- has_flipped_aes(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) diff --git a/R/geom-boxplot.r b/R/geom-boxplot.r index 4554025559..01ca61c8d6 100644 --- a/R/geom-boxplot.r +++ b/R/geom-boxplot.r @@ -116,6 +116,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 +149,7 @@ geom_boxplot <- function(mapping = NULL, data = NULL, notchwidth = notchwidth, varwidth = varwidth, na.rm = na.rm, + orientation = orientation, ... ) ) @@ -161,7 +163,7 @@ 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) @@ -169,6 +171,7 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, }, 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) diff --git a/R/geom-col.r b/R/geom-col.r index 53cc8648d0..be91cfc480 100644 --- a/R/geom-col.r +++ b/R/geom-col.r @@ -42,7 +42,10 @@ GeomCol <- ggproto("GeomCol", GeomRect, 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) diff --git a/R/geom-crossbar.r b/R/geom-crossbar.r index 56157b83b6..179894e912 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, ... ) ) @@ -32,6 +34,8 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom, GeomErrorbar$setup_params(data, params) }, + extra_params = c("na.rm", "orientation"), + setup_data = function(data, params) { GeomErrorbar$setup_data(data, params) }, diff --git a/R/geom-density.r b/R/geom-density.r index 5d96c3ac1a..f79bfb8f5d 100644 --- a/R/geom-density.r +++ b/R/geom-density.r @@ -49,6 +49,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 +63,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 ae9b3b0ba0..27072071ea 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, ... ) ) @@ -36,7 +38,10 @@ GeomErrorbar <- ggproto("GeomErrorbar", Geom, 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) diff --git a/R/geom-histogram.r b/R/geom-histogram.r index 2bdbe74315..c21ad9b82f 100644 --- a/R/geom-histogram.r +++ b/R/geom-histogram.r @@ -92,6 +92,7 @@ geom_histogram <- function(mapping = NULL, data = NULL, binwidth = NULL, bins = NULL, na.rm = FALSE, + orientation = orientation, show.legend = NA, inherit.aes = TRUE) { @@ -107,6 +108,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 ad09f5cffd..852fee4d3c 100644 --- a/R/geom-linerange.r +++ b/R/geom-linerange.r @@ -61,6 +61,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 +74,7 @@ geom_linerange <- function(mapping = NULL, data = NULL, inherit.aes = inherit.aes, params = list( na.rm = na.rm, + orientation = orientation, ... ) ) @@ -89,13 +91,20 @@ GeomLinerange <- ggproto("GeomLinerange", Geom, draw_key = draw_key_vpath, setup_params = function(data, params) { - params$flipped_aes <- all(c("y", "xmin", "xmax") %in% names(data)) - if (!params$flipped_aes || all(c("x", "ymin", "ymax") %in% names(data))) { + 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, flipped_aes = FALSE) { data <- flip_data(data, flipped_aes) data <- transform(data, xend = x, y = ymin, yend = ymax) diff --git a/R/geom-pointrange.r b/R/geom-pointrange.r index 6125a69fa9..6342160860 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, ... ) ) @@ -38,6 +40,12 @@ GeomPointrange <- ggproto("GeomPointrange", Geom, 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)) diff --git a/R/geom-ribbon.r b/R/geom-ribbon.r index 127ee02959..0f749fea74 100644 --- a/R/geom-ribbon.r +++ b/R/geom-ribbon.r @@ -36,6 +36,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 +49,7 @@ geom_ribbon <- function(mapping = NULL, data = NULL, inherit.aes = inherit.aes, params = list( na.rm = na.rm, + orientation = orientation, ... ) ) @@ -67,7 +69,10 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, params }, + extra_param = 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)) { @@ -134,8 +139,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, @@ -146,6 +151,7 @@ geom_area <- function(mapping = NULL, data = NULL, stat = "identity", inherit.aes = inherit.aes, params = list( na.rm = na.rm, + orientation = orientation, ... ) ) @@ -162,6 +168,7 @@ GeomArea <- ggproto("GeomArea", GeomRibbon, required_aes = c("x", "y"), setup_data = function(data, params) { + 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-violin.r b/R/geom-violin.r index d2bffb78f0..88a9b732fb 100644 --- a/R/geom-violin.r +++ b/R/geom-violin.r @@ -75,6 +75,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 +91,7 @@ geom_violin <- function(mapping = NULL, data = NULL, scale = scale, draw_quantiles = draw_quantiles, na.rm = na.rm, + orientation = orientation, ... ) ) @@ -101,10 +103,14 @@ geom_violin <- function(mapping = NULL, data = NULL, #' @export GeomViolin <- ggproto("GeomViolin", Geom, setup_params = function(data, params) { - params$flipped_aes <- has_flipped_aes(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) diff --git a/R/stat-bin.r b/R/stat-bin.r index 33fadc90fe..4c7b07de85 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,7 +84,7 @@ stat_bin <- function(mapping = NULL, data = NULL, #' @export StatBin <- ggproto("StatBin", Stat, setup_params = function(data, params) { - params$flipped_aes <- is.null(data$x) && is.null(params$x) + params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = FALSE) if (is.null(data$x) && is.null(params$x) && is.null(data$y) && is.null(params$y)) { stop("stat_bin() requires either an x or y aesthetic.", call. = FALSE) @@ -123,6 +125,8 @@ 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, diff --git a/R/stat-boxplot.r b/R/stat-boxplot.r index 82b58a0b2c..c48b3b5b01 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,7 +44,7 @@ stat_boxplot <- function(mapping = NULL, data = NULL, #' @usage NULL #' @export StatBoxplot <- ggproto("StatBoxplot", Stat, - required_aes = c("y"), + default_aes = aes(x = NULL, y = NULL), non_missing_aes = "weight", setup_data = function(data, params) { data <- flip_data(data, params$flipped_aes) @@ -57,23 +59,7 @@ StatBoxplot <- ggproto("StatBoxplot", Stat, }, setup_params = function(data, params) { - if (is.null(data$x)) { - params$flipped_aes <- FALSE - } else if (is.null(data$y)) { - params$flipped_aes <- TRUE - } else { - x_groups <- vapply(split(data$x, data$group), function(x) length(unique(x)), integer(1)) - if (all(x_groups == 1)) { - params$flipped_aes <- FALSE - } else { - y_groups <- vapply(split(data$y, data$group), function(x) length(unique(x)), integer(1)) - if (all(y_groups == 1)) { - params$flipped_aes <- TRUE - } else { - params$flipped_aes <- flipped_aes(data) - } - } - } + params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = TRUE, group_has_equal = TRUE) data <- flip_data(data, params$flipped_aes) if (is.null(data$x) && is.null(params$x) && is.null(data$y) && is.null(params$y)) { @@ -90,6 +76,8 @@ StatBoxplot <- ggproto("StatBoxplot", Stat, params }, + 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) diff --git a/R/stat-count.r b/R/stat-count.r index 85f11b5046..1243d63acb 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, ... ) @@ -49,7 +51,7 @@ StatCount <- ggproto("StatCount", Stat, default_aes = aes(x = stat(count), y = stat(count), weight = 1), setup_params = function(data, params) { - params$flipped_aes <- is.null(data$x) && is.null(params$x) + params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = FALSE) if (is.null(data$x) && is.null(params$x) && is.null(data$y) && is.null(params$y)) { stop("stat_count() requires either an x or y aesthetic.", call. = FALSE) @@ -57,6 +59,8 @@ StatCount <- ggproto("StatCount", Stat, params }, + 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 diff --git a/R/stat-density.r b/R/stat-density.r index c53b5e1c36..2cf33ebf10 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, ... ) ) @@ -66,7 +68,7 @@ StatDensity <- ggproto("StatDensity", Stat, default_aes = aes(x = stat(density), y = stat(density), fill = NA, weight = NULL), setup_params = function(data, params) { - params$flipped_aes <- is.null(data$x) && is.null(params$x) + params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = FALSE) if (is.null(data$x) && is.null(params$x) && is.null(data$y) && is.null(params$y)) { stop("stat_density() requires either an x or y aesthetic.", call. = FALSE) @@ -74,6 +76,8 @@ StatDensity <- ggproto("StatDensity", Stat, 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, flipped_aes = FALSE) { data <- flip_data(data, flipped_aes) diff --git a/R/stat-ydensity.r b/R/stat-ydensity.r index be46ed7be9..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")) @@ -61,21 +62,13 @@ StatYdensity <- ggproto("StatYdensity", Stat, non_missing_aes = "weight", setup_params = function(data, params) { - x_groups <- vapply(split(data$x, data$group), function(x) length(unique(x)), integer(1)) - if (all(x_groups == 1)) { - params$flipped_aes <- FALSE - } else { - y_groups <- vapply(split(data$y, data$group), function(x) length(unique(x)), integer(1)) - if (all(y_groups == 1)) { - params$flipped_aes <- TRUE - } else { - params$flipped_aes <- has_flipped_aes(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, flipped_aes = FALSE) { if (nrow(data) < 3) return(new_data_frame()) From 54183f126c145d52a86d5d5d94f6d5defb4bc77a Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Thu, 12 Sep 2019 11:28:01 +0200 Subject: [PATCH 21/49] Add line and smooth --- R/geom-path.r | 15 +++++++++++++-- R/geom-smooth.r | 17 ++++++++++++++--- R/stat-smooth.r | 12 ++++++++++-- 3 files changed, 37 insertions(+), 7 deletions(-) diff --git a/R/geom-path.r b/R/geom-path.r index f703809708..49ff3bff2c 100644 --- a/R/geom-path.r +++ b/R/geom-path.r @@ -236,7 +236,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 +248,7 @@ geom_line <- function(mapping = NULL, data = NULL, stat = "identity", inherit.aes = inherit.aes, params = list( na.rm = na.rm, + orientation = orientation, ... ) ) @@ -259,8 +260,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-smooth.r b/R/geom-smooth.r index 6c10e98ba5..514f9148e1 100644 --- a/R/geom-smooth.r +++ b/R/geom-smooth.r @@ -82,11 +82,13 @@ geom_smooth <- function(mapping = NULL, data = NULL, formula = y ~ x, 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 +114,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 +132,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/stat-smooth.r b/R/stat-smooth.r index 86e2e9dcab..1fd1fa0fb3 100644 --- a/R/stat-smooth.r +++ b/R/stat-smooth.r @@ -46,6 +46,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( @@ -64,6 +65,7 @@ stat_smooth <- function(mapping = NULL, data = NULL, fullrange = fullrange, level = level, na.rm = na.rm, + orientation = orientation, method.args = method.args, span = span, ... @@ -77,6 +79,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) if (identical(params$method, "auto")) { # Use loess for small datasets, gam with a cubic regression basis for # larger. Based on size of the _largest_ group to avoid bad memory @@ -98,10 +101,13 @@ StatSmooth <- ggproto("StatSmooth", Stat, params }, + extra_params = c("na.rm", "orientation"), + compute_group = function(data, scales, method = "auto", formula = y ~ x, 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()) @@ -146,7 +152,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") From 4a58c3f3d36713463601148f75f7d95daf771c9d Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Thu, 12 Sep 2019 14:34:52 +0200 Subject: [PATCH 22/49] Allow required_aes to take two distinct sets of aesthetics using "|" (e.g. "x|y") --- R/geom-.r | 3 ++- R/stat-.r | 3 ++- R/utilities.r | 16 +++++++++++++--- 3 files changed, 17 insertions(+), 5 deletions(-) diff --git a/R/geom-.r b/R/geom-.r index bca1b57ded..59d19bf87e 100644 --- a/R/geom-.r +++ b/R/geom-.r @@ -153,7 +153,8 @@ Geom <- ggproto("Geom", }, aesthetics = function(self) { - c(union(self$required_aes, names(self$default_aes)), self$optional_aes, "group") + required_aes <- unlist(strsplit(self$required_aes, '|', fixed = TRUE)) + c(union(required_aes, names(self$default_aes)), self$optional_aes, "group") } ) diff --git a/R/stat-.r b/R/stat-.r index f1b1b77985..fc318ed34a 100644 --- a/R/stat-.r +++ b/R/stat-.r @@ -144,7 +144,8 @@ Stat <- ggproto("Stat", }, aesthetics = function(self) { - c(union(self$required_aes, names(self$default_aes)), "group") + required_aes <- unlist(strsplit(self$required_aes, '|', fixed = TRUE)) + c(union(required_aes, names(self$default_aes)), "group") } ) diff --git a/R/utilities.r b/R/utilities.r index fb3356aada..31a7ee9905 100644 --- a/R/utilities.r +++ b/R/utilities.r @@ -24,11 +24,21 @@ 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() + 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 From f0518a9856abdad9ea4beb80a5a19c94aec33156 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Thu, 12 Sep 2019 14:35:16 +0200 Subject: [PATCH 23/49] fix sniffing if x and/or y are missing --- R/utilities.r | 32 ++++++++++++++++++++++---------- 1 file changed, 22 insertions(+), 10 deletions(-) diff --git a/R/utilities.r b/R/utilities.r index 31a7ee9905..0e03d2bb30 100644 --- a/R/utilities.r +++ b/R/utilities.r @@ -417,15 +417,22 @@ has_flipped_aes <- function(data, params = list(), main_is_orthogonal = NA, rang 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 each group have a single x or y value if (group_has_equal) { - x_groups <- vapply(split(data$x, data$group), function(x) length(unique(x)), integer(1)) - if (all(x_groups == 1)) { - return(FALSE) + 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) + } } - y_groups <- vapply(split(data$y, data$group), function(x) length(unique(x)), integer(1)) - if (all(y_groups == 1)) { - return(TRUE) + 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) + } } } @@ -444,9 +451,14 @@ has_flipped_aes <- function(data, params = list(), main_is_orthogonal = NA, rang return(FALSE) } + # give up early + if (!has_x && !has_y) { + return(FALSE) + } + # Is there a single discrete-like position - y_is_int <- all(data$y == round(data$y)) - x_is_int <- all(data$x == round(data$x)) + y_is_int <- if (has_y) all(data$y == round(data$y)) else FALSE + x_is_int <- if (has_x) all(data$x == round(data$x)) else FALSE if (xor(y_is_int, x_is_int)) { return(y_is_int) } @@ -457,8 +469,8 @@ has_flipped_aes <- function(data, params = list(), main_is_orthogonal = NA, rang return(sum(x_diff == 1) < sum(y_diff == 1)) } # If none are discrete is either regularly spaced - y_is_regular <- all((y_diff / min(y_diff)) %% 1 < .Machine$double.eps) - x_is_regular <- all((x_diff / min(x_diff)) %% 1 < .Machine$double.eps) + 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) } From 2cbd1d46084a18518dd2e9d8e94914c86fd31f15 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Thu, 12 Sep 2019 14:39:25 +0200 Subject: [PATCH 24/49] bring back required_aes --- R/geom-boxplot.r | 8 ++++---- R/geom-crossbar.r | 5 +++-- R/geom-errorbar.r | 5 +++-- R/geom-linerange.r | 5 +++-- R/geom-pointrange.r | 5 +++-- R/geom-ribbon.r | 7 ++++--- R/stat-bin.r | 4 +++- R/stat-boxplot.r | 2 +- R/stat-count.r | 2 ++ R/stat-density.r | 2 ++ 10 files changed, 28 insertions(+), 17 deletions(-) diff --git a/R/geom-boxplot.r b/R/geom-boxplot.r index 01ca61c8d6..8717e2978c 100644 --- a/R/geom-boxplot.r +++ b/R/geom-boxplot.r @@ -281,8 +281,8 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, draw_key = draw_key_boxplot, - default_aes = aes(x = NULL, ymin = NULL, ymax = NULL, y = NULL, xmin = NULL, - xmax = NULL, lower = NULL, upper = NULL, middle = NULL, xlower = NULL, - xupper = NULL, xmiddle = NULL, weight = 1, colour = "grey20", fill = "white", size = 0.5, - alpha = NA, shape = 19, linetype = "solid") + default_aes = aes(weight = 1, colour = "grey20", fill = "white", size = 0.5, + alpha = NA, shape = 19, linetype = "solid"), + + required_aes = c("x|y", "lower|xlower", "upper|xupper", "middle|xmiddle", "ymin|xmin", "ymax|ymin") ) diff --git a/R/geom-crossbar.r b/R/geom-crossbar.r index 179894e912..05fa058460 100644 --- a/R/geom-crossbar.r +++ b/R/geom-crossbar.r @@ -40,10 +40,11 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom, GeomErrorbar$setup_data(data, params) }, - default_aes = aes(x = NULL, y = NULL, xmin = NULL, xmax = NULL, ymin = NULL, - ymax = NULL, colour = "black", fill = NA, size = 0.5, linetype = 1, + default_aes = aes(colour = "black", fill = NA, size = 0.5, linetype = 1, alpha = NA), + 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, flipped_aes = FALSE) { diff --git a/R/geom-errorbar.r b/R/geom-errorbar.r index 27072071ea..4840d75d10 100644 --- a/R/geom-errorbar.r +++ b/R/geom-errorbar.r @@ -28,12 +28,13 @@ geom_errorbar <- function(mapping = NULL, data = NULL, #' @usage NULL #' @export GeomErrorbar <- ggproto("GeomErrorbar", Geom, - default_aes = aes(x = NULL, y = NULL, xmin = NULL, xmax = NULL, ymin = NULL, - ymax = NULL, colour = "black", size = 0.5, linetype = 1, width = 0.5, + default_aes = aes(colour = "black", size = 0.5, linetype = 1, width = 0.5, alpha = NA), draw_key = draw_key_path, + required_aes = c("x|y", "ymin|xmin", "ymax|xmax"), + setup_params = function(data, params) { GeomLinerange$setup_params(data, params) }, diff --git a/R/geom-linerange.r b/R/geom-linerange.r index 852fee4d3c..847db2ac56 100644 --- a/R/geom-linerange.r +++ b/R/geom-linerange.r @@ -85,11 +85,12 @@ geom_linerange <- function(mapping = NULL, data = NULL, #' @usage NULL #' @export GeomLinerange <- ggproto("GeomLinerange", Geom, - default_aes = aes(x = NULL, y = NULL, xmin = NULL, xmax = NULL, ymin = NULL, - ymax = NULL, colour = "black", size = 0.5, linetype = 1, alpha = NA), + default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA), draw_key = draw_key_vpath, + 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)))) { diff --git a/R/geom-pointrange.r b/R/geom-pointrange.r index 6342160860..5b018c1253 100644 --- a/R/geom-pointrange.r +++ b/R/geom-pointrange.r @@ -30,12 +30,13 @@ geom_pointrange <- function(mapping = NULL, data = NULL, #' @usage NULL #' @export GeomPointrange <- ggproto("GeomPointrange", Geom, - default_aes = aes(x = NULL, y = NULL, xmin = NULL, xmax = NULL, ymin = NULL, - ymax = NULL, colour = "black", size = 0.5, linetype = 1, shape = 19, + default_aes = aes(colour = "black", size = 0.5, linetype = 1, shape = 19, fill = NA, alpha = NA, stroke = 1), draw_key = draw_key_pointrange, + required_aes = c("x", "y", "ymin|xmin", "ymax|xmax"), + setup_params = function(data, params) { GeomLinerange$setup_params(data, params) }, diff --git a/R/geom-ribbon.r b/R/geom-ribbon.r index 0f749fea74..a4211d13f8 100644 --- a/R/geom-ribbon.r +++ b/R/geom-ribbon.r @@ -60,9 +60,10 @@ geom_ribbon <- function(mapping = NULL, data = NULL, #' @usage NULL #' @export GeomRibbon <- ggproto("GeomRibbon", Geom, - default_aes = aes(x = NULL, xmin = NULL, xmax = NULL, y = NULL, ymin = NULL, - ymax = NULL, colour = NA, fill = "grey20", size = 0.5, - linetype = 1, alpha = NA), + default_aes = aes(colour = NA, fill = "grey20", size = 0.5, linetype = 1, + alpha = NA), + + required_aes = c("x|y", "ymin|xmin", "ymax|xmax"), setup_params = function(data, params) { params$flipped_aes <- has_flipped_aes(data, params) diff --git a/R/stat-bin.r b/R/stat-bin.r index 4c7b07de85..1a45baa5bf 100644 --- a/R/stat-bin.r +++ b/R/stat-bin.r @@ -156,6 +156,8 @@ StatBin <- ggproto("StatBin", Stat, flip_data(bins, flipped_aes) }, - default_aes = aes(x = stat(count), y = stat(count), weight = 1) + 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 c48b3b5b01..1e936e214a 100644 --- a/R/stat-boxplot.r +++ b/R/stat-boxplot.r @@ -44,7 +44,7 @@ stat_boxplot <- function(mapping = NULL, data = NULL, #' @usage NULL #' @export StatBoxplot <- ggproto("StatBoxplot", Stat, - default_aes = aes(x = NULL, y = NULL), + required_aes = c("y|x"), non_missing_aes = "weight", setup_data = function(data, params) { data <- flip_data(data, params$flipped_aes) diff --git a/R/stat-count.r b/R/stat-count.r index 1243d63acb..b03859195b 100644 --- a/R/stat-count.r +++ b/R/stat-count.r @@ -48,6 +48,8 @@ stat_count <- function(mapping = NULL, data = NULL, #' @export #' @include stat-.r StatCount <- ggproto("StatCount", Stat, + required_aes = "x|y", + default_aes = aes(x = stat(count), y = stat(count), weight = 1), setup_params = function(data, params) { diff --git a/R/stat-density.r b/R/stat-density.r index 2cf33ebf10..98394bbef6 100644 --- a/R/stat-density.r +++ b/R/stat-density.r @@ -65,6 +65,8 @@ stat_density <- function(mapping = NULL, data = NULL, #' @usage NULL #' @export StatDensity <- ggproto("StatDensity", Stat, + required_aes = "x|y", + default_aes = aes(x = stat(density), y = stat(density), fill = NA, weight = NULL), setup_params = function(data, params) { From 68ebed43e4861ad4939c957c69d245db7ca8c773 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Thu, 12 Sep 2019 14:44:12 +0200 Subject: [PATCH 25/49] revert style --- R/stat-density.r | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/R/stat-density.r b/R/stat-density.r index 98394bbef6..3ad0573d40 100644 --- a/R/stat-density.r +++ b/R/stat-density.r @@ -109,15 +109,14 @@ compute_density <- function(x, w, from, to, bw = "nrd0", adjust = 1, # if less than 2 points return data frame of NAs and a warning if (nx < 2) { warning("Groups with fewer than two data points have been dropped.", call. = FALSE) - density <- new_data_frame(list( + return(new_data_frame(list( x = NA_real_, density = NA_real_, scaled = NA_real_, ndensity = NA_real_, count = NA_real_, n = NA_integer_ - ), n = 1) - return(density) + ), n = 1)) } dens <- stats::density(x, weights = w, bw = bw, adjust = adjust, From 7f5dad16c3cc88b142df24a5d1d92327b7a1646f Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Fri, 13 Sep 2019 14:28:22 +0200 Subject: [PATCH 26/49] update aesthetic doc generation to recognise "|" --- R/stat-summary-bin.R | 49 +++++++++++++++++++++++++++---------------- R/stat-summary.r | 33 ++++++++++++++++++++--------- R/utilities-help.r | 1 + man/geom_bar.Rd | 8 ++++--- man/geom_boxplot.Rd | 27 +++++++++++++++++------- man/geom_density.Rd | 6 +++--- man/geom_histogram.Rd | 5 +++-- man/geom_linerange.Rd | 24 +++++++++++++-------- man/geom_path.Rd | 4 ++-- man/geom_ribbon.Rd | 20 +++++++++++------- man/geom_smooth.Rd | 5 +++-- man/geom_violin.Rd | 6 +++--- man/stat_summary.Rd | 20 +++++++++--------- 13 files changed, 131 insertions(+), 77 deletions(-) diff --git a/R/stat-summary-bin.R b/R/stat-summary-bin.R index 0aa8a2dcaa..213673146d 100644 --- a/R/stat-summary-bin.R +++ b/R/stat-summary-bin.R @@ -5,16 +5,29 @@ 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, 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,9 +38,9 @@ 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, @@ -45,12 +58,12 @@ 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(), + 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) { - fun <- make_summary_fun(fun.data, fun.y, fun.ymax, fun.ymin, fun.args) + fun <- make_summary_fun(fun.data, fun, fun.max, fun.min, fun.args) breaks <- bin2d_breaks(scales$x, breaks, origin, binwidth, bins, right = right) @@ -64,11 +77,11 @@ StatSummaryBin <- ggproto("StatSummaryBin", Stat, } ) -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 +90,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 +100,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..c47c65a8fd 100644 --- a/R/stat-summary.r +++ b/R/stat-summary.r @@ -105,13 +105,26 @@ 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, 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,9 +135,9 @@ 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, ... @@ -139,11 +152,11 @@ 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(), + compute_panel = function(data, scales, fun.data = NULL, fun = NULL, + fun.max = NULL, fun.min = NULL, fun.args = list(), na.rm = FALSE) { - fun <- make_summary_fun(fun.data, fun.y, fun.ymax, fun.ymin, fun.args) + fun <- make_summary_fun(fun.data, fun, fun.max, fun.min, fun.args) summarise_by_x(data, fun) } ) diff --git a/R/utilities-help.r b/R/utilities-help.r index bff0a4fbe3..cb4da47398 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} ", req, fixed = TRUE) all <- union(req, sort(x$aesthetics())) ifelse(all %in% req, diff --git a/man/geom_bar.Rd b/man/geom_bar.Rd index d6245de4a9..b46ff7fae8 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 @@ -123,9 +124,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} y}} \item \code{group} \item \code{weight} +\item \code{x} \item \code{y} } Learn more about setting these aesthetics in \code{vignette("ggplot2-specs")}. diff --git a/man/geom_boxplot.Rd b/man/geom_boxplot.Rd index 19b56385ec..df4c3d6bc6 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 @@ -118,20 +118,31 @@ 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} y}} +\item \strong{\code{lower \emph{or} xlower}} +\item \strong{\code{upper \emph{or} xupper}} +\item \strong{\code{middle \emph{or} xmiddle}} +\item \strong{\code{ymin \emph{or} xmin}} +\item \strong{\code{ymax \emph{or} ymin}} \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{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")}. } diff --git a/man/geom_density.Rd b/man/geom_density.Rd index 3ccef5179d..fb9f0792ea 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 diff --git a/man/geom_histogram.Rd b/man/geom_histogram.Rd index 1cf44f65cf..12664608f8 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 = orientation, 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 diff --git a/man/geom_linerange.Rd b/man/geom_linerange.Rd index fcb57f367f..4d1b4712c5 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 @@ -82,14 +82,20 @@ Various ways of representing a vertical interval defined by \code{x}, \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} y}} +\item \strong{\code{ymin \emph{or} xmin}} +\item \strong{\code{ymax \emph{or} 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")}. } diff --git a/man/geom_path.Rd b/man/geom_path.Rd index 87042c73f0..4f9b2b036f 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, diff --git a/man/geom_ribbon.Rd b/man/geom_ribbon.Rd index f5142578ec..5a2e415e17 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 @@ -77,15 +77,21 @@ see the individual pattern as you move up the stack. See \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} y}} +\item \strong{\code{ymin \emph{or} xmin}} +\item \strong{\code{ymax \emph{or} 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")}. } diff --git a/man/geom_smooth.Rd b/man/geom_smooth.Rd index c29a0fa0d0..2504561e30 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 = "auto", formula = y ~ x, - 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 = "auto", formula = y ~ x, 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 diff --git a/man/geom_violin.Rd b/man/geom_violin.Rd index 247949f78d..0d83e6490e 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 diff --git a/man/stat_summary.Rd b/man/stat_summary.Rd index 3acd3a2588..45c636a356 100644 --- a/man/stat_summary.Rd +++ b/man/stat_summary.Rd @@ -6,15 +6,15 @@ \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, + 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, show.legend = NA, - inherit.aes = TRUE) + 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, + 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,10 +51,6 @@ 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 -single number.} - \item{fun.args}{Optional additional arguments passed on to the functions.} \item{bins}{Number of bins. Overridden by \code{binwidth}. Defaults to 30.} @@ -89,6 +85,10 @@ 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}{Alternatively, supply three individual +functions that are each passed a vector of x's and should return a +single number.} } \description{ \code{stat_summary} operates on unique \code{x}; \code{stat_summary_bin} From ca16b2cb62cb24dfdba51d6161a8e0125e1f0919 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Mon, 16 Sep 2019 13:46:44 +0200 Subject: [PATCH 27/49] Update docs to reflect orientation param etc --- R/geom-bar.r | 14 ++++++++++++++ R/geom-boxplot.r | 4 +++- R/geom-density.r | 4 +++- R/geom-histogram.r | 4 +++- R/geom-linerange.r | 4 +++- R/geom-path.r | 4 +++- R/geom-ribbon.r | 4 +++- R/geom-smooth.r | 4 +++- R/geom-violin.r | 4 +++- man/geom_bar.Rd | 17 +++++++++++++++++ man/geom_boxplot.Rd | 17 +++++++++++++++++ man/geom_density.Rd | 17 +++++++++++++++++ man/geom_histogram.Rd | 17 +++++++++++++++++ man/geom_linerange.Rd | 17 +++++++++++++++++ man/geom_path.Rd | 17 +++++++++++++++++ man/geom_ribbon.Rd | 17 +++++++++++++++++ man/geom_smooth.Rd | 17 +++++++++++++++++ man/geom_violin.Rd | 17 +++++++++++++++++ 18 files changed, 191 insertions(+), 8 deletions(-) diff --git a/R/geom-bar.r b/R/geom-bar.r index aee2d443e7..4f99e16200 100644 --- a/R/geom-bar.r +++ b/R/geom-bar.r @@ -19,6 +19,16 @@ #' [position_fill()] shows relative proportions at each `x` by stacking the bars #' and then standardising each bar to have the same height. #' +#' @section Orientation: +#' This geom treats each axis differently and can thus have two orientations. +#' Often the orientation is easily deducable from a combination of the given +#' mappings and the types of positional scales in use. Thus, ggplot2 will by +#' default try to guess which orientation the layer should have. Under rare +#' circumstances the orinetation is ambiguous and guessing may fail. In that +#' case the orientation can be given directly using the `orientation` parameter, +#' which can be either `"x"` or `"y"`. The value gives the axis that the geom +#' runs along, `"x"` being the default orientation you would expect for the geom. +#' #' @eval rd_aesthetics("geom", "bar") #' @eval rd_aesthetics("geom", "col") #' @eval rd_aesthetics("stat", "count") @@ -29,6 +39,10 @@ #' @export #' @inheritParams layer #' @inheritParams geom_point +#' @param orientation The orientation of the layer. The default (`NA`) +#' automatically determines the orientation from the aesthetic mapping. In the +#' rare event that this fails it can be given explicitly by setting `orientation` +#' to either `"x"` or `"y"`. #' @param width Bar width. By default, set to 90\% of the resolution of the data. #' @param binwidth `geom_bar()` no longer has a binwidth argument - if #' you use it you'll get an warning telling to you use diff --git a/R/geom-boxplot.r b/R/geom-boxplot.r index 8717e2978c..ecfcb698f9 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. #' +#' @inheritSection geom_bar Orientation +#' #' @section Summary statistics: #' The lower and upper hinges correspond to the first and third quartiles #' (the 25th and 75th percentiles). This differs slightly from the method used @@ -28,7 +30,7 @@ #' [geom_violin()] for a richer display of the distribution, and #' [geom_jitter()] for a useful technique for small data. #' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams geom_bar #' @param geom,stat Use to override the default connection between #' `geom_boxplot` and `stat_boxplot`. #' @param outlier.colour,outlier.color,outlier.fill,outlier.shape,outlier.size,outlier.stroke,outlier.alpha diff --git a/R/geom-density.r b/R/geom-density.r index f79bfb8f5d..affa65de68 100644 --- a/R/geom-density.r +++ b/R/geom-density.r @@ -4,12 +4,14 @@ #' the histogram. This is a useful alternative to the histogram for continuous #' data that comes from an underlying smooth distribution. #' +#' @inheritSection geom_bar Orientation +#' #' @eval rd_aesthetics("geom", "density") #' @seealso See [geom_histogram()], [geom_freqpoly()] for #' other methods of displaying continuous distribution. #' See [geom_violin()] for a compact density display. #' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams geom_bar #' @param geom,stat Use to override the default connection between #' `geom_density` and `stat_density`. #' @export diff --git a/R/geom-histogram.r b/R/geom-histogram.r index c21ad9b82f..348c5bd416 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. #' +#' @inheritSection geom_bar 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 diff --git a/R/geom-linerange.r b/R/geom-linerange.r index 847db2ac56..5b25cb522e 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. #' +#' @inheritSection geom_bar 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( diff --git a/R/geom-path.r b/R/geom-path.r index 49ff3bff2c..16979b7003 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. #' +#' @inheritSection geom_bar 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). diff --git a/R/geom-ribbon.r b/R/geom-ribbon.r index a4211d13f8..3b3610b9ce 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. #' +#' @inheritSection geom_bar 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 diff --git a/R/geom-smooth.r b/R/geom-smooth.r index 514f9148e1..1a0adf61bb 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. #' +#' @inheritSection geom_bar 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: diff --git a/R/geom-violin.r b/R/geom-violin.r index 88a9b732fb..aac08c02c6 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. #' +#' @inheritSection geom_bar 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 diff --git a/man/geom_bar.Rd b/man/geom_bar.Rd index b46ff7fae8..5d03a25221 100644 --- a/man/geom_bar.Rd +++ b/man/geom_bar.Rd @@ -57,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"}.} + \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. @@ -92,6 +97,18 @@ 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 can thus have two orientations. +Often the orientation is easily deducable from a combination of the given +mappings and the types of positional scales in use. Thus, ggplot2 will by +default try to guess which orientation the layer should have. Under rare +circumstances the orinetation is ambiguous and guessing may fail. In that +case the orientation can be given directly using the \code{orientation} parameter, +which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom +runs 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): diff --git a/man/geom_boxplot.Rd b/man/geom_boxplot.Rd index df4c3d6bc6..1c81e67876 100644 --- a/man/geom_boxplot.Rd +++ b/man/geom_boxplot.Rd @@ -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"}.} + \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. @@ -161,6 +166,18 @@ Learn more about setting these aesthetics in \code{vignette("ggplot2-specs")}. } } +\section{Orientation}{ + +This geom treats each axis differently and can thus have two orientations. +Often the orientation is easily deducable from a combination of the given +mappings and the types of positional scales in use. Thus, ggplot2 will by +default try to guess which orientation the layer should have. Under rare +circumstances the orinetation is ambiguous and guessing may fail. In that +case the orientation can be given directly using the \code{orientation} parameter, +which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom +runs along, \code{"x"} being the default orientation you would expect for the geom. +} + \examples{ p <- ggplot(mpg, aes(class, hwy)) p + geom_boxplot() diff --git a/man/geom_density.Rd b/man/geom_density.Rd index fb9f0792ea..793bc599f2 100644 --- a/man/geom_density.Rd +++ b/man/geom_density.Rd @@ -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"}.} + \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. @@ -116,6 +121,18 @@ plots} } } +\section{Orientation}{ + +This geom treats each axis differently and can thus have two orientations. +Often the orientation is easily deducable from a combination of the given +mappings and the types of positional scales in use. Thus, ggplot2 will by +default try to guess which orientation the layer should have. Under rare +circumstances the orinetation is ambiguous and guessing may fail. In that +case the orientation can be given directly using the \code{orientation} parameter, +which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom +runs along, \code{"x"} being the default orientation you would expect for the geom. +} + \examples{ ggplot(diamonds, aes(carat)) + geom_density() diff --git a/man/geom_histogram.Rd b/man/geom_histogram.Rd index 12664608f8..f899c9452a 100644 --- a/man/geom_histogram.Rd +++ b/man/geom_histogram.Rd @@ -80,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"}.} + \item{geom, stat}{Use to override the default connection between \code{geom_histogram()}/\code{geom_freqpoly()} and \code{stat_bin()}.} @@ -138,6 +143,18 @@ the full story behind your data. } } +\section{Orientation}{ + +This geom treats each axis differently and can thus have two orientations. +Often the orientation is easily deducable from a combination of the given +mappings and the types of positional scales in use. Thus, ggplot2 will by +default try to guess which orientation the layer should have. Under rare +circumstances the orinetation is ambiguous and guessing may fail. In that +case the orientation can be given directly using the \code{orientation} parameter, +which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom +runs along, \code{"x"} being the default orientation you would expect for the geom. +} + \examples{ ggplot(diamonds, aes(carat)) + geom_histogram() diff --git a/man/geom_linerange.Rd b/man/geom_linerange.Rd index 4d1b4712c5..7ff7baf131 100644 --- a/man/geom_linerange.Rd +++ b/man/geom_linerange.Rd @@ -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"}.} + \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. @@ -100,6 +105,18 @@ Various ways of representing a vertical interval defined by \code{x}, Learn more about setting these aesthetics in \code{vignette("ggplot2-specs")}. } +\section{Orientation}{ + +This geom treats each axis differently and can thus have two orientations. +Often the orientation is easily deducable from a combination of the given +mappings and the types of positional scales in use. Thus, ggplot2 will by +default try to guess which orientation the layer should have. Under rare +circumstances the orinetation is ambiguous and guessing may fail. In that +case the orientation can be given directly using the \code{orientation} parameter, +which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom +runs along, \code{"x"} being the default orientation you would expect for the geom. +} + \examples{ # Create a simple example dataset df <- data.frame( diff --git a/man/geom_path.Rd b/man/geom_path.Rd index 4f9b2b036f..3d26bfa7a4 100644 --- a/man/geom_path.Rd +++ b/man/geom_path.Rd @@ -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"}.} + \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.} @@ -116,6 +121,18 @@ the \code{NA} is removed silently, without warning. } } +\section{Orientation}{ + +This geom treats each axis differently and can thus have two orientations. +Often the orientation is easily deducable from a combination of the given +mappings and the types of positional scales in use. Thus, ggplot2 will by +default try to guess which orientation the layer should have. Under rare +circumstances the orinetation is ambiguous and guessing may fail. In that +case the orientation can be given directly using the \code{orientation} parameter, +which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom +runs along, \code{"x"} being the default orientation you would expect for the geom. +} + \examples{ # geom_line() is suitable for time series ggplot(economics, aes(date, unemploy)) + geom_line() diff --git a/man/geom_ribbon.Rd b/man/geom_ribbon.Rd index 5a2e415e17..e1f1718d34 100644 --- a/man/geom_ribbon.Rd +++ b/man/geom_ribbon.Rd @@ -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"}.} + \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. @@ -96,6 +101,18 @@ see the individual pattern as you move up the stack. See Learn more about setting these aesthetics in \code{vignette("ggplot2-specs")}. } +\section{Orientation}{ + +This geom treats each axis differently and can thus have two orientations. +Often the orientation is easily deducable from a combination of the given +mappings and the types of positional scales in use. Thus, ggplot2 will by +default try to guess which orientation the layer should have. Under rare +circumstances the orinetation is ambiguous and guessing may fail. In that +case the orientation can be given directly using the \code{orientation} parameter, +which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom +runs along, \code{"x"} being the default orientation you would expect for the geom. +} + \examples{ # Generate data huron <- data.frame(year = 1875:1972, level = as.vector(LakeHuron)) diff --git a/man/geom_smooth.Rd b/man/geom_smooth.Rd index 2504561e30..30c804af94 100644 --- a/man/geom_smooth.Rd +++ b/man/geom_smooth.Rd @@ -69,6 +69,11 @@ model that \code{method = "auto"} would use, then set \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"}.} + \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. @@ -140,6 +145,18 @@ Learn more about setting these aesthetics in \code{vignette("ggplot2-specs")}. } } +\section{Orientation}{ + +This geom treats each axis differently and can thus have two orientations. +Often the orientation is easily deducable from a combination of the given +mappings and the types of positional scales in use. Thus, ggplot2 will by +default try to guess which orientation the layer should have. Under rare +circumstances the orinetation is ambiguous and guessing may fail. In that +case the orientation can be given directly using the \code{orientation} parameter, +which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom +runs along, \code{"x"} being the default orientation you would expect for the geom. +} + \examples{ ggplot(mpg, aes(displ, hwy)) + geom_point() + diff --git a/man/geom_violin.Rd b/man/geom_violin.Rd index 0d83e6490e..dc67892fe3 100644 --- a/man/geom_violin.Rd +++ b/man/geom_violin.Rd @@ -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"}.} + \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. @@ -118,6 +123,18 @@ or to a constant maximum width} } } +\section{Orientation}{ + +This geom treats each axis differently and can thus have two orientations. +Often the orientation is easily deducable from a combination of the given +mappings and the types of positional scales in use. Thus, ggplot2 will by +default try to guess which orientation the layer should have. Under rare +circumstances the orinetation is ambiguous and guessing may fail. In that +case the orientation can be given directly using the \code{orientation} parameter, +which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom +runs along, \code{"x"} being the default orientation you would expect for the geom. +} + \examples{ p <- ggplot(mtcars, aes(factor(cyl), mpg)) p + geom_violin() From 3784134df6386e3eb56f630e476932a7ec2facc3 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 18 Sep 2019 08:59:56 +0200 Subject: [PATCH 28/49] Fix aesthetic spliiting when required_aes is NULL --- R/geom-.r | 6 +++++- R/stat-.r | 6 +++++- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/R/geom-.r b/R/geom-.r index 59d19bf87e..7c8fa47356 100644 --- a/R/geom-.r +++ b/R/geom-.r @@ -153,7 +153,11 @@ Geom <- ggproto("Geom", }, aesthetics = function(self) { - required_aes <- unlist(strsplit(self$required_aes, '|', fixed = TRUE)) + 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/stat-.r b/R/stat-.r index fc318ed34a..dc09bf99ba 100644 --- a/R/stat-.r +++ b/R/stat-.r @@ -144,7 +144,11 @@ Stat <- ggproto("Stat", }, aesthetics = function(self) { - required_aes <- unlist(strsplit(self$required_aes, '|', fixed = TRUE)) + 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") } From 03b631870b3da03e6e22409c243958fd3ce196b7 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 18 Sep 2019 09:01:50 +0200 Subject: [PATCH 29/49] Further refine sniffing to not break edge cases --- R/utilities.r | 24 ++++++++++++++++++++---- 1 file changed, 20 insertions(+), 4 deletions(-) diff --git a/R/utilities.r b/R/utilities.r index 0e03d2bb30..7883ae2a92 100644 --- a/R/utilities.r +++ b/R/utilities.r @@ -447,7 +447,7 @@ has_flipped_aes <- function(data, params = list(), main_is_orthogonal = NA, rang } # If ambiguous orientation = NA will give FALSE - if (ambiguous && is.na(params$orientation)) { + if (!is.null(params$orientation) && ambiguous && is.na(params$orientation)) { return(FALSE) } @@ -455,13 +455,29 @@ has_flipped_aes <- function(data, params = list(), main_is_orthogonal = NA, rang if (!has_x && !has_y) { 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) + } + # 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) all(data$y == round(data$y)) else FALSE - x_is_int <- if (has_x) all(data$x == round(data$x)) else FALSE + 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) } + # Is one of the axes a single value + if (all(data$x == 1)) { + return(FALSE) + } + if (all(data$y == 1)) { + return(TRUE) + } # If both are discrete like, which have most 1-spaced values y_diff <- diff(unique(sort(data$y))) x_diff <- diff(unique(sort(data$x))) From 57a09c3847cc470e433a7f69de00f944dcf71d33 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 18 Sep 2019 09:02:21 +0200 Subject: [PATCH 30/49] put \emph{} outside code block --- R/utilities-help.r | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/utilities-help.r b/R/utilities-help.r index cb4da47398..52290597ba 100644 --- a/R/utilities-help.r +++ b/R/utilities-help.r @@ -21,7 +21,7 @@ rd_aesthetics <- function(type, name) { rd_aesthetics_item <- function(x) { req <- x$required_aes - req <- sub("|", " \\emph{or} ", req, fixed = TRUE) + req <- sub("|", "} \\emph{or} \\code{", req, fixed = TRUE) all <- union(req, sort(x$aesthetics())) ifelse(all %in% req, From e6b41c4b1202072a9cc43f16382691bfb62651d8 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 18 Sep 2019 09:02:49 +0200 Subject: [PATCH 31/49] Refine error reporting --- R/stat-bin.r | 10 ++++++++-- R/stat-boxplot.r | 7 +++++-- R/stat-count.r | 10 ++++++++-- R/stat-density.r | 10 ++++++++-- 4 files changed, 29 insertions(+), 8 deletions(-) diff --git a/R/stat-bin.r b/R/stat-bin.r index 1a45baa5bf..ca4e8163c0 100644 --- a/R/stat-bin.r +++ b/R/stat-bin.r @@ -86,9 +86,15 @@ StatBin <- ggproto("StatBin", Stat, setup_params = function(data, params) { params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = FALSE) - if (is.null(data$x) && is.null(params$x) && is.null(data$y) && is.null(params$y)) { - stop("stat_bin() requires either an x or y aesthetic.", call. = 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) + } + x <- flipped_names(params$flipped_aes)$x if (is.integer(data[[x]])) { stop('StatBin requires a continuous ', x, ' variable: the ', diff --git a/R/stat-boxplot.r b/R/stat-boxplot.r index 1e936e214a..ac8ab5dc27 100644 --- a/R/stat-boxplot.r +++ b/R/stat-boxplot.r @@ -62,9 +62,12 @@ StatBoxplot <- ggproto("StatBoxplot", Stat, params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = TRUE, group_has_equal = TRUE) data <- flip_data(data, params$flipped_aes) - if (is.null(data$x) && is.null(params$x) && is.null(data$y) && is.null(params$y)) { - stop("stat_boxplot() requires either an x or y aesthetic.", call. = 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_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])) { diff --git a/R/stat-count.r b/R/stat-count.r index b03859195b..2276f56549 100644 --- a/R/stat-count.r +++ b/R/stat-count.r @@ -55,9 +55,15 @@ StatCount <- ggproto("StatCount", Stat, setup_params = function(data, params) { params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = FALSE) - if (is.null(data$x) && is.null(params$x) && is.null(data$y) && is.null(params$y)) { - stop("stat_count() requires either an x or y aesthetic.", call. = 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 }, diff --git a/R/stat-density.r b/R/stat-density.r index 3ad0573d40..3bdb28febb 100644 --- a/R/stat-density.r +++ b/R/stat-density.r @@ -72,9 +72,15 @@ StatDensity <- ggproto("StatDensity", Stat, setup_params = function(data, params) { params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = FALSE) - if (is.null(data$x) && is.null(params$x) && is.null(data$y) && is.null(params$y)) { - stop("stat_density() requires either an x or y aesthetic.", call. = 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_density() requires an x or y aesthetic.", call. = FALSE) } + if (has_x && has_y) { + stop("stat_density() can only have an x or y aesthetic.", call. = FALSE) + } + params }, From 4cdce8fb9b6c9c1e449c8838b2f5d5838b20b248 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 18 Sep 2019 09:03:18 +0200 Subject: [PATCH 32/49] Don't pass in non-existing params variable --- R/position-dodge.r | 2 +- R/position-dodge2.r | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/position-dodge.r b/R/position-dodge.r index 7f1970ada2..4730a7fbf3 100644 --- a/R/position-dodge.r +++ b/R/position-dodge.r @@ -89,7 +89,7 @@ PositionDodge <- ggproto("PositionDodge", Position, width = NULL, preserve = "total", setup_params = function(self, data) { - flipped_aes <- has_flipped_aes(data, params) + 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 = ?)`", diff --git a/R/position-dodge2.r b/R/position-dodge2.r index 87c1ac06ad..8cb6cb6d77 100644 --- a/R/position-dodge2.r +++ b/R/position-dodge2.r @@ -24,7 +24,7 @@ PositionDodge2 <- ggproto("PositionDodge2", PositionDodge, reverse = FALSE, setup_params = function(self, data) { - flipped_aes <- has_flipped_aes(data, params) + 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 = ?)`", From 71542a6fd87a93680fe69ffc2953dfa4ad7226a9 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 18 Sep 2019 09:03:49 +0200 Subject: [PATCH 33/49] Update docs and examples to show new orientation features --- R/geom-bar.r | 19 ++++++------------- R/geom-boxplot.r | 5 +++-- R/geom-density.r | 5 ++++- R/geom-histogram.r | 7 +++++-- R/geom-linerange.r | 6 +++++- R/geom-path.r | 5 ++++- R/geom-ribbon.r | 7 +++++-- R/geom-smooth.r | 7 ++++++- R/geom-violin.r | 6 +++++- R/utilities-help.r | 16 ++++++++++++++++ man/geom_bar.Rd | 20 +++++++------------- man/geom_boxplot.Rd | 34 ++++++++++++++-------------------- man/geom_density.Rd | 22 +++++++++------------- man/geom_histogram.Rd | 22 +++++++++------------- man/geom_linerange.Rd | 29 +++++++++++++---------------- man/geom_path.Rd | 22 +++++++++------------- man/geom_ribbon.Rd | 28 ++++++++++++---------------- man/geom_smooth.Rd | 24 +++++++++++------------- man/geom_violin.Rd | 23 ++++++++++------------- 19 files changed, 153 insertions(+), 154 deletions(-) diff --git a/R/geom-bar.r b/R/geom-bar.r index 4f99e16200..4a8309cffe 100644 --- a/R/geom-bar.r +++ b/R/geom-bar.r @@ -19,15 +19,7 @@ #' [position_fill()] shows relative proportions at each `x` by stacking the bars #' and then standardising each bar to have the same height. #' -#' @section Orientation: -#' This geom treats each axis differently and can thus have two orientations. -#' Often the orientation is easily deducable from a combination of the given -#' mappings and the types of positional scales in use. Thus, ggplot2 will by -#' default try to guess which orientation the layer should have. Under rare -#' circumstances the orinetation is ambiguous and guessing may fail. In that -#' case the orientation can be given directly using the `orientation` parameter, -#' which can be either `"x"` or `"y"`. The value gives the axis that the geom -#' runs along, `"x"` being the default orientation you would expect for the geom. +#' @eval rd_orientation() #' #' @eval rd_aesthetics("geom", "bar") #' @eval rd_aesthetics("geom", "col") @@ -42,7 +34,7 @@ #' @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"`. +#' 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 @@ -57,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() diff --git a/R/geom-boxplot.r b/R/geom-boxplot.r index ecfcb698f9..2c181b315b 100644 --- a/R/geom-boxplot.r +++ b/R/geom-boxplot.r @@ -4,7 +4,7 @@ #' It visualises five summary statistics (the median, two hinges #' and two whiskers), and all "outlying" points individually. #' -#' @inheritSection geom_bar Orientation +#' @eval rd_orientation() #' #' @section Summary statistics: #' The lower and upper hinges correspond to the first and third quartiles @@ -62,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) diff --git a/R/geom-density.r b/R/geom-density.r index affa65de68..093e3bf53e 100644 --- a/R/geom-density.r +++ b/R/geom-density.r @@ -4,7 +4,7 @@ #' the histogram. This is a useful alternative to the histogram for continuous #' data that comes from an underlying smooth distribution. #' -#' @inheritSection geom_bar Orientation +#' @eval rd_orientation() #' #' @eval rd_aesthetics("geom", "density") #' @seealso See [geom_histogram()], [geom_freqpoly()] for @@ -18,6 +18,9 @@ #' @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/R/geom-histogram.r b/R/geom-histogram.r index 348c5bd416..0629d93a65 100644 --- a/R/geom-histogram.r +++ b/R/geom-histogram.r @@ -17,7 +17,7 @@ #' one change at a time. You may need to look at a few options to uncover #' the full story behind your data. #' -#' @inheritSection geom_bar Orientation +#' @eval rd_orientation() #' #' @section Aesthetics: #' `geom_histogram()` uses the same aesthetics as [geom_bar()]; @@ -35,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 @@ -94,7 +97,7 @@ geom_histogram <- function(mapping = NULL, data = NULL, binwidth = NULL, bins = NULL, na.rm = FALSE, - orientation = orientation, + orientation = NA, show.legend = NA, inherit.aes = TRUE) { diff --git a/R/geom-linerange.r b/R/geom-linerange.r index 5b25cb522e..9676901c01 100644 --- a/R/geom-linerange.r +++ b/R/geom-linerange.r @@ -3,7 +3,7 @@ #' Various ways of representing a vertical interval defined by `x`, #' `ymin` and `ymax`. Each case draws a single graphical object. #' -#' @inheritSection geom_bar Orientation +#' @eval rd_orientation() #' #' @eval rd_aesthetics("geom", "linerange") #' @param fatten A multiplicative factor used to increase the size of the @@ -32,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)) + diff --git a/R/geom-path.r b/R/geom-path.r index 16979b7003..0f02f2f045 100644 --- a/R/geom-path.r +++ b/R/geom-path.r @@ -9,7 +9,7 @@ #' An alternative parameterisation is [geom_segment()], where each line #' corresponds to a single case which provides the start and end coordinates. #' -#' @inheritSection geom_bar Orientation +#' @eval rd_orientation() #' #' @eval rd_aesthetics("geom", "path") #' @inheritParams layer @@ -37,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"), ] diff --git a/R/geom-ribbon.r b/R/geom-ribbon.r index 3b3610b9ce..e28fdfb98a 100644 --- a/R/geom-ribbon.r +++ b/R/geom-ribbon.r @@ -12,7 +12,7 @@ #' see the individual pattern as you move up the stack. See #' [position_stack()] for the details of stacking algorithm. #' -#' @inheritSection geom_bar Orientation +#' @eval rd_orientation() #' #' @eval rd_aesthetics("geom", "ribbon") #' @seealso @@ -30,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") + @@ -72,7 +75,7 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, params }, - extra_param = c("na.rm", "orientation"), + extra_params = c("na.rm", "orientation"), setup_data = function(data, params) { data$flipped_aes <- params$flipped_aes diff --git a/R/geom-smooth.r b/R/geom-smooth.r index 1a0adf61bb..0ef3886b6f 100644 --- a/R/geom-smooth.r +++ b/R/geom-smooth.r @@ -12,7 +12,7 @@ #' `glm()`, where the normal confidence interval is constructed on the link #' scale and then back-transformed to the response scale. #' -#' @inheritSection geom_bar Orientation +#' @eval rd_orientation() #' #' @eval rd_aesthetics("geom", "smooth") #' @inheritParams layer @@ -29,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. diff --git a/R/geom-violin.r b/R/geom-violin.r index aac08c02c6..9a56f34639 100644 --- a/R/geom-violin.r +++ b/R/geom-violin.r @@ -5,7 +5,7 @@ #' violin plot is a mirrored density plot displayed in the same way as a #' boxplot. #' -#' @inheritSection geom_bar Orientation +#' @eval rd_orientation() #' #' @eval rd_aesthetics("geom", "violin") #' @inheritParams layer @@ -23,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) #' diff --git a/R/utilities-help.r b/R/utilities-help.r index 52290597ba..341fe257d1 100644 --- a/R/utilities-help.r +++ b/R/utilities-help.r @@ -29,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/man/geom_bar.Rd b/man/geom_bar.Rd index 5d03a25221..aa3d2737e8 100644 --- a/man/geom_bar.Rd +++ b/man/geom_bar.Rd @@ -60,7 +60,7 @@ 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"}.} +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. @@ -99,14 +99,7 @@ and then standardising each bar to have the same height. } \section{Orientation}{ -This geom treats each axis differently and can thus have two orientations. -Often the orientation is easily deducable from a combination of the given -mappings and the types of positional scales in use. Thus, ggplot2 will by -default try to guess which orientation the layer should have. Under rare -circumstances the orinetation is ambiguous and guessing may fail. In that -case the orientation can be given directly using the \code{orientation} parameter, -which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom -runs along, \code{"x"} being the default orientation you would expect for the geom. +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}{ @@ -141,7 +134,7 @@ 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 \emph{or} y}} +\item \strong{\code{x} \emph{or} \code{y}} \item \code{group} \item \code{weight} \item \code{x} @@ -166,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 1c81e67876..0a89551fdc 100644 --- a/man/geom_boxplot.Rd +++ b/man/geom_boxplot.Rd @@ -76,7 +76,7 @@ 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"}.} +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. @@ -99,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 @@ -123,12 +128,12 @@ 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 \emph{or} y}} -\item \strong{\code{lower \emph{or} xlower}} -\item \strong{\code{upper \emph{or} xupper}} -\item \strong{\code{middle \emph{or} xmiddle}} -\item \strong{\code{ymin \emph{or} xmin}} -\item \strong{\code{ymax \emph{or} ymin}} +\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{ymin}} \item \code{alpha} \item \code{colour} \item \code{fill} @@ -166,22 +171,11 @@ Learn more about setting these aesthetics in \code{vignette("ggplot2-specs")}. } } -\section{Orientation}{ - -This geom treats each axis differently and can thus have two orientations. -Often the orientation is easily deducable from a combination of the given -mappings and the types of positional scales in use. Thus, ggplot2 will by -default try to guess which orientation the layer should have. Under rare -circumstances the orinetation is ambiguous and guessing may fail. In that -case the orientation can be given directly using the \code{orientation} parameter, -which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom -runs along, \code{"x"} being the default orientation you would expect for the geom. -} - \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 793bc599f2..4aa678c18f 100644 --- a/man/geom_density.Rd +++ b/man/geom_density.Rd @@ -49,7 +49,7 @@ 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"}.} +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. @@ -92,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): @@ -121,21 +126,12 @@ plots} } } -\section{Orientation}{ - -This geom treats each axis differently and can thus have two orientations. -Often the orientation is easily deducable from a combination of the given -mappings and the types of positional scales in use. Thus, ggplot2 will by -default try to guess which orientation the layer should have. Under rare -circumstances the orinetation is ambiguous and guessing may fail. In that -case the orientation can be given directly using the \code{orientation} parameter, -which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom -runs along, \code{"x"} being the default orientation you would expect for the geom. -} - \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 f899c9452a..195b09d1d9 100644 --- a/man/geom_histogram.Rd +++ b/man/geom_histogram.Rd @@ -83,7 +83,7 @@ bin width of a time variable is the number of seconds.} \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"}.} +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()}.} @@ -127,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()}}; @@ -143,18 +148,6 @@ the full story behind your data. } } -\section{Orientation}{ - -This geom treats each axis differently and can thus have two orientations. -Often the orientation is easily deducable from a combination of the given -mappings and the types of positional scales in use. Thus, ggplot2 will by -default try to guess which orientation the layer should have. Under rare -circumstances the orinetation is ambiguous and guessing may fail. In that -case the orientation can be given directly using the \code{orientation} parameter, -which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom -runs along, \code{"x"} being the default orientation you would expect for the geom. -} - \examples{ ggplot(diamonds, aes(carat)) + geom_histogram() @@ -162,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 7ff7baf131..9e18cdfe89 100644 --- a/man/geom_linerange.Rd +++ b/man/geom_linerange.Rd @@ -66,7 +66,7 @@ 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"}.} +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. @@ -83,13 +83,18 @@ 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 \emph{or} y}} -\item \strong{\code{ymin \emph{or} xmin}} -\item \strong{\code{ymax \emph{or} xmax}} +\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} @@ -105,18 +110,6 @@ Various ways of representing a vertical interval defined by \code{x}, Learn more about setting these aesthetics in \code{vignette("ggplot2-specs")}. } -\section{Orientation}{ - -This geom treats each axis differently and can thus have two orientations. -Often the orientation is easily deducable from a combination of the given -mappings and the types of positional scales in use. Thus, ggplot2 will by -default try to guess which orientation the layer should have. Under rare -circumstances the orinetation is ambiguous and guessing may fail. In that -case the orientation can be given directly using the \code{orientation} parameter, -which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom -runs along, \code{"x"} being the default orientation you would expect for the geom. -} - \examples{ # Create a simple example dataset df <- data.frame( @@ -133,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 3d26bfa7a4..5685b91c23 100644 --- a/man/geom_path.Rd +++ b/man/geom_path.Rd @@ -76,7 +76,7 @@ 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"}.} +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 @@ -93,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): @@ -121,24 +126,15 @@ the \code{NA} is removed silently, without warning. } } -\section{Orientation}{ - -This geom treats each axis differently and can thus have two orientations. -Often the orientation is easily deducable from a combination of the given -mappings and the types of positional scales in use. Thus, ggplot2 will by -default try to guess which orientation the layer should have. Under rare -circumstances the orinetation is ambiguous and guessing may fail. In that -case the orientation can be given directly using the \code{orientation} parameter, -which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom -runs along, \code{"x"} being the default orientation you would expect for the geom. -} - \examples{ # geom_line() is suitable for time series 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 e1f1718d34..06b5b619d0 100644 --- a/man/geom_ribbon.Rd +++ b/man/geom_ribbon.Rd @@ -51,7 +51,7 @@ 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"}.} +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. @@ -78,13 +78,18 @@ 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 \emph{or} y}} -\item \strong{\code{ymin \emph{or} xmin}} -\item \strong{\code{ymax \emph{or} xmax}} +\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} @@ -101,18 +106,6 @@ see the individual pattern as you move up the stack. See Learn more about setting these aesthetics in \code{vignette("ggplot2-specs")}. } -\section{Orientation}{ - -This geom treats each axis differently and can thus have two orientations. -Often the orientation is easily deducable from a combination of the given -mappings and the types of positional scales in use. Thus, ggplot2 will by -default try to guess which orientation the layer should have. Under rare -circumstances the orinetation is ambiguous and guessing may fail. In that -case the orientation can be given directly using the \code{orientation} parameter, -which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom -runs along, \code{"x"} being the default orientation you would expect for the geom. -} - \examples{ # Generate data huron <- data.frame(year = 1875:1972, level = as.vector(LakeHuron)) @@ -121,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 30c804af94..58fc94563c 100644 --- a/man/geom_smooth.Rd +++ b/man/geom_smooth.Rd @@ -72,7 +72,7 @@ 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"}.} +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. @@ -116,6 +116,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): @@ -145,23 +150,16 @@ Learn more about setting these aesthetics in \code{vignette("ggplot2-specs")}. } } -\section{Orientation}{ - -This geom treats each axis differently and can thus have two orientations. -Often the orientation is easily deducable from a combination of the given -mappings and the types of positional scales in use. Thus, ggplot2 will by -default try to guess which orientation the layer should have. Under rare -circumstances the orinetation is ambiguous and guessing may fail. In that -case the orientation can be given directly using the \code{orientation} parameter, -which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom -runs along, \code{"x"} being the default orientation you would expect for the geom. -} - \examples{ 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 dc67892fe3..a290448257 100644 --- a/man/geom_violin.Rd +++ b/man/geom_violin.Rd @@ -60,7 +60,7 @@ 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"}.} +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. @@ -93,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): @@ -123,22 +128,14 @@ or to a constant maximum width} } } -\section{Orientation}{ - -This geom treats each axis differently and can thus have two orientations. -Often the orientation is easily deducable from a combination of the given -mappings and the types of positional scales in use. Thus, ggplot2 will by -default try to guess which orientation the layer should have. Under rare -circumstances the orinetation is ambiguous and guessing may fail. In that -case the orientation can be given directly using the \code{orientation} parameter, -which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom -runs along, \code{"x"} being the default orientation you would expect for the geom. -} - \examples{ 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) From ff2c240ab31d2e71d88317e5ec0bc6f35fa87407 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 18 Sep 2019 09:04:06 +0200 Subject: [PATCH 34/49] Fix expected errors in tests --- tests/testthat/test-stat-bin.R | 4 ++-- tests/testthat/test-stats.r | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-stat-bin.R b/tests/testthat/test-stat-bin.R index c76520a4c6..5f97f57003 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)), @@ -144,7 +144,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-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$") }) From ff7b19fb2684139ccfccfb1de5c5b55014d2d5f8 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 18 Sep 2019 12:12:41 +0200 Subject: [PATCH 35/49] Fix typo in required aes --- R/geom-boxplot.r | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/geom-boxplot.r b/R/geom-boxplot.r index 2c181b315b..8ce8574114 100644 --- a/R/geom-boxplot.r +++ b/R/geom-boxplot.r @@ -287,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|y", "lower|xlower", "upper|xupper", "middle|xmiddle", "ymin|xmin", "ymax|ymin") + required_aes = c("x|y", "lower|xlower", "upper|xupper", "middle|xmiddle", "ymin|xmin", "ymax|xmax") ) From e39a9f95317f81e4c2dff681253ddea9fb0b728e Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 18 Sep 2019 12:13:00 +0200 Subject: [PATCH 36/49] geom_area is ambiguous --- R/geom-ribbon.r | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/geom-ribbon.r b/R/geom-ribbon.r index e28fdfb98a..df9e8b7968 100644 --- a/R/geom-ribbon.r +++ b/R/geom-ribbon.r @@ -173,6 +173,11 @@ 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) { data$flipped_aes <- params$flipped_aes data <- flip_data(data, params$flipped_aes) From b701af75146c3025c9b9d42e02deaa3a156e3f01 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 18 Sep 2019 12:14:15 +0200 Subject: [PATCH 37/49] =?UTF-8?q?Use=20#=20for=20comments=20(=EF=BC=8D?= =?UTF-8?q?=E2=80=B8=E1=83=9A)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- R/geom-smooth.r | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/geom-smooth.r b/R/geom-smooth.r index 0ef3886b6f..210b9cc540 100644 --- a/R/geom-smooth.r +++ b/R/geom-smooth.r @@ -29,7 +29,7 @@ #' geom_point() + #' geom_smooth() #' -#' IF you need the fitting to be done along the y-axis set the orientation +#' # 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") From 98786e7d6d4acc3da18a9cf019d62983f01fa457 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 18 Sep 2019 12:15:35 +0200 Subject: [PATCH 38/49] stat_density can be used with both positions mapped --- R/stat-density.r | 3 --- 1 file changed, 3 deletions(-) diff --git a/R/stat-density.r b/R/stat-density.r index 3bdb28febb..4b1990647f 100644 --- a/R/stat-density.r +++ b/R/stat-density.r @@ -77,9 +77,6 @@ StatDensity <- ggproto("StatDensity", Stat, if (!has_x && !has_y) { stop("stat_density() requires an x or y aesthetic.", call. = FALSE) } - if (has_x && has_y) { - stop("stat_density() can only have an x or y aesthetic.", call. = FALSE) - } params }, From f805f18db7f9e6021cce046e233cf803cd1017fd Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 18 Sep 2019 12:16:11 +0200 Subject: [PATCH 39/49] fix docs --- R/stat-summary.r | 2 +- man/geom_boxplot.Rd | 3 ++- man/geom_histogram.Rd | 2 +- man/geom_smooth.Rd | 2 +- man/stat_summary.Rd | 8 ++++---- 5 files changed, 9 insertions(+), 8 deletions(-) diff --git a/R/stat-summary.r b/R/stat-summary.r index c47c65a8fd..1bc63d6435 100644 --- a/R/stat-summary.r +++ b/R/stat-summary.r @@ -34,7 +34,7 @@ #' #' @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 +#' @param fun.min,fun,fun.max Alternatively, supply three individual #' functions that are each passed a vector of x's and should return a #' single number. #' @param fun.args Optional additional arguments passed on to the functions. diff --git a/man/geom_boxplot.Rd b/man/geom_boxplot.Rd index 0a89551fdc..32d492425c 100644 --- a/man/geom_boxplot.Rd +++ b/man/geom_boxplot.Rd @@ -133,7 +133,7 @@ See McGill et al. (1978) for more details. \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{ymin}} +\item \strong{\code{ymax} \emph{or} \code{xmax}} \item \code{alpha} \item \code{colour} \item \code{fill} @@ -147,6 +147,7 @@ See McGill et al. (1978) for more details. \item \code{weight} \item \code{x} \item \code{xlower} +\item \code{xmax} \item \code{xmiddle} \item \code{xmin} \item \code{xupper} diff --git a/man/geom_histogram.Rd b/man/geom_histogram.Rd index 195b09d1d9..228c06c73a 100644 --- a/man/geom_histogram.Rd +++ b/man/geom_histogram.Rd @@ -13,7 +13,7 @@ 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, orientation = orientation, show.legend = NA, + na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE) stat_bin(mapping = NULL, data = NULL, geom = "bar", diff --git a/man/geom_smooth.Rd b/man/geom_smooth.Rd index 58fc94563c..f314d9177f 100644 --- a/man/geom_smooth.Rd +++ b/man/geom_smooth.Rd @@ -155,7 +155,7 @@ ggplot(mpg, aes(displ, hwy)) + geom_point() + geom_smooth() -IF you need the fitting to be done along the y-axis set the orientation +# 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") diff --git a/man/stat_summary.Rd b/man/stat_summary.Rd index 45c636a356..e1d6322156 100644 --- a/man/stat_summary.Rd +++ b/man/stat_summary.Rd @@ -51,6 +51,10 @@ 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.min, fun, fun.max}{Alternatively, supply three individual +functions that are each passed a vector of x's and should return a +single number.} + \item{fun.args}{Optional additional arguments passed on to the functions.} \item{bins}{Number of bins. Overridden by \code{binwidth}. Defaults to 30.} @@ -85,10 +89,6 @@ 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}{Alternatively, supply three individual -functions that are each passed a vector of x's and should return a -single number.} } \description{ \code{stat_summary} operates on unique \code{x}; \code{stat_summary_bin} From 0bd3f5209979a2ef4faf184b60df3bb4d97144d3 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 18 Sep 2019 12:16:47 +0200 Subject: [PATCH 40/49] Further tweaks to sniffing... a few layers has a continuous main axis --- R/stat-density.r | 2 +- R/utilities.r | 24 +++++++++++++----------- 2 files changed, 14 insertions(+), 12 deletions(-) diff --git a/R/stat-density.r b/R/stat-density.r index 4b1990647f..804d2c6e0c 100644 --- a/R/stat-density.r +++ b/R/stat-density.r @@ -70,7 +70,7 @@ StatDensity <- ggproto("StatDensity", Stat, 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) + 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)) diff --git a/R/utilities.r b/R/utilities.r index 7883ae2a92..1a7c065391 100644 --- a/R/utilities.r +++ b/R/utilities.r @@ -24,6 +24,8 @@ scales::alpha # @param name of object for error message # @keyword internal check_required_aesthetics <- function(required, present, name) { + if (is.null(required)) return() + required <- strsplit(required, "|", fixed = TRUE) if (any(vapply(required, length, integer(1)) > 1)) { required <- lapply(required, rep_len, 2) @@ -401,7 +403,7 @@ parse_safe <- function(text) { # Sniff out the intended direction based on the mapped aesthetics, returning as # soon as possible to make minimal work -has_flipped_aes <- function(data, params = list(), main_is_orthogonal = NA, range_is_orthogonal = NA, group_has_equal = FALSE, ambiguous = FALSE) { +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]) @@ -447,7 +449,7 @@ has_flipped_aes <- function(data, params = list(), main_is_orthogonal = NA, rang } # If ambiguous orientation = NA will give FALSE - if (!is.null(params$orientation) && ambiguous && is.na(params$orientation)) { + if (ambiguous && (is.null(params$orientation) || is.na(params$orientation))) { return(FALSE) } @@ -459,7 +461,7 @@ has_flipped_aes <- function(data, params = list(), main_is_orthogonal = NA, rang 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) + return(y_is_int != main_is_continuous) } # Both true discrete. give up if (y_is_int && x_is_int) { @@ -469,26 +471,26 @@ has_flipped_aes <- function(data, params = list(), main_is_orthogonal = NA, rang 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) + return(y_is_int != main_is_continuous) } # Is one of the axes a single value if (all(data$x == 1)) { - return(FALSE) + return(main_is_continuous) } if (all(data$y == 1)) { - return(TRUE) + return(!main_is_continuous) } - # If both are discrete like, which have most 1-spaced values - y_diff <- diff(unique(sort(data$y))) - x_diff <- diff(unique(sort(data$x))) + # 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)) + 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) + return(y_is_regular != main_is_continuous) } # default to no FALSE From 881ec191f934c656701b662f42470c59f2f039b1 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 18 Sep 2019 13:54:10 +0200 Subject: [PATCH 41/49] Add stat_summary[_bin]() --- R/stat-summary-bin.R | 22 ++++++++++----- R/stat-summary.r | 64 +++++++++++++++++++++++++++++++------------- man/stat_summary.Rd | 64 +++++++++++++++++++++++++++++++------------- 3 files changed, 108 insertions(+), 42 deletions(-) diff --git a/R/stat-summary-bin.R b/R/stat-summary-bin.R index 213673146d..811f598faa 100644 --- a/R/stat-summary-bin.R +++ b/R/stat-summary-bin.R @@ -13,6 +13,7 @@ stat_summary_bin <- function(mapping = NULL, data = NULL, binwidth = NULL, breaks = NULL, na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE, fun.y, fun.ymin, fun.ymax) { @@ -46,6 +47,7 @@ stat_summary_bin <- function(mapping = NULL, data = NULL, binwidth = binwidth, breaks = breaks, na.rm = na.rm, + orientation = orientation, ... ) ) @@ -58,22 +60,30 @@ stat_summary_bin <- function(mapping = NULL, data = NULL, StatSummaryBin <- ggproto("StatSummaryBin", Stat, required_aes = c("x", "y"), + extra_params = c("na.rm", "orientation"), + setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params, ambiguous = TRUE) + params + }, + 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) { - + 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) - - breaks <- bin2d_breaks(scales$x, breaks, origin, binwidth, bins, right = right) + 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) } ) diff --git a/R/stat-summary.r b/R/stat-summary.r index 1bc63d6435..b4a43ebb8d 100644 --- a/R/stat-summary.r +++ b/R/stat-summary.r @@ -1,33 +1,40 @@ #' 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()]. @@ -35,32 +42,43 @@ #' @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.min,fun,fun.max Alternatively, supply three individual -#' functions that are each passed a vector of x's and should return a +#' 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 @@ -110,6 +128,7 @@ stat_summary <- function(mapping = NULL, data = NULL, fun.min = NULL, fun.args = list(), na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE, fun.y, fun.ymin, fun.ymax) { @@ -140,6 +159,7 @@ stat_summary <- function(mapping = NULL, data = NULL, fun.min = fun.min, fun.args = fun.args, na.rm = na.rm, + orientation = orientation, ... ) ) @@ -152,12 +172,20 @@ stat_summary <- function(mapping = NULL, data = NULL, StatSummary <- ggproto("StatSummary", Stat, required_aes = c("x", "y"), + extra_params = c("na.rm", "orientation"), + setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params) + params + }, + compute_panel = function(data, scales, fun.data = NULL, fun = NULL, fun.max = NULL, fun.min = NULL, fun.args = list(), - na.rm = 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) - summarise_by_x(data, fun) + summarised <- summarise_by_x(data, fun) + summarised$flipped_aes <- flipped_aes + flip_data(summarised, flipped_aes) } ) diff --git a/man/stat_summary.Rd b/man/stat_summary.Rd index e1d6322156..6480650e9d 100644 --- a/man/stat_summary.Rd +++ b/man/stat_summary.Rd @@ -8,13 +8,14 @@ stat_summary_bin(mapping = NULL, data = NULL, geom = "pointrange", 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, show.legend = NA, - inherit.aes = TRUE, fun.y, fun.ymin, fun.ymax) + 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 = NULL, fun.max = NULL, fun.min = NULL, fun.args = list(), na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE, fun.y, fun.ymin, fun.ymax) + 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 @@ -52,7 +53,7 @@ to the paired geom/stat.} return a data frame with variables \code{ymin}, \code{y}, and \code{ymax}.} \item{fun.min, fun, fun.max}{Alternatively, supply three individual -functions that are each passed a vector of x's and should return a +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 From 1932acc10cb90117d872680d76f87a6703de960e Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Thu, 19 Sep 2019 13:07:16 +0200 Subject: [PATCH 42/49] Test for correct orientation handling --- tests/testthat/test-geom-bar.R | 16 ++++++++++++++++ tests/testthat/test-geom-boxplot.R | 16 ++++++++++++++++ tests/testthat/test-geom-col.R | 16 ++++++++++++++++ tests/testthat/test-geom-ribbon.R | 18 ++++++++++++++++++ tests/testthat/test-geom-smooth.R | 14 ++++++++++++++ tests/testthat/test-geom-violin.R | 14 ++++++++++++++ tests/testthat/test-stat-bin.R | 14 ++++++++++++++ tests/testthat/test-stat-density.R | 14 ++++++++++++++ 8 files changed, 122 insertions(+) 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 0c378eae31..ebb423c25f 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 5f97f57003..818bb41135 100644 --- a/tests/testthat/test-stat-bin.R +++ b/tests/testthat/test-stat-bin.R @@ -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, ...) { 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)) From 64c1a01c6074a73d0959a21a7c8ca53a75d43655 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Thu, 19 Sep 2019 13:07:45 +0200 Subject: [PATCH 43/49] export utilities for omnidirectionality --- NAMESPACE | 3 ++ R/utilities.r | 98 ++++++++++++++++++++++++++++++++------------ man/omnidirection.Rd | 65 +++++++++++++++++++++++++++++ 3 files changed, 139 insertions(+), 27 deletions(-) create mode 100644 man/omnidirection.Rd diff --git a/NAMESPACE b/NAMESPACE index 3670510528..c00d2cceac 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -298,6 +298,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) @@ -366,6 +368,7 @@ export(guide_legend) export(guide_merge) export(guide_train) export(guides) +export(has_flipped_aes) export(is.Coord) export(is.facet) export(is.ggplot) diff --git a/R/utilities.r b/R/utilities.r index 1a7c065391..2177ddecc5 100644 --- a/R/utilities.r +++ b/R/utilities.r @@ -401,9 +401,68 @@ parse_safe <- function(text) { out } -# Sniff out the intended direction based on the mapped aesthetics, returning as -# soon as possible to make minimal work -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) { +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 omnidirecitonal 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. +#' +#' @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 does 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 omnidirection +#' +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]) @@ -495,25 +554,17 @@ has_flipped_aes <- function(data, params = list(), main_is_orthogonal = NA, rang # default to no FALSE } - -# Switch x and y variables in a data frame -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]] +#' @rdname omnidirection +#' @export +flip_data <- function(data, flip = NULL) { + flip <- flip %||% data$flipped_aes[1] %||% FALSE + if (flip) { + names(data) <- switch_orientation(names(data)) } - aesthetics + data } - +#' @rdname omnidirection +#' @export flipped_names <- function(flip = FALSE) { x_aes <- ggplot_global$x_aes y_aes <- ggplot_global$y_aes @@ -525,10 +576,3 @@ flipped_names <- function(flip = FALSE) { names(ret) <- c(x_aes, y_aes) ret } -flip_data <- function(data, flip = NULL) { - flip <- flip %||% data$flipped_aes[1] %||% FALSE - if (flip) { - names(data) <- switch_orientation(names(data)) - } - data -} diff --git a/man/omnidirection.Rd b/man/omnidirection.Rd new file mode 100644 index 0000000000..7b465485f8 --- /dev/null +++ b/man/omnidirection.Rd @@ -0,0 +1,65 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities.r +\name{omnidirection} +\alias{omnidirection} +\alias{has_flipped_aes} +\alias{flip_data} +\alias{flipped_names} +\title{Utilities for working with omnidirecitonal 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 does 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. +} +\keyword{internal} From 0430426f07264427cf1537ab2db4b9ed92c646f0 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Thu, 19 Sep 2019 13:08:15 +0200 Subject: [PATCH 44/49] add section on how to create stats and geoms that handle two orientations --- vignettes/extending-ggplot2.Rmd | 46 +++++++++++++++++++++++++++++++++ 1 file changed, 46 insertions(+) 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: From 5ba49d5cea606d63b51f99d249b652ce0838fa5c Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Thu, 26 Sep 2019 15:08:33 +0200 Subject: [PATCH 45/49] change name to bidirection --- R/utilities.r | 6 +-- man/bidirection.Rd | 101 +++++++++++++++++++++++++++++++++++++++++++ man/omnidirection.Rd | 65 ---------------------------- 3 files changed, 104 insertions(+), 68 deletions(-) create mode 100644 man/bidirection.Rd delete mode 100644 man/omnidirection.Rd diff --git a/R/utilities.r b/R/utilities.r index 2177ddecc5..3369be0741 100644 --- a/R/utilities.r +++ b/R/utilities.r @@ -418,7 +418,7 @@ switch_orientation <- function(aesthetics) { aesthetics } -#' Utilities for working with omnidirecitonal layers +#' 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 @@ -554,7 +554,7 @@ has_flipped_aes <- function(data, params = list(), main_is_orthogonal = NA, # default to no FALSE } -#' @rdname omnidirection +#' @rdname bidirection #' @export flip_data <- function(data, flip = NULL) { flip <- flip %||% data$flipped_aes[1] %||% FALSE @@ -563,7 +563,7 @@ flip_data <- function(data, flip = NULL) { } data } -#' @rdname omnidirection +#' @rdname bidirection #' @export flipped_names <- function(flip = FALSE) { x_aes <- ggplot_global$x_aes diff --git a/man/bidirection.Rd b/man/bidirection.Rd new file mode 100644 index 0000000000..4e6012dff3 --- /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_histogram]{stat_histogram()}}, \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_histogram]{stat_histogram()}}, 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/omnidirection.Rd b/man/omnidirection.Rd deleted file mode 100644 index 7b465485f8..0000000000 --- a/man/omnidirection.Rd +++ /dev/null @@ -1,65 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utilities.r -\name{omnidirection} -\alias{omnidirection} -\alias{has_flipped_aes} -\alias{flip_data} -\alias{flipped_names} -\title{Utilities for working with omnidirecitonal 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 does 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. -} -\keyword{internal} From 0854ee8b6240afed49519065b1a7b3841d984c8b Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Thu, 26 Sep 2019 15:08:57 +0200 Subject: [PATCH 46/49] Better examples of has_flipped_aes() behaviour --- R/geom-ribbon.r | 2 +- R/utilities.r | 83 +++++++++++++++++++++++++++++++++++-------------- 2 files changed, 60 insertions(+), 25 deletions(-) diff --git a/R/geom-ribbon.r b/R/geom-ribbon.r index df9e8b7968..4625cdc2bd 100644 --- a/R/geom-ribbon.r +++ b/R/geom-ribbon.r @@ -71,7 +71,7 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, required_aes = c("x|y", "ymin|xmin", "ymax|xmax"), setup_params = function(data, params) { - params$flipped_aes <- has_flipped_aes(data, params) + params$flipped_aes <- has_flipped_aes(data, params, range_is_orthogonal = TRUE) params }, diff --git a/R/utilities.r b/R/utilities.r index 3369be0741..58d4190882 100644 --- a/R/utilities.r +++ b/R/utilities.r @@ -431,10 +431,43 @@ switch_orientation <- function(aesthetics) { #' `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_histogram()], [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_histogram()], 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 does they correspond +#' @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 @@ -445,7 +478,7 @@ switch_orientation <- function(aesthetics) { #' @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. +#' 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 @@ -458,14 +491,14 @@ switch_orientation <- function(aesthetics) { #' #' @export #' @keywords internal -#' @name omnidirection +#' @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]) + return(data$flipped_aes[[1]]) } # Is orientation requested in the params @@ -481,22 +514,6 @@ has_flipped_aes <- function(data, params = list(), main_is_orthogonal = NA, has_x <- !is.null(data$x) has_y <- !is.null(data$y) - # 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) - } - } - } - # Does a provided range indicate an orientation if (!is.na(range_is_orthogonal)) { if (any(c("ymin", "ymax") %in% names(data))) { @@ -512,16 +529,34 @@ has_flipped_aes <- function(data, params = list(), main_is_orthogonal = NA, return(FALSE) } - # give up early - if (!has_x && !has_y) { - 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) From 3e7ad39e36b873bd021b0dbc888c989fc6a9281f Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Mon, 30 Sep 2019 13:11:29 +0200 Subject: [PATCH 47/49] hanging indent on params --- R/utilities.r | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/R/utilities.r b/R/utilities.r index 58d4190882..0a6da19b0b 100644 --- a/R/utilities.r +++ b/R/utilities.r @@ -466,19 +466,19 @@ switch_orientation <- function(aesthetics) { #' #' @param data The layer data #' @param params The parameters of the `Stat`/`Geom`. Only the `orientation` -#' parameter will be used. +#' 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. +#' 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. +#' 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. +#' `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"` +#' 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? +#' 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 From c2f7a01024cae015f4208e8bdbdac8c574061536 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Tue, 1 Oct 2019 10:28:09 +0200 Subject: [PATCH 48/49] fix merge --- man/geom_smooth.Rd | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/man/geom_smooth.Rd b/man/geom_smooth.Rd index 19cb9dcf9e..7b7d67cfa1 100644 --- a/man/geom_smooth.Rd +++ b/man/geom_smooth.Rd @@ -6,14 +6,9 @@ \title{Smoothed conditional means} \usage{ geom_smooth(mapping = NULL, data = NULL, stat = "smooth", -<<<<<<< HEAD - position = "identity", ..., method = "auto", formula = y ~ x, + position = "identity", ..., method = NULL, formula = NULL, se = TRUE, na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE) -======= - position = "identity", ..., method = NULL, formula = NULL, - se = TRUE, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) ->>>>>>> 0ee259ccbbe9866ad9cc618d66eb452d870cacd6 stat_smooth(mapping = NULL, data = NULL, geom = "smooth", position = "identity", ..., method = NULL, formula = NULL, From 6f0380cbd263683775f4234034d6bfd5ec3a344f Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Tue, 1 Oct 2019 10:28:31 +0200 Subject: [PATCH 49/49] Fix cross linking --- R/utilities.r | 4 ++-- man/bidirection.Rd | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/R/utilities.r b/R/utilities.r index 0a6da19b0b..6f5b1e9b5d 100644 --- a/R/utilities.r +++ b/R/utilities.r @@ -440,7 +440,7 @@ switch_orientation <- function(aesthetics) { #' 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_histogram()], [geom_count()], and [stat_density()]. +#' 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 @@ -461,7 +461,7 @@ switch_orientation <- function(aesthetics) { #' 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_histogram()], while examples of `FALSE` is [stat_ydensity()] and +#' [stat_bin()], while examples of `FALSE` is [stat_ydensity()] and #' [stat_boxplot()] #' #' @param data The layer data diff --git a/man/bidirection.Rd b/man/bidirection.Rd index 4e6012dff3..1542f5780a 100644 --- a/man/bidirection.Rd +++ b/man/bidirection.Rd @@ -22,8 +22,8 @@ flipped_names(flip = FALSE) 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.} +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 @@ -72,7 +72,7 @@ features in the data correspond to: 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_histogram]{stat_histogram()}}, \code{\link[=geom_count]{geom_count()}}, and \code{\link[=stat_density]{stat_density()}}. +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 @@ -93,7 +93,7 @@ data based guessing and only take hint from the \code{orientation} element in 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_histogram]{stat_histogram()}}, while examples of \code{FALSE} is \code{\link[=stat_ydensity]{stat_ydensity()}} 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()}} } }