diff --git a/DESCRIPTION b/DESCRIPTION index 95cb820686..0b2fa2e53f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -55,7 +55,8 @@ Suggests: sf (>= 0.7-3), svglite (>= 1.2.0.9001), testthat (>= 2.1.0), - vdiffr (>= 0.3.0) + vdiffr (>= 0.3.0), + tsbox Enhances: sp License: GPL-2 | file LICENSE URL: http://ggplot2.tidyverse.org, https://github.com/tidyverse/ggplot2 @@ -153,11 +154,14 @@ Collate: 'grob-dotstack.r' 'grob-null.r' 'grouping.r' + 'guide-bins.R' 'guide-colorbar.r' + 'guide-colorsteps.R' 'guide-legend.r' 'guides-.r' 'guides-axis.r' 'guides-grid.r' + 'guides-none.r' 'hexbin.R' 'labeller.r' 'labels.r' @@ -179,12 +183,14 @@ Collate: 'position-jitter.r' 'position-jitterdodge.R' 'position-nudge.R' + 'position-nudgestack.R' 'position-stack.r' 'quick-plot.r' 'range.r' 'save.r' 'scale-.r' 'scale-alpha.r' + 'scale-binned.R' 'scale-brewer.r' 'scale-colour.r' 'scale-continuous.r' @@ -199,6 +205,7 @@ Collate: 'scale-manual.r' 'scale-shape.r' 'scale-size.r' + 'scale-steps.R' 'scale-type.R' 'scale-view.r' 'scale-viridis.r' diff --git a/NAMESPACE b/NAMESPACE index 3670510528..62e0efb2d1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -67,14 +67,30 @@ S3method(grobWidth,absoluteGrob) S3method(grobWidth,zeroGrob) S3method(grobX,absoluteGrob) S3method(grobY,absoluteGrob) +S3method(guide_gengrob,axis) +S3method(guide_gengrob,bins) S3method(guide_gengrob,colorbar) +S3method(guide_gengrob,guide_none) S3method(guide_gengrob,legend) +S3method(guide_geom,axis) +S3method(guide_geom,bins) S3method(guide_geom,colorbar) +S3method(guide_geom,guide_none) S3method(guide_geom,legend) +S3method(guide_merge,axis) +S3method(guide_merge,bins) S3method(guide_merge,colorbar) +S3method(guide_merge,guide_none) S3method(guide_merge,legend) +S3method(guide_train,axis) +S3method(guide_train,bins) S3method(guide_train,colorbar) +S3method(guide_train,colorsteps) +S3method(guide_train,guide_none) S3method(guide_train,legend) +S3method(guide_transform,axis) +S3method(guide_transform,default) +S3method(guide_transform,guide_none) S3method(heightDetails,titleGrob) S3method(heightDetails,zeroGrob) S3method(interleave,default) @@ -188,8 +204,11 @@ export(PositionIdentity) export(PositionJitter) export(PositionJitterdodge) export(PositionNudge) +export(PositionNudgeStack) export(PositionStack) export(Scale) +export(ScaleBinned) +export(ScaleBinnedPosition) export(ScaleContinuous) export(ScaleContinuousDate) export(ScaleContinuousDatetime) @@ -298,6 +317,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) @@ -358,14 +379,21 @@ export(ggproto) export(ggproto_parent) export(ggsave) export(ggtitle) +export(guide_axis) +export(guide_bins) export(guide_colorbar) +export(guide_colorsteps) export(guide_colourbar) +export(guide_coloursteps) export(guide_gengrob) export(guide_geom) export(guide_legend) export(guide_merge) +export(guide_none) export(guide_train) +export(guide_transform) export(guides) +export(has_flipped_aes) export(is.Coord) export(is.facet) export(is.ggplot) @@ -405,6 +433,7 @@ export(position_identity) export(position_jitter) export(position_jitterdodge) export(position_nudge) +export(position_nudgestack) export(position_stack) export(qplot) export(quickplot) @@ -424,12 +453,14 @@ export(scale_alpha_discrete) export(scale_alpha_identity) export(scale_alpha_manual) export(scale_alpha_ordinal) +export(scale_color_binned) export(scale_color_brewer) export(scale_color_continuous) export(scale_color_date) export(scale_color_datetime) export(scale_color_discrete) export(scale_color_distiller) +export(scale_color_fermenter) export(scale_color_gradient) export(scale_color_gradient2) export(scale_color_gradientn) @@ -438,14 +469,19 @@ export(scale_color_hue) export(scale_color_identity) export(scale_color_manual) export(scale_color_ordinal) +export(scale_color_steps) +export(scale_color_steps2) +export(scale_color_stepsn) export(scale_color_viridis_c) export(scale_color_viridis_d) +export(scale_colour_binned) export(scale_colour_brewer) export(scale_colour_continuous) export(scale_colour_date) export(scale_colour_datetime) export(scale_colour_discrete) export(scale_colour_distiller) +export(scale_colour_fermenter) export(scale_colour_gradient) export(scale_colour_gradient2) export(scale_colour_gradientn) @@ -454,17 +490,23 @@ export(scale_colour_hue) export(scale_colour_identity) export(scale_colour_manual) export(scale_colour_ordinal) +export(scale_colour_steps) +export(scale_colour_steps2) +export(scale_colour_stepsn) +export(scale_colour_viridis_b) export(scale_colour_viridis_c) export(scale_colour_viridis_d) export(scale_continuous_identity) export(scale_discrete_identity) export(scale_discrete_manual) +export(scale_fill_binned) export(scale_fill_brewer) export(scale_fill_continuous) export(scale_fill_date) export(scale_fill_datetime) export(scale_fill_discrete) export(scale_fill_distiller) +export(scale_fill_fermenter) export(scale_fill_gradient) export(scale_fill_gradient2) export(scale_fill_gradientn) @@ -473,15 +515,21 @@ export(scale_fill_hue) export(scale_fill_identity) export(scale_fill_manual) export(scale_fill_ordinal) +export(scale_fill_steps) +export(scale_fill_steps2) +export(scale_fill_stepsn) +export(scale_fill_viridis_b) export(scale_fill_viridis_c) export(scale_fill_viridis_d) export(scale_linetype) +export(scale_linetype_binned) export(scale_linetype_continuous) export(scale_linetype_discrete) export(scale_linetype_identity) export(scale_linetype_manual) export(scale_radius) export(scale_shape) +export(scale_shape_binned) export(scale_shape_continuous) export(scale_shape_discrete) export(scale_shape_identity) @@ -489,6 +537,8 @@ export(scale_shape_manual) export(scale_shape_ordinal) export(scale_size) export(scale_size_area) +export(scale_size_binned) +export(scale_size_binned_area) export(scale_size_continuous) export(scale_size_date) export(scale_size_datetime) @@ -497,6 +547,7 @@ export(scale_size_identity) export(scale_size_manual) export(scale_size_ordinal) export(scale_type) +export(scale_x_binned) export(scale_x_continuous) export(scale_x_date) export(scale_x_datetime) @@ -505,6 +556,7 @@ export(scale_x_log10) export(scale_x_reverse) export(scale_x_sqrt) export(scale_x_time) +export(scale_y_binned) export(scale_y_continuous) export(scale_y_date) export(scale_y_datetime) diff --git a/NEWS.md b/NEWS.md index 5e96c37dcf..ac1c5fdb58 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,18 @@ # ggplot2 (development version) +* Added `position_nudgestack()`, which allows to nudge stacked columns. (@ThomasKnecht ) + +* A new scale type has been added, that allows binning of aesthetics at the + scale level. It has versions for both position and non-position aesthetics and + comes with two new guides (`guide_bins` and `guide_coloursteps`) (@thomasp85, #3096) + +* Position guides can now be customized using the new `guide_axis()`, + which can be passed to position `scale_*()` functions or via + `guides()`. The new axis guide (`guide_axis()`) comes with + arguments `check.overlap` (automatic removal of overlapping + labels), `angle` (easy rotation of axis labels), and + `n.dodge` (dodge labels into multiple rows/columns) (@paleolimbot, #3322). + * `Geom` now gains a `setup_params()` method in line with the other ggproto classes (@thomasp85, #3509) diff --git a/R/axis-secondary.R b/R/axis-secondary.R index 0d7f6df1a3..27b0554bd0 100644 --- a/R/axis-secondary.R +++ b/R/axis-secondary.R @@ -20,6 +20,9 @@ #' - A character vector giving labels (must be same length as `breaks`) #' - A function that takes the breaks as input and returns labels as output #' +#' @param guide A position guide that will be used to render +#' the axis on the plot. Usually this is [guide_axis()]. +#' #' @details #' `sec_axis` is used to create the specifications for a secondary axis. #' Except for the `trans` argument any of the arguments can be set to @@ -79,7 +82,8 @@ #' labels = scales::time_format("%b %d %I %p"))) #' #' @export -sec_axis <- function(trans = NULL, name = waiver(), breaks = waiver(), labels = waiver()) { +sec_axis <- function(trans = NULL, name = waiver(), breaks = waiver(), labels = waiver(), + guide = waiver()) { # sec_axis() historically accpeted two-sided formula, so be permissive. if (length(trans) > 2) trans <- trans[c(1,3)] @@ -88,14 +92,15 @@ sec_axis <- function(trans = NULL, name = waiver(), breaks = waiver(), labels = trans = trans, name = name, breaks = breaks, - labels = labels + labels = labels, + guide = guide ) } #' @rdname sec_axis #' #' @export -dup_axis <- function(trans = ~., name = derive(), breaks = derive(), labels = derive()) { - sec_axis(trans, name, breaks, labels) +dup_axis <- function(trans = ~., name = derive(), breaks = derive(), labels = derive(), guide = derive()) { + sec_axis(trans, name, breaks, labels, guide) } is.sec_axis <- function(x) { @@ -148,6 +153,7 @@ AxisSecondary <- ggproto("AxisSecondary", NULL, if (is.derived(self$breaks)) self$breaks <- scale$breaks if (is.waive(self$breaks)) self$breaks <- scale$trans$breaks if (is.derived(self$labels)) self$labels <- scale$labels + if (is.derived(self$guide)) self$guide <- scale$guide }, transform_range = function(self, range) { diff --git a/R/coord-.r b/R/coord-.r index e2ea1a025d..26f45c9c17 100644 --- a/R/coord-.r +++ b/R/coord-.r @@ -59,7 +59,7 @@ Coord <- ggproto("Coord", aspect = function(ranges) NULL, - labels = function(panel_params) panel_params, + labels = function(labels, panel_params) labels, render_fg = function(panel_params, theme) element_render(theme, "panel.border"), @@ -91,6 +91,14 @@ Coord <- ggproto("Coord", list() }, + setup_panel_guides = function(self, panel_params, guides, params = list()) { + panel_params + }, + + train_panel_guides = function(self, panel_params, layers, default_mapping, params = list()) { + panel_params + }, + transform = function(data, range) NULL, distance = function(x, y, panel_params) NULL, diff --git a/R/coord-cartesian-.r b/R/coord-cartesian-.r index 8222604039..d36a49674a 100644 --- a/R/coord-cartesian-.r +++ b/R/coord-cartesian-.r @@ -103,6 +103,75 @@ CoordCartesian <- ggproto("CoordCartesian", Coord, ) }, + setup_panel_guides = function(self, panel_params, guides, params = list()) { + aesthetics <- c("x", "y", "x.sec", "y.sec") + names(aesthetics) <- aesthetics + + # resolve the specified guide from the scale and/or guides + guides <- lapply(aesthetics, function(aesthetic) { + resolve_guide( + aesthetic, + panel_params[[aesthetic]], + guides, + default = guide_axis(), + null = guide_none() + ) + }) + + # resolve the guide definition as a "guide" S3 + guides <- lapply(guides, validate_guide) + + # if there is an "position" specification in the scale, pass this on to the guide + # ideally, this should be specified in the guide + guides <- lapply(aesthetics, function(aesthetic) { + guide <- guides[[aesthetic]] + scale <- panel_params[[aesthetic]] + # position could be NULL here for an empty scale + guide$position <- guide$position %|W|% scale$position + guide + }) + + panel_params$guides <- guides + panel_params + }, + + train_panel_guides = function(self, panel_params, layers, default_mapping, params = list()) { + aesthetics <- c("x", "y", "x.sec", "y.sec") + names(aesthetics) <- aesthetics + + panel_params$guides <- lapply(aesthetics, function(aesthetic) { + axis <- substr(aesthetic, 1, 1) + guide <- panel_params$guides[[aesthetic]] + guide <- guide_train(guide, panel_params[[aesthetic]]) + guide <- guide_transform(guide, self, panel_params) + guide <- guide_geom(guide, layers, default_mapping) + guide + }) + + panel_params + }, + + labels = function(self, labels, panel_params) { + positions_x <- c("top", "bottom") + positions_y <- c("left", "right") + + list( + x = lapply(c(1, 2), function(i) { + panel_guide_label( + panel_params$guides, + position = positions_x[[i]], + default_label = labels$x[[i]] + ) + }), + y = lapply(c(1, 2), function(i) { + panel_guide_label( + panel_params$guides, + position = positions_y[[i]], + default_label = labels$y[[i]]) + }) + ) + }, + render_bg = function(panel_params, theme) { guide_grid( theme, @@ -114,24 +183,16 @@ CoordCartesian <- ggproto("CoordCartesian", Coord, }, render_axis_h = function(panel_params, theme) { - arrange <- panel_params$x.arrange %||% c("secondary", "primary") - arrange_scale_keys <- c("primary" = "x", "secondary" = "x.sec")[arrange] - arrange_scales <- panel_params[arrange_scale_keys] - list( - top = draw_view_scale_axis(arrange_scales[[1]], "top", theme), - bottom = draw_view_scale_axis(arrange_scales[[2]], "bottom", theme) + top = panel_guides_grob(panel_params$guides, position = "top", theme = theme), + bottom = panel_guides_grob(panel_params$guides, position = "bottom", theme = theme) ) }, render_axis_v = function(panel_params, theme) { - arrange <- panel_params$y.arrange %||% c("primary", "secondary") - arrange_scale_keys <- c("primary" = "y", "secondary" = "y.sec")[arrange] - arrange_scales <- panel_params[arrange_scale_keys] - list( - left = draw_view_scale_axis(arrange_scales[[1]], "left", theme), - right = draw_view_scale_axis(arrange_scales[[2]], "right", theme) + left = panel_guides_grob(panel_params$guides, position = "left", theme = theme), + right = panel_guides_grob(panel_params$guides, position = "right", theme = theme) ) } ) @@ -153,10 +214,24 @@ view_scales_from_scale <- function(scale, coord_limits = NULL, expand = TRUE) { view_scales } -draw_view_scale_axis <- function(view_scale, axis_position, theme) { - if(is.null(view_scale) || view_scale$is_empty()) { - return(zeroGrob()) - } +panel_guide_label <- function(guides, position, default_label) { + guide <- guide_for_position(guides, position) %||% guide_none(title = NULL) + guide$title %|W|% default_label +} + +panel_guides_grob <- function(guides, position, theme) { + guide <- guide_for_position(guides, position) %||% guide_none() + guide_gengrob(guide, theme) +} + +guide_for_position <- function(guides, position) { + has_position <- vapply( + guides, + function(guide) identical(guide$position, position), + logical(1) + ) - draw_axis(view_scale$break_positions(), view_scale$get_labels(), axis_position, theme) + guides <- guides[has_position] + guides_order <- vapply(guides, function(guide) as.numeric(guide$order)[1], numeric(1)) + Reduce(guide_merge, guides[order(guides_order)]) } diff --git a/R/coord-flip.r b/R/coord-flip.r index 71d11f26ec..45e87c57f5 100644 --- a/R/coord-flip.r +++ b/R/coord-flip.r @@ -40,7 +40,7 @@ coord_flip <- function(xlim = NULL, ylim = NULL, expand = TRUE, clip = "on") { CoordFlip <- ggproto("CoordFlip", CoordCartesian, transform = function(data, panel_params) { - data <- flip_labels(data) + data <- flip_axis_labels(data) CoordCartesian$transform(data, panel_params) }, @@ -58,11 +58,11 @@ CoordFlip <- ggproto("CoordFlip", CoordCartesian, setup_panel_params = function(self, scale_x, scale_y, params = list()) { parent <- ggproto_parent(CoordCartesian, self) panel_params <- parent$setup_panel_params(scale_x, scale_y, params) - flip_labels(panel_params) + flip_axis_labels(panel_params) }, - labels = function(panel_params) { - flip_labels(CoordCartesian$labels(panel_params)) + labels = function(labels, panel_params) { + flip_axis_labels(CoordCartesian$labels(labels, panel_params)) }, setup_layout = function(layout, params) { @@ -72,14 +72,29 @@ CoordFlip <- ggproto("CoordFlip", CoordCartesian, }, modify_scales = function(scales_x, scales_y) { - lapply(scales_x, scale_flip_position) - lapply(scales_y, scale_flip_position) + lapply(scales_x, scale_flip_axis) + lapply(scales_y, scale_flip_axis) } ) +# In-place modification of a scale position to swap axes +scale_flip_axis <- function(scale) { + scale$position <- switch(scale$position, + top = "right", + bottom = "left", + left = "bottom", + right = "top", + scale$position + ) + + invisible(scale) +} -flip_labels <- function(x) { +# maintaining the position of the x* and y* names is +# important for re-using the same guide_transform() +# as CoordCartesian +flip_axis_labels <- function(x) { old_names <- names(x) new_names <- old_names diff --git a/R/coord-polar.r b/R/coord-polar.r index fd5d44fa3f..591447d015 100644 --- a/R/coord-polar.r +++ b/R/coord-polar.r @@ -305,11 +305,11 @@ CoordPolar <- ggproto("CoordPolar", Coord, ) }, - labels = function(self, panel_params) { + labels = function(self, labels, panel_params) { if (self$theta == "y") { - list(x = panel_params$y, y = panel_params$x) + list(x = labels$y, y = labels$x) } else { - panel_params + labels } }, diff --git a/R/coord-sf.R b/R/coord-sf.R index b73227c7e7..ed41ce4c94 100644 --- a/R/coord-sf.R +++ b/R/coord-sf.R @@ -195,6 +195,8 @@ CoordSf <- ggproto("CoordSf", CoordCartesian, diff(panel_params$y_range) / diff(panel_params$x_range) / ratio }, + labels = function(labels, panel_params) labels, + render_bg = function(self, panel_params, theme) { el <- calc_element("panel.grid.major", theme) diff --git a/R/data.R b/R/data.R index 909c639b93..19ff85b59d 100644 --- a/R/data.R +++ b/R/data.R @@ -1,4 +1,4 @@ -#' Prices of 50,000 round cut diamonds +#' Prices of over 50,000 round cut diamonds #' #' A dataset containing the prices and other attributes of almost 54,000 #' diamonds. The variables are as follows: @@ -26,19 +26,19 @@ #' \url{http://research.stlouisfed.org/fred2}. `economics` is in "wide" #' format, `economics_long` is in "long" format. #' -#' @format A data frame with 478 rows and 6 variables +#' @format A data frame with 574 rows and 6 variables: #' \describe{ #' \item{date}{Month of data collection} -#' \item{psavert}{personal savings rate, -#' \url{http://research.stlouisfed.org/fred2/series/PSAVERT/}} #' \item{pce}{personal consumption expenditures, in billions of dollars, #' \url{http://research.stlouisfed.org/fred2/series/PCE}} -#' \item{unemploy}{number of unemployed in thousands, -#' \url{http://research.stlouisfed.org/fred2/series/UNEMPLOY}} -#' \item{uempmed}{median duration of unemployment, in weeks, -#' \url{http://research.stlouisfed.org/fred2/series/UEMPMED}} #' \item{pop}{total population, in thousands, #' \url{http://research.stlouisfed.org/fred2/series/POP}} +#' \item{psavert}{personal savings rate, +#' \url{http://research.stlouisfed.org/fred2/series/PSAVERT/}} +#' \item{uempmed}{median duration of unemployment, in weeks, +#' \url{http://research.stlouisfed.org/fred2/series/UEMPMED}} +#' \item{unemploy}{number of unemployed in thousands, +#' \url{http://research.stlouisfed.org/fred2/series/UNEMPLOY}} #' } #' "economics" @@ -50,7 +50,7 @@ #' #' Demographic information of midwest counties #' -#' @format A data frame with 437 rows and 28 variables +#' @format A data frame with 437 rows and 28 variables: #' \describe{ #' \item{PID}{} #' \item{county}{} @@ -85,22 +85,22 @@ "midwest" -#' Fuel economy data from 1999 and 2008 for 38 popular models of car +#' Fuel economy data from 1999 to 2008 for 38 popular models of cars #' #' This dataset contains a subset of the fuel economy data that the EPA makes #' available on \url{http://fueleconomy.gov}. It contains only models which #' had a new release every year between 1999 and 2008 - this was used as a #' proxy for the popularity of the car. #' -#' @format A data frame with 234 rows and 11 variables +#' @format A data frame with 234 rows and 11 variables: #' \describe{ -#' \item{manufacturer}{} +#' \item{manufacturer}{manufacturer name} #' \item{model}{model name} #' \item{displ}{engine displacement, in litres} #' \item{year}{year of manufacture} #' \item{cyl}{number of cylinders} #' \item{trans}{type of transmission} -#' \item{drv}{f = front-wheel drive, r = rear wheel drive, 4 = 4wd} +#' \item{drv}{the type of drive train, where f = front-wheel drive, r = rear wheel drive, 4 = 4wd} #' \item{cty}{city miles per gallon} #' \item{hwy}{highway miles per gallon} #' \item{fl}{fuel type} @@ -119,7 +119,7 @@ #' Additional variables order, conservation status and vore were added from #' wikipedia. #' -#' @format A data frame with 83 rows and 11 variables +#' @format A data frame with 83 rows and 11 variables: #' \describe{ #' \item{name}{common name} #' \item{genus}{} @@ -140,7 +140,13 @@ #' The names of each president, the start and end date of their term, and #' their party of 11 US presidents from Eisenhower to Obama. #' -#' @format A data frame with 11 rows and 4 variables +#' @format A data frame with 11 rows and 4 variables: +#' \describe{ +#' \item{name}{Last name of president} +#' \item{start}{Presidency start date} +#' \item{end}{Presidency end date} +#' \item{party}{Party of president} +#' } "presidential" #' Vector field of seal movements @@ -161,7 +167,12 @@ #' A 2d density estimate of the waiting and eruptions variables data #' \link{faithful}. #' -#' @format A data frame with 5,625 observations and 3 variables. +#' @format A data frame with 5,625 observations and 3 variables: +#' \describe{ +#' \item{eruptions}{Eruption time in mins} +#' \item{waiting}{Waiting time to next eruption in mins} +#' \item{density}{2d density estimate} +#' } "faithfuld" #' `colors()` in Luv space @@ -182,7 +193,7 @@ #' #' @format A data frame with 8602 observations and 9 variables: #' \describe{ -#' \item{city}{Name of MLS area} +#' \item{city}{Name of multiple listing service (MLS) area} #' \item{year,month,date}{Date} #' \item{sales}{Number of sales} #' \item{volume}{Total value of sales} diff --git a/R/geom-.r b/R/geom-.r index bca1b57ded..7c8fa47356 100644 --- a/R/geom-.r +++ b/R/geom-.r @@ -153,7 +153,12 @@ Geom <- ggproto("Geom", }, aesthetics = function(self) { - c(union(self$required_aes, names(self$default_aes)), self$optional_aes, "group") + if (is.null(self$required_aes)) { + required_aes <- NULL + } else { + required_aes <- unlist(strsplit(self$required_aes, '|', fixed = TRUE)) + } + c(union(required_aes, names(self$default_aes)), self$optional_aes, "group") } ) diff --git a/R/geom-bar.r b/R/geom-bar.r index 91d1767f3e..4a8309cffe 100644 --- a/R/geom-bar.r +++ b/R/geom-bar.r @@ -19,6 +19,8 @@ #' [position_fill()] shows relative proportions at each `x` by stacking the bars #' and then standardising each bar to have the same height. #' +#' @eval rd_orientation() +#' #' @eval rd_aesthetics("geom", "bar") #' @eval rd_aesthetics("geom", "col") #' @eval rd_aesthetics("stat", "count") @@ -29,6 +31,10 @@ #' @export #' @inheritParams layer #' @inheritParams geom_point +#' @param orientation The orientation of the layer. The default (`NA`) +#' automatically determines the orientation from the aesthetic mapping. In the +#' rare event that this fails it can be given explicitly by setting `orientation` +#' to either `"x"` or `"y"`. See the *Orientation* section for more detail. #' @param width Bar width. By default, set to 90\% of the resolution of the data. #' @param binwidth `geom_bar()` no longer has a binwidth argument - if #' you use it you'll get an warning telling to you use @@ -43,17 +49,18 @@ #' g + geom_bar() #' # Total engine displacement of each class #' g + geom_bar(aes(weight = displ)) +#' # Map class to y instead to flip the orientation +#' ggplot(mpg) + geom_bar(aes(y = class)) #' #' # Bar charts are automatically stacked when multiple bars are placed #' # at the same location. The order of the fill is designed to match #' # the legend #' g + geom_bar(aes(fill = drv)) #' -#' # If you need to flip the order (because you've flipped the plot) +#' # If you need to flip the order (because you've flipped the orientation) #' # call position_stack() explicitly: -#' g + +#' ggplot(mpg, aes(y = class)) + #' geom_bar(aes(fill = drv), position = position_stack(reverse = TRUE)) + -#' coord_flip() + #' theme(legend.position = "top") #' #' # To show (e.g.) means, you need geom_col() @@ -77,6 +84,7 @@ geom_bar <- function(mapping = NULL, data = NULL, width = NULL, binwidth = NULL, na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE) { @@ -99,6 +107,7 @@ geom_bar <- function(mapping = NULL, data = NULL, params = list( width = width, na.rm = na.rm, + orientation = orientation, ... ) ) @@ -117,16 +126,26 @@ GeomBar <- ggproto("GeomBar", GeomRect, # limits, not just those for which x and y are outside the limits non_missing_aes = c("xmin", "xmax", "ymin", "ymax"), + setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params, range_is_orthogonal = FALSE) + params + }, + + extra_params = c("na.rm", "orientation"), + setup_data = function(data, params) { + data$flipped_aes <- params$flipped_aes + data <- flip_data(data, params$flipped_aes) data$width <- data$width %||% params$width %||% (resolution(data$x, FALSE) * 0.9) - transform(data, + data <- transform(data, ymin = pmin(y, 0), ymax = pmax(y, 0), xmin = x - width / 2, xmax = x + width / 2, width = NULL ) + flip_data(data, params$flipped_aes) }, - draw_panel = function(self, data, panel_params, coord, width = NULL) { + draw_panel = function(self, data, panel_params, coord, width = NULL, flipped_aes = FALSE) { # Hack to ensure that width is detected as a parameter ggproto_parent(GeomRect, self)$draw_panel(data, panel_params, coord) } diff --git a/R/geom-boxplot.r b/R/geom-boxplot.r index 246a0a13f9..8ce8574114 100644 --- a/R/geom-boxplot.r +++ b/R/geom-boxplot.r @@ -4,6 +4,8 @@ #' It visualises five summary statistics (the median, two hinges #' and two whiskers), and all "outlying" points individually. #' +#' @eval rd_orientation() +#' #' @section Summary statistics: #' The lower and upper hinges correspond to the first and third quartiles #' (the 25th and 75th percentiles). This differs slightly from the method used @@ -28,7 +30,7 @@ #' [geom_violin()] for a richer display of the distribution, and #' [geom_jitter()] for a useful technique for small data. #' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams geom_bar #' @param geom,stat Use to override the default connection between #' `geom_boxplot` and `stat_boxplot`. #' @param outlier.colour,outlier.color,outlier.fill,outlier.shape,outlier.size,outlier.stroke,outlier.alpha @@ -60,7 +62,8 @@ #' @examples #' p <- ggplot(mpg, aes(class, hwy)) #' p + geom_boxplot() -#' p + geom_boxplot() + coord_flip() +#' # Orientation follows the discrete axis +#' ggplot(mpg, aes(hwy, class)) + geom_boxplot() #' #' p + geom_boxplot(notch = TRUE) #' p + geom_boxplot(varwidth = TRUE) @@ -116,6 +119,7 @@ geom_boxplot <- function(mapping = NULL, data = NULL, notchwidth = 0.5, varwidth = FALSE, na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE) { @@ -148,6 +152,7 @@ geom_boxplot <- function(mapping = NULL, data = NULL, notchwidth = notchwidth, varwidth = varwidth, na.rm = na.rm, + orientation = orientation, ... ) ) @@ -161,9 +166,16 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, # need to declare `width` here in case this geom is used with a stat that # doesn't have a `width` parameter (e.g., `stat_identity`). - extra_params = c("na.rm", "width"), + extra_params = c("na.rm", "width", "orientation"), + + setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params) + params + }, setup_data = function(data, params) { + data$flipped_aes <- params$flipped_aes + data <- flip_data(data, params$flipped_aes) data$width <- data$width %||% params$width %||% (resolution(data$x, FALSE) * 0.9) @@ -173,8 +185,8 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, out_max <- vapply(data$outliers, max, numeric(1)) }) - data$ymin_final <- pmin(out_min, data$ymin) - data$ymax_final <- pmax(out_max, data$ymax) + data$ymin_final <- pmin(out_min, data$ymin) + data$ymax_final <- pmax(out_max, data$ymax) } # if `varwidth` not requested or not available, don't use it @@ -190,7 +202,7 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, data$width <- NULL if (!is.null(data$relvarwidth)) data$relvarwidth <- NULL - data + flip_data(data, params$flipped_aes) }, draw_group = function(data, panel_params, coord, fatten = 2, @@ -198,8 +210,8 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, outlier.shape = 19, outlier.size = 1.5, outlier.stroke = 0.5, outlier.alpha = NULL, - notch = FALSE, notchwidth = 0.5, varwidth = FALSE) { - + notch = FALSE, notchwidth = 0.5, varwidth = FALSE, flipped_aes = FALSE) { + data <- flip_data(data, flipped_aes) # this may occur when using geom_boxplot(stat = "identity") if (nrow(data) != 1) { stop( @@ -226,6 +238,7 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, ), common ), n = 2) + whiskers <- flip_data(whiskers, flipped_aes) box <- new_data_frame(c( list( @@ -241,6 +254,7 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, ), common )) + box <- flip_data(box, flipped_aes) if (!is.null(data$outliers) && length(data$outliers[[1]] >= 1)) { outliers <- new_data_frame(list( @@ -254,6 +268,8 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, fill = NA, alpha = outlier.alpha %||% data$alpha[1] ), n = length(data$outliers[[1]])) + outliers <- flip_data(outliers, flipped_aes) + outliers_grob <- GeomPoint$draw_panel(outliers, panel_params, coord) } else { outliers_grob <- NULL @@ -262,7 +278,7 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, ggname("geom_boxplot", grobTree( outliers_grob, GeomSegment$draw_panel(whiskers, panel_params, coord), - GeomCrossbar$draw_panel(box, fatten = fatten, panel_params, coord) + GeomCrossbar$draw_panel(box, fatten = fatten, panel_params, coord, flipped_aes = flipped_aes) )) }, @@ -271,5 +287,5 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, default_aes = aes(weight = 1, colour = "grey20", fill = "white", size = 0.5, alpha = NA, shape = 19, linetype = "solid"), - required_aes = c("x", "lower", "upper", "middle", "ymin", "ymax") + required_aes = c("x|y", "lower|xlower", "upper|xupper", "middle|xmiddle", "ymin|xmin", "ymax|xmax") ) diff --git a/R/geom-col.r b/R/geom-col.r index 7ebd51f8fc..be91cfc480 100644 --- a/R/geom-col.r +++ b/R/geom-col.r @@ -37,16 +37,26 @@ GeomCol <- ggproto("GeomCol", GeomRect, # limits, not just those for which x and y are outside the limits non_missing_aes = c("xmin", "xmax", "ymin", "ymax"), + setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params) + params + }, + + extra_params = c("na.rm", "orientation"), + setup_data = function(data, params) { + data$flipped_aes <- params$flipped_aes + data <- flip_data(data, params$flipped_aes) data$width <- data$width %||% params$width %||% (resolution(data$x, FALSE) * 0.9) - transform(data, - ymin = pmin(y, 0), ymax = pmax(y, 0), - xmin = x - width / 2, xmax = x + width / 2, width = NULL + data <- transform(data, + ymin = pmin(y, 0), ymax = pmax(y, 0), + xmin = x - width / 2, xmax = x + width / 2, width = NULL ) + flip_data(data, params$flipped_aes) }, - draw_panel = function(self, data, panel_params, coord, width = NULL) { + draw_panel = function(self, data, panel_params, coord, width = NULL, flipped_aes = FALSE) { # Hack to ensure that width is detected as a parameter ggproto_parent(GeomRect, self)$draw_panel(data, panel_params, coord) } diff --git a/R/geom-crossbar.r b/R/geom-crossbar.r index 0a901133d7..05fa058460 100644 --- a/R/geom-crossbar.r +++ b/R/geom-crossbar.r @@ -5,6 +5,7 @@ geom_crossbar <- function(mapping = NULL, data = NULL, ..., fatten = 2.5, na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE) { layer( @@ -18,6 +19,7 @@ geom_crossbar <- function(mapping = NULL, data = NULL, params = list( fatten = fatten, na.rm = na.rm, + orientation = orientation, ... ) ) @@ -28,6 +30,12 @@ geom_crossbar <- function(mapping = NULL, data = NULL, #' @usage NULL #' @export GeomCrossbar <- ggproto("GeomCrossbar", Geom, + setup_params = function(data, params) { + GeomErrorbar$setup_params(data, params) + }, + + extra_params = c("na.rm", "orientation"), + setup_data = function(data, params) { GeomErrorbar$setup_data(data, params) }, @@ -35,11 +43,13 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom, default_aes = aes(colour = "black", fill = NA, size = 0.5, linetype = 1, alpha = NA), - required_aes = c("x", "y", "ymin", "ymax"), + required_aes = c("x", "y", "ymin|xmin", "ymax|xmax"), draw_key = draw_key_crossbar, - draw_panel = function(data, panel_params, coord, fatten = 2.5, width = NULL) { + draw_panel = function(data, panel_params, coord, fatten = 2.5, width = NULL, flipped_aes = FALSE) { + data <- flip_data(data, flipped_aes) + middle <- transform(data, x = xmin, xend = xmax, yend = y, size = size * fatten, alpha = NA) has_notch <- !is.null(data$ynotchlower) && !is.null(data$ynotchupper) && @@ -85,6 +95,8 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom, group = rep(seq_len(nrow(data)), 5) # each bar forms it's own group )) } + box <- flip_data(box, flipped_aes) + middle <- flip_data(middle, flipped_aes) ggname("geom_crossbar", gTree(children = gList( GeomPolygon$draw_panel(box, panel_params, coord), diff --git a/R/geom-density.r b/R/geom-density.r index 5d96c3ac1a..093e3bf53e 100644 --- a/R/geom-density.r +++ b/R/geom-density.r @@ -4,18 +4,23 @@ #' the histogram. This is a useful alternative to the histogram for continuous #' data that comes from an underlying smooth distribution. #' +#' @eval rd_orientation() +#' #' @eval rd_aesthetics("geom", "density") #' @seealso See [geom_histogram()], [geom_freqpoly()] for #' other methods of displaying continuous distribution. #' See [geom_violin()] for a compact density display. #' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams geom_bar #' @param geom,stat Use to override the default connection between #' `geom_density` and `stat_density`. #' @export #' @examples #' ggplot(diamonds, aes(carat)) + #' geom_density() +#' # Map the values to y to flip the orientation +#' ggplot(diamonds, aes(y = carat)) + +#' geom_density() #' #' ggplot(diamonds, aes(carat)) + #' geom_density(adjust = 1/5) @@ -49,6 +54,7 @@ geom_density <- function(mapping = NULL, data = NULL, stat = "density", position = "identity", ..., na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE) { @@ -62,6 +68,7 @@ geom_density <- function(mapping = NULL, data = NULL, inherit.aes = inherit.aes, params = list( na.rm = na.rm, + orientation = orientation, ... ) ) diff --git a/R/geom-errorbar.r b/R/geom-errorbar.r index 9c0a4361c2..4840d75d10 100644 --- a/R/geom-errorbar.r +++ b/R/geom-errorbar.r @@ -4,6 +4,7 @@ geom_errorbar <- function(mapping = NULL, data = NULL, stat = "identity", position = "identity", ..., na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE) { layer( @@ -16,6 +17,7 @@ geom_errorbar <- function(mapping = NULL, data = NULL, inherit.aes = inherit.aes, params = list( na.rm = na.rm, + orientation = orientation, ... ) ) @@ -31,27 +33,40 @@ GeomErrorbar <- ggproto("GeomErrorbar", Geom, draw_key = draw_key_path, - required_aes = c("x", "ymin", "ymax"), + required_aes = c("x|y", "ymin|xmin", "ymax|xmax"), + + setup_params = function(data, params) { + GeomLinerange$setup_params(data, params) + }, + + extra_params = c("na.rm", "orientation"), setup_data = function(data, params) { + data$flipped_aes <- params$flipped_aes + data <- flip_data(data, params$flipped_aes) data$width <- data$width %||% params$width %||% (resolution(data$x, FALSE) * 0.9) - - transform(data, + data <- transform(data, xmin = x - width / 2, xmax = x + width / 2, width = NULL ) + flip_data(data, params$flipped_aes) }, - draw_panel = function(data, panel_params, coord, width = NULL) { - GeomPath$draw_panel(new_data_frame(list( - x = as.vector(rbind(data$xmin, data$xmax, NA, data$x, data$x, NA, data$xmin, data$xmax)), - y = as.vector(rbind(data$ymax, data$ymax, NA, data$ymax, data$ymin, NA, data$ymin, data$ymin)), + draw_panel = function(data, panel_params, coord, width = NULL, flipped_aes = FALSE) { + data <- flip_data(data, flipped_aes) + x <- as.vector(rbind(data$xmin, data$xmax, NA, data$x, data$x, NA, data$xmin, data$xmax)) + y <- as.vector(rbind(data$ymax, data$ymax, NA, data$ymax, data$ymin, NA, data$ymin, data$ymin)) + data <- new_data_frame(list( + x = x, + y = y, colour = rep(data$colour, each = 8), alpha = rep(data$alpha, each = 8), size = rep(data$size, each = 8), linetype = rep(data$linetype, each = 8), group = rep(1:(nrow(data)), each = 8), row.names = 1:(nrow(data) * 8) - )), panel_params, coord) + )) + data <- flip_data(data, flipped_aes) + GeomPath$draw_panel(data, panel_params, coord) } ) diff --git a/R/geom-histogram.r b/R/geom-histogram.r index 2bdbe74315..0629d93a65 100644 --- a/R/geom-histogram.r +++ b/R/geom-histogram.r @@ -17,13 +17,15 @@ #' one change at a time. You may need to look at a few options to uncover #' the full story behind your data. #' +#' @eval rd_orientation() +#' #' @section Aesthetics: #' `geom_histogram()` uses the same aesthetics as [geom_bar()]; #' `geom_freqpoly()` uses the same aesthetics as [geom_line()]. #' #' @export #' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams geom_bar #' @param geom,stat Use to override the default connection between #' `geom_histogram()`/`geom_freqpoly()` and `stat_bin()`. #' @examples @@ -33,6 +35,9 @@ #' geom_histogram(binwidth = 0.01) #' ggplot(diamonds, aes(carat)) + #' geom_histogram(bins = 200) +#' # Map values to y to flip the orientation +#' ggplot(diamonds, aes(y = carat)) + +#' geom_histogram() #' #' # Rather than stacking histograms, it's easier to compare frequency #' # polygons @@ -92,6 +97,7 @@ geom_histogram <- function(mapping = NULL, data = NULL, binwidth = NULL, bins = NULL, na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE) { @@ -107,6 +113,7 @@ geom_histogram <- function(mapping = NULL, data = NULL, binwidth = binwidth, bins = bins, na.rm = na.rm, + orientation = orientation, pad = FALSE, ... ) diff --git a/R/geom-linerange.r b/R/geom-linerange.r index 861c8b0760..9676901c01 100644 --- a/R/geom-linerange.r +++ b/R/geom-linerange.r @@ -3,6 +3,8 @@ #' Various ways of representing a vertical interval defined by `x`, #' `ymin` and `ymax`. Each case draws a single graphical object. #' +#' @eval rd_orientation() +#' #' @eval rd_aesthetics("geom", "linerange") #' @param fatten A multiplicative factor used to increase the size of the #' middle bar in `geom_crossbar()` and the middle point in @@ -13,7 +15,7 @@ #' [geom_errorbarh()] for a horizontal error bar. #' @export #' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams geom_bar #' @examples #' # Create a simple example dataset #' df <- data.frame( @@ -30,6 +32,10 @@ #' p + geom_crossbar(aes(ymin = lower, ymax = upper), width = 0.2) #' p + geom_errorbar(aes(ymin = lower, ymax = upper), width = 0.2) #' +#' # Flip the orientation by changing mapping +#' ggplot(df, aes(resp, trt, colour = group)) + +#' geom_linerange(aes(xmin = lower, xmax = upper)) +#' #' # Draw lines connecting group means #' p + #' geom_line(aes(group = group)) + @@ -61,6 +67,7 @@ geom_linerange <- function(mapping = NULL, data = NULL, stat = "identity", position = "identity", ..., na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE) { layer( @@ -73,6 +80,7 @@ geom_linerange <- function(mapping = NULL, data = NULL, inherit.aes = inherit.aes, params = list( na.rm = na.rm, + orientation = orientation, ... ) ) @@ -87,10 +95,27 @@ GeomLinerange <- ggproto("GeomLinerange", Geom, draw_key = draw_key_vpath, - required_aes = c("x", "ymin", "ymax"), + required_aes = c("x|y", "ymin|xmin", "ymax|xmax"), + + setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params, range_is_orthogonal = TRUE) + if (!(params$flipped_aes || all(c("x", "ymin", "ymax") %in% names(data)))) { + stop("Either, `x`, `ymin`, and `ymax` or `y`, `xmin`, and `xmax` must be supplied", call. = FALSE) + } + params + }, + + extra_params = c("na.rm", "orientation"), + + setup_data = function(data, params) { + data$flipped_aes <- params$flipped_aes + data + }, - draw_panel = function(data, panel_params, coord) { + draw_panel = function(data, panel_params, coord, flipped_aes = FALSE) { + data <- flip_data(data, flipped_aes) data <- transform(data, xend = x, y = ymin, yend = ymax) + data <- flip_data(data, flipped_aes) ggname("geom_linerange", GeomSegment$draw_panel(data, panel_params, coord)) } ) diff --git a/R/geom-path.r b/R/geom-path.r index f703809708..0f02f2f045 100644 --- a/R/geom-path.r +++ b/R/geom-path.r @@ -9,9 +9,11 @@ #' An alternative parameterisation is [geom_segment()], where each line #' corresponds to a single case which provides the start and end coordinates. #' +#' @eval rd_orientation() +#' #' @eval rd_aesthetics("geom", "path") #' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams geom_bar #' @param lineend Line end style (round, butt, square). #' @param linejoin Line join style (round, mitre, bevel). #' @param linemitre Line mitre limit (number greater than 1). @@ -35,6 +37,9 @@ #' ggplot(economics_long, aes(date, value01, colour = variable)) + #' geom_line() #' +#' # You can get a timeseries that run vertically by setting the orientation +#' ggplot(economics, aes(unemploy, date)) + geom_line(orientation = "y") +#' #' # geom_step() is useful when you want to highlight exactly when #' # the y value changes #' recent <- economics[economics$date > as.Date("2013-01-01"), ] @@ -236,7 +241,7 @@ keep_mid_true <- function(x) { #' @export #' @rdname geom_path geom_line <- function(mapping = NULL, data = NULL, stat = "identity", - position = "identity", na.rm = FALSE, + position = "identity", na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE, ...) { layer( data = data, @@ -248,6 +253,7 @@ geom_line <- function(mapping = NULL, data = NULL, stat = "identity", inherit.aes = inherit.aes, params = list( na.rm = na.rm, + orientation = orientation, ... ) ) @@ -259,8 +265,18 @@ geom_line <- function(mapping = NULL, data = NULL, stat = "identity", #' @export #' @include geom-path.r GeomLine <- ggproto("GeomLine", GeomPath, + setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params, ambiguous = TRUE) + params + }, + + extra_params = c("na.rm", "orientation"), + setup_data = function(data, params) { - data[order(data$PANEL, data$group, data$x), ] + data$flipped_aes <- params$flipped_aes + data <- flip_data(data, params$flipped_aes) + data <- data[order(data$PANEL, data$group, data$x), ] + flip_data(data, params$flipped_aes) } ) diff --git a/R/geom-pointrange.r b/R/geom-pointrange.r index 6777aa0151..5b018c1253 100644 --- a/R/geom-pointrange.r +++ b/R/geom-pointrange.r @@ -5,6 +5,7 @@ geom_pointrange <- function(mapping = NULL, data = NULL, ..., fatten = 4, na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE) { layer( @@ -18,6 +19,7 @@ geom_pointrange <- function(mapping = NULL, data = NULL, params = list( fatten = fatten, na.rm = na.rm, + orientation = orientation, ... ) ) @@ -33,15 +35,25 @@ GeomPointrange <- ggproto("GeomPointrange", Geom, draw_key = draw_key_pointrange, - required_aes = c("x", "y", "ymin", "ymax"), + required_aes = c("x", "y", "ymin|xmin", "ymax|xmax"), - draw_panel = function(data, panel_params, coord, fatten = 4) { - if (is.null(data$y)) - return(GeomLinerange$draw_panel(data, panel_params, coord)) + setup_params = function(data, params) { + GeomLinerange$setup_params(data, params) + }, + + extra_params = c("na.rm", "orientation"), + + setup_data = function(data, params) { + GeomLinerange$setup_data(data, params) + }, + + draw_panel = function(data, panel_params, coord, fatten = 4, flipped_aes = FALSE) { + if (is.null(data[[flipped_names(flipped_aes)$y]])) + return(GeomLinerange$draw_panel(data, panel_params, coord, flipped_aes = flipped_aes)) ggname("geom_pointrange", gTree(children = gList( - GeomLinerange$draw_panel(data, panel_params, coord), + GeomLinerange$draw_panel(data, panel_params, coord, flipped_aes = flipped_aes), GeomPoint$draw_panel(transform(data, size = size * fatten), panel_params, coord) )) ) diff --git a/R/geom-ribbon.r b/R/geom-ribbon.r index 17df0ed118..4625cdc2bd 100644 --- a/R/geom-ribbon.r +++ b/R/geom-ribbon.r @@ -12,13 +12,15 @@ #' see the individual pattern as you move up the stack. See #' [position_stack()] for the details of stacking algorithm. #' +#' @eval rd_orientation() +#' #' @eval rd_aesthetics("geom", "ribbon") #' @seealso #' [geom_bar()] for discrete intervals (bars), #' [geom_linerange()] for discrete intervals (lines), #' [geom_polygon()] for general polygons #' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams geom_bar #' @export #' @examples #' # Generate data @@ -28,6 +30,9 @@ #' h + geom_ribbon(aes(ymin=0, ymax=level)) #' h + geom_area(aes(y = level)) #' +#' # Change orientation be switching the mapping +#' h + geom_area(aes(x = level, y = year)) +#' #' # Add aesthetic mappings #' h + #' geom_ribbon(aes(ymin = level - 1, ymax = level + 1), fill = "grey70") + @@ -36,6 +41,7 @@ geom_ribbon <- function(mapping = NULL, data = NULL, stat = "identity", position = "identity", ..., na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE) { layer( @@ -48,6 +54,7 @@ geom_ribbon <- function(mapping = NULL, data = NULL, inherit.aes = inherit.aes, params = list( na.rm = na.rm, + orientation = orientation, ... ) ) @@ -61,15 +68,26 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, default_aes = aes(colour = NA, fill = "grey20", size = 0.5, linetype = 1, alpha = NA), - required_aes = c("x", "ymin", "ymax"), + required_aes = c("x|y", "ymin|xmin", "ymax|xmax"), + + setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params, range_is_orthogonal = TRUE) + params + }, + + extra_params = c("na.rm", "orientation"), setup_data = function(data, params) { + data$flipped_aes <- params$flipped_aes + data <- flip_data(data, params$flipped_aes) + if (is.null(data$ymin) && is.null(data$ymax)) { - stop("Either ymin or ymax must be given as an aesthetic.", call. = FALSE) + stop("Either ", flipped_names(params$flipped_aes)$ymin, " or ", + flipped_names(params$flipped_aes)$ymax, " must be given as an aesthetic.", call. = FALSE) } data <- data[order(data$PANEL, data$group, data$x), , drop = FALSE] data$y <- data$ymin %||% data$ymax - data + flip_data(data, params$flipped_aes) }, draw_key = draw_key_polygon, @@ -78,7 +96,8 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, data }, - draw_group = function(data, panel_params, coord, na.rm = FALSE) { + draw_group = function(data, panel_params, coord, na.rm = FALSE, flipped_aes = FALSE) { + data <- flip_data(data, flipped_aes) if (na.rm) data <- data[stats::complete.cases(data[c("x", "ymin", "ymax")]), ] data <- data[order(data$group), ] @@ -106,6 +125,9 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, y = c(data$ymax, rev(data$ymin)), id = c(ids, rev(ids)) )) + + positions <- flip_data(positions, flipped_aes) + munched <- coord_munch(coord, positions, panel_params) ggname("geom_ribbon", polygonGrob( @@ -123,8 +145,8 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, #' @rdname geom_ribbon #' @export geom_area <- function(mapping = NULL, data = NULL, stat = "identity", - position = "stack", na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE, ...) { + position = "stack", na.rm = FALSE, orientation = NA, + show.legend = NA, inherit.aes = TRUE, ...) { layer( data = data, mapping = mapping, @@ -135,6 +157,7 @@ geom_area <- function(mapping = NULL, data = NULL, stat = "identity", inherit.aes = inherit.aes, params = list( na.rm = na.rm, + orientation = orientation, ... ) ) @@ -150,7 +173,15 @@ GeomArea <- ggproto("GeomArea", GeomRibbon, required_aes = c("x", "y"), + setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params, ambiguous = TRUE) + params + }, + setup_data = function(data, params) { - transform(data[order(data$PANEL, data$group, data$x), ], ymin = 0, ymax = y) + data$flipped_aes <- params$flipped_aes + data <- flip_data(data, params$flipped_aes) + data <- transform(data[order(data$PANEL, data$group, data$x), ], ymin = 0, ymax = y) + flip_data(data, params$flipped_aes) } ) diff --git a/R/geom-smooth.r b/R/geom-smooth.r index 6c10e98ba5..05bd1a8f29 100644 --- a/R/geom-smooth.r +++ b/R/geom-smooth.r @@ -12,9 +12,11 @@ #' `glm()`, where the normal confidence interval is constructed on the link #' scale and then back-transformed to the response scale. #' +#' @eval rd_orientation() +#' #' @eval rd_aesthetics("geom", "smooth") #' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams geom_bar #' @param geom,stat Use to override the default connection between #' `geom_smooth()` and `stat_smooth()`. #' @seealso See individual modelling functions for more details: @@ -27,6 +29,11 @@ #' geom_point() + #' geom_smooth() #' +#' # If you need the fitting to be done along the y-axis set the orientation +#' ggplot(mpg, aes(displ, hwy)) + +#' geom_point() + +#' geom_smooth(orientation = "y") +#' #' # Use span to control the "wiggliness" of the default loess smoother. #' # The span is the fraction of points used to fit each local regression: #' # small numbers make a wigglier curve, larger numbers make a smoother curve. @@ -78,15 +85,17 @@ geom_smooth <- function(mapping = NULL, data = NULL, stat = "smooth", position = "identity", ..., - method = "auto", - formula = y ~ x, + method = NULL, + formula = NULL, se = TRUE, na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE) { params <- list( na.rm = na.rm, + orientation = orientation, se = se, ... ) @@ -112,6 +121,13 @@ geom_smooth <- function(mapping = NULL, data = NULL, #' @usage NULL #' @export GeomSmooth <- ggproto("GeomSmooth", Geom, + setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params, range_is_orthogonal = TRUE, ambiguous = TRUE) + params + }, + + extra_params = c("na.rm", "orientation"), + setup_data = function(data, params) { GeomLine$setup_data(data, params) }, @@ -123,14 +139,16 @@ GeomSmooth <- ggproto("GeomSmooth", Geom, # ribbon won't be drawn either in that case, keeping the overall # behavior predictable and sensible. The user will realize that they # need to set `se = TRUE` to obtain the ribbon and the legend key. - draw_group = function(data, panel_params, coord, se = FALSE) { + draw_group = function(data, panel_params, coord, se = FALSE, flipped_aes = FALSE) { ribbon <- transform(data, colour = NA) path <- transform(data, alpha = NA) - has_ribbon <- se && !is.null(data$ymax) && !is.null(data$ymin) + ymin = flipped_names(flipped_aes)$ymin + ymax = flipped_names(flipped_aes)$ymax + has_ribbon <- se && !is.null(data[[ymax]]) && !is.null(data[[ymin]]) gList( - if (has_ribbon) GeomRibbon$draw_group(ribbon, panel_params, coord), + if (has_ribbon) GeomRibbon$draw_group(ribbon, panel_params, coord, flipped_aes = flipped_aes), GeomLine$draw_panel(path, panel_params, coord) ) }, diff --git a/R/geom-violin.r b/R/geom-violin.r index 5a6be2add9..9a56f34639 100644 --- a/R/geom-violin.r +++ b/R/geom-violin.r @@ -5,9 +5,11 @@ #' violin plot is a mirrored density plot displayed in the same way as a #' boxplot. #' +#' @eval rd_orientation() +#' #' @eval rd_aesthetics("geom", "violin") #' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams geom_bar #' @param draw_quantiles If `not(NULL)` (default), draw horizontal lines #' at the given quantiles of the density estimate. #' @param trim If `TRUE` (default), trim the tails of the violins @@ -21,6 +23,10 @@ #' p <- ggplot(mtcars, aes(factor(cyl), mpg)) #' p + geom_violin() #' +#' # Orientation follows the discrete axis +#' ggplot(mtcars, aes(mpg, factor(cyl))) + +#' geom_violin() +#' #' \donttest{ #' p + geom_violin() + geom_jitter(height = 0, width = 0.1) #' @@ -75,6 +81,7 @@ geom_violin <- function(mapping = NULL, data = NULL, trim = TRUE, scale = "area", na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE) { layer( @@ -90,6 +97,7 @@ geom_violin <- function(mapping = NULL, data = NULL, scale = scale, draw_quantiles = draw_quantiles, na.rm = na.rm, + orientation = orientation, ... ) ) @@ -100,18 +108,28 @@ geom_violin <- function(mapping = NULL, data = NULL, #' @usage NULL #' @export GeomViolin <- ggproto("GeomViolin", Geom, + setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params, ambiguous = TRUE) + params + }, + + extra_params = c("na.rm", "orientation"), + setup_data = function(data, params) { + data$flipped_aes <- params$flipped_aes + data <- flip_data(data, params$flipped_aes) data$width <- data$width %||% params$width %||% (resolution(data$x, FALSE) * 0.9) - # ymin, ymax, xmin, and xmax define the bounding rectangle for each group - dapply(data, "group", transform, + data <- dapply(data, "group", transform, xmin = x - width / 2, xmax = x + width / 2 ) + flip_data(data, params$flipped_aes) }, - draw_group = function(self, data, ..., draw_quantiles = NULL) { + draw_group = function(self, data, ..., draw_quantiles = NULL, flipped_aes = FALSE) { + data <- flip_data(data, flipped_aes) # Find the points for the line to go all the way around data <- transform(data, xminv = x - violinwidth * (x - xmin), @@ -127,6 +145,7 @@ GeomViolin <- ggproto("GeomViolin", Geom, # Close the polygon: set first and last point the same # Needed for coord_polar and such newdata <- rbind(newdata, newdata[1,]) + newdata <- flip_data(newdata, flipped_aes) # Draw quantiles if requested, so long as there is non-zero y range if (length(draw_quantiles) > 0 & !scales::zero_range(range(data$y))) { @@ -142,6 +161,7 @@ GeomViolin <- ggproto("GeomViolin", Geom, aesthetics$alpha <- rep(1, nrow(quantiles)) both <- cbind(quantiles, aesthetics) both <- both[!is.na(both$group), , drop = FALSE] + both <- flip_data(both, flipped_aes) quantile_grob <- if (nrow(both) == 0) { zeroGrob() } else { diff --git a/R/ggplot-global.R b/R/ggplot-global.R index e9b871ae6c..2fa0604024 100644 --- a/R/ggplot-global.R +++ b/R/ggplot-global.R @@ -44,3 +44,9 @@ ggplot_global$all_aesthetics <- .all_aesthetics ) ggplot_global$base_to_ggplot <- .base_to_ggplot + +ggplot_global$x_aes <- c("x", "xmin", "xmax", "xend", "xintercept", + "xmin_final", "xmax_final", "xlower", "xmiddle", "xupper", "x0") + +ggplot_global$y_aes <- c("y", "ymin", "ymax", "yend", "yintercept", "ymin_final", + "ymax_final", "lower", "middle", "upper", "y0") diff --git a/R/guide-bins.R b/R/guide-bins.R new file mode 100644 index 0000000000..88a21e1c10 --- /dev/null +++ b/R/guide-bins.R @@ -0,0 +1,587 @@ +#' A binned version of guide_legend +#' +#' This guide is a version of the [guide_legend()] guide for binned scales. It +#' differs in that it places ticks correctly between the keys, and sports a +#' small axis to better show the binning. Like [guide_legend()] it can be used +#' for all non-position aesthetics though colour and fill defaults to +#' [guide_coloursteps()], and it will merge aesthetics together into the same +#' guide if they are mapped in the same way. +#' +#' @inheritParams guide_legend +#' @param axis Logical. Should a small axis be drawn along the guide +#' @param axis.colour,axis.linewidth Graphic specifications for the look of the +#' axis. +#' @param axis.arrow A call to `arrow()` to specify arrows at the end of the +#' axis line, thus showing an open interval. +#' @param show.limits Logical. Should the limits of the scale be shown with +#' labels and ticks. +#' +#' @return A guide object +#' @family guides +#' @export +#' +#' @examples +#' p <- ggplot(mtcars) + +#' geom_point(aes(disp, mpg, size = hp)) + +#' scale_size_binned() +#' +#' # Standard look +#' p +#' +#' # Remove the axis or style it +#' p + guides(size = guide_bins(axis = FALSE)) +#' +#' p + guides(size = guide_bins(show.limits = TRUE)) +#' +#' p + guides(size = guide_bins( +#' axis.arrow = arrow(length = unit(1.5, 'mm'), ends = 'both') +#' )) +#' +#' # Guides are merged together if possible +#' ggplot(mtcars) + +#' geom_point(aes(disp, mpg, size = hp, colour = hp)) + +#' scale_size_binned() + +#' scale_colour_binned(guide = "bins") +#' +guide_bins <- function( + # title + title = waiver(), + title.position = NULL, + title.theme = NULL, + title.hjust = NULL, + title.vjust = NULL, + + # label + label = TRUE, + label.position = NULL, + label.theme = NULL, + label.hjust = NULL, + label.vjust = NULL, + + # key + keywidth = NULL, + keyheight = NULL, + + # ticks + axis = TRUE, + axis.colour = "black", + axis.linewidth = 0.5, + axis.arrow = NULL, + + # general + direction = NULL, + default.unit = "line", + override.aes = list(), + reverse = FALSE, + order = 0, + show.limits = NULL, + ...) { + + structure(list( + # title + title = title, + title.position = title.position, + title.theme = title.theme, + title.hjust = title.hjust, + title.vjust = title.vjust, + + # label + label = label, + label.position = label.position, + label.theme = label.theme, + label.hjust = label.hjust, + label.vjust = label.vjust, + + # key + keywidth = keywidth, + keyheight = keyheight, + + # ticks + axis = axis, + axis.colour = axis.colour, + axis.linewidth = axis.linewidth, + axis.arrow = axis.arrow, + + # general + direction = direction, + default.unit = default.unit, + reverse = reverse, + order = order, + show.limits = show.limits, + + # parameter + available_aes = c("any"), + ..., + name = "bins"), + class = c("guide", "bins") + ) +} + +#' @export +guide_train.bins <- function(guide, scale, aesthetic = NULL) { + breaks <- scale$get_breaks() + if (length(breaks) == 0 || all(is.na(breaks))) { + return() + } + limits <- scale$get_limits() + all_breaks <- c(limits[1], breaks, limits[2]) + bin_at <- all_breaks[-1] - diff(all_breaks) / 2 + # in the key data frame, use either the aesthetic provided as + # argument to this function or, as a fall back, the first in the vector + # of possible aesthetics handled by the scale + aes_column_name <- aesthetic %||% scale$aesthetics[1] + key <- new_data_frame(setNames(list(c(scale$map(bin_at), NA)), aes_column_name)) + key$.label <- scale$get_labels(all_breaks) + guide$show.limits <- guide$show.limits %||% scale$show_limits %||% FALSE + + if (guide$reverse) key <- key[nrow(key):1, ] + + guide$key <- key + guide$hash <- with( + guide, + digest::digest(list(title, key$.label, direction, name)) + ) + guide +} + +#' @export +guide_merge.bins <- function(guide, new_guide) { + guide$key <- merge(guide$key, new_guide$key, sort = FALSE) + guide$override.aes <- c(guide$override.aes, new_guide$override.aes) + if (any(duplicated(names(guide$override.aes)))) { + warning("Duplicated override.aes is ignored.") + } + guide$override.aes <- guide$override.aes[!duplicated(names(guide$override.aes))] + guide +} + +#' @export +guide_geom.bins <- function(guide, layers, default_mapping) { + # arrange common data for vertical and horizontal guide + guide$geoms <- lapply(layers, function(layer) { + matched <- matched_aes(layer, guide, default_mapping) + + if (length(matched) > 0) { + # This layer contributes to the legend + + # check if this layer should be included, different behaviour depending on + # if show.legend is a logical or a named logical vector + if (!is.null(names(layer$show.legend))) { + layer$show.legend <- rename_aes(layer$show.legend) + include <- is.na(layer$show.legend[matched]) || + layer$show.legend[matched] + } else { + include <- is.na(layer$show.legend) || layer$show.legend + } + + if (include) { + # Default is to include it + + # Filter out set aesthetics that can't be applied to the legend + n <- vapply(layer$aes_params, length, integer(1)) + params <- layer$aes_params[n == 1] + + data <- layer$geom$use_defaults(guide$key[matched], params) + } else { + return(NULL) + } + } else { + # This layer does not contribute to the legend + if (is.na(layer$show.legend) || !layer$show.legend) { + # Default is to exclude it + return(NULL) + } else { + data <- layer$geom$use_defaults(NULL, layer$aes_params)[rep(1, nrow(guide$key)), ] + } + } + + # override.aes in guide_legend manually changes the geom + data <- modify_list(data, guide$override.aes) + + list( + draw_key = layer$geom$draw_key, + data = data, + params = c(layer$geom_params, layer$stat_params) + ) + }) + + # remove null geom + guide$geoms <- compact(guide$geoms) + + # Finally, remove this guide if no layer is drawn + if (length(guide$geoms) == 0) guide <- NULL + guide +} + +#' @export +guide_gengrob.bins <- function(guide, theme) { + if (!guide$show.limits) { + guide$key$.label[c(1, nrow(guide$key))] <- NA + } + + # default setting + if (guide$direction == "horizontal") { + label.position <- guide$label.position %||% "bottom" + if (!label.position %in% c("top", "bottom")) { + warning("Ignoring invalid label.position", call. = FALSE) + label.position <- "bottom" + } + } else { + label.position <- guide$label.position %||% "right" + if (!label.position %in% c("left", "right")) { + warning("Ignoring invalid label.position", call. = FALSE) + label.position <- "right" + } + } + + n_keys <- nrow(guide$key) - 1 + + # obtain the theme for the legend title. We need this both for the title grob + # and to obtain the title fontsize. + title.theme <- guide$title.theme %||% calc_element("legend.title", theme) + + title.hjust <- guide$title.hjust %||% theme$legend.title.align %||% title.theme$hjust %||% 0 + title.vjust <- guide$title.vjust %||% title.theme$vjust %||% 0.5 + + grob.title <- ggname("guide.title", + element_grob( + title.theme, + label = guide$title, + hjust = title.hjust, + vjust = title.vjust, + margin_x = TRUE, + margin_y = TRUE + ) + ) + + title_width <- width_cm(grob.title) + title_height <- height_cm(grob.title) + title_fontsize <- title.theme$size %||% calc_element("legend.title", theme)$size %||% + calc_element("text", theme)$size %||% 11 + + # gap between keys etc + # the default horizontal and vertical gap need to be the same to avoid strange + # effects for certain guide layouts + hgap <- width_cm(theme$legend.spacing.x %||% (0.5 * unit(title_fontsize, "pt"))) + vgap <- height_cm(theme$legend.spacing.y %||% (0.5 * unit(title_fontsize, "pt"))) + + # Labels + + # first get the label theme, we need it below even when there are no labels + label.theme <- guide$label.theme %||% calc_element("legend.text", theme) + + if (!guide$label || is.null(guide$key$.label)) { + grob.labels <- rep(list(zeroGrob()), nrow(guide$key)) + } else { + # get the defaults for label justification. The defaults are complicated and depend + # on the direction of the legend and on label placement + just_defaults <- label_just_defaults.bins(guide$direction, label.position) + # don't set expressions left-justified + if (just_defaults$hjust == 0 && any(is.expression(guide$key$.label))) just_defaults$hjust <- 1 + + # We break inheritance for hjust and vjust, because that's more intuitive here; it still allows manual + # setting of hjust and vjust if desired. The alternative is to ignore hjust and vjust altogether, which + # seems worse + if (is.null(guide$label.theme$hjust) && is.null(theme$legend.text$hjust)) label.theme$hjust <- NULL + if (is.null(guide$label.theme$vjust) && is.null(theme$legend.text$vjust)) label.theme$vjust <- NULL + + # label.theme in param of guide_legend() > theme$legend.text.align > default + hjust <- guide$label.hjust %||% theme$legend.text.align %||% label.theme$hjust %||% + just_defaults$hjust + vjust <- guide$label.vjust %||% label.theme$vjust %||% + just_defaults$vjust + + grob.labels <- lapply(guide$key$.label, function(label, ...) { + g <- element_grob( + element = label.theme, + label = label, + hjust = hjust, + vjust = vjust, + margin_x = TRUE, + margin_y = TRUE + ) + ggname("guide.label", g) + }) + if (!guide$show.limits) { + grob.labels[c(1, length(grob.labels))] <- list(zeroGrob()) + } + } + + label_widths <- width_cm(grob.labels) + label_heights <- height_cm(grob.labels) + + # Keys + key_width <- width_cm( + guide$keywidth %||% theme$legend.key.width %||% theme$legend.key.size + ) + key_height <- height_cm( + guide$keyheight %||% theme$legend.key.height %||% theme$legend.key.size + ) + + key_size_mat <- do.call("cbind", + lapply(guide$geoms, function(g) g$data$size / 10) + )[seq_len(n_keys), , drop = FALSE] + + if (nrow(key_size_mat) == 0 || ncol(key_size_mat) == 0) { + key_size_mat <- matrix(0, ncol = 1, nrow = n_keys) + } + key_sizes <- apply(key_size_mat, 1, max) + + if (guide$direction == "horizontal") { + key.nrow <- 1 + key.ncol <- n_keys + label.nrow <- 1 + label.ncol <- n_keys + 1 + } else { + key.nrow <- n_keys + key.ncol <- 1 + label.nrow <- n_keys + 1 + label.ncol <- 1 + } + + key_sizes <- matrix(key_sizes, key.nrow, key.ncol) + label_sizes <- matrix(label_widths, label.nrow, label.ncol) + + key_widths <- max(key_width, apply(key_sizes, 2, max)) + key_heights <- max(key_height, apply(key_sizes, 1, max)) + + label_widths <- max(apply(label_sizes, 2, max)) + label_heights <- max(apply(label_sizes, 1, max)) + + key_loc <- data_frame( + R = seq(2, by = 2, length.out = n_keys), + C = if (label.position %in% c("right", "bottom")) 1 else 3 + ) + label_loc <- data_frame( + R = seq(1, by = 2, length.out = n_keys + 1), + C = if (label.position %in% c("right", "bottom")) 3 else 1 + ) + tick_loc <- label_loc + tick_loc$C <- if (label.position %in% c("right", "bottom")) 1 else 3 + + widths <- c(key_widths, hgap, label_widths) + if (label.position != "right") widths <- rev(widths) + heights <- c(interleave(rep(0, n_keys), key_heights), 0) + if (guide$direction == "horizontal") { + names(key_loc) <- c("C", "R") + names(label_loc) <- c("C", "R") + names(tick_loc) <- c("C", "R") + heights <- c(key_heights, vgap, label_heights) + if (label.position != "bottom") heights <- rev(heights) + widths <- c(interleave(rep(0, n_keys), key_widths), 0) + } + + # layout the title over key-label + switch(guide$title.position, + "top" = { + widths <- c(widths, max(0, title_width - sum(widths))) + heights <- c(title_height, vgap, heights) + key_loc$R <- key_loc$R + 2 + label_loc$R <- label_loc$R + 2 + tick_loc$R <- tick_loc$R + 2 + title_row = 1 + title_col = seq_along(widths) + }, + "bottom" = { + widths <- c(widths, max(0, title_width - sum(widths))) + heights <- c(heights, vgap, title_height) + title_row = length(heights) + title_col = seq_along(widths) + }, + "left" = { + widths <- c(title_width, hgap, widths) + heights <- c(heights, max(0, title_height - sum(heights))) + key_loc$C <- key_loc$C + 2 + label_loc$C <- label_loc$C + 2 + tick_loc$C <- tick_loc$C + 2 + title_row = seq_along(heights) + title_col = 1 + }, + "right" = { + widths <- c(widths, hgap, title_width) + heights <- c(heights, max(0, title_height - sum(heights))) + title_row = seq_along(heights) + title_col = length(widths) + } + ) + + # grob for key + key_size <- c(key_width, key_height) * 10 + + draw_key <- function(i) { + bg <- element_render(theme, "legend.key") + keys <- lapply(guide$geoms, function(g) { + g$draw_key(g$data[i, ], g$params, key_size) + }) + c(list(bg), keys) + } + grob.keys <- unlist(lapply(seq_len(n_keys), draw_key), recursive = FALSE) + + # background + grob.background <- element_render(theme, "legend.background") + + ngeom <- length(guide$geoms) + 1 + kcols <- rep(key_loc$C, each = ngeom) + krows <- rep(key_loc$R, each = ngeom) + + # padding + padding <- convertUnit(theme$legend.margin %||% margin(), "cm", valueOnly = TRUE) + widths <- c(padding[4], widths, padding[2]) + heights <- c(padding[1], heights, padding[3]) + + # make the ticks grob (`grob.ticks`) + if (!guide$axis) { + grob.ticks <- zeroGrob() + grob.axis <- zeroGrob() + } else { + if (guide$direction == "horizontal") { + x0 <- 0.5 + y0 <- 0 + x1 <- 0.5 + y1 <- 1/5 + axis_x <- c(0, 1) + axis_y <- c(0, 0) + if (label.position == "top") { + y0 <- 4/5 + y1 <- 1 + axis_y <- c(1, 1) + } + } else { # guide$direction == "vertical" + y0 <- 0.5 + x0 <- 4/5 + y1 <- 0.5 + x1 <- 1 + axis_x <- c(1, 1) + axis_y <- c(0, 1) + if (label.position == "left") { + x0 <- 0 + x1 <- 1/5 + axis_x <- c(0, 0) + } + } + grob.ticks <- segmentsGrob( + x0 = x0, y0 = y0, x1 = x1, y1 = y1, + default.units = "npc", + gp = gpar( + col = guide$axis.colour, + lwd = guide$axis.linewidth, + lineend = "butt" + ) + ) + grob.axis <- segmentsGrob( + x0 = axis_x[1], y0 = axis_y[1], x1 = axis_x[2], y1 = axis_y[2], + default.units = "npc", + arrow = guide$axis.arrow, + gp = gpar( + col = guide$axis.colour, + lwd = guide$axis.linewidth, + lineend = if (is.null(guide$axis.arrow)) "square" else "round" + ) + ) + } + grob.ticks <- rep_len(list(grob.ticks), length(grob.labels)) + if (!guide$show.limits) { + grob.ticks[c(1, length(grob.ticks))] <- list(zeroGrob()) + } + # Create the gtable for the legend + gt <- gtable(widths = unit(widths, "cm"), heights = unit(heights, "cm")) + gt <- gtable_add_grob( + gt, + grob.background, + name = "background", + clip = "off", + t = 1, + r = -1, + b = -1, + l = 1 + ) + gt <- gtable_add_grob( + gt, + justify_grobs( + grob.title, + hjust = title.hjust, + vjust = title.vjust, + int_angle = title.theme$angle, + debug = title.theme$debug + ), + name = "title", + clip = "off", + t = 1 + min(title_row), + r = 1 + max(title_col), + b = 1 + max(title_row), + l = 1 + min(title_col) + ) + gt <- gtable_add_grob( + gt, + grob.keys, + name = paste("key", krows, kcols, c("bg", seq(ngeom - 1)), sep = "-"), + clip = "off", + t = 1 + krows, + r = 1 + kcols, + b = 1 + krows, + l = 1 + kcols + ) + gt <- gtable_add_grob( + gt, + grob.ticks, + name = paste("tick", tick_loc$R, tick_loc$C, sep = "-"), + clip = "off", + t = 1 + tick_loc$R, + r = 1 + tick_loc$C, + b = 1 + tick_loc$R, + l = 1 + tick_loc$C + ) + gt <- gtable_add_grob( + gt, + grob.axis, + name = "axis", + clip = "off", + t = min(1 + tick_loc$R), + r = min(1 + tick_loc$C), + b = max(1 + tick_loc$R), + l = max(1 + tick_loc$C) + ) + gt <- gtable_add_grob( + gt, + justify_grobs( + grob.labels, + hjust = hjust, + vjust = vjust, + int_angle = label.theme$angle, + debug = label.theme$debug + ), + name = paste("label", label_loc$R, label_loc$C, sep = "-"), + clip = "off", + t = 1 + label_loc$R, + r = 1 + label_loc$C, + b = 1 + label_loc$R, + l = 1 + label_loc$C + ) + gt +} + +#' Calculate the default hjust and vjust settings depending on legend +#' direction and position. +#' +#' @noRd +label_just_defaults.bins <- function(direction, position) { + if (direction == "horizontal") { + switch( + position, + "top" = list(hjust = 0.5, vjust = 0), + "bottom" = list(hjust = 0.5, vjust = 1), + "left" = list(hjust = 1, vjust = 0.5), + list(hjust = 0.5, vjust = 0.5) + ) + } + else { + switch( + position, + "top" = list(hjust = 0.5, vjust = 0), + "bottom" = list(hjust = 0.5, vjust = 1), + "left" = list(hjust = 1, vjust = 0.5), + list(hjust = 0, vjust = 0.5) + ) + + } +} diff --git a/R/guide-colorbar.r b/R/guide-colorbar.r index 4250443b9d..26a959ad3f 100644 --- a/R/guide-colorbar.r +++ b/R/guide-colorbar.r @@ -566,25 +566,3 @@ guide_gengrob.colorbar <- function(guide, theme) { #' @export #' @rdname guide_colourbar guide_colorbar <- guide_colourbar - -#' Calculate the default hjust and vjust settings depending on legend -#' direction and position. -#' -#' @noRd -label_just_defaults.colorbar <- function(direction, position) { - if (direction == "horizontal") { - switch( - position, - "top" = list(hjust = 0.5, vjust = 0), - list(hjust = 0.5, vjust = 1) - ) - } - else { - switch( - position, - "left" = list(hjust = 1, vjust = 0.5), - list(hjust = 0, vjust = 0.5) - ) - } -} - diff --git a/R/guide-colorsteps.R b/R/guide-colorsteps.R new file mode 100644 index 0000000000..fcbabf448f --- /dev/null +++ b/R/guide-colorsteps.R @@ -0,0 +1,106 @@ +#' Discretized colourbar guide +#' +#' This guide is version of [guide_colourbar()] for binned colour and fill +#' scales. It shows areas between breaks as a single constant colour instead of +#' the gradient known from the colourbar counterpart. +#' +#' @param even.steps Should the rendered size of the bins be equal, or should +#' they be proportional to their length in the data space? Defaults to `TRUE` +#' @param show.limits Should labels for the outer limits of the bins be printed? +#' Default is `NULL` which makes the guide use the setting from the scale +#' @param ticks A logical specifying if tick marks on the colourbar should be +#' visible. +#' @inheritDotParams guide_colourbar -nbin -raster -ticks -available_aes +#' +#' @return A guide object +#' @export +#' +#' @family guides +#' @examples +#' df <- reshape2::melt(outer(1:10, 1:10), varnames = c("X1", "X2")) +#' +#' p <- ggplot(df, aes(X1, X2)) + geom_tile(aes(fill = value)) +#' +#' # Coloursteps guide is the default for binned colour scales +#' p + scale_fill_binned() +#' +#' # By default each bin in the guide is the same size irrespectively of how +#' # their sizes relate in data space +#' p + scale_fill_binned(breaks = c(10, 25, 50)) +#' +#' # This can be changed with the `even.steps` argument +#' p + scale_fill_binned( +#' breaks = c(10, 25, 50), +#' guide = guide_coloursteps(even.steps = FALSE) +#' ) +#' +#' # By default the limits is not shown, but this can be changed +#' p + scale_fill_binned(guide = guide_coloursteps(show.limits = TRUE)) +#' +#' # (can also be set in the scale) +#' p + scale_fill_binned(show.limits = TRUE) +#' +guide_coloursteps <- function(even.steps = TRUE, show.limits = NULL, ticks = FALSE, ...) { + guide <- guide_colourbar(raster = FALSE, ticks = ticks, nbin = 100, ...) + guide$even.steps <- even.steps + guide$show.limits <- show.limits + class(guide) <- c('colorsteps', class(guide)) + guide +} +#' @export +#' @rdname guide_coloursteps +guide_colorsteps <- guide_coloursteps + +#' @export +guide_train.colorsteps <- function(guide, scale, aesthetic = NULL) { + if (guide$even.steps) { + breaks <- scale$get_breaks() + if (length(breaks) == 0 || all(is.na(breaks))) + return() + limits <- scale$get_limits() + all_breaks <- c(limits[1], breaks, limits[2]) + bin_at <- all_breaks[-1] - diff(all_breaks) / 2 + ticks <- new_data_frame(setNames(list(scale$map(breaks)), aesthetic %||% scale$aesthetics[1])) + ticks$.value <- seq_along(breaks) - 0.5 + ticks$.label <- scale$get_labels(breaks) + guide$nbin <- length(breaks) + 1 + guide$key <- ticks + guide$bar <- new_data_frame(list(colour = scale$map(bin_at), value = seq_along(bin_at) - 1), n = length(bin_at)) + if (guide$reverse) { + guide$key <- guide$key[nrow(guide$key):1, ] + guide$bar <- guide$bar[nrow(guide$bar):1, ] + } + guide$hash <- with(guide, digest::digest(list(title, key$.label, bar, name))) + } else { + guide <- NextMethod() + } + if (guide$show.limits %||% scale$show.limits %||% FALSE) { + edges <- rescale(c(0, 1), to = guide$bar$value[c(1, nrow(guide$bar))], from = c(0.5, guide$nbin - 0.5) / guide$nbin) + limits <- scale$get_limits() + guide$key <- guide$key[c(NA, seq_len(nrow(guide$key)), NA), , drop = FALSE] + guide$key$.value[c(1, nrow(guide$key))] <- edges + guide$key$.label[c(1, nrow(guide$key))] <- scale$get_labels(limits) + } + guide +} + +#' Calculate the default hjust and vjust settings depending on legend +#' direction and position. +#' +#' @noRd +label_just_defaults.colorbar <- function(direction, position) { + if (direction == "horizontal") { + switch( + position, + "top" = list(hjust = 0.5, vjust = 0), + list(hjust = 0.5, vjust = 1) + ) + } + else { + switch( + position, + "left" = list(hjust = 1, vjust = 0.5), + list(hjust = 0, vjust = 0.5) + ) + } +} diff --git a/R/guides-.r b/R/guides-.r index 0ad41eb131..40284afa00 100644 --- a/R/guides-.r +++ b/R/guides-.r @@ -73,7 +73,7 @@ update_guides <- function(p, guides) { } -# building guides - called in ggplotGrob (plot-render.r) +# building non-position guides - called in ggplotGrob (plot-build.r) # # the procedure is as follows: # @@ -116,7 +116,13 @@ build_guides <- function(scales, layers, default_mapping, position, theme, guide } # scales -> data for guides - gdefs <- guides_train(scales = scales, theme = theme, guides = guides, labels = labels) + gdefs <- guides_train( + scales = scales$non_position_scales(), + theme = theme, + guides = guides, + labels = labels + ) + if (length(gdefs) == 0) return(zeroGrob()) # merge overlay guides @@ -148,9 +154,15 @@ legend_position <- function(position) { } } +# resolve the guide from the scale and guides +resolve_guide <- function(aesthetic, scale, guides, default = "none", null = "none") { + guides[[aesthetic]] %||% scale$guide %|W|% default %||% null +} + # validate guide object validate_guide <- function(guide) { # if guide is specified by character, then find the corresponding guide + # when guides are officially extensible, this should use find_global() if (is.character(guide)) match.fun(paste("guide_", guide, sep = ""))() else if (inherits(guide, "guide")) @@ -170,12 +182,12 @@ guides_train <- function(scales, theme, guides, labels) { # which is prior to scale_ZZZ(guide=XXX) # guide is determined in order of: # + guides(XXX) > + scale_ZZZ(guide=XXX) > default(i.e., legend) - guide <- guides[[output]] %||% scale$guide + guide <- resolve_guide(output, scale, guides) # this should be changed to testing guide == "none" # scale$legend is backward compatibility # if guides(XXX=FALSE), then scale_ZZZ(guides=XXX) is discarded. - if (identical(guide, "none") || isFALSE(guide)) next + if (identical(guide, "none") || isFALSE(guide) || inherits(guide, "guide_none")) next # check the validity of guide. # if guide is character, then find the guide object @@ -322,6 +334,21 @@ guide_merge <- function(guide, new_guide) UseMethod("guide_merge") #' @rdname guide-exts guide_geom <- function(guide, layers, default_mapping) UseMethod("guide_geom") +#' @export +#' @rdname guide-exts +guide_transform <- function(guide, coord, panel_params) UseMethod("guide_transform") + +#' @export +guide_transform.default <- function(guide, coord, panel_params) { + stop( + "Guide with class ", + paste(class(guide), collapse = " / "), + " does not implement guide_transform(). ", + "Did you mean to use guide_axis()?", + call. = FALSE + ) +} + #' @export #' @rdname guide-exts guide_gengrob <- function(guide, theme) UseMethod("guide_gengrob") diff --git a/R/guides-axis.r b/R/guides-axis.r index d7bc5449ed..ef0c7b6f65 100644 --- a/R/guides-axis.r +++ b/R/guides-axis.r @@ -1,4 +1,165 @@ +#' Axis guide +#' +#' Axis guides are the visual representation of position scales like those +#' created with [scale_(x|y)_continuous()][scale_x_continuous()] and +#' [scale_(x|y)_discrete()][scale_x_discrete()]. +#' +#' @inheritParams guide_legend +#' @param check.overlap silently remove overlapping labels, +#' (recursively) prioritizing the first, last, and middle labels. +#' @param angle Compared to setting the angle in [theme()] / [element_text()], +#' this also uses some heuristics to automatically pick the `hjust` and `vjust` that +#' you probably want. +#' @param n.dodge The number of rows (for vertical axes) or columns (for +#' horizontal axes) that should be used to render the labels. This is +#' useful for displaying labels that would otherwise overlap. +#' @param order Used to determine the order of the guides (left-to-right, +#' top-to-bottom), if more than one guide must be drawn at the same location. +#' @param position Where this guide should be drawn: one of top, bottom, +#' left, or right. +#' +#' @export +#' +#' @examples +#' # plot with overlapping text +#' p <- ggplot(mpg, aes(cty * 100, hwy * 100)) + +#' geom_point() + +#' facet_wrap(vars(class)) +#' +#' # axis guides can be customized in the scale_* functions or +#' # using guides() +#' p + scale_x_continuous(guide = guide_axis(n.dodge = 2)) +#' p + guides(x = guide_axis(angle = 90)) +#' +#' # can also be used to add a duplicate guide +#' p + guides(x = guide_axis(n.dodge = 2), y.sec = guide_axis()) +#' +#' +guide_axis <- function(title = waiver(), check.overlap = FALSE, angle = NULL, n.dodge = 1, + order = 0, position = waiver()) { + structure( + list( + title = title, + + # customizations + check.overlap = check.overlap, + angle = angle, + n.dodge = n.dodge, + + # general + order = order, + position = position, + + # parameter + available_aes = c("x", "y"), + + name = "axis" + ), + class = c("guide", "axis") + ) +} + +#' @export +guide_train.axis <- function(guide, scale, aesthetic = NULL) { + + aesthetic <- aesthetic %||% scale$aesthetics[1] + breaks <- scale$get_breaks() + + empty_ticks <- new_data_frame( + list(aesthetic = numeric(0), .value = numeric(0), .label = character(0)) + ) + names(empty_ticks) <- c(aesthetic, ".value", ".label") + + if (length(intersect(scale$aesthetics, guide$available_aes)) == 0) { + warning( + "axis guide needs appropriate scales: ", + paste(guide$available_aes, collapse = ", "), + call. = FALSE + ) + guide$key <- empty_ticks + } else if (length(breaks) == 0) { + guide$key <- empty_ticks + } else { + ticks <- new_data_frame(setNames(list(scale$map(breaks)), aesthetic)) + ticks$.value <- breaks + ticks$.label <- scale$get_labels(breaks) + + if (is.list(ticks$.label)) { + if (any(sapply(ticks$.label, is.language))) { + ticks$.label <- do.call(expression, ticks$.label) + } else { + ticks$.label <- unlist(ticks$.label) + } + } + + guide$key <- ticks + } + + guide$name <- paste0(guide$name, "_", aesthetic) + guide$hash <- digest::digest(list(guide$title, guide$key$.value, guide$key$.label, guide$name)) + guide +} + +#' @export +guide_transform.axis <- function(guide, coord, panel_params) { + if (is.null(guide$position) || nrow(guide$key) == 0) { + return(guide) + } + + aesthetics <- names(guide$key)[!grepl("^\\.", names(guide$key))] + + if (all(c("x", "y") %in% aesthetics)) { + guide$key <- coord$transform(guide$key, panel_params) + } else { + other_aesthetic <- setdiff(c("x", "y"), aesthetics) + override_value <- if (guide$position %in% c("bottom", "left")) -Inf else Inf + guide$key[[other_aesthetic]] <- override_value + + guide$key <- coord$transform(guide$key, panel_params) + + warn_for_guide_position(guide) + } + + guide +} + +# discards the new guide with a warning +#' @export +guide_merge.axis <- function(guide, new_guide) { + if (!inherits(guide, "guide_none")) { + warning( + "guide_axis(): Discarding guide on merge. ", + "Do you have more than one guide with the same position?", + call. = FALSE + ) + } + + guide +} + +# axis guides don't care which geometry uses these aesthetics +#' @export +guide_geom.axis <- function(guide, layers, default_mapping) { + guide +} + +#' @export +guide_gengrob.axis <- function(guide, theme) { + aesthetic <- names(guide$key)[!grepl("^\\.", names(guide$key))][1] + + draw_axis( + break_positions = guide$key[[aesthetic]], + break_labels = guide$key$.label, + axis_position = guide$position, + theme = theme, + check.overlap = guide$check.overlap, + angle = guide$angle, + n.dodge = guide$n.dodge + ) +} + + #' Grob for axes #' #' @param break_position position of ticks @@ -10,14 +171,14 @@ #' @param angle Compared to setting the angle in [theme()] / [element_text()], #' this also uses some heuristics to automatically pick the `hjust` and `vjust` that #' you probably want. -#' @param n_dodge The number of rows (for vertical axes) or columns (for +#' @param n.dodge The number of rows (for vertical axes) or columns (for #' horizontal axes) that should be used to render the labels. This is #' useful for displaying labels that would otherwise overlap. #' #' @noRd #' draw_axis <- function(break_positions, break_labels, axis_position, theme, - check.overlap = FALSE, angle = NULL, n_dodge = 1) { + check.overlap = FALSE, angle = NULL, n.dodge = 1) { axis_position <- match.arg(axis_position, c("top", "bottom", "right", "left")) aesthetic <- if (axis_position %in% c("top", "bottom")) "x" else "y" @@ -96,7 +257,7 @@ draw_axis <- function(break_positions, break_labels, axis_position, theme, } # calculate multiple rows/columns of labels (which is usually 1) - dodge_pos <- rep(seq_len(n_dodge), length.out = n_breaks) + dodge_pos <- rep(seq_len(n.dodge), length.out = n_breaks) dodge_indices <- split(seq_len(n_breaks), dodge_pos) label_grobs <- lapply(dodge_indices, function(indices) { @@ -256,3 +417,28 @@ axis_label_element_overrides <- function(axis_position, angle = NULL) { stop("Unrecognized position: '", axis_position, "'", call. = FALSE) } } + +warn_for_guide_position <- function(guide) { + if (empty(guide$key) || nrow(guide$key) == 1) { + return() + } + + # this is trying to catch when a user specifies a position perpendicular + # to the direction of the axis (e.g., a "y" axis on "top") + + if (guide$position %in% c("top", "bottom")) { + position_aes <- "x" + } else if(guide$position %in% c("left", "right")) { + position_aes <- "y" + } else { + return() + } + + if (length(unique(guide$key[[position_aes]])) == 1) { + warning( + "Position guide is perpendicular to the intended axis. ", + "Did you mean to specify a different guide `position`?", + call. = FALSE + ) + } +} diff --git a/R/guides-none.r b/R/guides-none.r new file mode 100644 index 0000000000..e27b6e9892 --- /dev/null +++ b/R/guides-none.r @@ -0,0 +1,44 @@ + +#' Empty guide +#' +#' This guide draws nothing. +#' +#' @inheritParams guide_axis +#' +#' @export +#' +guide_none <- function(title = waiver(), position = waiver()) { + structure( + list( + title = title, + position = position, + available_aes = "any" + ), + class = c("guide", "guide_none") + ) +} + +#' @export +guide_train.guide_none <- function(guide, scale, aesthetic = NULL) { + guide +} + +#' @export +guide_merge.guide_none <- function(guide, new_guide) { + new_guide +} + +#' @export +guide_geom.guide_none <- function(guide, layers, default_mapping) { + guide +} + +#' @export +guide_transform.guide_none <- function(guide, coord, panel_params) { + guide +} + +#' @export +guide_gengrob.guide_none <- function(guide, theme, ...) { + zeroGrob() +} diff --git a/R/layout.R b/R/layout.R index 966f301fda..b1f9bb2a89 100644 --- a/R/layout.R +++ b/R/layout.R @@ -104,10 +104,13 @@ Layout <- ggproto("Layout", NULL, ) # Draw individual labels, then add to gtable - labels <- self$coord$labels(list( - x = self$xlabel(labels), - y = self$ylabel(labels) - )) + labels <- self$coord$labels( + list( + x = self$xlabel(labels), + y = self$ylabel(labels) + ), + self$panel_params[[1]] + ) labels <- self$render_labels(labels, theme) self$facet$draw_labels( plot_table, @@ -209,6 +212,25 @@ Layout <- ggproto("Layout", NULL, invisible() }, + setup_panel_guides = function(self, guides, layers, default_mapping) { + self$panel_params <- lapply( + self$panel_params, + self$coord$setup_panel_guides, + guides, + self$coord_params + ) + + self$panel_params <- lapply( + self$panel_params, + self$coord$train_panel_guides, + layers, + default_mapping, + self$coord_params + ) + + invisible() + }, + xlabel = function(self, labels) { primary <- self$panel_scales_x[[1]]$name %|W|% labels$x primary <- self$panel_scales_x[[1]]$make_title(primary) diff --git a/R/plot-build.r b/R/plot-build.r index e24a3d8882..714d200307 100644 --- a/R/plot-build.r +++ b/R/plot-build.r @@ -166,6 +166,7 @@ ggplot_gtable.ggplot_built <- function(data) { theme <- plot_theme(plot) geom_grobs <- Map(function(l, d) l$draw_geom(d, layout), plot$layers, data) + layout$setup_panel_guides(plot$guides, plot$layers, plot$mapping) plot_table <- layout$render(geom_grobs, data, theme, plot$labels) # Legends diff --git a/R/position-dodge.r b/R/position-dodge.r index dd9f67fe52..4730a7fbf3 100644 --- a/R/position-dodge.r +++ b/R/position-dodge.r @@ -89,6 +89,8 @@ PositionDodge <- ggproto("PositionDodge", Position, width = NULL, preserve = "total", setup_params = function(self, data) { + flipped_aes <- has_flipped_aes(data) + data <- flip_data(data, flipped_aes) if (is.null(data$xmin) && is.null(data$xmax) && is.null(self$width)) { warning("Width not defined. Set with `position_dodge(width = ?)`", call. = FALSE) @@ -104,19 +106,22 @@ PositionDodge <- ggproto("PositionDodge", Position, list( width = self$width, - n = n + n = n, + flipped_aes = flipped_aes ) }, setup_data = function(self, data, params) { + data <- flip_data(data, params$flipped_aes) if (!"x" %in% names(data) && all(c("xmin", "xmax") %in% names(data))) { data$x <- (data$xmin + data$xmax) / 2 } - data + flip_data(data, params$flipped_aes) }, compute_panel = function(data, params, scales) { - collide( + data <- flip_data(data, params$flipped_aes) + collided <- collide( data, params$width, name = "position_dodge", @@ -124,6 +129,7 @@ PositionDodge <- ggproto("PositionDodge", Position, n = params$n, check.width = FALSE ) + flip_data(collided, params$flipped_aes) } ) diff --git a/R/position-dodge2.r b/R/position-dodge2.r index 2bab0ba4fc..8cb6cb6d77 100644 --- a/R/position-dodge2.r +++ b/R/position-dodge2.r @@ -24,6 +24,8 @@ PositionDodge2 <- ggproto("PositionDodge2", PositionDodge, reverse = FALSE, setup_params = function(self, data) { + flipped_aes <- has_flipped_aes(data) + data <- flip_data(data, flipped_aes) if (is.null(data$xmin) && is.null(data$xmax) && is.null(self$width)) { warning("Width not defined. Set with `position_dodge2(width = ?)`", call. = FALSE) @@ -48,12 +50,14 @@ PositionDodge2 <- ggproto("PositionDodge2", PositionDodge, width = self$width, n = n, padding = self$padding, - reverse = self$reverse + reverse = self$reverse, + flipped_aes = flipped_aes ) }, compute_panel = function(data, params, scales) { - collide2( + data <- flip_data(data, params$flipped_aes) + collided <- collide2( data, params$width, name = "position_dodge2", @@ -63,6 +67,7 @@ PositionDodge2 <- ggproto("PositionDodge2", PositionDodge, check.width = FALSE, reverse = params$reverse ) + flip_data(collided, params$flipped_aes) } ) diff --git a/R/position-jitterdodge.R b/R/position-jitterdodge.R index 494db5f9f8..eba442395c 100644 --- a/R/position-jitterdodge.R +++ b/R/position-jitterdodge.R @@ -43,6 +43,8 @@ PositionJitterdodge <- ggproto("PositionJitterdodge", Position, required_aes = c("x", "y"), setup_params = function(self, data) { + flipped_aes <- has_flipped_aes(data) + data <- flip_data(data, flipped_aes) width <- self$jitter.width %||% (resolution(data$x, zero = FALSE) * 0.4) # Adjust the x transformation based on the number of 'dodge' variables dodgecols <- intersect(c("fill", "colour", "linetype", "shape", "size", "alpha"), colnames(data)) @@ -56,17 +58,20 @@ PositionJitterdodge <- ggproto("PositionJitterdodge", Position, dodge.width = self$dodge.width, jitter.height = self$jitter.height, jitter.width = width / (ndodge + 2), - seed = self$seed + seed = self$seed, + flipped_aes = flipped_aes ) }, compute_panel = function(data, params, scales) { + data <- flip_data(data, params$flipped_aes) data <- collide(data, params$dodge.width, "position_jitterdodge", pos_dodge, check.width = FALSE) trans_x <- if (params$jitter.width > 0) function(x) jitter(x, amount = params$jitter.width) trans_y <- if (params$jitter.height > 0) function(x) jitter(x, amount = params$jitter.height) - with_seed_null(params$seed, transform_position(data, trans_x, trans_y)) + data <- with_seed_null(params$seed, transform_position(data, trans_x, trans_y)) + flip_data(data, params$flipped_aes) } ) diff --git a/R/position-nudgestack.R b/R/position-nudgestack.R new file mode 100644 index 0000000000..ba05873b06 --- /dev/null +++ b/R/position-nudgestack.R @@ -0,0 +1,115 @@ +#' Simultaneously nudge and stack +#' +#' This is primarily used for set stacked columns between the ticks on the +#' x-axis. +#' +#' @family position adjustments +#' @param x,y Amount of vertical and horizontal distance to move. +#' @param vjust Vertical adjustment for geoms that have a position +#' (like points or lines), not a dimension (like bars or areas). Set to +#' `0` to align with the bottom, `0.5` for the middle, +#' and `1` (the default) for the top. +#' @param reverse If `TRUE`, will reverse the default stacking order. +#' This is useful if you're rotating both the plot and legend. +#' @export +#' @examples +#' ESM <- tsbox::ts_tbl(EuStockMarkets) +#' +#' ESM_prep <- ESM %>% +#' dplyr::mutate(time = as.Date(paste0(format(time, "%Y-%m"), "-1"))) %>% +#' dplyr::group_by(id, time) %>% +#' dplyr::summarize(value = mean(value)) %>% +#' dplyr::filter(time >= "1995-01-01" & time < "1998-01-01") +#' +#' ggplot(data = ESM_prep, mapping = aes(x = time, y = value, fill = id)) + +#' geom_col(position = position_nudgestack(x = 15)) +position_nudgestack <- function(x = 0, y = 0, vjust = 1, reverse = FALSE) { + ggproto(NULL, PositionNudgeStack, + x = x, + y = y, + vjust = vjust, + reverse = reverse + ) +} + +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +PositionNudgeStack <- ggproto("PositionNudgeStack", Position, + x = 0, + y = 0, + vjust = 1, + fill = FALSE, + reverse = FALSE, + + setup_params = function(self, data) { + list( + x = self$x, + y = self$y, + var = if (!is.null(self$var)) self$var else stack_var(data), + fill = self$fill, + vjust = self$vjust, + reverse = self$reverse + ) + }, + + setup_data = function(self, data, params) { + if (is.null(params$var)) { + return(data) + } + + data$ymax <- switch(params$var, + y = data$y, + ymax = ifelse(data$ymax == 0, data$ymin, data$ymax) + ) + + remove_missing( + data, + vars = c("x", "xmin", "xmax", "y"), + name = "position_stack" + ) + }, + + compute_layer = function(self, data, params, layout) { + if (is.null(params$var)) { + return(data) + } + + negative <- data$ymax < 0 + negative[is.na(negative)] <- FALSE + + neg <- data[negative, , drop = FALSE] + pos <- data[!negative, , drop = FALSE] + + if (any(negative)) { + neg <- collide(neg, NULL, "position_stack", pos_stack, + vjust = params$vjust, + fill = params$fill, + reverse = params$reverse + ) + } + if (any(!negative)) { + pos <- collide(pos, NULL, "position_stack", pos_stack, + vjust = params$vjust, + fill = params$fill, + reverse = params$reverse + ) + } + + data <- rbind(neg, pos)[match(seq_len(nrow(data)), c(which(negative), which(!negative))), ] + + # transform only the dimensions for which non-zero nudging is requested + if (any(params$x != 0)) { + if (any(params$y != 0)) { + transform_position(data, function(x) x + params$x, function(y) y + params$y) + } else { + transform_position(data, function(x) x + params$x, NULL) + } + } else if (any(params$y != 0)) { + transform_position(data, NULL, function(y) y + params$y) + } else { + data # if both x and y are 0 we don't need to transform + } + } +) diff --git a/R/position-stack.r b/R/position-stack.r index 7e42a8aef3..2775235a89 100644 --- a/R/position-stack.r +++ b/R/position-stack.r @@ -146,15 +146,19 @@ PositionStack <- ggproto("PositionStack", Position, reverse = FALSE, setup_params = function(self, data) { + flipped_aes <- has_flipped_aes(data) + data <- flip_data(data, flipped_aes) list( var = self$var %||% stack_var(data), fill = self$fill, vjust = self$vjust, - reverse = self$reverse + reverse = self$reverse, + flipped_aes = flipped_aes ) }, setup_data = function(self, data, params) { + data <- flip_data(data, params$flipped_aes) if (is.null(params$var)) { return(data) } @@ -164,14 +168,16 @@ PositionStack <- ggproto("PositionStack", Position, ymax = ifelse(data$ymax == 0, data$ymin, data$ymax) ) - remove_missing( + data <- remove_missing( data, vars = c("x", "xmin", "xmax", "y"), name = "position_stack" ) + flip_data(data, params$flip_data) }, compute_panel = function(data, params, scales) { + data <- flip_data(data, params$flipped_aes) if (is.null(params$var)) { return(data) } @@ -197,7 +203,8 @@ PositionStack <- ggproto("PositionStack", Position, ) } - rbind(neg, pos)[match(seq_len(nrow(data)), c(which(negative), which(!negative))),] + data <- rbind(neg, pos)[match(seq_len(nrow(data)), c(which(negative), which(!negative))),] + flip_data(data, params$flipped_aes) } ) diff --git a/R/scale-.r b/R/scale-.r index 9ccd77b42d..76e32d006d 100644 --- a/R/scale-.r +++ b/R/scale-.r @@ -186,6 +186,70 @@ discrete_scale <- function(aesthetics, scale_name, palette, name = waiver(), ) } +#' Binning scale constructor +#' +#' @inheritParams continuous_scale +#' @param n.breaks The number of break points to create if breaks are not given +#' directly. +#' @param nice.breaks Logical. Should breaks be attempted placed at nice values +#' instead of exactly evenly spaced between the limits. If `TRUE` (default) +#' the scale will ask the transformation object to create breaks, and this +#' may result in a different number of breaks than requested. Ignored if +#' breaks are given explicetly. +#' @param right Should values on the border between bins be part of the right +#' (upper) bin? +#' @param show.limits should the limits of the scale appear as ticks +#' @keywords internal +binned_scale <- function(aesthetics, scale_name, palette, name = waiver(), + breaks = waiver(), labels = waiver(), limits = NULL, + rescaler = rescale, oob = squish, expand = waiver(), + na.value = NA_real_, n.breaks = NULL, nice.breaks = TRUE, + right = TRUE, trans = "identity", show.limits = FALSE, + guide = "bins", position = "left", super = ScaleBinned) { + + aesthetics <- standardise_aes_names(aesthetics) + + check_breaks_labels(breaks, labels) + + position <- match.arg(position, c("left", "right", "top", "bottom")) + + if (is.null(breaks) && !is_position_aes(aesthetics) && guide != "none") { + guide <- "none" + } + + trans <- as.trans(trans) + if (!is.null(limits)) { + limits <- trans$transform(limits) + } + + ggproto(NULL, super, + call = match.call(), + + aesthetics = aesthetics, + scale_name = scale_name, + palette = palette, + + range = continuous_range(), + limits = limits, + trans = trans, + na.value = na.value, + expand = expand, + rescaler = rescaler, + oob = oob, + n.breaks = n.breaks, + nice.breaks = nice.breaks, + right = right, + show.limits = show.limits, + + name = name, + breaks = breaks, + + labels = labels, + guide = guide, + position = position + ) +} + #' @section Scales: #' #' All `scale_*` functions like [scale_x_continuous()] return a `Scale*` @@ -472,11 +536,8 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, transform = function(self, x) { new_x <- self$trans$transform(x) - if (any(is.finite(x) != is.finite(new_x))) { - type <- if (self$scale_name == "position_c") "continuous" else "discrete" - axis <- if ("x" %in% self$aesthetics) "x" else "y" - warning("Transformation introduced infinite values in ", type, " ", axis, "-axis", call. = FALSE) - } + axis <- if ("x" %in% self$aesthetics) "x" else "y" + check_transformation(x, new_x, self$scale_name, axis) new_x }, @@ -810,6 +871,193 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale, } ) +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +ScaleBinned <- ggproto("ScaleBinned", Scale, + range = continuous_range(), + na.value = NA_real_, + rescaler = rescale, + oob = squish, + n.breaks = NULL, + nice.breaks = TRUE, + right = TRUE, + after.stat = FALSE, + show.limits = FALSE, + + is_discrete = function() FALSE, + + train = function(self, x) { + if (!is.numeric(x)) { + stop("Binned scales only support continuous data", call. = FALSE) + } + + if (length(x) == 0) { + return() + } + self$range$train(x) + }, + + transform = function(self, x) { + new_x <- self$trans$transform(x) + axis <- if ("x" %in% self$aesthetics) "x" else "y" + check_transformation(x, new_x, self$scale_name, axis) + new_x + }, + + map = function(self, x, limits = self$get_limits()) { + if (self$after.stat) { + x + } else { + breaks <- self$get_breaks(limits) + breaks <- sort(unique(c(limits[1], breaks, limits[2]))) + + x <- self$rescale(self$oob(x, range = limits), limits) + breaks <- self$rescale(breaks, limits) + + x_binned <- cut(x, breaks, + labels = FALSE, + include.lowest = TRUE, + right = self$right + ) + + if (!is.null(self$palette.cache)) { + pal <- self$palette.cache + } else { + pal <- self$palette(breaks[-1] - diff(breaks) / 2) + self$palette.cache <- pal + } + + pal[x_binned] + } + }, + + rescale = function(self, x, limits = self$get_limits(), range = limits) { + self$rescaler(x, from = range) + }, + + dimension = function(self, expand = c(0, 0, 0, 0)) { + expand_range4(self$get_limits(), expand) + }, + + get_breaks = function(self, limits = self$get_limits()) { + if (self$is_empty()) return(numeric()) + + limits <- self$trans$inverse(limits) + + if (is.null(self$breaks)) { + return(NULL) + } else if (identical(self$breaks, NA)) { + stop("Invalid breaks specification. Use NULL, not NA", call. = FALSE) + } else if (is.waive(self$breaks)) { + if (self$nice.breaks) { + if (!is.null(self$n.breaks) && "n" %in% names(formals(self$trans$breaks))) { + breaks <- self$trans$breaks(limits, n = self$n.breaks) + } else { + if (!is.null(self$n.breaks)) { + warning("Ignoring n.breaks. Use a trans object that supports setting number of breaks", call. = FALSE) + } + breaks <- self$trans$breaks(limits) + } + } else { + n.breaks <- self$n.breaks %||% 5 # same default as trans objects + breaks <- seq(limits[1], limits[2], length.out = n.breaks + 2) + breaks <- breaks[-c(1, length(breaks))] + } + + # Ensure terminal bins are same width if limits not set + if (is.null(self$limits)) { + # Remove calculated breaks if they coincide with limits + breaks <- setdiff(breaks, limits) + nbreaks <- length(breaks) + if (nbreaks >= 2) { + new_limits <- c(2 * breaks[1] - breaks[2], 2 * breaks[nbreaks] - breaks[nbreaks - 1]) + if (breaks[nbreaks] > limits[2]) { + new_limits[2] <- breaks[nbreaks] + breaks <- breaks[-nbreaks] + } + if (breaks[1] < limits[1]) { + new_limits[1] <- breaks[1] + breaks <- breaks[-1] + } + limits <- new_limits + } else { + bin_size <- max(breaks[1] - limits[1], limits[2] - breaks[1]) + limits <- c(breaks[1] - bin_size, breaks[1] + bin_size) + } + self$limits <- self$trans$transform(limits) + } + } else if (is.function(self$breaks)) { + breaks <- self$breaks(limits, self$n_bins) + } else { + breaks <- self$breaks + } + + # Breaks must be within limits + breaks <- breaks[breaks >= limits[1] & breaks <= limits[2]] + self$breaks <- breaks + + self$trans$transform(breaks) + }, + + get_breaks_minor = function(...) NULL, + + get_labels = function(self, breaks = self$get_breaks()) { + if (is.null(breaks)) return(NULL) + + breaks <- self$trans$inverse(breaks) + + if (is.null(self$labels)) { + return(NULL) + } else if (identical(self$labels, NA)) { + stop("Invalid labels specification. Use NULL, not NA", call. = FALSE) + } else if (is.waive(self$labels)) { + labels <- self$trans$format(breaks) + } else if (is.function(self$labels)) { + labels <- self$labels(breaks) + } else { + labels <- self$labels + } + if (length(labels) != length(breaks)) { + stop("Breaks and labels are different lengths") + } + labels + }, + + clone = function(self) { + new <- ggproto(NULL, self) + new$range <- continuous_range() + new + }, + + break_info = function(self, range = NULL) { + # range + if (is.null(range)) range <- self$dimension() + + # major breaks + major <- self$get_breaks(range) + + if (!is.null(self$palette.cache)) { + pal <- self$palette.cache + } else { + pal <- self$palette(length(major) + 1) + } + + if (self$show.limits) { + limits <- self$get_limits() + major <- sort(unique(c(limits, major))) + } + + # labels + labels <- self$get_labels(major) + + list(range = range, labels = labels, + major = pal, minor = NULL, + major_source = major, minor_source = NULL) + } +) + # In place modification of a scale to change the primary axis scale_flip_position <- function(scale) { scale$position <- switch(scale$position, @@ -821,3 +1069,16 @@ scale_flip_position <- function(scale) { ) invisible() } + +check_transformation <- function(x, transformed, name, axis) { + if (any(is.finite(x) != is.finite(transformed))) { + type <- if (name == "position_b") { + "binned" + } else if (name == "position_c") { + "continuous" + } else { + "discrete" + } + warning("Transformation introduced infinite values in ", type, " ", axis, "-axis", call. = FALSE) + } +} diff --git a/R/scale-alpha.r b/R/scale-alpha.r index 967ae92d9a..9c59f09d20 100644 --- a/R/scale-alpha.r +++ b/R/scale-alpha.r @@ -5,7 +5,7 @@ #' `scale_alpha` is an alias for `scale_alpha_continuous` since #' that is the most common use of alpha, and it saves a bit of typing. #' -#' @param ... Other arguments passed on to [continuous_scale()] +#' @param ... Other arguments passed on to [continuous_scale()], [binned_scale], #' or [discrete_scale()] as appropriate, to control name, limits, #' breaks, labels and so forth. #' @param range Output range of alpha values. Must lie between 0 and 1. @@ -26,6 +26,11 @@ scale_alpha <- function(..., range = c(0.1, 1)) { #' @export scale_alpha_continuous <- scale_alpha +#' @rdname scale_alpha +scale_alpha_binned <- function(..., range = c(0.1, 1)) { + binned_scale("alpha", "alpha_b", rescale_pal(range), ...) +} + #' @rdname scale_alpha #' @export scale_alpha_discrete <- function(...) { diff --git a/R/scale-binned.R b/R/scale-binned.R new file mode 100644 index 0000000000..4a869bc726 --- /dev/null +++ b/R/scale-binned.R @@ -0,0 +1,110 @@ +#' Positional scales for binning continuous data (x & y) +#' +#' `scale_x_binned()` and `scale_y_binned()` are scales that discretize +#' continuous position data. You can use these scales to transform continuous +#' inputs before using it with a geom that requires discrete positions. An +#' example is using `scale_x_binned()` with [geom_bar()] to create a histogram. +#' +#' @inheritParams binned_scale +#' +#' @family position scales +#' @name scale_binned +#' @aliases NULL +#' +#' @examples +#' # Create a histogram by binning the x-axis +#' ggplot(mtcars) + +#' geom_bar(aes(mpg)) + +#' scale_x_binned() +NULL + +#' @rdname scale_binned +#' +#' @export +scale_x_binned <- function(name = waiver(), n.breaks = 10, nice.breaks = TRUE, + breaks = waiver(), labels = waiver(), limits = NULL, + expand = waiver(), oob = squish, na.value = NA_real_, + right = TRUE, show.limits = FALSE, trans = "identity", + position = "bottom") { + binned_scale( + aesthetics = c("x", "xmin", "xmax", "xend", "xintercept", "xmin_final", "xmax_final", "xlower", "xmiddle", "xupper"), + scale_name = "position_b", palette = identity, name = name, breaks = breaks, + labels = labels, limits = limits, expand = expand, oob = oob, na.value = na.value, + n.breaks = n.breaks, nice.breaks = nice.breaks, right = right, trans = trans, + show.limits = show.limits, guide = "none", position = position, super = ScaleBinnedPosition + ) +} + +#' @rdname scale_binned +#' +#' @export +scale_y_binned <- function(name = waiver(), n.breaks = 10, nice.breaks = TRUE, + breaks = waiver(), labels = waiver(), limits = NULL, + expand = waiver(), oob = squish, na.value = NA_real_, + right = TRUE, show.limits = FALSE, trans = "identity", + position = "left") { + binned_scale( + aesthetics = c("y", "ymin", "ymax", "yend", "yintercept", "ymin_final", "ymax_final", "lower", "middle", "upper"), + scale_name = "position_b", palette = identity, name = name, breaks = breaks, + labels = labels, limits = limits, expand = expand, oob = oob, na.value = na.value, + n.breaks = n.breaks, nice.breaks = nice.breaks, right = right, trans = trans, + show.limits = show.limits, guide = "none", position = position, super = ScaleBinnedPosition + ) +} + +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +ScaleBinnedPosition <- ggproto("ScaleBinnedPosition", ScaleBinned, + after.stat = FALSE, + + train = function(self, x) { + if (!is.numeric(x)) { + stop("Binned scales only support continuous data", call. = FALSE) + } + + if (length(x) == 0 || self$after.stat) return() + self$range$train(x) + }, + + map = function(self, x, limits = self$get_limits()) { + breaks <- self$get_breaks(limits) + all_breaks <- unique(sort(c(limits[1], breaks, limits[2]))) + + if (self$after.stat) { + # Backtransform to original scale + x_binned <- cut(x, seq_len(length(all_breaks) + 1) - 0.5, + labels = FALSE, + include.lowest = TRUE, + right = self$right + ) + (x - x_binned + .5) * diff(all_breaks)[x_binned] + all_breaks[x_binned] + } else { + x <- as.numeric(self$oob(x, limits)) + x <- ifelse(!is.na(x), x, self$na.value) + x_binned <- cut(x, all_breaks, + labels = FALSE, + include.lowest = TRUE, + right = self$right + ) + + x_binned # Return integer form so stat treat it like a discrete scale + } + }, + reset = function(self) { + self$after.stat <- TRUE + limits <- self$get_limits() + breaks <- self$get_breaks(limits) + self$range$reset() + self$range$train(c(limits, breaks)) + }, + + get_breaks = function(self, limits = self$get_limits()) { + breaks <- ggproto_parent(ScaleBinned, self)$get_breaks(limits) + if (self$show.limits) { + breaks <- sort(unique(c(self$get_limits(), breaks))) + } + breaks + } +) diff --git a/R/scale-brewer.r b/R/scale-brewer.r index ccbfc869ac..aa5d95d11d 100644 --- a/R/scale-brewer.r +++ b/R/scale-brewer.r @@ -8,7 +8,8 @@ #' #' @note #' The `distiller` scales extend brewer to continuous scales by smoothly -#' interpolating 7 colours from any palette to a continuous scale. +#' interpolating 7 colours from any palette to a continuous scale. The `fermenter` +#' scales provide binned versions of the brewer scales. #' #' @details #' The `brewer` scales were carefully designed and tested on discrete data. @@ -32,9 +33,9 @@ #' @param palette If a string, will use that named palette. If a number, will index into #' the list of palettes of appropriate `type`. The list of available palettes can found #' in the Palettes section. -#' @param ... Other arguments passed on to [discrete_scale()] or, for -#' `distiller` scales, [continuous_scale()] to control name, -#' limits, breaks, labels and so forth. +#' @param ... Other arguments passed on to [discrete_scale()], [continuous_scale()], +#' or [binned_scale()], for `brewer`, `distiller`, and `fermenter` variants +#' respectively, to control name, limits, breaks, labels and so forth. #' @family colour scales #' @rdname scale_brewer #' @export @@ -69,6 +70,10 @@ #' v #' v + scale_fill_distiller() #' v + scale_fill_distiller(palette = "Spectral") +#' +#' # or use blender variants to discretize continuous data +#' v + scale_fill_fermenter() +#' scale_colour_brewer <- function(..., type = "seq", palette = 1, direction = 1, aesthetics = "colour") { discrete_scale(aesthetics, "brewer", brewer_pal(type, palette, direction), ...) } @@ -104,6 +109,27 @@ scale_fill_distiller <- function(..., type = "seq", palette = 1, direction = -1, gradient_n_pal(brewer_pal(type, palette, direction)(7), values, space), na.value = na.value, guide = guide, ...) } +#' @export +#' @rdname scale_brewer +scale_colour_fermenter <- function(..., type = "seq", palette = 1, direction = -1, na.value = "grey50", guide = "coloursteps", aesthetics = "colour") { + # warn about using a qualitative brewer palette to generate the gradient + type <- match.arg(type, c("seq", "div", "qual")) + if (type == "qual") { + warning("Using a discrete colour palette in a binned scale.\n Consider using type = \"seq\" or type = \"div\" instead", call. = FALSE) + } + binned_scale(aesthetics, "fermenter", binned_pal(brewer_pal(type, palette, direction)), na.value = na.value, guide = guide, ...) +} + +#' @export +#' @rdname scale_brewer +scale_fill_fermenter <- function(..., type = "seq", palette = 1, direction = -1, na.value = "grey50", guide = "coloursteps", aesthetics = "fill") { + type <- match.arg(type, c("seq", "div", "qual")) + if (type == "qual") { + warning("Using a discrete colour palette in a binned scale.\n Consider using type = \"seq\" or type = \"div\" instead", call. = FALSE) + } + binned_scale(aesthetics, "fermenter", binned_pal(brewer_pal(type, palette, direction)), na.value = na.value, guide = guide, ...) +} + # icon.brewer <- function() { # rectGrob(c(0.1, 0.3, 0.5, 0.7, 0.9), width = 0.21, # gp = gpar(fill = RColorBrewer::brewer.pal(5, "PuOr"), col = NA) diff --git a/R/scale-colour.r b/R/scale-colour.r index d50fb9e22c..e9637a9120 100644 --- a/R/scale-colour.r +++ b/R/scale-colour.r @@ -1,4 +1,4 @@ -#' Continuous colour scales +#' Continuous and binned colour scales #' #' Colour scales for continuous data default to the values of the #' `ggplot2.continuous.colour` and `ggplot2.continuous.fill` options. If these @@ -9,7 +9,8 @@ #' @param type One of "gradient" (the default) or "viridis" indicating the #' colour scale to use #' @seealso [scale_colour_gradient()], [scale_colour_viridis_c()], -#' [scale_fill_gradient()], and [scale_fill_viridis_c()] +#' [scale_colour_steps()], [scale_colour_viridis_b()], [scale_fill_gradient()], +#' [scale_fill_viridis_c()], [scale_fill_steps()], and [scale_fill_viridis_b()] #' @export #' @rdname scale_colour_continuous #' @section Color Blindness: @@ -58,3 +59,29 @@ scale_fill_continuous <- function(..., stop("Unknown scale type", call. = FALSE) ) } + +#' @export +#' @rdname scale_colour_continuous +#' @usage NULL +scale_colour_binned <- function(..., + type = getOption("ggplot2.continuous.colour", default = "gradient")) { + switch( + type, + gradient = scale_colour_steps(...), + viridis = scale_colour_viridis_b(...), + stop("Unknown scale type", call. = FALSE) + ) +} + +#' @export +#' @rdname scale_colour_continuous +#' @usage NULL +scale_fill_binned <- function(..., + type = getOption("ggplot2.continuous.colour", default = "gradient")) { + switch( + type, + gradient = scale_fill_steps(...), + viridis = scale_fill_viridis_b(...), + stop("Unknown scale type", call. = FALSE) + ) +} diff --git a/R/scale-continuous.r b/R/scale-continuous.r index 662f39b913..8f1cfb1217 100644 --- a/R/scale-continuous.r +++ b/R/scale-continuous.r @@ -76,14 +76,14 @@ NULL scale_x_continuous <- function(name = waiver(), breaks = waiver(), minor_breaks = waiver(), labels = waiver(), limits = NULL, expand = waiver(), oob = censor, - na.value = NA_real_, trans = "identity", + na.value = NA_real_, trans = "identity", guide = waiver(), position = "bottom", sec.axis = waiver()) { sc <- continuous_scale( c("x", "xmin", "xmax", "xend", "xintercept", "xmin_final", "xmax_final", "xlower", "xmiddle", "xupper", "x0"), "position_c", identity, name = name, breaks = breaks, minor_breaks = minor_breaks, labels = labels, limits = limits, expand = expand, oob = oob, na.value = na.value, trans = trans, - guide = "none", position = position, super = ScaleContinuousPosition + guide = guide, position = position, super = ScaleContinuousPosition ) set_sec_axis(sec.axis, sc) @@ -95,14 +95,14 @@ scale_x_continuous <- function(name = waiver(), breaks = waiver(), scale_y_continuous <- function(name = waiver(), breaks = waiver(), minor_breaks = waiver(), labels = waiver(), limits = NULL, expand = waiver(), oob = censor, - na.value = NA_real_, trans = "identity", + na.value = NA_real_, trans = "identity", guide = waiver(), position = "left", sec.axis = waiver()) { sc <- continuous_scale( c("y", "ymin", "ymax", "yend", "yintercept", "ymin_final", "ymax_final", "lower", "middle", "upper", "y0"), "position_c", identity, name = name, breaks = breaks, minor_breaks = minor_breaks, labels = labels, limits = limits, expand = expand, oob = oob, na.value = na.value, trans = trans, - guide = "none", position = position, super = ScaleContinuousPosition + guide = guide, position = position, super = ScaleContinuousPosition ) set_sec_axis(sec.axis, sc) diff --git a/R/scale-date.r b/R/scale-date.r index 030d2f412d..14f002d702 100644 --- a/R/scale-date.r +++ b/R/scale-date.r @@ -66,6 +66,7 @@ scale_x_date <- function(name = waiver(), date_minor_breaks = waiver(), limits = NULL, expand = waiver(), + guide = waiver(), position = "bottom", sec.axis = waiver()) { @@ -80,7 +81,7 @@ scale_x_date <- function(name = waiver(), date_labels = date_labels, minor_breaks = minor_breaks, date_minor_breaks = date_minor_breaks, - guide = "none", + guide = guide, limits = limits, expand = expand, position = position @@ -100,6 +101,7 @@ scale_y_date <- function(name = waiver(), date_minor_breaks = waiver(), limits = NULL, expand = waiver(), + guide = waiver(), position = "left", sec.axis = waiver()) { @@ -114,7 +116,7 @@ scale_y_date <- function(name = waiver(), date_labels = date_labels, minor_breaks = minor_breaks, date_minor_breaks = date_minor_breaks, - guide = "none", + guide = guide, limits = limits, expand = expand, position = position @@ -135,6 +137,7 @@ scale_x_datetime <- function(name = waiver(), timezone = NULL, limits = NULL, expand = waiver(), + guide = waiver(), position = "bottom", sec.axis = waiver()) { @@ -150,7 +153,7 @@ scale_x_datetime <- function(name = waiver(), minor_breaks = minor_breaks, date_minor_breaks = date_minor_breaks, timezone = timezone, - guide = "none", + guide = guide, limits = limits, expand = expand, position = position @@ -172,6 +175,7 @@ scale_y_datetime <- function(name = waiver(), timezone = NULL, limits = NULL, expand = waiver(), + guide = waiver(), position = "left", sec.axis = waiver()) { @@ -187,7 +191,7 @@ scale_y_datetime <- function(name = waiver(), minor_breaks = minor_breaks, date_minor_breaks = date_minor_breaks, timezone = timezone, - guide = "none", + guide = guide, limits = limits, expand = expand, position = position @@ -208,6 +212,7 @@ scale_x_time <- function(name = waiver(), expand = waiver(), oob = censor, na.value = NA_real_, + guide = waiver(), position = "bottom", sec.axis = waiver()) { @@ -220,6 +225,7 @@ scale_x_time <- function(name = waiver(), expand = expand, oob = oob, na.value = na.value, + guide = guide, position = position, trans = scales::hms_trans(), sec.axis = sec.axis @@ -237,6 +243,7 @@ scale_y_time <- function(name = waiver(), expand = waiver(), oob = censor, na.value = NA_real_, + guide = waiver(), position = "left", sec.axis = waiver()) { @@ -249,6 +256,7 @@ scale_y_time <- function(name = waiver(), expand = expand, oob = oob, na.value = na.value, + guide = guide, position = position, trans = scales::hms_trans(), sec.axis = sec.axis diff --git a/R/scale-discrete-.r b/R/scale-discrete-.r index 49e7e0eee7..1390bef2af 100644 --- a/R/scale-discrete-.r +++ b/R/scale-discrete-.r @@ -47,18 +47,18 @@ #' geom_point() + #' scale_x_discrete(labels = abbreviate) #' } -scale_x_discrete <- function(..., expand = waiver(), position = "bottom") { +scale_x_discrete <- function(..., expand = waiver(), guide = waiver(), position = "bottom") { sc <- discrete_scale(c("x", "xmin", "xmax", "xend"), "position_d", identity, ..., - expand = expand, guide = "none", position = position, super = ScaleDiscretePosition) + expand = expand, guide = guide, position = position, super = ScaleDiscretePosition) sc$range_c <- continuous_range() sc } #' @rdname scale_discrete #' @export -scale_y_discrete <- function(..., expand = waiver(), position = "left") { +scale_y_discrete <- function(..., expand = waiver(), guide = waiver(), position = "left") { sc <- discrete_scale(c("y", "ymin", "ymax", "yend"), "position_d", identity, ..., - expand = expand, guide = "none", position = position, super = ScaleDiscretePosition) + expand = expand, guide = guide, position = position, super = ScaleDiscretePosition) sc$range_c <- continuous_range() sc diff --git a/R/scale-linetype.r b/R/scale-linetype.r index 874c25d6ff..e7c7ac7d6e 100644 --- a/R/scale-linetype.r +++ b/R/scale-linetype.r @@ -2,7 +2,8 @@ #' #' Default line types based on a set supplied by Richard Pearson, #' University of Manchester. Continuous values can not be mapped to -#' line types. +#' line types unless `scale_linetype_binned()` is used. Still, as linetypes has +#' no inherent order, this use is not advised. #' #' @inheritParams scale_x_discrete #' @inheritDotParams discrete_scale -expand -position -na.value @@ -33,6 +34,12 @@ scale_linetype <- function(..., na.value = "blank") { na.value = na.value, ...) } +#' @rdname scale_linetype +#' @export +scale_linetype_binned <- function(..., na.value = "blank") { + binned_scale("linetype", "linetype_b", binned_pal(linetype_pal()), ...) +} + #' @rdname scale_linetype #' @export scale_linetype_continuous <- function(...) { diff --git a/R/scale-shape.r b/R/scale-shape.r index 2a7c8cabac..8c496f1d92 100644 --- a/R/scale-shape.r +++ b/R/scale-shape.r @@ -4,7 +4,8 @@ #' If you have more than six levels, you will get a warning message, and the #' seventh and subsequence levels will not appear on the plot. Use #' [scale_shape_manual()] to supply your own values. You can not map -#' a continuous variable to shape. +#' a continuous variable to shape unless `scale_shape_binned()` is used. Still, +#' as shape has no inherent order, this use is not advised.. #' #' @param solid Should the shapes be solid, `TRUE`, or hollow, #' `FALSE`? @@ -38,6 +39,12 @@ scale_shape <- function(..., solid = TRUE) { discrete_scale("shape", "shape_d", shape_pal(solid), ...) } +#' @rdname scale_shape +#' @export +scale_shape_binned <- function(..., solid = TRUE) { + binned_scale("shape", "shape_b", binned_pal(shape_pal(solid)), ...) +} + #' @rdname scale_shape #' @export #' @usage NULL diff --git a/R/scale-size.r b/R/scale-size.r index fafc562e88..ea6f81003a 100644 --- a/R/scale-size.r +++ b/R/scale-size.r @@ -4,10 +4,13 @@ #' aesthetic is most commonly used for points and text, and humans perceive #' the area of points (not their radius), so this provides for optimal #' perception. `scale_size_area` ensures that a value of 0 is mapped -#' to a size of 0. +#' to a size of 0. `scale_size_binned` is a binned version of `scale_size` that +#' scales by area (but does not ensure 0 equals an area of zero). For a binned +#' equivalent of `scale_size_area` use `scale_size_binned_area`. #' #' @name scale_size #' @inheritParams continuous_scale +#' @inheritParams binned_scale #' @param range a numeric vector of length 2 that specifies the minimum and #' maximum size of the plotting symbol after transformation. #' @seealso [scale_size_area()] if you want 0 values to be mapped @@ -22,6 +25,9 @@ #' # If you want zero value to have zero size, use scale_size_area: #' p + scale_size_area() #' +#' # Binning can sometimes make it easier to match the scaled data to the legend +#' p + scale_size_binned() +#' #' # This is most useful when size is a count #' ggplot(mpg, aes(class, cyl)) + #' geom_count() + @@ -42,6 +48,10 @@ scale_size_continuous <- function(name = waiver(), breaks = waiver(), labels = w guide = guide) } +#' @rdname scale_size +#' @export +scale_size <- scale_size_continuous + #' @rdname scale_size #' @export scale_radius <- function(name = waiver(), breaks = waiver(), labels = waiver(), @@ -54,7 +64,13 @@ scale_radius <- function(name = waiver(), breaks = waiver(), labels = waiver(), #' @rdname scale_size #' @export -scale_size <- scale_size_continuous +scale_size_binned <- function(name = waiver(), breaks = waiver(), labels = waiver(), + limits = NULL, range = c(1, 6), n.breaks = NULL, + nice.breaks = TRUE, trans = "identity", guide = "bins") { + binned_scale("size", "area_b", area_pal(range), name = name, + breaks = breaks, labels = labels, limits = limits, trans = trans, + n.breaks = n.breaks, nice.breaks = nice.breaks, guide = guide) +} #' @rdname scale_size #' @export @@ -91,6 +107,14 @@ scale_size_area <- function(..., max_size = 6) { rescaler = rescale_max, ...) } +#' @export +#' @rdname scale_size +scale_size_binned_area <- function(..., max_size = 6) { + binned_scale("size", "area_b", + palette = abs_area(max_size), + rescaler = rescale_max, ...) +} + #' @rdname scale_size #' @export #' @usage NULL diff --git a/R/scale-steps.R b/R/scale-steps.R new file mode 100644 index 0000000000..d671569754 --- /dev/null +++ b/R/scale-steps.R @@ -0,0 +1,91 @@ +#' Binned gradient colour scales +#' +#' `scale_*_steps` creates a two colour binned gradient (low-high), +#' `scale_*_steps2` creates a diverging binned colour gradient (low-mid-high), +#' and `scale_*_stepsn` creates a n-colour binned gradient. These scales are +#' binned variants of the [gradient scale][scale_colour_gradient] family and +#' works in the same way. +#' +#' Default colours are generated with \pkg{munsell} and +#' `mnsl(c("2.5PB 2/4", "2.5PB 7/10"))`. Generally, for continuous +#' colour scales you want to keep hue constant, but vary chroma and +#' luminance. The \pkg{munsell} package makes this easy to do using the +#' Munsell colour system. +#' +#' @inheritParams scale_colour_gradient +#' @inheritDotParams binned_scale -aesthetics -scale_name -palette -na.value -guide -rescaler +#' +#' @seealso [scales::seq_gradient_pal()] for details on underlying +#' palette +#' @family colour scales +#' @rdname scale_steps +#' @export +#' @examples +#' df <- data.frame( +#' x = runif(100), +#' y = runif(100), +#' z1 = rnorm(100) +#' ) +#' +#' # Use scale_colour_steps for a standard binned gradient +#' ggplot(df, aes(x, y)) + +#' geom_point(aes(colour = z1)) + +#' scale_colour_steps() +#' +#' # Get a divergent binned scale with the *2 variant +#' ggplot(df, aes(x, y)) + +#' geom_point(aes(colour = z1)) + +#' scale_colour_steps2() +#' +#' # Define your own colour ramp to extract binned colours from +#' ggplot(df, aes(x, y)) + +#' geom_point(aes(colour = z1)) + +#' scale_colour_stepsn(colours = terrain.colors(10)) +#' + +#' @rdname scale_steps +#' @export +scale_colour_steps <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab", + na.value = "grey50", guide = "coloursteps", aesthetics = "colour") { + binned_scale(aesthetics, "steps", seq_gradient_pal(low, high, space), + na.value = na.value, guide = guide, ...) +} +#' @rdname scale_steps +#' @export +scale_colour_steps2 <- function(..., low = muted("red"), mid = "white", high = muted("blue"), + midpoint = 0, space = "Lab", na.value = "grey50", guide = "coloursteps", + aesthetics = "colour") { + binned_scale(aesthetics, "steps2", div_gradient_pal(low, mid, high, space), + na.value = na.value, guide = guide, rescaler = mid_rescaler(mid = midpoint), ...) +} +#' @rdname scale_steps +#' @export +scale_colour_stepsn <- function(..., colours, values = NULL, space = "Lab", na.value = "grey50", + guide = "coloursteps", aesthetics = "colour", colors) { + colours <- if (missing(colours)) colors else colours + binned_scale(aesthetics, "stepsn", + gradient_n_pal(colours, values, space), na.value = na.value, guide = guide, ...) +} +#' @rdname scale_steps +#' @export +scale_fill_steps <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab", + na.value = "grey50", guide = "coloursteps", aesthetics = "fill") { + binned_scale(aesthetics, "steps", seq_gradient_pal(low, high, space), + na.value = na.value, guide = guide, ...) +} +#' @rdname scale_steps +#' @export +scale_fill_steps2 <- function(..., low = muted("red"), mid = "white", high = muted("blue"), + midpoint = 0, space = "Lab", na.value = "grey50", guide = "coloursteps", + aesthetics = "fill") { + binned_scale(aesthetics, "steps2", div_gradient_pal(low, mid, high, space), + na.value = na.value, guide = guide, rescaler = mid_rescaler(mid = midpoint), ...) +} +#' @rdname scale_steps +#' @export +scale_fill_stepsn <- function(..., colours, values = NULL, space = "Lab", na.value = "grey50", + guide = "coloursteps", aesthetics = "fill", colors) { + colours <- if (missing(colours)) colors else colours + binned_scale(aesthetics, "stepsn", + gradient_n_pal(colours, values, space), na.value = na.value, guide = guide, ...) +} diff --git a/R/scale-view.r b/R/scale-view.r index 13afdba516..2986e275cd 100644 --- a/R/scale-view.r +++ b/R/scale-view.r @@ -26,13 +26,14 @@ view_scale_primary <- function(scale, limits = scale$get_limits(), ggproto(NULL, ViewScale, scale = scale, + guide = scale$guide, + position = scale$position, aesthetics = scale$aesthetics, name = scale$name, scale_is_discrete = scale$is_discrete(), limits = limits, continuous_range = continuous_range, breaks = breaks, - labels = scale$get_labels(breaks), minor_breaks = minor_breaks ) } @@ -40,17 +41,37 @@ view_scale_primary <- function(scale, limits = scale$get_limits(), # this function is a hack that is difficult to avoid given the complex implementation of second axes view_scale_secondary <- function(scale, limits = scale$get_limits(), continuous_range = scale$dimension(limits = limits)) { + if (is.null(scale$secondary.axis) || is.waive(scale$secondary.axis) || scale$secondary.axis$empty()) { - view_scale_empty() + # if there is no second axis, return the primary scale with no guide + # this guide can be overridden using guides() + primary_scale <- view_scale_primary(scale, limits, continuous_range) + scale_flip_position(primary_scale) + primary_scale$guide <- guide_none() + primary_scale } else { scale$secondary.axis$init(scale) break_info <- scale$secondary.axis$break_info(continuous_range, scale) names(break_info) <- gsub("sec\\.", "", names(break_info)) + # flip position from the original scale by default + # this can (should) be overridden in the guide + position <- switch(scale$position, + top = "bottom", + bottom = "top", + left = "right", + right = "left", + scale$position + ) + ggproto(NULL, ViewScale, scale = scale, + guide = scale$secondary.axis$guide, + position = position, break_info = break_info, - aesthetics = paste0(scale$aesthetics, ".sec"), + # as far as scales are concerned, this is a regular scale with + # different breaks and labels in a different data space + aesthetics = scale$aesthetics, name = scale$sec_name(), make_title = function(self, title) self$scale$make_sec_title(title), @@ -60,7 +81,7 @@ view_scale_secondary <- function(scale, limits = scale$get_limits(), get_breaks_minor = function(self) self$break_info$minor_source, break_positions = function(self) self$break_info$major, break_positions_minor = function(self) self$break_info$minor, - get_labels = function(self) self$break_info$labels, + get_labels = function(self, breaks = self$get_breaks()) self$break_info$labels, rescale = function(x) rescale(x, from = break_info$range, to = c(0, 1)) ) } @@ -74,7 +95,7 @@ view_scale_empty <- function() { get_limits = function() c(0, 1), get_breaks = function() NULL, get_breaks_minor = function() NULL, - get_labels = function() NULL, + get_labels = function(breaks = NULL) breaks, rescale = function(x) stop("Not implemented", call. = FALSE), map = function(x) stop("Not implemented", call. = FALSE), make_title = function(title) title, @@ -87,13 +108,14 @@ ViewScale <- ggproto("ViewScale", NULL, # map, rescale, and make_title need a reference # to the original scale scale = ggproto(NULL, Scale), + guide = guide_none(), + position = NULL, aesthetics = NULL, name = waiver(), scale_is_discrete = FALSE, limits = NULL, continuous_range = NULL, breaks = NULL, - labels = NULL, minor_breaks = NULL, is_empty = function(self) { @@ -104,12 +126,16 @@ ViewScale <- ggproto("ViewScale", NULL, get_limits = function(self) self$limits, get_breaks = function(self) self$breaks, get_breaks_minor = function(self) self$minor_breaks, - get_labels = function(self) self$labels, + get_labels = function(self, breaks = self$get_breaks()) self$scale$get_labels(breaks), rescale = function(self, x) { self$scale$rescale(x, self$limits, self$continuous_range) }, map = function(self, x) { - self$scale$map(x, self$limits) + if (self$is_discrete()) { + self$scale$map(x, self$limits) + } else { + self$scale$map(x, self$continuous_range) + } }, make_title = function(self, title) { self$scale$make_title(title) diff --git a/R/scale-viridis.r b/R/scale-viridis.r index ef5da6b395..4b4dde093a 100644 --- a/R/scale-viridis.r +++ b/R/scale-viridis.r @@ -8,8 +8,9 @@ #' @inheritParams viridisLite::viridis #' @inheritParams scales::gradient_n_pal #' @inheritParams continuous_scale -#' @param ... Other arguments passed on to [discrete_scale()] or -#' [continuous_scale()] to control name, limits, breaks, labels and so forth. +#' @param ... Other arguments passed on to [discrete_scale()], +#' [continuous_scale()], or [binned_scale] to control name, limits, breaks, +#' labels and so forth. #' @param aesthetics Character string or vector of character strings listing the #' name(s) of the aesthetic(s) that this scale works with. This can be useful, for #' example, to apply colour settings to the `colour` and `fill` aesthetics at the @@ -50,6 +51,10 @@ #' geom_tile(aes(waiting, eruptions, fill = density))) #' v + scale_fill_viridis_c() #' v + scale_fill_viridis_c(option = "plasma") +#' +#' # Use viridis_b to bin continuous data before mapping +#' v + scale_fill_viridis_b() +#' scale_colour_viridis_d <- function(..., alpha = 1, begin = 0, end = 1, direction = 1, option = "D", aesthetics = "colour") { discrete_scale( @@ -111,3 +116,43 @@ scale_fill_viridis_c <- function(..., alpha = 1, begin = 0, end = 1, ... ) } + +#' @export +#' @rdname scale_viridis +scale_colour_viridis_b <- function(..., alpha = 1, begin = 0, end = 1, + direction = 1, option = "D", values = NULL, + space = "Lab", na.value = "grey50", + guide = "coloursteps", aesthetics = "colour") { + binned_scale( + aesthetics, + "viridis_b", + gradient_n_pal( + viridis_pal(alpha, begin, end, direction, option)(6), + values, + space + ), + na.value = na.value, + guide = guide, + ... + ) +} + +#' @export +#' @rdname scale_viridis +scale_fill_viridis_b <- function(..., alpha = 1, begin = 0, end = 1, + direction = 1, option = "D", values = NULL, + space = "Lab", na.value = "grey50", + guide = "coloursteps", aesthetics = "fill") { + binned_scale( + aesthetics, + "viridis_b", + gradient_n_pal( + viridis_pal(alpha, begin, end, direction, option)(6), + values, + space + ), + na.value = na.value, + guide = guide, + ... + ) +} diff --git a/R/stat-.r b/R/stat-.r index f1b1b77985..dc09bf99ba 100644 --- a/R/stat-.r +++ b/R/stat-.r @@ -144,7 +144,12 @@ Stat <- ggproto("Stat", }, aesthetics = function(self) { - c(union(self$required_aes, names(self$default_aes)), "group") + if (is.null(self$required_aes)) { + required_aes <- NULL + } else { + required_aes <- unlist(strsplit(self$required_aes, '|', fixed = TRUE)) + } + c(union(required_aes, names(self$default_aes)), "group") } ) diff --git a/R/stat-bin.r b/R/stat-bin.r index 591034bbfb..ca4e8163c0 100644 --- a/R/stat-bin.r +++ b/R/stat-bin.r @@ -51,6 +51,7 @@ stat_bin <- function(mapping = NULL, data = NULL, closed = c("right", "left"), pad = FALSE, na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE) { @@ -71,6 +72,7 @@ stat_bin <- function(mapping = NULL, data = NULL, closed = closed, pad = pad, na.rm = na.rm, + orientation = orientation, ... ) ) @@ -82,11 +84,21 @@ stat_bin <- function(mapping = NULL, data = NULL, #' @export StatBin <- ggproto("StatBin", Stat, setup_params = function(data, params) { - if (!is.null(data$y) || !is.null(params$y)) { - stop("stat_bin() must not be used with a y aesthetic.", call. = FALSE) + params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = FALSE) + + has_x <- !(is.null(data$x) && is.null(params$x)) + has_y <- !(is.null(data$y) && is.null(params$y)) + if (!has_x && !has_y) { + stop("stat_bin() requires an x or y aesthetic.", call. = FALSE) + } + if (has_x && has_y) { + stop("stat_bin() can only have an x or y aesthetic.", call. = FALSE) } - if (is.integer(data$x)) { - stop('StatBin requires a continuous x variable: the x variable is discrete. Perhaps you want stat="count"?', + + x <- flipped_names(params$flipped_aes)$x + if (is.integer(data[[x]])) { + stop('StatBin requires a continuous ', x, ' variable: the ', + x, ' variable is discrete. Perhaps you want stat="count"?', call. = FALSE) } @@ -119,34 +131,39 @@ StatBin <- ggproto("StatBin", Stat, params }, + extra_params = c("na.rm", "orientation"), + compute_group = function(data, scales, binwidth = NULL, bins = NULL, center = NULL, boundary = NULL, closed = c("right", "left"), pad = FALSE, - breaks = NULL, + breaks = NULL, flipped_aes = FALSE, # The following arguments are not used, but must # be listed so parameters are computed correctly origin = NULL, right = NULL, drop = NULL, width = NULL) { - + x <- flipped_names(flipped_aes)$x if (!is.null(breaks)) { - if (!scales$x$is_discrete()){ - breaks <- scales$x$transform(breaks) + if (!scales[[x]]$is_discrete()) { + breaks <- scales[[x]]$transform(breaks) } bins <- bin_breaks(breaks, closed) } else if (!is.null(binwidth)) { if (is.function(binwidth)) { - binwidth <- binwidth(data$x) + binwidth <- binwidth(data[[x]]) } - bins <- bin_breaks_width(scales$x$dimension(), binwidth, + bins <- bin_breaks_width(scales[[x]]$dimension(), binwidth, center = center, boundary = boundary, closed = closed) } else { - bins <- bin_breaks_bins(scales$x$dimension(), bins, center = center, + bins <- bin_breaks_bins(scales[[x]]$dimension(), bins, center = center, boundary = boundary, closed = closed) } - bin_vector(data$x, bins, weight = data$weight, pad = pad) + bins <- bin_vector(data[[x]], bins, weight = data$weight, pad = pad) + bins$flipped_aes <- flipped_aes + flip_data(bins, flipped_aes) }, - default_aes = aes(y = stat(count), weight = 1), - required_aes = c("x") + default_aes = aes(x = stat(count), y = stat(count), weight = 1), + + required_aes = "x|y" ) diff --git a/R/stat-boxplot.r b/R/stat-boxplot.r index 618d57e99c..ac8ab5dc27 100644 --- a/R/stat-boxplot.r +++ b/R/stat-boxplot.r @@ -18,6 +18,7 @@ stat_boxplot <- function(mapping = NULL, data = NULL, ..., coef = 1.5, na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE) { layer( @@ -30,6 +31,7 @@ stat_boxplot <- function(mapping = NULL, data = NULL, inherit.aes = inherit.aes, params = list( na.rm = na.rm, + orientation = orientation, coef = coef, ... ) @@ -42,9 +44,10 @@ stat_boxplot <- function(mapping = NULL, data = NULL, #' @usage NULL #' @export StatBoxplot <- ggproto("StatBoxplot", Stat, - required_aes = c("y"), + required_aes = c("y|x"), non_missing_aes = "weight", setup_data = function(data, params) { + data <- flip_data(data, params$flipped_aes) data$x <- data$x %||% 0 data <- remove_missing( data, @@ -52,22 +55,34 @@ StatBoxplot <- ggproto("StatBoxplot", Stat, vars = "x", name = "stat_boxplot" ) - data + flip_data(data, params$flipped_aes) }, setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = TRUE, group_has_equal = TRUE) + data <- flip_data(data, params$flipped_aes) + + has_x <- !(is.null(data$x) && is.null(params$x)) + has_y <- !(is.null(data$y) && is.null(params$y)) + if (!has_x && !has_y) { + stop("stat_boxplot() requires an x or y aesthetic.", call. = FALSE) + } + params$width <- params$width %||% (resolution(data$x %||% 0) * 0.75) if (is.double(data$x) && !has_groups(data) && any(data$x != data$x[1L])) { warning( - "Continuous x aesthetic -- did you forget aes(group=...)?", + "Continuous ", flipped_names(params$flipped_aes)$x, " aesthetic -- did you forget aes(group=...)?", call. = FALSE) } params }, - compute_group = function(data, scales, width = NULL, na.rm = FALSE, coef = 1.5) { + extra_params = c("na.rm", "orientation"), + + compute_group = function(data, scales, width = NULL, na.rm = FALSE, coef = 1.5, flipped_aes = FALSE) { + data <- flip_data(data, flipped_aes) qs <- c(0, 0.25, 0.5, 0.75, 1) if (!is.null(data$weight)) { @@ -103,6 +118,7 @@ StatBoxplot <- ggproto("StatBoxplot", Stat, df$x <- if (is.factor(data$x)) data$x[1] else mean(range(data$x)) df$width <- width df$relvarwidth <- sqrt(n) - df + df$flipped_aes <- flipped_aes + flip_data(df, flipped_aes) } ) diff --git a/R/stat-count.r b/R/stat-count.r index c08381d8c7..2276f56549 100644 --- a/R/stat-count.r +++ b/R/stat-count.r @@ -16,11 +16,13 @@ stat_count <- function(mapping = NULL, data = NULL, ..., width = NULL, na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE) { params <- list( na.rm = na.rm, + orientation = orientation, width = width, ... ) @@ -46,17 +48,29 @@ stat_count <- function(mapping = NULL, data = NULL, #' @export #' @include stat-.r StatCount <- ggproto("StatCount", Stat, - required_aes = "x", - default_aes = aes(y = stat(count), weight = 1), + required_aes = "x|y", + + default_aes = aes(x = stat(count), y = stat(count), weight = 1), setup_params = function(data, params) { - if (!is.null(data$y)) { - stop("stat_count() must not be used with a y aesthetic.", call. = FALSE) + params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = FALSE) + + has_x <- !(is.null(data$x) && is.null(params$x)) + has_y <- !(is.null(data$y) && is.null(params$y)) + if (!has_x && !has_y) { + stop("stat_count() requires an x or y aesthetic.", call. = FALSE) + } + if (has_x && has_y) { + stop("stat_count() can only have an x or y aesthetic.", call. = FALSE) } + params }, - compute_group = function(self, data, scales, width = NULL) { + extra_params = c("na.rm", "orientation"), + + compute_group = function(self, data, scales, width = NULL, flipped_aes = FALSE) { + data <- flip_data(data, flipped_aes) x <- data$x weight <- data$weight %||% rep(1, length(x)) width <- width %||% (resolution(x) * 0.9) @@ -64,11 +78,13 @@ StatCount <- ggproto("StatCount", Stat, count <- as.numeric(tapply(weight, x, sum, na.rm = TRUE)) count[is.na(count)] <- 0 - new_data_frame(list( + bars <- new_data_frame(list( count = count, prop = count / sum(abs(count)), x = sort(unique(x)), - width = width + width = width, + flipped_aes = flipped_aes ), n = length(count)) + flip_data(bars, flipped_aes) } ) diff --git a/R/stat-density.r b/R/stat-density.r index 6d18b8bb12..804d2c6e0c 100644 --- a/R/stat-density.r +++ b/R/stat-density.r @@ -35,6 +35,7 @@ stat_density <- function(mapping = NULL, data = NULL, n = 512, trim = FALSE, na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE) { @@ -53,6 +54,7 @@ stat_density <- function(mapping = NULL, data = NULL, n = n, trim = trim, na.rm = na.rm, + orientation = orientation, ... ) ) @@ -63,19 +65,37 @@ stat_density <- function(mapping = NULL, data = NULL, #' @usage NULL #' @export StatDensity <- ggproto("StatDensity", Stat, - required_aes = "x", - default_aes = aes(y = stat(density), fill = NA, weight = NULL), + required_aes = "x|y", + + default_aes = aes(x = stat(density), y = stat(density), fill = NA, weight = NULL), + + setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = FALSE, main_is_continuous = TRUE) + + has_x <- !(is.null(data$x) && is.null(params$x)) + has_y <- !(is.null(data$y) && is.null(params$y)) + if (!has_x && !has_y) { + stop("stat_density() requires an x or y aesthetic.", call. = FALSE) + } + + params + }, + + extra_params = c("na.rm", "orientation"), compute_group = function(data, scales, bw = "nrd0", adjust = 1, kernel = "gaussian", - n = 512, trim = FALSE, na.rm = FALSE) { + n = 512, trim = FALSE, na.rm = FALSE, flipped_aes = FALSE) { + data <- flip_data(data, flipped_aes) if (trim) { range <- range(data$x, na.rm = TRUE) } else { - range <- scales$x$dimension() + range <- scales[[flipped_names(flipped_aes)$x]]$dimension() } - compute_density(data$x, data$weight, from = range[1], to = range[2], - bw = bw, adjust = adjust, kernel = kernel, n = n) + density <- compute_density(data$x, data$weight, from = range[1], + to = range[2], bw = bw, adjust = adjust, kernel = kernel, n = n) + density$flipped_aes <- flipped_aes + flip_data(density, flipped_aes) } ) diff --git a/R/stat-smooth.r b/R/stat-smooth.r index 86e2e9dcab..31a7941bb2 100644 --- a/R/stat-smooth.r +++ b/R/stat-smooth.r @@ -1,8 +1,10 @@ -#' @param method Smoothing method (function) to use, accepts either a character vector, -#' e.g. `"auto"`, `"lm"`, `"glm"`, `"gam"`, `"loess"` or a function, e.g. -#' `MASS::rlm` or `mgcv::gam`, `stats::lm`, or `stats::loess`. +#' @param method Smoothing method (function) to use, accepts either +#' `NULL` or a character vector, e.g. `"lm"`, `"glm"`, `"gam"`, `"loess"` +#' or a function, e.g. `MASS::rlm` or `mgcv::gam`, `stats::lm`, or `stats::loess`. +#' `"auto"` is also accepted for backwards compatibility. It is equivalent to +#' `NULL`. #' -#' For `method = "auto"` the smoothing method is chosen based on the +#' For `method = NULL` the smoothing method is chosen based on the #' size of the largest group (across all panels). [stats::loess()] is #' used for less than 1,000 observations; otherwise [mgcv::gam()] is #' used with `formula = y ~ s(x, bs = "cs")` with `method = "REML"`. Somewhat anecdotally, @@ -10,10 +12,12 @@ #' so does not work for larger datasets. #' #' If you have fewer than 1,000 observations but want to use the same `gam()` -#' model that `method = "auto"` would use, then set +#' model that `method = NULL` would use, then set #' `method = "gam", formula = y ~ s(x, bs = "cs")`. #' @param formula Formula to use in smoothing function, eg. `y ~ x`, -#' `y ~ poly(x, 2)`, `y ~ log(x)` +#' `y ~ poly(x, 2)`, `y ~ log(x)`. `NULL` by default, in which case +#' `method = NULL` implies `formula = y ~ x` when there are fewer than 1,000 +#' observations and `formula = y ~ s(x, bs = "cs")` otherwise. #' @param se Display confidence interval around smooth? (`TRUE` by default, see #' `level` to control.) #' @param fullrange Should the fit span the full range of the plot, or just @@ -37,8 +41,8 @@ stat_smooth <- function(mapping = NULL, data = NULL, geom = "smooth", position = "identity", ..., - method = "auto", - formula = y ~ x, + method = NULL, + formula = NULL, se = TRUE, n = 80, span = 0.75, @@ -46,6 +50,7 @@ stat_smooth <- function(mapping = NULL, data = NULL, level = 0.95, method.args = list(), na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE) { layer( @@ -64,6 +69,7 @@ stat_smooth <- function(mapping = NULL, data = NULL, fullrange = fullrange, level = level, na.rm = na.rm, + orientation = orientation, method.args = method.args, span = span, ... @@ -77,7 +83,9 @@ stat_smooth <- function(mapping = NULL, data = NULL, #' @export StatSmooth <- ggproto("StatSmooth", Stat, setup_params = function(data, params) { - if (identical(params$method, "auto")) { + params$flipped_aes <- has_flipped_aes(data, params, ambiguous = TRUE) + msg <- character() + if (is.null(params$method) || identical(params$method, "auto")) { # Use loess for small datasets, gam with a cubic regression basis for # larger. Based on size of the _largest_ group to avoid bad memory # behaviour of loess @@ -87,21 +95,36 @@ StatSmooth <- ggproto("StatSmooth", Stat, params$method <- "loess" } else { params$method <- "gam" + } + msg <- c(msg, paste0("method = '", params$method, "'")) + } + + if (is.null(params$formula)) { + if (identical(params$method, "gam")) { params$formula <- y ~ s(x, bs = "cs") + } else { + params$formula <- y ~ x } - message( - "`geom_smooth()` using method = '", params$method, - "' and formula '", deparse(params$formula), "'" - ) + msg <- c(msg, paste0("formula '", deparse(params$formula), "'")) + } + if (identical(params$method, "gam")) { + params$method <- mgcv::gam + } + + if (length(msg) > 0) { + message("`geom_smooth()` using ", paste0(msg, collapse = " and ")) } params }, - compute_group = function(data, scales, method = "auto", formula = y ~ x, + extra_params = c("na.rm", "orientation"), + + compute_group = function(data, scales, method = NULL, formula = NULL, se = TRUE, n = 80, span = 0.75, fullrange = FALSE, xseq = NULL, level = 0.95, method.args = list(), - na.rm = FALSE) { + na.rm = FALSE, flipped_aes = NA) { + data <- flip_data(data, flipped_aes) if (length(unique(data$x)) < 2) { # Not enough data to perform fit return(new_data_frame()) @@ -146,7 +169,9 @@ StatSmooth <- ggproto("StatSmooth", Stat, base.args <- list(quote(formula), data = quote(data), weights = quote(weight)) model <- do.call(method, c(base.args, method.args)) - predictdf(model, xseq, se, level) + prediction <- predictdf(model, xseq, se, level) + prediction$flipped_aes <- flipped_aes + flip_data(prediction, flipped_aes) }, required_aes = c("x", "y") diff --git a/R/stat-summary-bin.R b/R/stat-summary-bin.R index 0aa8a2dcaa..811f598faa 100644 --- a/R/stat-summary-bin.R +++ b/R/stat-summary-bin.R @@ -5,16 +5,30 @@ stat_summary_bin <- function(mapping = NULL, data = NULL, geom = "pointrange", position = "identity", ..., fun.data = NULL, - fun.y = NULL, - fun.ymax = NULL, - fun.ymin = NULL, + fun = NULL, + fun.max = NULL, + fun.min = NULL, fun.args = list(), bins = 30, binwidth = NULL, breaks = NULL, na.rm = FALSE, + orientation = NA, show.legend = NA, - inherit.aes = TRUE) { + inherit.aes = TRUE, + fun.y, fun.ymin, fun.ymax) { + if (!missing(fun.y)) { + warn("`fun.y` is deprecated. Use `fun` instead.") + fun = fun %||% fun.y + } + if (!missing(fun.ymin)) { + warn("`fun.ymin` is deprecated. Use `fun.min` instead.") + fun.min = fun.min %||% fun.ymin + } + if (!missing(fun.ymax)) { + warn("`fun.ymax` is deprecated. Use `fun.max` instead.") + fun.max = fun.max %||% fun.ymax + } layer( data = data, mapping = mapping, @@ -25,14 +39,15 @@ stat_summary_bin <- function(mapping = NULL, data = NULL, inherit.aes = inherit.aes, params = list( fun.data = fun.data, - fun.y = fun.y, - fun.ymax = fun.ymax, - fun.ymin = fun.ymin, + fun = fun, + fun.max = fun.max, + fun.min = fun.min, fun.args = fun.args, bins = bins, binwidth = binwidth, breaks = breaks, na.rm = na.rm, + orientation = orientation, ... ) ) @@ -45,30 +60,38 @@ stat_summary_bin <- function(mapping = NULL, data = NULL, StatSummaryBin <- ggproto("StatSummaryBin", Stat, required_aes = c("x", "y"), - compute_group = function(data, scales, fun.data = NULL, fun.y = NULL, - fun.ymax = NULL, fun.ymin = NULL, fun.args = list(), - bins = 30, binwidth = NULL, breaks = NULL, - origin = NULL, right = FALSE, na.rm = FALSE) { - - fun <- make_summary_fun(fun.data, fun.y, fun.ymax, fun.ymin, fun.args) + extra_params = c("na.rm", "orientation"), + setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params, ambiguous = TRUE) + params + }, - breaks <- bin2d_breaks(scales$x, breaks, origin, binwidth, bins, right = right) + compute_group = function(data, scales, fun.data = NULL, fun = NULL, + fun.max = NULL, fun.min = NULL, fun.args = list(), + bins = 30, binwidth = NULL, breaks = NULL, + origin = NULL, right = FALSE, na.rm = FALSE, + flipped_aes = FALSE) { + data <- flip_data(data, flipped_aes) + fun <- make_summary_fun(fun.data, fun, fun.max, fun.min, fun.args) + x <- flipped_names(flipped_aes)$x + breaks <- bin2d_breaks(scales[[x]], breaks, origin, binwidth, bins, right = right) data$bin <- cut(data$x, breaks, include.lowest = TRUE, labels = FALSE) out <- dapply(data, "bin", fun) locs <- bin_loc(breaks, out$bin) out$x <- locs$mid - out$width <- if (scales$x$is_discrete()) 0.9 else locs$length - out + out$width <- if (scales[[x]]$is_discrete()) 0.9 else locs$length + out$flipped_aes <- flipped_aes + flip_data(out, flipped_aes) } ) -make_summary_fun <- function(fun.data, fun.y, fun.ymax, fun.ymin, fun.args) { +make_summary_fun <- function(fun.data, fun, fun.max, fun.min, fun.args) { force(fun.data) - force(fun.y) - force(fun.ymax) - force(fun.ymin) + force(fun) + force(fun.max) + force(fun.min) force(fun.args) if (!is.null(fun.data)) { @@ -77,7 +100,7 @@ make_summary_fun <- function(fun.data, fun.y, fun.ymax, fun.ymin, fun.args) { function(df) { do.call(fun.data, c(list(quote(df$y)), fun.args)) } - } else if (!is.null(fun.y) || !is.null(fun.ymax) || !is.null(fun.ymin)) { + } else if (!is.null(fun) || !is.null(fun.max) || !is.null(fun.min)) { # Three functions that take vectors as inputs call_f <- function(fun, x) { @@ -87,9 +110,9 @@ make_summary_fun <- function(fun.data, fun.y, fun.ymax, fun.ymin, fun.args) { function(df, ...) { new_data_frame(list( - ymin = call_f(fun.ymin, df$y), - y = call_f(fun.y, df$y), - ymax = call_f(fun.ymax, df$y) + ymin = call_f(fun.min, df$y), + y = call_f(fun, df$y), + ymax = call_f(fun.max, df$y) )) } } else { diff --git a/R/stat-summary.r b/R/stat-summary.r index 27ed095e3f..b4a43ebb8d 100644 --- a/R/stat-summary.r +++ b/R/stat-summary.r @@ -1,66 +1,84 @@ #' Summarise y values at unique/binned x #' -#' `stat_summary` operates on unique `x`; `stat_summary_bin` -#' operates on binned `x`. They are more flexible versions of +#' `stat_summary` operates on unique `x` or `y`; `stat_summary_bin` +#' operates on binned `x` or `y`. They are more flexible versions of #' [stat_bin()]: instead of just counting, they can compute any #' aggregate. #' +#' @eval rd_orientation() +#' #' @eval rd_aesthetics("stat", "summary") #' @seealso [geom_errorbar()], [geom_pointrange()], #' [geom_linerange()], [geom_crossbar()] for geoms to #' display summarised data #' @inheritParams stat_identity #' @section Summary functions: -#' You can either supply summary functions individually (`fun.y`, -#' `fun.ymax`, `fun.ymin`), or as a single function (`fun.data`): +#' You can either supply summary functions individually (`fun`, +#' `fun.max`, `fun.min`), or as a single function (`fun.data`): #' #' \describe{ #' \item{fun.data}{Complete summary function. Should take numeric vector as #' input and return data frame as output} -#' \item{fun.ymin}{ymin summary function (should take numeric vector and +#' \item{fun.min}{min summary function (should take numeric vector and #' return single number)} -#' \item{fun.y}{y summary function (should take numeric vector and return +#' \item{fun}{main summary function (should take numeric vector and return #' single number)} -#' \item{fun.ymax}{ymax summary function (should take numeric vector and +#' \item{fun.max}{max summary function (should take numeric vector and #' return single number)} #' } #' #' A simple vector function is easiest to work with as you can return a single #' number, but is somewhat less flexible. If your summary function computes -#' multiple values at once (e.g. ymin and ymax), use `fun.data`. +#' multiple values at once (e.g. min and max), use `fun.data`. +#' +#' `fun.data` will recieve data as if it was oriented along the x-axis and +#' should return a data.frame that corresponds to that orientation. The layer +#' will take care of flipping the input and output if it is oriented along the +#' y-axis. #' #' If no aggregation functions are supplied, will default to #' [mean_se()]. #' #' @param fun.data A function that is given the complete data and should #' return a data frame with variables `ymin`, `y`, and `ymax`. -#' @param fun.ymin,fun.y,fun.ymax Alternatively, supply three individual -#' functions that are each passed a vector of x's and should return a +#' @param fun.min,fun,fun.max Alternatively, supply three individual +#' functions that are each passed a vector of values and should return a #' single number. +#' @param fun.ymin,fun.y,fun.ymax Deprecated, use the versions specified above +#' instead. #' @param fun.args Optional additional arguments passed on to the functions. #' @export #' @examples #' d <- ggplot(mtcars, aes(cyl, mpg)) + geom_point() #' d + stat_summary(fun.data = "mean_cl_boot", colour = "red", size = 2) #' +#' # Orientation follows the discrete axis +#' ggplot(mtcars, aes(mpg, cyl)) + +#' geom_point() + +#' stat_summary(fun.data = "mean_cl_boot", colour = "red", size = 2) +#' #' # You can supply individual functions to summarise the value at #' # each x: -#' d + stat_summary(fun.y = "median", colour = "red", size = 2, geom = "point") -#' d + stat_summary(fun.y = "mean", colour = "red", size = 2, geom = "point") -#' d + aes(colour = factor(vs)) + stat_summary(fun.y = mean, geom="line") +#' d + stat_summary(fun = "median", colour = "red", size = 2, geom = "point") +#' d + stat_summary(fun = "mean", colour = "red", size = 2, geom = "point") +#' d + aes(colour = factor(vs)) + stat_summary(fun = mean, geom="line") #' -#' d + stat_summary(fun.y = mean, fun.ymin = min, fun.ymax = max, +#' d + stat_summary(fun = mean, fun.min = min, fun.max = max, #' colour = "red") #' #' d <- ggplot(diamonds, aes(cut)) #' d + geom_bar() -#' d + stat_summary_bin(aes(y = price), fun.y = "mean", geom = "bar") +#' d + stat_summary(aes(y = price), fun = "mean", geom = "bar") +#' +#' # Orientation of stat_summary_bin is ambiguous and must be specified directly +#' ggplot(diamonds, aes(carat, price)) + +#' stat_summary_bin(fun = "mean", geom = "bar", orientation = 'y') #' #' \donttest{ #' # Don't use ylim to zoom into a summary plot - this throws the #' # data away #' p <- ggplot(mtcars, aes(cyl, mpg)) + -#' stat_summary(fun.y = "mean", geom = "point") +#' stat_summary(fun = "mean", geom = "point") #' p #' p + ylim(15, 30) #' # Instead use coord_cartesian @@ -105,13 +123,27 @@ stat_summary <- function(mapping = NULL, data = NULL, geom = "pointrange", position = "identity", ..., fun.data = NULL, - fun.y = NULL, - fun.ymax = NULL, - fun.ymin = NULL, + fun = NULL, + fun.max = NULL, + fun.min = NULL, fun.args = list(), na.rm = FALSE, + orientation = NA, show.legend = NA, - inherit.aes = TRUE) { + inherit.aes = TRUE, + fun.y, fun.ymin, fun.ymax) { + if (!missing(fun.y)) { + warn("`fun.y` is deprecated. Use `fun` instead.") + fun = fun %||% fun.y + } + if (!missing(fun.ymin)) { + warn("`fun.ymin` is deprecated. Use `fun.min` instead.") + fun.min = fun.min %||% fun.ymin + } + if (!missing(fun.ymax)) { + warn("`fun.ymax` is deprecated. Use `fun.max` instead.") + fun.max = fun.max %||% fun.ymax + } layer( data = data, mapping = mapping, @@ -122,11 +154,12 @@ stat_summary <- function(mapping = NULL, data = NULL, inherit.aes = inherit.aes, params = list( fun.data = fun.data, - fun.y = fun.y, - fun.ymax = fun.ymax, - fun.ymin = fun.ymin, + fun = fun, + fun.max = fun.max, + fun.min = fun.min, fun.args = fun.args, na.rm = na.rm, + orientation = orientation, ... ) ) @@ -139,12 +172,20 @@ stat_summary <- function(mapping = NULL, data = NULL, StatSummary <- ggproto("StatSummary", Stat, required_aes = c("x", "y"), - compute_panel = function(data, scales, fun.data = NULL, fun.y = NULL, - fun.ymax = NULL, fun.ymin = NULL, fun.args = list(), - na.rm = FALSE) { + extra_params = c("na.rm", "orientation"), + setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params) + params + }, - fun <- make_summary_fun(fun.data, fun.y, fun.ymax, fun.ymin, fun.args) - summarise_by_x(data, fun) + compute_panel = function(data, scales, fun.data = NULL, fun = NULL, + fun.max = NULL, fun.min = NULL, fun.args = list(), + na.rm = FALSE, flipped_aes = FALSE) { + data <- flip_data(data, flipped_aes) + fun <- make_summary_fun(fun.data, fun, fun.max, fun.min, fun.args) + summarised <- summarise_by_x(data, fun) + summarised$flipped_aes <- flipped_aes + flip_data(summarised, flipped_aes) } ) diff --git a/R/stat-ydensity.r b/R/stat-ydensity.r index 978f60ad0c..b246c477fa 100644 --- a/R/stat-ydensity.r +++ b/R/stat-ydensity.r @@ -27,6 +27,7 @@ stat_ydensity <- function(mapping = NULL, data = NULL, trim = TRUE, scale = "area", na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE) { scale <- match.arg(scale, c("area", "count", "width")) @@ -60,8 +61,16 @@ StatYdensity <- ggproto("StatYdensity", Stat, required_aes = c("x", "y"), non_missing_aes = "weight", + setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = TRUE, group_has_equal = TRUE) + + params + }, + + extra_params = c("na.rm", "orientation"), + compute_group = function(data, scales, width = NULL, bw = "nrd0", adjust = 1, - kernel = "gaussian", trim = TRUE, na.rm = FALSE) { + kernel = "gaussian", trim = TRUE, na.rm = FALSE, flipped_aes = FALSE) { if (nrow(data) < 3) return(new_data_frame()) range <- range(data$y, na.rm = TRUE) modifier <- if (trim) 0 else 3 @@ -83,7 +92,8 @@ StatYdensity <- ggproto("StatYdensity", Stat, compute_panel = function(self, data, scales, width = NULL, bw = "nrd0", adjust = 1, kernel = "gaussian", trim = TRUE, na.rm = FALSE, - scale = "area") { + scale = "area", flipped_aes = FALSE) { + data <- flip_data(data, flipped_aes) data <- ggproto_parent(Stat, self)$compute_panel( data, scales, width = width, bw = bw, adjust = adjust, kernel = kernel, trim = trim, na.rm = na.rm @@ -100,7 +110,8 @@ StatYdensity <- ggproto("StatYdensity", Stat, # width: constant width (density scaled to a maximum of 1) width = data$scaled ) - data + data$flipped_aes <- flipped_aes + flip_data(data, flipped_aes) } ) diff --git a/R/utilities-help.r b/R/utilities-help.r index bff0a4fbe3..341fe257d1 100644 --- a/R/utilities-help.r +++ b/R/utilities-help.r @@ -21,6 +21,7 @@ rd_aesthetics <- function(type, name) { rd_aesthetics_item <- function(x) { req <- x$required_aes + req <- sub("|", "} \\emph{or} \\code{", req, fixed = TRUE) all <- union(req, sort(x$aesthetics())) ifelse(all %in% req, @@ -28,3 +29,19 @@ rd_aesthetics_item <- function(x) { paste0("\\code{", all, "}") ) } + +rd_orientation <- function() { + c( + "@section Orientation: ", + paste( + 'This geom treats each axis differently and, thus, can thus have two orientations.', + 'Often the orientation is easy to deduce from a combination of the given', + 'mappings and the types of positional scales in use. Thus, ggplot2 will by', + 'default try to guess which orientation the layer should have. Under rare', + 'circumstances, the orientation is ambiguous and guessing may fail. In that', + 'case the orientation can be specified directly using the \\code{orientation} parameter,', + 'which can be either \\code{"x"} or \\code{"y"}. The value gives the axis that the geom', + 'should run along, \\code{"x"} being the default orientation you would expect for the geom.' + ) + ) +} diff --git a/R/utilities.r b/R/utilities.r index 6336ace4b8..3334463ab0 100644 --- a/R/utilities.r +++ b/R/utilities.r @@ -24,11 +24,23 @@ scales::alpha # @param name of object for error message # @keyword internal check_required_aesthetics <- function(required, present, name) { - missing_aes <- setdiff(required, present) - if (length(missing_aes) == 0) return() + if (is.null(required)) return() + + required <- strsplit(required, "|", fixed = TRUE) + if (any(vapply(required, length, integer(1)) > 1)) { + required <- lapply(required, rep_len, 2) + required <- list( + vapply(required, `[`, character(1), 1), + vapply(required, `[`, character(1), 2) + ) + } else { + required <- list(unlist(required)) + } + missing_aes <- lapply(required, setdiff, present) + if (any(vapply(missing_aes, length, integer(1)) == 0)) return() stop(name, " requires the following missing aesthetics: ", - paste(missing_aes, collapse = ", "), call. = FALSE) + paste(lapply(missing_aes, paste, collapse = ", "), collapse = " or "), call. = FALSE) } # Concatenate a named list for output @@ -176,6 +188,12 @@ rescale01 <- function(x) { (x - rng[1]) / (rng[2] - rng[1]) } +binned_pal <- function(palette) { + function(x) { + palette(length(x)) + } +} + #' Give a deprecation error, warning, or message, depending on version number. #' #' This function is deprecated. @@ -388,3 +406,214 @@ parse_safe <- function(text) { } out } + +switch_orientation <- function(aesthetics) { + # We should have these as globals somewhere + x <- ggplot_global$x_aes + y <- ggplot_global$y_aes + x_aes <- match(aesthetics, x) + x_aes_pos <- which(!is.na(x_aes)) + y_aes <- match(aesthetics, y) + y_aes_pos <- which(!is.na(y_aes)) + if (length(x_aes_pos) > 0) { + aesthetics[x_aes_pos] <- y[x_aes[x_aes_pos]] + } + if (length(y_aes_pos) > 0) { + aesthetics[y_aes_pos] <- x[y_aes[y_aes_pos]] + } + aesthetics +} + +#' Utilities for working with bidirecitonal layers +#' +#' These functions are what underpins the ability of certain geoms to work +#' automatically in both directions. See the *Extending ggplot2* for how they +#' are used when implementing `Geom`, `Stat`, and `Position` classes. +#' +#' `has_flipped_aes()` is used to sniff out the orientation of the layer from +#' the data. It has a range of arguments that can be used to finetune the +#' sniffing based on what the data should look like. `flip_data()` will switch +#' the column names of the data so that it looks like x-oriented data. +#' `flipped_names()` provides a named list of aesthetic names that corresponds +#' to the orientation of the layer. +#' +#' @section Controlling the sniffing: +#' How the layer data should be interpreted depends on its specific features. +#' `has_flipped_aes()` contains a range of flags for defining what certain +#' features in the data correspond to: +#' +#' - `main_is_orthogonal`: This argument controls how the existence of only a `x` +#' or `y` aesthetic is understood. If `TRUE` then the exisiting aesthetic +#' would be then secondary axis. This behaviour is present in [stat_ydensity()] +#' and [stat_boxplot()]. If `FALSE` then the exisiting aesthetic is the main +#' axis as seen in e.g. [stat_bin()], [geom_count()], and [stat_density()]. +#' - `range_is_orthogonal`: This argument controls whether the existance of +#' range-like aesthetics (e.g. `xmin` and `xmax`) represents the main or +#' secondary axis. If `TRUE` then the range is given for the secondary axis as +#' seen in e.g. [geom_ribbon()] and [geom_linerange()]. `FALSE` is less +#' prevalent but can be seen in [geom_bar()] where it may encode the span of +#' each bar. +#' - `group_has_equal`: This argument controls whether to test for equality of +#' all `x` and `y` values inside each group and set the main axis to the one +#' where all is equal. This test is only performed if `TRUE`, and only after +#' less computationally heavy tests has come up empty handed. Examples are +#' [stat_boxplot()] and [stat_ydensity] +#' - `ambiguous`: This argument tells the function that the layer, while +#' bidirectional, doesn't treat each axis differently. It will circumvent any +#' data based guessing and only take hint from the `orientation` element in +#' `params`. If this is not present it will fall back to `FALSE`. Examples are +#' [geom_line()] and [geom_area()] +#' - `main_is_continuous`: This argument controls how the test for discreteness +#' in the scales should be interpreted. If `TRUE` then the main axis will be +#' the one which is not discrete-like. Conversely, if `FALSE` the main axis +#' will be the discrete-like one. Examples of `TRUE` is [stat_density()] and +#' [stat_bin()], while examples of `FALSE` is [stat_ydensity()] and +#' [stat_boxplot()] +#' +#' @param data The layer data +#' @param params The parameters of the `Stat`/`Geom`. Only the `orientation` +#' parameter will be used. +#' @param main_is_orthogonal If only `x` or `y` are present do they correspond +#' to the main orientation or the reverse. E.g. If `TRUE` and `y` is present +#' it is not flipped. If `NA` this check will be ignored. +#' @param range_is_orthogonal If `xmin`/`xmax` or `ymin`/`ymax` is present do +#' they correspond to the main orientation or reverse. If `NA` this check will +#' be ignored. +#' @param group_has_equal Is it expected that grouped data has either a single +#' `x` or `y` value that will correspond to the orientation. +#' @param ambiguous Is the layer ambiguous in its mapping by nature. If so, it +#' will only be flipped if `params$orientation == "y"` +#' @param main_is_continuous If there is a discrete and continuous axis, does +#' the continuous one correspond to the main orientation? +#' @param flip Logical. Is the layer flipped. +#' +#' @return `has_flipped_aes()` returns `TRUE` if it detects a layer in the other +#' orientation and `FALSE` otherwise. `flip_data()` will return the input +#' unchanged if `flip = FALSE` and the data with flipped aesthetic names if +#' `flip = TRUE`. `flipped_names()` returns a named list of strings. If +#' `flip = FALSE` the name of the element will correspond to the element, e.g. +#' `flipped_names(FALSE)$x == "x"` and if `flip = TRUE` it will correspond to +#' the flipped name, e.g. `flipped_names(FALSE)$x == "y"` +#' +#' @export +#' @keywords internal +#' @name bidirection +#' +has_flipped_aes <- function(data, params = list(), main_is_orthogonal = NA, + range_is_orthogonal = NA, group_has_equal = FALSE, + ambiguous = FALSE, main_is_continuous = FALSE) { + # Is orientation already encoded in data? + if (!is.null(data$flipped_aes)) { + return(data$flipped_aes[[1]]) + } + + # Is orientation requested in the params + if (!is.null(params$orientation) && !is.na(params$orientation)) { + return(params$orientation == "y") + } + + # Does a single x or y aesthetic corespond to a specific orientation + if (!is.na(main_is_orthogonal) && sum(c("x", "y") %in% names(data)) + sum(c("x", "y") %in% names(params)) == 1) { + return(("x" %in% names(data) || "x" %in% names(params)) == main_is_orthogonal) + } + + has_x <- !is.null(data$x) + has_y <- !is.null(data$y) + + # Does a provided range indicate an orientation + if (!is.na(range_is_orthogonal)) { + if (any(c("ymin", "ymax") %in% names(data))) { + return(!range_is_orthogonal) + } + if (any(c("xmin", "xmax") %in% names(data))) { + return(range_is_orthogonal) + } + } + + # If ambiguous orientation = NA will give FALSE + if (ambiguous && (is.null(params$orientation) || is.na(params$orientation))) { + return(FALSE) + } + + # Is there a single actual discrete position + y_is_int <- is.integer(data$y) + x_is_int <- is.integer(data$x) + if (xor(y_is_int, x_is_int)) { + return(y_is_int != main_is_continuous) + } + + # Does each group have a single x or y value + if (group_has_equal) { + if (has_x) { + x_groups <- vapply(split(data$x, data$group), function(x) length(unique(x)), integer(1)) + if (all(x_groups == 1)) { + return(FALSE) + } + } + if (has_y) { + y_groups <- vapply(split(data$y, data$group), function(x) length(unique(x)), integer(1)) + if (all(y_groups == 1)) { + return(TRUE) + } + } + } + + # give up early + if (!has_x && !has_y) { + return(FALSE) + } + + # Both true discrete. give up + if (y_is_int && x_is_int) { + return(FALSE) + } + # Is there a single discrete-like position + y_is_int <- if (has_y) isTRUE(all.equal(data$y, round(data$y))) else FALSE + x_is_int <- if (has_x) isTRUE(all.equal(data$x, round(data$x))) else FALSE + if (xor(y_is_int, x_is_int)) { + return(y_is_int != main_is_continuous) + } + # Is one of the axes a single value + if (all(data$x == 1)) { + return(main_is_continuous) + } + if (all(data$y == 1)) { + return(!main_is_continuous) + } + # If both are discrete like, which have most 0 or 1-spaced values + y_diff <- diff(sort(data$y)) + x_diff <- diff(sort(data$x)) + if (y_is_int && x_is_int) { + return((sum(x_diff <= 1) < sum(y_diff <= 1)) != main_is_continuous) + } + # If none are discrete is either regularly spaced + y_is_regular <- if (has_y) all((y_diff / min(y_diff)) %% 1 < .Machine$double.eps) else FALSE + x_is_regular <- if (has_x) all((x_diff / min(x_diff)) %% 1 < .Machine$double.eps) else FALSE + if (xor(y_is_regular, x_is_regular)) { + return(y_is_regular != main_is_continuous) + } + # default to no + FALSE +} +#' @rdname bidirection +#' @export +flip_data <- function(data, flip = NULL) { + flip <- flip %||% data$flipped_aes[1] %||% FALSE + if (flip) { + names(data) <- switch_orientation(names(data)) + } + data +} +#' @rdname bidirection +#' @export +flipped_names <- function(flip = FALSE) { + x_aes <- ggplot_global$x_aes + y_aes <- ggplot_global$y_aes + if (flip) { + ret <- as.list(c(y_aes, x_aes)) + } else { + ret <- as.list(c(x_aes, y_aes)) + } + names(ret) <- c(x_aes, y_aes) + ret +} diff --git a/R/zxx.r b/R/zxx.r index 28dc498ca1..b90bd9804c 100644 --- a/R/zxx.r +++ b/R/zxx.r @@ -125,11 +125,21 @@ scale_color_brewer <- scale_colour_brewer #' @usage NULL scale_color_distiller <- scale_colour_distiller +#' @export +#' @rdname scale_brewer +#' @usage NULL +scale_color_fermenter <- scale_colour_fermenter + #' @export #' @rdname scale_colour_continuous #' @usage NULL scale_color_continuous <- scale_colour_continuous +#' @export +#' @rdname scale_colour_continuous +#' @usage NULL +scale_color_binned <- scale_colour_binned + #' @export #' @rdname scale_hue #' @usage NULL @@ -150,6 +160,21 @@ scale_color_gradient2 <- scale_colour_gradient2 #' @usage NULL scale_color_gradientn <- scale_colour_gradientn +#' @export +#' @rdname scale_steps +#' @usage NULL +scale_color_steps <- scale_colour_steps + +#' @export +#' @rdname scale_steps +#' @usage NULL +scale_color_steps2 <- scale_colour_steps2 + +#' @export +#' @rdname scale_steps +#' @usage NULL +scale_color_stepsn <- scale_colour_stepsn + #' @export #' @rdname scale_grey #' @usage NULL diff --git a/man/bidirection.Rd b/man/bidirection.Rd new file mode 100644 index 0000000000..1542f5780a --- /dev/null +++ b/man/bidirection.Rd @@ -0,0 +1,101 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities.r +\name{bidirection} +\alias{bidirection} +\alias{has_flipped_aes} +\alias{flip_data} +\alias{flipped_names} +\title{Utilities for working with bidirecitonal layers} +\usage{ +has_flipped_aes(data, params = list(), main_is_orthogonal = NA, + range_is_orthogonal = NA, group_has_equal = FALSE, + ambiguous = FALSE, main_is_continuous = FALSE) + +flip_data(data, flip = NULL) + +flipped_names(flip = FALSE) +} +\arguments{ +\item{data}{The layer data} + +\item{params}{The parameters of the \code{Stat}/\code{Geom}. Only the \code{orientation} +parameter will be used.} + +\item{main_is_orthogonal}{If only \code{x} or \code{y} are present do they correspond +to the main orientation or the reverse. E.g. If \code{TRUE} and \code{y} is present +it is not flipped. If \code{NA} this check will be ignored.} + +\item{range_is_orthogonal}{If \code{xmin}/\code{xmax} or \code{ymin}/\code{ymax} is present do +they correspond to the main orientation or reverse. If \code{NA} this check will +be ignored.} + +\item{group_has_equal}{Is it expected that grouped data has either a single +\code{x} or \code{y} value that will correspond to the orientation.} + +\item{ambiguous}{Is the layer ambiguous in its mapping by nature. If so, it +will only be flipped if \code{params$orientation == "y"}} + +\item{main_is_continuous}{If there is a discrete and continuous axis, does +the continuous one correspond to the main orientation?} + +\item{flip}{Logical. Is the layer flipped.} +} +\value{ +\code{has_flipped_aes()} returns \code{TRUE} if it detects a layer in the other +orientation and \code{FALSE} otherwise. \code{flip_data()} will return the input +unchanged if \code{flip = FALSE} and the data with flipped aesthetic names if +\code{flip = TRUE}. \code{flipped_names()} returns a named list of strings. If +\code{flip = FALSE} the name of the element will correspond to the element, e.g. +\code{flipped_names(FALSE)$x == "x"} and if \code{flip = TRUE} it will correspond to +the flipped name, e.g. \code{flipped_names(FALSE)$x == "y"} +} +\description{ +These functions are what underpins the ability of certain geoms to work +automatically in both directions. See the \emph{Extending ggplot2} for how they +are used when implementing \code{Geom}, \code{Stat}, and \code{Position} classes. +} +\details{ +\code{has_flipped_aes()} is used to sniff out the orientation of the layer from +the data. It has a range of arguments that can be used to finetune the +sniffing based on what the data should look like. \code{flip_data()} will switch +the column names of the data so that it looks like x-oriented data. +\code{flipped_names()} provides a named list of aesthetic names that corresponds +to the orientation of the layer. +} +\section{Controlling the sniffing}{ + +How the layer data should be interpreted depends on its specific features. +\code{has_flipped_aes()} contains a range of flags for defining what certain +features in the data correspond to: +\itemize{ +\item \code{main_is_orthogonal}: This argument controls how the existence of only a \code{x} +or \code{y} aesthetic is understood. If \code{TRUE} then the exisiting aesthetic +would be then secondary axis. This behaviour is present in \code{\link[=stat_ydensity]{stat_ydensity()}} +and \code{\link[=stat_boxplot]{stat_boxplot()}}. If \code{FALSE} then the exisiting aesthetic is the main +axis as seen in e.g. \code{\link[=stat_bin]{stat_bin()}}, \code{\link[=geom_count]{geom_count()}}, and \code{\link[=stat_density]{stat_density()}}. +\item \code{range_is_orthogonal}: This argument controls whether the existance of +range-like aesthetics (e.g. \code{xmin} and \code{xmax}) represents the main or +secondary axis. If \code{TRUE} then the range is given for the secondary axis as +seen in e.g. \code{\link[=geom_ribbon]{geom_ribbon()}} and \code{\link[=geom_linerange]{geom_linerange()}}. \code{FALSE} is less +prevalent but can be seen in \code{\link[=geom_bar]{geom_bar()}} where it may encode the span of +each bar. +\item \code{group_has_equal}: This argument controls whether to test for equality of +all \code{x} and \code{y} values inside each group and set the main axis to the one +where all is equal. This test is only performed if \code{TRUE}, and only after +less computationally heavy tests has come up empty handed. Examples are +\code{\link[=stat_boxplot]{stat_boxplot()}} and \link{stat_ydensity} +\item \code{ambiguous}: This argument tells the function that the layer, while +bidirectional, doesn't treat each axis differently. It will circumvent any +data based guessing and only take hint from the \code{orientation} element in +\code{params}. If this is not present it will fall back to \code{FALSE}. Examples are +\code{\link[=geom_line]{geom_line()}} and \code{\link[=geom_area]{geom_area()}} +\item \code{main_is_continuous}: This argument controls how the test for discreteness +in the scales should be interpreted. If \code{TRUE} then the main axis will be +the one which is not discrete-like. Conversely, if \code{FALSE} the main axis +will be the discrete-like one. Examples of \code{TRUE} is \code{\link[=stat_density]{stat_density()}} and +\code{\link[=stat_bin]{stat_bin()}}, while examples of \code{FALSE} is \code{\link[=stat_ydensity]{stat_ydensity()}} and +\code{\link[=stat_boxplot]{stat_boxplot()}} +} +} + +\keyword{internal} diff --git a/man/binned_scale.Rd b/man/binned_scale.Rd new file mode 100644 index 0000000000..0da32bd185 --- /dev/null +++ b/man/binned_scale.Rd @@ -0,0 +1,123 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/scale-.r +\name{binned_scale} +\alias{binned_scale} +\title{Binning scale constructor} +\usage{ +binned_scale(aesthetics, scale_name, palette, name = waiver(), + breaks = waiver(), labels = waiver(), limits = NULL, + rescaler = rescale, oob = squish, expand = waiver(), + na.value = NA_real_, n.breaks = NULL, nice.breaks = TRUE, + right = TRUE, trans = "identity", show.limits = FALSE, + guide = "bins", position = "left", super = ScaleBinned) +} +\arguments{ +\item{aesthetics}{The names of the aesthetics that this scale works with.} + +\item{scale_name}{The name of the scale that should be used for error messages +associated with this scale.} + +\item{palette}{A palette function that when called with a numeric vector with +values between 0 and 1 returns the corresponding output values +(e.g., \code{\link[scales:area_pal]{scales::area_pal()}}).} + +\item{name}{The name of the scale. Used as the axis or legend title. If +\code{waiver()}, the default, the name of the scale is taken from the first +mapping used for that aesthetic. If \code{NULL}, the legend title will be +omitted.} + +\item{breaks}{One of: +\itemize{ +\item \code{NULL} for no breaks +\item \code{waiver()} for the default breaks computed by the +\link[scales:trans_new]{transformation object} +\item A numeric vector of positions +\item A function that takes the limits as input and returns breaks +as output (e.g., a function returned by \code{\link[scales:extended_breaks]{scales::extended_breaks()}}) +}} + +\item{labels}{One of: +\itemize{ +\item \code{NULL} for no labels +\item \code{waiver()} for the default labels computed by the +transformation object +\item A character vector giving labels (must be same length as \code{breaks}) +\item A function that takes the breaks as input and returns labels +as output +}} + +\item{limits}{One of: +\itemize{ +\item \code{NULL} to use the default scale range +\item A numeric vector of length two providing limits of the scale. +Use \code{NA} to refer to the existing minimum or maximum +\item A function that accepts the existing (automatic) limits and returns +new limits +Note that setting limits on positional scales will \strong{remove} data outside of the limits. +If the purpose is to zoom, use the limit argument in the coordinate system +(see \code{\link[=coord_cartesian]{coord_cartesian()}}). +}} + +\item{rescaler}{A function used to scale the input values to the +range [0, 1]. This is always \code{\link[scales:rescale]{scales::rescale()}}, except for +diverging and n colour gradients (i.e., \code{\link[=scale_colour_gradient2]{scale_colour_gradient2()}}, +\code{\link[=scale_colour_gradientn]{scale_colour_gradientn()}}). The \code{rescaler} is ignored by position +scales, which ways use \code{\link[scales:rescale]{scales::rescale()}}.} + +\item{oob}{One of: +\itemize{ +\item Function that handles limits outside of the scale limits +(out of bounds). +\item The default (\code{\link[scales:censor]{scales::censor()}}) replaces out of +bounds values with \code{NA}. +\item \code{\link[scales:squish]{scales::squish()}} for squishing out of bounds values into range. +\item \code{\link[scales:squish_infinite]{scales::squish_infinite()}} for squishing infitite values into range. +}} + +\item{expand}{For position scales, a vector of range expansion constants used to add some +padding around the data to ensure that they are placed some distance +away from the axes. Use the convenience function \code{\link[=expansion]{expansion()}} +to generate the values for the \code{expand} argument. The defaults are to +expand the scale by 5\% on each side for continuous variables, and by +0.6 units on each side for discrete variables.} + +\item{na.value}{Missing values will be replaced with this value.} + +\item{n.breaks}{The number of break points to create if breaks are not given +directly.} + +\item{nice.breaks}{Logical. Should breaks be attempted placed at nice values +instead of exactly evenly spaced between the limits. If \code{TRUE} (default) +the scale will ask the transformation object to create breaks, and this +may result in a different number of breaks than requested. Ignored if +breaks are given explicetly.} + +\item{right}{Should values on the border between bins be part of the right +(upper) bin?} + +\item{trans}{For continuous scales, the name of a transformation object +or the object itself. Built-in transformations include "asn", "atanh", +"boxcox", "date", "exp", "hms", "identity", "log", "log10", "log1p", "log2", +"logit", "modulus", "probability", "probit", "pseudo_log", "reciprocal", +"reverse", "sqrt" and "time". + +A transformation object bundles together a transform, its inverse, +and methods for generating breaks and labels. Transformation objects +are defined in the scales package, and are called \code{_trans} (e.g., +\code{\link[scales:boxcox_trans]{scales::boxcox_trans()}}). You can create your own +transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} + +\item{show.limits}{should the limits of the scale appear as ticks} + +\item{guide}{A function used to create a guide or its name. See +\code{\link[=guides]{guides()}} for more information.} + +\item{position}{For position scales, The position of the axis. +\code{left} or \code{right} for y axes, \code{top} or \code{bottom} for x axes.} + +\item{super}{The super class to use for the constructed scale} +} +\description{ +Binning scale constructor +} +\keyword{internal} diff --git a/man/diamonds.Rd b/man/diamonds.Rd index 8d2cb9c0b7..ed13e7e846 100644 --- a/man/diamonds.Rd +++ b/man/diamonds.Rd @@ -3,7 +3,7 @@ \docType{data} \name{diamonds} \alias{diamonds} -\title{Prices of 50,000 round cut diamonds} +\title{Prices of over 50,000 round cut diamonds} \format{A data frame with 53940 rows and 10 variables: \describe{ \item{price}{price in US dollars (\$326--\$18,823)} diff --git a/man/economics.Rd b/man/economics.Rd index 50dc689d90..e099d23e8e 100644 --- a/man/economics.Rd +++ b/man/economics.Rd @@ -5,19 +5,19 @@ \alias{economics} \alias{economics_long} \title{US economic time series} -\format{A data frame with 478 rows and 6 variables +\format{A data frame with 574 rows and 6 variables: \describe{ \item{date}{Month of data collection} -\item{psavert}{personal savings rate, -\url{http://research.stlouisfed.org/fred2/series/PSAVERT/}} \item{pce}{personal consumption expenditures, in billions of dollars, \url{http://research.stlouisfed.org/fred2/series/PCE}} -\item{unemploy}{number of unemployed in thousands, -\url{http://research.stlouisfed.org/fred2/series/UNEMPLOY}} -\item{uempmed}{median duration of unemployment, in weeks, -\url{http://research.stlouisfed.org/fred2/series/UEMPMED}} \item{pop}{total population, in thousands, \url{http://research.stlouisfed.org/fred2/series/POP}} +\item{psavert}{personal savings rate, +\url{http://research.stlouisfed.org/fred2/series/PSAVERT/}} +\item{uempmed}{median duration of unemployment, in weeks, +\url{http://research.stlouisfed.org/fred2/series/UEMPMED}} +\item{unemploy}{number of unemployed in thousands, +\url{http://research.stlouisfed.org/fred2/series/UNEMPLOY}} }} \usage{ economics diff --git a/man/faithfuld.Rd b/man/faithfuld.Rd index 440b3999d1..a5d8d0b7d0 100644 --- a/man/faithfuld.Rd +++ b/man/faithfuld.Rd @@ -4,7 +4,12 @@ \name{faithfuld} \alias{faithfuld} \title{2d density estimate of Old Faithful data} -\format{A data frame with 5,625 observations and 3 variables.} +\format{A data frame with 5,625 observations and 3 variables: +\describe{ +\item{eruptions}{Eruption time in mins} +\item{waiting}{Waiting time to next eruption in mins} +\item{density}{2d density estimate} +}} \usage{ faithfuld } diff --git a/man/geom_bar.Rd b/man/geom_bar.Rd index d6245de4a9..aa3d2737e8 100644 --- a/man/geom_bar.Rd +++ b/man/geom_bar.Rd @@ -8,7 +8,8 @@ \usage{ geom_bar(mapping = NULL, data = NULL, stat = "count", position = "stack", ..., width = NULL, binwidth = NULL, - na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) + na.rm = FALSE, orientation = NA, show.legend = NA, + inherit.aes = TRUE) geom_col(mapping = NULL, data = NULL, position = "stack", ..., width = NULL, na.rm = FALSE, show.legend = NA, @@ -16,7 +17,7 @@ geom_col(mapping = NULL, data = NULL, position = "stack", ..., stat_count(mapping = NULL, data = NULL, geom = "bar", position = "stack", ..., width = NULL, na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) + orientation = NA, show.legend = NA, inherit.aes = TRUE) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[=aes]{aes()}} or @@ -56,6 +57,11 @@ you use it you'll get an warning telling to you use \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} +\item{orientation}{The orientation of the layer. The default (\code{NA}) +automatically determines the orientation from the aesthetic mapping. In the +rare event that this fails it can be given explicitly by setting \code{orientation} +to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} + \item{show.legend}{logical. Should this layer be included in the legends? \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. @@ -91,6 +97,11 @@ side-to-side, use \code{\link[=position_dodge]{position_dodge()}} or \code{\link \code{\link[=position_fill]{position_fill()}} shows relative proportions at each \code{x} by stacking the bars and then standardising each bar to have the same height. } +\section{Orientation}{ + +This geom treats each axis differently and, thus, can thus have two orientations. Often the orientation is easy to deduce from a combination of the given mappings and the types of positional scales in use. Thus, ggplot2 will by default try to guess which orientation the layer should have. Under rare circumstances, the orientation is ambiguous and guessing may fail. In that case the orientation can be specified directly using the \code{orientation} parameter, which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom should run along, \code{"x"} being the default orientation you would expect for the geom. +} + \section{Aesthetics}{ \code{geom_bar()} understands the following aesthetics (required aesthetics are in bold): @@ -123,9 +134,10 @@ Learn more about setting these aesthetics in \code{vignette("ggplot2-specs")}. \code{stat_count()} understands the following aesthetics (required aesthetics are in bold): \itemize{ -\item \strong{\code{x}} +\item \strong{\code{x} \emph{or} \code{y}} \item \code{group} \item \code{weight} +\item \code{x} \item \code{y} } Learn more about setting these aesthetics in \code{vignette("ggplot2-specs")}. @@ -147,17 +159,18 @@ g <- ggplot(mpg, aes(class)) g + geom_bar() # Total engine displacement of each class g + geom_bar(aes(weight = displ)) +# Map class to y instead to flip the orientation +ggplot(mpg) + geom_bar(aes(y = class)) # Bar charts are automatically stacked when multiple bars are placed # at the same location. The order of the fill is designed to match # the legend g + geom_bar(aes(fill = drv)) -# If you need to flip the order (because you've flipped the plot) +# If you need to flip the order (because you've flipped the orientation) # call position_stack() explicitly: -g + +ggplot(mpg, aes(y = class)) + geom_bar(aes(fill = drv), position = position_stack(reverse = TRUE)) + - coord_flip() + theme(legend.position = "top") # To show (e.g.) means, you need geom_col() diff --git a/man/geom_boxplot.Rd b/man/geom_boxplot.Rd index 19b56385ec..32d492425c 100644 --- a/man/geom_boxplot.Rd +++ b/man/geom_boxplot.Rd @@ -10,11 +10,11 @@ geom_boxplot(mapping = NULL, data = NULL, stat = "boxplot", outlier.color = NULL, outlier.fill = NULL, outlier.shape = 19, outlier.size = 1.5, outlier.stroke = 0.5, outlier.alpha = NULL, notch = FALSE, notchwidth = 0.5, varwidth = FALSE, na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) + orientation = NA, show.legend = NA, inherit.aes = TRUE) stat_boxplot(mapping = NULL, data = NULL, geom = "boxplot", position = "dodge2", ..., coef = 1.5, na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) + orientation = NA, show.legend = NA, inherit.aes = TRUE) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[=aes]{aes()}} or @@ -73,6 +73,11 @@ weighted, using the \code{weight} aesthetic).} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} +\item{orientation}{The orientation of the layer. The default (\code{NA}) +automatically determines the orientation from the aesthetic mapping. In the +rare event that this fails it can be given explicitly by setting \code{orientation} +to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} + \item{show.legend}{logical. Should this layer be included in the legends? \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. @@ -94,6 +99,11 @@ The boxplot compactly displays the distribution of a continuous variable. It visualises five summary statistics (the median, two hinges and two whiskers), and all "outlying" points individually. } +\section{Orientation}{ + +This geom treats each axis differently and, thus, can thus have two orientations. Often the orientation is easy to deduce from a combination of the given mappings and the types of positional scales in use. Thus, ggplot2 will by default try to guess which orientation the layer should have. Under rare circumstances, the orientation is ambiguous and guessing may fail. In that case the orientation can be specified directly using the \code{orientation} parameter, which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom should run along, \code{"x"} being the default orientation you would expect for the geom. +} + \section{Summary statistics}{ The lower and upper hinges correspond to the first and third quartiles @@ -118,20 +128,32 @@ See McGill et al. (1978) for more details. \code{geom_boxplot()} understands the following aesthetics (required aesthetics are in bold): \itemize{ -\item \strong{\code{x}} -\item \strong{\code{lower}} -\item \strong{\code{upper}} -\item \strong{\code{middle}} -\item \strong{\code{ymin}} -\item \strong{\code{ymax}} +\item \strong{\code{x} \emph{or} \code{y}} +\item \strong{\code{lower} \emph{or} \code{xlower}} +\item \strong{\code{upper} \emph{or} \code{xupper}} +\item \strong{\code{middle} \emph{or} \code{xmiddle}} +\item \strong{\code{ymin} \emph{or} \code{xmin}} +\item \strong{\code{ymax} \emph{or} \code{xmax}} \item \code{alpha} \item \code{colour} \item \code{fill} \item \code{group} \item \code{linetype} +\item \code{lower} +\item \code{middle} \item \code{shape} \item \code{size} +\item \code{upper} \item \code{weight} +\item \code{x} +\item \code{xlower} +\item \code{xmax} +\item \code{xmiddle} +\item \code{xmin} +\item \code{xupper} +\item \code{y} +\item \code{ymax} +\item \code{ymin} } Learn more about setting these aesthetics in \code{vignette("ggplot2-specs")}. } @@ -153,7 +175,8 @@ Learn more about setting these aesthetics in \code{vignette("ggplot2-specs")}. \examples{ p <- ggplot(mpg, aes(class, hwy)) p + geom_boxplot() -p + geom_boxplot() + coord_flip() +# Orientation follows the discrete axis +ggplot(mpg, aes(hwy, class)) + geom_boxplot() p + geom_boxplot(notch = TRUE) p + geom_boxplot(varwidth = TRUE) diff --git a/man/geom_density.Rd b/man/geom_density.Rd index 3ccef5179d..4aa678c18f 100644 --- a/man/geom_density.Rd +++ b/man/geom_density.Rd @@ -6,13 +6,13 @@ \title{Smoothed density estimates} \usage{ geom_density(mapping = NULL, data = NULL, stat = "density", - position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) + position = "identity", ..., na.rm = FALSE, orientation = NA, + show.legend = NA, inherit.aes = TRUE) stat_density(mapping = NULL, data = NULL, geom = "area", position = "stack", ..., bw = "nrd0", adjust = 1, kernel = "gaussian", n = 512, trim = FALSE, na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) + orientation = NA, show.legend = NA, inherit.aes = TRUE) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[=aes]{aes()}} or @@ -46,6 +46,11 @@ to the paired geom/stat.} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} +\item{orientation}{The orientation of the layer. The default (\code{NA}) +automatically determines the orientation from the aesthetic mapping. In the +rare event that this fails it can be given explicitly by setting \code{orientation} +to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} + \item{show.legend}{logical. Should this layer be included in the legends? \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. @@ -87,6 +92,11 @@ Computes and draws kernel density estimate, which is a smoothed version of the histogram. This is a useful alternative to the histogram for continuous data that comes from an underlying smooth distribution. } +\section{Orientation}{ + +This geom treats each axis differently and, thus, can thus have two orientations. Often the orientation is easy to deduce from a combination of the given mappings and the types of positional scales in use. Thus, ggplot2 will by default try to guess which orientation the layer should have. Under rare circumstances, the orientation is ambiguous and guessing may fail. In that case the orientation can be specified directly using the \code{orientation} parameter, which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom should run along, \code{"x"} being the default orientation you would expect for the geom. +} + \section{Aesthetics}{ \code{geom_density()} understands the following aesthetics (required aesthetics are in bold): @@ -119,6 +129,9 @@ plots} \examples{ ggplot(diamonds, aes(carat)) + geom_density() +# Map the values to y to flip the orientation +ggplot(diamonds, aes(y = carat)) + + geom_density() ggplot(diamonds, aes(carat)) + geom_density(adjust = 1/5) diff --git a/man/geom_histogram.Rd b/man/geom_histogram.Rd index 1cf44f65cf..228c06c73a 100644 --- a/man/geom_histogram.Rd +++ b/man/geom_histogram.Rd @@ -13,13 +13,14 @@ geom_freqpoly(mapping = NULL, data = NULL, stat = "bin", geom_histogram(mapping = NULL, data = NULL, stat = "bin", position = "stack", ..., binwidth = NULL, bins = NULL, - na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) + na.rm = FALSE, orientation = NA, show.legend = NA, + inherit.aes = TRUE) stat_bin(mapping = NULL, data = NULL, geom = "bar", position = "stack", ..., binwidth = NULL, bins = NULL, center = NULL, boundary = NULL, breaks = NULL, closed = c("right", "left"), pad = FALSE, na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) + orientation = NA, show.legend = NA, inherit.aes = TRUE) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[=aes]{aes()}} or @@ -79,6 +80,11 @@ bin width of a time variable is the number of seconds.} \item{bins}{Number of bins. Overridden by \code{binwidth}. Defaults to 30.} +\item{orientation}{The orientation of the layer. The default (\code{NA}) +automatically determines the orientation from the aesthetic mapping. In the +rare event that this fails it can be given explicitly by setting \code{orientation} +to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} + \item{geom, stat}{Use to override the default connection between \code{geom_histogram()}/\code{geom_freqpoly()} and \code{stat_bin()}.} @@ -121,6 +127,11 @@ different number of bins. You can also experiment modifying the \code{binwidth} one change at a time. You may need to look at a few options to uncover the full story behind your data. } +\section{Orientation}{ + +This geom treats each axis differently and, thus, can thus have two orientations. Often the orientation is easy to deduce from a combination of the given mappings and the types of positional scales in use. Thus, ggplot2 will by default try to guess which orientation the layer should have. Under rare circumstances, the orientation is ambiguous and guessing may fail. In that case the orientation can be specified directly using the \code{orientation} parameter, which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom should run along, \code{"x"} being the default orientation you would expect for the geom. +} + \section{Aesthetics}{ \code{geom_histogram()} uses the same aesthetics as \code{\link[=geom_bar]{geom_bar()}}; @@ -144,6 +155,9 @@ ggplot(diamonds, aes(carat)) + geom_histogram(binwidth = 0.01) ggplot(diamonds, aes(carat)) + geom_histogram(bins = 200) +# Map values to y to flip the orientation +ggplot(diamonds, aes(y = carat)) + + geom_histogram() # Rather than stacking histograms, it's easier to compare frequency # polygons diff --git a/man/geom_linerange.Rd b/man/geom_linerange.Rd index fcb57f367f..9e18cdfe89 100644 --- a/man/geom_linerange.Rd +++ b/man/geom_linerange.Rd @@ -10,19 +10,19 @@ \usage{ geom_crossbar(mapping = NULL, data = NULL, stat = "identity", position = "identity", ..., fatten = 2.5, na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) + orientation = NA, show.legend = NA, inherit.aes = TRUE) geom_errorbar(mapping = NULL, data = NULL, stat = "identity", - position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) + position = "identity", ..., na.rm = FALSE, orientation = NA, + show.legend = NA, inherit.aes = TRUE) geom_linerange(mapping = NULL, data = NULL, stat = "identity", - position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) + position = "identity", ..., na.rm = FALSE, orientation = NA, + show.legend = NA, inherit.aes = TRUE) geom_pointrange(mapping = NULL, data = NULL, stat = "identity", position = "identity", ..., fatten = 4, na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) + orientation = NA, show.legend = NA, inherit.aes = TRUE) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[=aes]{aes()}} or @@ -63,6 +63,11 @@ middle bar in \code{geom_crossbar()} and the middle point in \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} +\item{orientation}{The orientation of the layer. The default (\code{NA}) +automatically determines the orientation from the aesthetic mapping. In the +rare event that this fails it can be given explicitly by setting \code{orientation} +to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} + \item{show.legend}{logical. Should this layer be included in the legends? \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. @@ -78,18 +83,29 @@ the default plot specification, e.g. \code{\link[=borders]{borders()}}.} Various ways of representing a vertical interval defined by \code{x}, \code{ymin} and \code{ymax}. Each case draws a single graphical object. } +\section{Orientation}{ + +This geom treats each axis differently and, thus, can thus have two orientations. Often the orientation is easy to deduce from a combination of the given mappings and the types of positional scales in use. Thus, ggplot2 will by default try to guess which orientation the layer should have. Under rare circumstances, the orientation is ambiguous and guessing may fail. In that case the orientation can be specified directly using the \code{orientation} parameter, which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom should run along, \code{"x"} being the default orientation you would expect for the geom. +} + \section{Aesthetics}{ \code{geom_linerange()} understands the following aesthetics (required aesthetics are in bold): \itemize{ -\item \strong{\code{x}} -\item \strong{\code{ymin}} -\item \strong{\code{ymax}} +\item \strong{\code{x} \emph{or} \code{y}} +\item \strong{\code{ymin} \emph{or} \code{xmin}} +\item \strong{\code{ymax} \emph{or} \code{xmax}} \item \code{alpha} \item \code{colour} \item \code{group} \item \code{linetype} \item \code{size} +\item \code{x} +\item \code{xmax} +\item \code{xmin} +\item \code{y} +\item \code{ymax} +\item \code{ymin} } Learn more about setting these aesthetics in \code{vignette("ggplot2-specs")}. } @@ -110,6 +126,10 @@ p + geom_pointrange(aes(ymin = lower, ymax = upper)) p + geom_crossbar(aes(ymin = lower, ymax = upper), width = 0.2) p + geom_errorbar(aes(ymin = lower, ymax = upper), width = 0.2) +# Flip the orientation by changing mapping +ggplot(df, aes(resp, trt, colour = group)) + + geom_linerange(aes(xmin = lower, xmax = upper)) + # Draw lines connecting group means p + geom_line(aes(group = group)) + diff --git a/man/geom_path.Rd b/man/geom_path.Rd index 87042c73f0..5685b91c23 100644 --- a/man/geom_path.Rd +++ b/man/geom_path.Rd @@ -12,8 +12,8 @@ geom_path(mapping = NULL, data = NULL, stat = "identity", inherit.aes = TRUE) geom_line(mapping = NULL, data = NULL, stat = "identity", - position = "identity", na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE, ...) + position = "identity", na.rm = FALSE, orientation = NA, + show.legend = NA, inherit.aes = TRUE, ...) geom_step(mapping = NULL, data = NULL, stat = "identity", position = "identity", direction = "hv", na.rm = FALSE, @@ -73,6 +73,11 @@ rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link[=borders]{borders()}}.} +\item{orientation}{The orientation of the layer. The default (\code{NA}) +automatically determines the orientation from the aesthetic mapping. In the +rare event that this fails it can be given explicitly by setting \code{orientation} +to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} + \item{direction}{direction of stairs: 'vh' for vertical then horizontal, 'hv' for horizontal then vertical, or 'mid' for step half-way between adjacent x-values.} @@ -88,6 +93,11 @@ connected together. An alternative parameterisation is \code{\link[=geom_segment]{geom_segment()}}, where each line corresponds to a single case which provides the start and end coordinates. } +\section{Orientation}{ + +This geom treats each axis differently and, thus, can thus have two orientations. Often the orientation is easy to deduce from a combination of the given mappings and the types of positional scales in use. Thus, ggplot2 will by default try to guess which orientation the layer should have. Under rare circumstances, the orientation is ambiguous and guessing may fail. In that case the orientation can be specified directly using the \code{orientation} parameter, which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom should run along, \code{"x"} being the default orientation you would expect for the geom. +} + \section{Aesthetics}{ \code{geom_path()} understands the following aesthetics (required aesthetics are in bold): @@ -122,6 +132,9 @@ ggplot(economics, aes(date, unemploy)) + geom_line() ggplot(economics_long, aes(date, value01, colour = variable)) + geom_line() +# You can get a timeseries that run vertically by setting the orientation +ggplot(economics, aes(unemploy, date)) + geom_line(orientation = "y") + # geom_step() is useful when you want to highlight exactly when # the y value changes recent <- economics[economics$date > as.Date("2013-01-01"), ] diff --git a/man/geom_ribbon.Rd b/man/geom_ribbon.Rd index f5142578ec..06b5b619d0 100644 --- a/man/geom_ribbon.Rd +++ b/man/geom_ribbon.Rd @@ -6,12 +6,12 @@ \title{Ribbons and area plots} \usage{ geom_ribbon(mapping = NULL, data = NULL, stat = "identity", - position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) + position = "identity", ..., na.rm = FALSE, orientation = NA, + show.legend = NA, inherit.aes = TRUE) geom_area(mapping = NULL, data = NULL, stat = "identity", - position = "stack", na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE, ...) + position = "stack", na.rm = FALSE, orientation = NA, + show.legend = NA, inherit.aes = TRUE, ...) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[=aes]{aes()}} or @@ -48,6 +48,11 @@ to the paired geom/stat.} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} +\item{orientation}{The orientation of the layer. The default (\code{NA}) +automatically determines the orientation from the aesthetic mapping. In the +rare event that this fails it can be given explicitly by setting \code{orientation} +to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} + \item{show.legend}{logical. Should this layer be included in the legends? \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. @@ -73,19 +78,30 @@ components is stacked is very important, as it becomes increasing hard to see the individual pattern as you move up the stack. See \code{\link[=position_stack]{position_stack()}} for the details of stacking algorithm. } +\section{Orientation}{ + +This geom treats each axis differently and, thus, can thus have two orientations. Often the orientation is easy to deduce from a combination of the given mappings and the types of positional scales in use. Thus, ggplot2 will by default try to guess which orientation the layer should have. Under rare circumstances, the orientation is ambiguous and guessing may fail. In that case the orientation can be specified directly using the \code{orientation} parameter, which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom should run along, \code{"x"} being the default orientation you would expect for the geom. +} + \section{Aesthetics}{ \code{geom_ribbon()} understands the following aesthetics (required aesthetics are in bold): \itemize{ -\item \strong{\code{x}} -\item \strong{\code{ymin}} -\item \strong{\code{ymax}} +\item \strong{\code{x} \emph{or} \code{y}} +\item \strong{\code{ymin} \emph{or} \code{xmin}} +\item \strong{\code{ymax} \emph{or} \code{xmax}} \item \code{alpha} \item \code{colour} \item \code{fill} \item \code{group} \item \code{linetype} \item \code{size} +\item \code{x} +\item \code{xmax} +\item \code{xmin} +\item \code{y} +\item \code{ymax} +\item \code{ymin} } Learn more about setting these aesthetics in \code{vignette("ggplot2-specs")}. } @@ -98,6 +114,9 @@ h <- ggplot(huron, aes(year)) h + geom_ribbon(aes(ymin=0, ymax=level)) h + geom_area(aes(y = level)) +# Change orientation be switching the mapping +h + geom_area(aes(x = level, y = year)) + # Add aesthetic mappings h + geom_ribbon(aes(ymin = level - 1, ymax = level + 1), fill = "grey70") + diff --git a/man/geom_smooth.Rd b/man/geom_smooth.Rd index c29a0fa0d0..7b7d67cfa1 100644 --- a/man/geom_smooth.Rd +++ b/man/geom_smooth.Rd @@ -6,14 +6,15 @@ \title{Smoothed conditional means} \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) + position = "identity", ..., method = NULL, formula = NULL, + 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, + position = "identity", ..., method = NULL, formula = NULL, se = TRUE, n = 80, span = 0.75, fullrange = FALSE, level = 0.95, method.args = list(), na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) + orientation = NA, show.legend = NA, inherit.aes = TRUE) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[=aes]{aes()}} or @@ -44,11 +45,13 @@ often aesthetics, used to set an aesthetic to a fixed value, like \code{colour = "red"} or \code{size = 3}. They may also be parameters to the paired geom/stat.} -\item{method}{Smoothing method (function) to use, accepts either a character vector, -e.g. \code{"auto"}, \code{"lm"}, \code{"glm"}, \code{"gam"}, \code{"loess"} or a function, e.g. -\code{MASS::rlm} or \code{mgcv::gam}, \code{stats::lm}, or \code{stats::loess}. +\item{method}{Smoothing method (function) to use, accepts either +\code{NULL} or a character vector, e.g. \code{"lm"}, \code{"glm"}, \code{"gam"}, \code{"loess"} +or a function, e.g. \code{MASS::rlm} or \code{mgcv::gam}, \code{stats::lm}, or \code{stats::loess}. +\code{"auto"} is also accepted for backwards compatibility. It is equivalent to +\code{NULL}. -For \code{method = "auto"} the smoothing method is chosen based on the +For \code{method = NULL} the smoothing method is chosen based on the size of the largest group (across all panels). \code{\link[stats:loess]{stats::loess()}} is used for less than 1,000 observations; otherwise \code{\link[mgcv:gam]{mgcv::gam()}} is used with \code{formula = y ~ s(x, bs = "cs")} with \code{method = "REML"}. Somewhat anecdotally, @@ -56,11 +59,13 @@ used with \code{formula = y ~ s(x, bs = "cs")} with \code{method = "REML"}. Some so does not work for larger datasets. If you have fewer than 1,000 observations but want to use the same \code{gam()} -model that \code{method = "auto"} would use, then set +model that \code{method = NULL} would use, then set \code{method = "gam", formula = y ~ s(x, bs = "cs")}.} \item{formula}{Formula to use in smoothing function, eg. \code{y ~ x}, -\code{y ~ poly(x, 2)}, \code{y ~ log(x)}} +\code{y ~ poly(x, 2)}, \code{y ~ log(x)}. \code{NULL} by default, in which case +\code{method = NULL} implies \code{formula = y ~ x} when there are fewer than 1,000 +observations and \code{formula = y ~ s(x, bs = "cs")} otherwise.} \item{se}{Display confidence interval around smooth? (\code{TRUE} by default, see \code{level} to control.)} @@ -68,6 +73,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"}. 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. @@ -110,6 +120,11 @@ exceptions are \code{loess()}, which uses a t-based approximation, and \code{glm()}, where the normal confidence interval is constructed on the link scale and then back-transformed to the response scale. } +\section{Orientation}{ + +This geom treats each axis differently and, thus, can thus have two orientations. Often the orientation is easy to deduce from a combination of the given mappings and the types of positional scales in use. Thus, ggplot2 will by default try to guess which orientation the layer should have. Under rare circumstances, the orientation is ambiguous and guessing may fail. In that case the orientation can be specified directly using the \code{orientation} parameter, which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom should run along, \code{"x"} being the default orientation you would expect for the geom. +} + \section{Aesthetics}{ \code{geom_smooth()} understands the following aesthetics (required aesthetics are in bold): @@ -144,6 +159,11 @@ ggplot(mpg, aes(displ, hwy)) + geom_point() + geom_smooth() +# If you need the fitting to be done along the y-axis set the orientation +ggplot(mpg, aes(displ, hwy)) + + geom_point() + + geom_smooth(orientation = "y") + # Use span to control the "wiggliness" of the default loess smoother. # The span is the fraction of points used to fit each local regression: # small numbers make a wigglier curve, larger numbers make a smoother curve. diff --git a/man/geom_violin.Rd b/man/geom_violin.Rd index 247949f78d..a290448257 100644 --- a/man/geom_violin.Rd +++ b/man/geom_violin.Rd @@ -7,13 +7,13 @@ \usage{ geom_violin(mapping = NULL, data = NULL, stat = "ydensity", position = "dodge", ..., draw_quantiles = NULL, trim = TRUE, - scale = "area", na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) + scale = "area", na.rm = FALSE, orientation = NA, + show.legend = NA, inherit.aes = TRUE) stat_ydensity(mapping = NULL, data = NULL, geom = "violin", position = "dodge", ..., bw = "nrd0", adjust = 1, kernel = "gaussian", trim = TRUE, scale = "area", na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) + orientation = NA, show.legend = NA, inherit.aes = TRUE) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[=aes]{aes()}} or @@ -57,6 +57,11 @@ observations. If "width", all violins have the same maximum width.} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} +\item{orientation}{The orientation of the layer. The default (\code{NA}) +automatically determines the orientation from the aesthetic mapping. In the +rare event that this fails it can be given explicitly by setting \code{orientation} +to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} + \item{show.legend}{logical. Should this layer be included in the legends? \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. @@ -88,6 +93,11 @@ blend of \code{\link[=geom_boxplot]{geom_boxplot()}} and \code{\link[=geom_densi violin plot is a mirrored density plot displayed in the same way as a boxplot. } +\section{Orientation}{ + +This geom treats each axis differently and, thus, can thus have two orientations. Often the orientation is easy to deduce from a combination of the given mappings and the types of positional scales in use. Thus, ggplot2 will by default try to guess which orientation the layer should have. Under rare circumstances, the orientation is ambiguous and guessing may fail. In that case the orientation can be specified directly using the \code{orientation} parameter, which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom should run along, \code{"x"} being the default orientation you would expect for the geom. +} + \section{Aesthetics}{ \code{geom_violin()} understands the following aesthetics (required aesthetics are in bold): @@ -122,6 +132,10 @@ or to a constant maximum width} p <- ggplot(mtcars, aes(factor(cyl), mpg)) p + geom_violin() +# Orientation follows the discrete axis +ggplot(mtcars, aes(mpg, factor(cyl))) + + geom_violin() + \donttest{ p + geom_violin() + geom_jitter(height = 0, width = 0.1) diff --git a/man/ggplot2-ggproto.Rd b/man/ggplot2-ggproto.Rd index df35148ece..1f6c4bc083 100644 --- a/man/ggplot2-ggproto.Rd +++ b/man/ggplot2-ggproto.Rd @@ -14,15 +14,15 @@ % R/geom-spoke.r, R/geom-text.r, R/geom-tile.r, R/geom-violin.r, % R/geom-vline.r, R/layout.R, R/position-.r, R/position-dodge.r, % R/position-dodge2.r, R/position-identity.r, R/position-jitter.r, -% R/position-jitterdodge.R, R/position-nudge.R, R/position-stack.r, -% R/scale-.r, R/scale-continuous.r, R/scale-date.r, R/scale-discrete-.r, -% R/scale-identity.r, R/stat-bin.r, R/stat-bin2d.r, R/stat-bindot.r, -% R/stat-binhex.r, R/stat-boxplot.r, R/stat-contour.r, R/stat-count.r, -% R/stat-density-2d.r, R/stat-density.r, R/stat-ecdf.r, R/stat-ellipse.R, -% R/stat-function.r, R/stat-identity.r, R/stat-qq-line.R, R/stat-qq.r, -% R/stat-quantile.r, R/stat-smooth.r, R/stat-sum.r, R/stat-summary-2d.r, -% R/stat-summary-bin.R, R/stat-summary-hex.r, R/stat-summary.r, -% R/stat-unique.r, R/stat-ydensity.r +% R/position-jitterdodge.R, R/position-nudge.R, R/position-nudgestack.R, +% R/position-stack.r, R/scale-.r, R/scale-binned.R, R/scale-continuous.r, +% R/scale-date.r, R/scale-discrete-.r, R/scale-identity.r, R/stat-bin.r, +% R/stat-bin2d.r, R/stat-bindot.r, R/stat-binhex.r, R/stat-boxplot.r, +% R/stat-contour.r, R/stat-count.r, R/stat-density-2d.r, R/stat-density.r, +% R/stat-ecdf.r, R/stat-ellipse.R, R/stat-function.r, R/stat-identity.r, +% R/stat-qq-line.R, R/stat-qq.r, R/stat-quantile.r, R/stat-smooth.r, +% R/stat-sum.r, R/stat-summary-2d.r, R/stat-summary-bin.R, +% R/stat-summary-hex.r, R/stat-summary.r, R/stat-unique.r, R/stat-ydensity.r \docType{data} \name{ggplot2-ggproto} \alias{ggplot2-ggproto} @@ -90,11 +90,14 @@ \alias{PositionJitter} \alias{PositionJitterdodge} \alias{PositionNudge} +\alias{PositionNudgeStack} \alias{PositionStack} \alias{PositionFill} \alias{Scale} \alias{ScaleContinuous} \alias{ScaleDiscrete} +\alias{ScaleBinned} +\alias{ScaleBinnedPosition} \alias{ScaleContinuousPosition} \alias{ScaleContinuousDatetime} \alias{ScaleContinuousDate} diff --git a/man/guide-exts.Rd b/man/guide-exts.Rd index 8d4fb270f4..17c1591cb6 100644 --- a/man/guide-exts.Rd +++ b/man/guide-exts.Rd @@ -5,6 +5,7 @@ \alias{guide_train} \alias{guide_merge} \alias{guide_geom} +\alias{guide_transform} \alias{guide_gengrob} \title{S3 generics for guides.} \usage{ @@ -14,6 +15,8 @@ guide_merge(guide, new_guide) guide_geom(guide, layers, default_mapping) +guide_transform(guide, coord, panel_params) + guide_gengrob(guide, theme) } \arguments{ diff --git a/man/guide_axis.Rd b/man/guide_axis.Rd new file mode 100644 index 0000000000..dbd206aaa5 --- /dev/null +++ b/man/guide_axis.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/guides-axis.r +\name{guide_axis} +\alias{guide_axis} +\title{Axis guide} +\usage{ +guide_axis(title = waiver(), check.overlap = FALSE, angle = NULL, + n.dodge = 1, order = 0, position = waiver()) +} +\arguments{ +\item{title}{A character string or expression indicating a title of guide. +If \code{NULL}, the title is not shown. By default +(\code{\link[=waiver]{waiver()}}), the name of the scale object or the name +specified in \code{\link[=labs]{labs()}} is used for the title.} + +\item{check.overlap}{silently remove overlapping labels, +(recursively) prioritizing the first, last, and middle labels.} + +\item{angle}{Compared to setting the angle in \code{\link[=theme]{theme()}} / \code{\link[=element_text]{element_text()}}, +this also uses some heuristics to automatically pick the \code{hjust} and \code{vjust} that +you probably want.} + +\item{n.dodge}{The number of rows (for vertical axes) or columns (for +horizontal axes) that should be used to render the labels. This is +useful for displaying labels that would otherwise overlap.} + +\item{order}{Used to determine the order of the guides (left-to-right, +top-to-bottom), if more than one guide must be drawn at the same location.} + +\item{position}{Where this guide should be drawn: one of top, bottom, +left, or right.} +} +\description{ +Axis guides are the visual representation of position scales like those +created with \link[=scale_x_continuous]{scale_(x|y)_continuous()} and +\link[=scale_x_discrete]{scale_(x|y)_discrete()}. +} +\examples{ +# plot with overlapping text +p <- ggplot(mpg, aes(cty * 100, hwy * 100)) + + geom_point() + + facet_wrap(vars(class)) + +# axis guides can be customized in the scale_* functions or +# using guides() +p + scale_x_continuous(guide = guide_axis(n.dodge = 2)) +p + guides(x = guide_axis(angle = 90)) + +# can also be used to add a duplicate guide +p + guides(x = guide_axis(n.dodge = 2), y.sec = guide_axis()) + + +} diff --git a/man/guide_bins.Rd b/man/guide_bins.Rd new file mode 100644 index 0000000000..13e0bce1fc --- /dev/null +++ b/man/guide_bins.Rd @@ -0,0 +1,130 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/guide-bins.R +\name{guide_bins} +\alias{guide_bins} +\title{A binned version of guide_legend} +\usage{ +guide_bins(title = waiver(), title.position = NULL, + title.theme = NULL, title.hjust = NULL, title.vjust = NULL, + label = TRUE, label.position = NULL, label.theme = NULL, + label.hjust = NULL, label.vjust = NULL, keywidth = NULL, + keyheight = NULL, axis = TRUE, axis.colour = "black", + axis.linewidth = 0.5, axis.arrow = NULL, direction = NULL, + default.unit = "line", override.aes = list(), reverse = FALSE, + order = 0, show.limits = NULL, ...) +} +\arguments{ +\item{title}{A character string or expression indicating a title of guide. +If \code{NULL}, the title is not shown. By default +(\code{\link[=waiver]{waiver()}}), the name of the scale object or the name +specified in \code{\link[=labs]{labs()}} is used for the title.} + +\item{title.position}{A character string indicating the position of a +title. One of "top" (default for a vertical guide), "bottom", "left" +(default for a horizontal guide), or "right."} + +\item{title.theme}{A theme object for rendering the title text. Usually the +object of \code{\link[=element_text]{element_text()}} is expected. By default, the theme is +specified by \code{legend.title} in \code{\link[=theme]{theme()}} or theme.} + +\item{title.hjust}{A number specifying horizontal justification of the +title text.} + +\item{title.vjust}{A number specifying vertical justification of the title +text.} + +\item{label}{logical. If \code{TRUE} then the labels are drawn. If +\code{FALSE} then the labels are invisible.} + +\item{label.position}{A character string indicating the position of a +label. One of "top", "bottom" (default for horizontal guide), "left", or +"right" (default for vertical guide).} + +\item{label.theme}{A theme object for rendering the label text. Usually the +object of \code{\link[=element_text]{element_text()}} is expected. By default, the theme is +specified by \code{legend.text} in \code{\link[=theme]{theme()}}.} + +\item{label.hjust}{A numeric specifying horizontal justification of the +label text.} + +\item{label.vjust}{A numeric specifying vertical justification of the label +text.} + +\item{keywidth}{A numeric or a \code{\link[grid:unit]{grid::unit()}} object specifying +the width of the legend key. Default value is \code{legend.key.width} or +\code{legend.key.size} in \code{\link[=theme]{theme()}}.} + +\item{keyheight}{A numeric or a \code{\link[grid:unit]{grid::unit()}} object specifying +the height of the legend key. Default value is \code{legend.key.height} or +\code{legend.key.size} in \code{\link[=theme]{theme()}}.} + +\item{axis}{Logical. Should a small axis be drawn along the guide} + +\item{axis.colour, axis.linewidth}{Graphic specifications for the look of the +axis.} + +\item{axis.arrow}{A call to \code{arrow()} to specify arrows at the end of the +axis line, thus showing an open interval.} + +\item{direction}{A character string indicating the direction of the guide. +One of "horizontal" or "vertical."} + +\item{default.unit}{A character string indicating \code{\link[grid:unit]{grid::unit()}} +for \code{keywidth} and \code{keyheight}.} + +\item{override.aes}{A list specifying aesthetic parameters of legend key. +See details and examples.} + +\item{reverse}{logical. If \code{TRUE} the order of legends is reversed.} + +\item{order}{positive integer less than 99 that specifies the order of +this guide among multiple guides. This controls the order in which +multiple guides are displayed, not the contents of the guide itself. +If 0 (default), the order is determined by a secret algorithm.} + +\item{show.limits}{Logical. Should the limits of the scale be shown with +labels and ticks.} + +\item{...}{ignored.} +} +\value{ +A guide object +} +\description{ +This guide is a version of the \code{\link[=guide_legend]{guide_legend()}} guide for binned scales. It +differs in that it places ticks correctly between the keys, and sports a +small axis to better show the binning. Like \code{\link[=guide_legend]{guide_legend()}} it can be used +for all non-position aesthetics though colour and fill defaults to +\code{\link[=guide_coloursteps]{guide_coloursteps()}}, and it will merge aesthetics together into the same +guide if they are mapped in the same way. +} +\examples{ +p <- ggplot(mtcars) + + geom_point(aes(disp, mpg, size = hp)) + + scale_size_binned() + +# Standard look +p + +# Remove the axis or style it +p + guides(size = guide_bins(axis = FALSE)) + +p + guides(size = guide_bins(show.limits = TRUE)) + +p + guides(size = guide_bins( + axis.arrow = arrow(length = unit(1.5, 'mm'), ends = 'both') +)) + +# Guides are merged together if possible +ggplot(mtcars) + + geom_point(aes(disp, mpg, size = hp, colour = hp)) + + scale_size_binned() + + scale_colour_binned(guide = "bins") + +} +\seealso{ +Other guides: \code{\link{guide_colourbar}}, + \code{\link{guide_coloursteps}}, + \code{\link{guide_legend}}, \code{\link{guides}} +} +\concept{guides} diff --git a/man/guide_colourbar.Rd b/man/guide_colourbar.Rd index 63330959ff..c7eebdfa4d 100644 --- a/man/guide_colourbar.Rd +++ b/man/guide_colourbar.Rd @@ -186,7 +186,8 @@ p2 + scale_size(guide = guide_legend(direction = "vertical")) } \seealso{ -Other guides: \code{\link{guide_legend}}, - \code{\link{guides}} +Other guides: \code{\link{guide_bins}}, + \code{\link{guide_coloursteps}}, + \code{\link{guide_legend}}, \code{\link{guides}} } \concept{guides} diff --git a/man/guide_coloursteps.Rd b/man/guide_coloursteps.Rd new file mode 100644 index 0000000000..dd73dfff61 --- /dev/null +++ b/man/guide_coloursteps.Rd @@ -0,0 +1,120 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/guide-colorsteps.R +\name{guide_coloursteps} +\alias{guide_coloursteps} +\alias{guide_colorsteps} +\title{Discretized colourbar guide} +\usage{ +guide_coloursteps(even.steps = TRUE, show.limits = NULL, + ticks = FALSE, ...) + +guide_colorsteps(even.steps = TRUE, show.limits = NULL, + ticks = FALSE, ...) +} +\arguments{ +\item{even.steps}{Should the rendered size of the bins be equal, or should +they be proportional to their length in the data space? Defaults to \code{TRUE}} + +\item{show.limits}{Should labels for the outer limits of the bins be printed? +Default is \code{NULL} which makes the guide use the setting from the scale} + +\item{ticks}{A logical specifying if tick marks on the colourbar should be +visible.} + +\item{...}{Arguments passed on to \code{guide_colourbar} +\describe{ + \item{barwidth}{A numeric or a \code{\link[grid:unit]{grid::unit()}} object specifying +the width of the colourbar. Default value is \code{legend.key.width} or +\code{legend.key.size} in \code{\link[=theme]{theme()}} or theme.} + \item{barheight}{A numeric or a \code{\link[grid:unit]{grid::unit()}} object specifying +the height of the colourbar. Default value is \code{legend.key.height} or +\code{legend.key.size} in \code{\link[=theme]{theme()}} or theme.} + \item{frame.colour}{A string specifying the colour of the frame +drawn around the bar. If \code{NULL} (the default), no frame is drawn.} + \item{frame.linewidth}{A numeric specifying the width of the frame +drawn around the bar.} + \item{frame.linetype}{A numeric specifying the linetype of the frame +drawn around the bar.} + \item{ticks.colour}{A string specifying the colour of the tick marks.} + \item{ticks.linewidth}{A numeric specifying the width of the tick marks.} + \item{draw.ulim}{A logical specifying if the upper limit tick marks should +be visible.} + \item{draw.llim}{A logical specifying if the lower limit tick marks should +be visible.} + \item{direction}{A character string indicating the direction of the guide. +One of "horizontal" or "vertical."} + \item{default.unit}{A character string indicating \code{\link[grid:unit]{grid::unit()}} +for \code{barwidth} and \code{barheight}.} + \item{reverse}{logical. If \code{TRUE} the colourbar is reversed. By default, +the highest value is on the top and the lowest value is on the bottom} + \item{title}{A character string or expression indicating a title of guide. +If \code{NULL}, the title is not shown. By default +(\code{\link[=waiver]{waiver()}}), the name of the scale object or the name +specified in \code{\link[=labs]{labs()}} is used for the title.} + \item{title.position}{A character string indicating the position of a +title. One of "top" (default for a vertical guide), "bottom", "left" +(default for a horizontal guide), or "right."} + \item{title.theme}{A theme object for rendering the title text. Usually the +object of \code{\link[=element_text]{element_text()}} is expected. By default, the theme is +specified by \code{legend.title} in \code{\link[=theme]{theme()}} or theme.} + \item{title.hjust}{A number specifying horizontal justification of the +title text.} + \item{title.vjust}{A number specifying vertical justification of the title +text.} + \item{label}{logical. If \code{TRUE} then the labels are drawn. If +\code{FALSE} then the labels are invisible.} + \item{label.position}{A character string indicating the position of a +label. One of "top", "bottom" (default for horizontal guide), "left", or +"right" (default for vertical guide).} + \item{label.theme}{A theme object for rendering the label text. Usually the +object of \code{\link[=element_text]{element_text()}} is expected. By default, the theme is +specified by \code{legend.text} in \code{\link[=theme]{theme()}}.} + \item{label.hjust}{A numeric specifying horizontal justification of the +label text.} + \item{label.vjust}{A numeric specifying vertical justification of the label +text.} + \item{order}{positive integer less than 99 that specifies the order of +this guide among multiple guides. This controls the order in which +multiple guides are displayed, not the contents of the guide itself. +If 0 (default), the order is determined by a secret algorithm.} +}} +} +\value{ +A guide object +} +\description{ +This guide is version of \code{\link[=guide_colourbar]{guide_colourbar()}} for binned colour and fill +scales. It shows areas between breaks as a single constant colour instead of +the gradient known from the colourbar counterpart. +} +\examples{ +df <- reshape2::melt(outer(1:10, 1:10), varnames = c("X1", "X2")) + +p <- ggplot(df, aes(X1, X2)) + geom_tile(aes(fill = value)) + +# Coloursteps guide is the default for binned colour scales +p + scale_fill_binned() + +# By default each bin in the guide is the same size irrespectively of how +# their sizes relate in data space +p + scale_fill_binned(breaks = c(10, 25, 50)) + +# This can be changed with the `even.steps` argument +p + scale_fill_binned( + breaks = c(10, 25, 50), + guide = guide_coloursteps(even.steps = FALSE) +) + +# By default the limits is not shown, but this can be changed +p + scale_fill_binned(guide = guide_coloursteps(show.limits = TRUE)) + +# (can also be set in the scale) +p + scale_fill_binned(show.limits = TRUE) + +} +\seealso{ +Other guides: \code{\link{guide_bins}}, + \code{\link{guide_colourbar}}, + \code{\link{guide_legend}}, \code{\link{guides}} +} +\concept{guides} diff --git a/man/guide_legend.Rd b/man/guide_legend.Rd index bd53036d09..7dadfbfc52 100644 --- a/man/guide_legend.Rd +++ b/man/guide_legend.Rd @@ -157,7 +157,8 @@ p + guides(col = guide_legend(reverse = TRUE)) } } \seealso{ -Other guides: \code{\link{guide_colourbar}}, - \code{\link{guides}} +Other guides: \code{\link{guide_bins}}, + \code{\link{guide_colourbar}}, + \code{\link{guide_coloursteps}}, \code{\link{guides}} } \concept{guides} diff --git a/man/guide_none.Rd b/man/guide_none.Rd new file mode 100644 index 0000000000..514784d7c9 --- /dev/null +++ b/man/guide_none.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/guides-none.r +\name{guide_none} +\alias{guide_none} +\title{Empty guide} +\usage{ +guide_none(title = waiver(), position = waiver()) +} +\arguments{ +\item{title}{A character string or expression indicating a title of guide. +If \code{NULL}, the title is not shown. By default +(\code{\link[=waiver]{waiver()}}), the name of the scale object or the name +specified in \code{\link[=labs]{labs()}} is used for the title.} + +\item{position}{Where this guide should be drawn: one of top, bottom, +left, or right.} +} +\description{ +This guide draws nothing. +} diff --git a/man/guides.Rd b/man/guides.Rd index b3f01d6c70..43928a73cd 100644 --- a/man/guides.Rd +++ b/man/guides.Rd @@ -68,7 +68,9 @@ ggplot(mpg, aes(displ, cty)) + } } \seealso{ -Other guides: \code{\link{guide_colourbar}}, +Other guides: \code{\link{guide_bins}}, + \code{\link{guide_colourbar}}, + \code{\link{guide_coloursteps}}, \code{\link{guide_legend}} } \concept{guides} diff --git a/man/midwest.Rd b/man/midwest.Rd index f5ccf869dc..ee8b5e85ae 100644 --- a/man/midwest.Rd +++ b/man/midwest.Rd @@ -4,7 +4,7 @@ \name{midwest} \alias{midwest} \title{Midwest demographics} -\format{A data frame with 437 rows and 28 variables +\format{A data frame with 437 rows and 28 variables: \describe{ \item{PID}{} \item{county}{} diff --git a/man/mpg.Rd b/man/mpg.Rd index 598a59979f..ec696861bd 100644 --- a/man/mpg.Rd +++ b/man/mpg.Rd @@ -3,16 +3,16 @@ \docType{data} \name{mpg} \alias{mpg} -\title{Fuel economy data from 1999 and 2008 for 38 popular models of car} -\format{A data frame with 234 rows and 11 variables +\title{Fuel economy data from 1999 to 2008 for 38 popular models of cars} +\format{A data frame with 234 rows and 11 variables: \describe{ -\item{manufacturer}{} +\item{manufacturer}{manufacturer name} \item{model}{model name} \item{displ}{engine displacement, in litres} \item{year}{year of manufacture} \item{cyl}{number of cylinders} \item{trans}{type of transmission} -\item{drv}{f = front-wheel drive, r = rear wheel drive, 4 = 4wd} +\item{drv}{the type of drive train, where f = front-wheel drive, r = rear wheel drive, 4 = 4wd} \item{cty}{city miles per gallon} \item{hwy}{highway miles per gallon} \item{fl}{fuel type} diff --git a/man/msleep.Rd b/man/msleep.Rd index 682992290e..a53c1cd3e2 100644 --- a/man/msleep.Rd +++ b/man/msleep.Rd @@ -4,7 +4,7 @@ \name{msleep} \alias{msleep} \title{An updated and expanded version of the mammals sleep dataset} -\format{A data frame with 83 rows and 11 variables +\format{A data frame with 83 rows and 11 variables: \describe{ \item{name}{common name} \item{genus}{} diff --git a/man/position_dodge.Rd b/man/position_dodge.Rd index a35191e4fa..cef3386d86 100644 --- a/man/position_dodge.Rd +++ b/man/position_dodge.Rd @@ -96,6 +96,7 @@ ggplot(mtcars, aes(factor(cyl), fill = factor(vs))) + Other position adjustments: \code{\link{position_identity}}, \code{\link{position_jitterdodge}}, \code{\link{position_jitter}}, + \code{\link{position_nudgestack}}, \code{\link{position_nudge}}, \code{\link{position_stack}} } diff --git a/man/position_identity.Rd b/man/position_identity.Rd index 440e575682..994bd2952e 100644 --- a/man/position_identity.Rd +++ b/man/position_identity.Rd @@ -13,6 +13,7 @@ Don't adjust position Other position adjustments: \code{\link{position_dodge}}, \code{\link{position_jitterdodge}}, \code{\link{position_jitter}}, + \code{\link{position_nudgestack}}, \code{\link{position_nudge}}, \code{\link{position_stack}} } diff --git a/man/position_jitter.Rd b/man/position_jitter.Rd index 16548f6496..37b6df322c 100644 --- a/man/position_jitter.Rd +++ b/man/position_jitter.Rd @@ -58,6 +58,7 @@ ggplot(mtcars, aes(am, vs)) + Other position adjustments: \code{\link{position_dodge}}, \code{\link{position_identity}}, \code{\link{position_jitterdodge}}, + \code{\link{position_nudgestack}}, \code{\link{position_nudge}}, \code{\link{position_stack}} } diff --git a/man/position_jitterdodge.Rd b/man/position_jitterdodge.Rd index f543bb332a..ff6e5f05b9 100644 --- a/man/position_jitterdodge.Rd +++ b/man/position_jitterdodge.Rd @@ -40,6 +40,7 @@ ggplot(dsub, aes(x = cut, y = carat, fill = clarity)) + Other position adjustments: \code{\link{position_dodge}}, \code{\link{position_identity}}, \code{\link{position_jitter}}, + \code{\link{position_nudgestack}}, \code{\link{position_nudge}}, \code{\link{position_stack}} } diff --git a/man/position_nudge.Rd b/man/position_nudge.Rd index aaf735e236..9597692160 100644 --- a/man/position_nudge.Rd +++ b/man/position_nudge.Rd @@ -39,6 +39,7 @@ Other position adjustments: \code{\link{position_dodge}}, \code{\link{position_identity}}, \code{\link{position_jitterdodge}}, \code{\link{position_jitter}}, + \code{\link{position_nudgestack}}, \code{\link{position_stack}} } \concept{position adjustments} diff --git a/man/position_nudgestack.Rd b/man/position_nudgestack.Rd new file mode 100644 index 0000000000..076fb198de --- /dev/null +++ b/man/position_nudgestack.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/position-nudgestack.R +\name{position_nudgestack} +\alias{position_nudgestack} +\title{Simultaneously nudge and stack} +\usage{ +position_nudgestack(x = 0, y = 0, vjust = 1, reverse = FALSE) +} +\arguments{ +\item{x, y}{Amount of vertical and horizontal distance to move.} + +\item{vjust}{Vertical adjustment for geoms that have a position +(like points or lines), not a dimension (like bars or areas). Set to +\code{0} to align with the bottom, \code{0.5} for the middle, +and \code{1} (the default) for the top.} + +\item{reverse}{If \code{TRUE}, will reverse the default stacking order. +This is useful if you're rotating both the plot and legend.} +} +\description{ +This is primarily used for set stacked columns between the ticks on the +x-axis. +} +\examples{ +ESM <- tsbox::ts_tbl(EuStockMarkets) + +ESM_prep <- ESM \%>\% + dplyr::mutate(time = as.Date(paste0(format(time, "\%Y-\%m"), "-1"))) \%>\% + dplyr::group_by(id, time) \%>\% + dplyr::summarize(value = mean(value)) \%>\% + dplyr::filter(time >= "1995-01-01" & time < "1998-01-01") + +ggplot(data = ESM_prep, mapping = aes(x = time, y = value, fill = id)) + + geom_col(position = position_nudgestack(x = 15)) +} +\seealso{ +Other position adjustments: \code{\link{position_dodge}}, + \code{\link{position_identity}}, + \code{\link{position_jitterdodge}}, + \code{\link{position_jitter}}, + \code{\link{position_nudge}}, + \code{\link{position_stack}} +} +\concept{position adjustments} diff --git a/man/position_stack.Rd b/man/position_stack.Rd index 39ea363603..991aed9c2c 100644 --- a/man/position_stack.Rd +++ b/man/position_stack.Rd @@ -144,6 +144,7 @@ Other position adjustments: \code{\link{position_dodge}}, \code{\link{position_identity}}, \code{\link{position_jitterdodge}}, \code{\link{position_jitter}}, + \code{\link{position_nudgestack}}, \code{\link{position_nudge}} } \concept{position adjustments} diff --git a/man/presidential.Rd b/man/presidential.Rd index f3de3abdf8..4c827f93aa 100644 --- a/man/presidential.Rd +++ b/man/presidential.Rd @@ -4,7 +4,13 @@ \name{presidential} \alias{presidential} \title{Terms of 11 presidents from Eisenhower to Obama} -\format{A data frame with 11 rows and 4 variables} +\format{A data frame with 11 rows and 4 variables: +\describe{ +\item{name}{Last name of president} +\item{start}{Presidency start date} +\item{end}{Presidency end date} +\item{party}{Party of president} +}} \usage{ presidential } diff --git a/man/scale_alpha.Rd b/man/scale_alpha.Rd index fdd86fffc4..93f1da10ca 100644 --- a/man/scale_alpha.Rd +++ b/man/scale_alpha.Rd @@ -3,6 +3,7 @@ \name{scale_alpha} \alias{scale_alpha} \alias{scale_alpha_continuous} +\alias{scale_alpha_binned} \alias{scale_alpha_discrete} \alias{scale_alpha_ordinal} \alias{scale_alpha_datetime} @@ -13,12 +14,14 @@ scale_alpha(..., range = c(0.1, 1)) scale_alpha_continuous(..., range = c(0.1, 1)) +scale_alpha_binned(..., range = c(0.1, 1)) + scale_alpha_discrete(...) scale_alpha_ordinal(..., range = c(0.1, 1)) } \arguments{ -\item{...}{Other arguments passed on to \code{\link[=continuous_scale]{continuous_scale()}} +\item{...}{Other arguments passed on to \code{\link[=continuous_scale]{continuous_scale()}}, \link{binned_scale}, or \code{\link[=discrete_scale]{discrete_scale()}} as appropriate, to control name, limits, breaks, labels and so forth.} @@ -43,6 +46,7 @@ Other colour scales: \code{\link{scale_colour_brewer}}, \code{\link{scale_colour_gradient}}, \code{\link{scale_colour_grey}}, \code{\link{scale_colour_hue}}, + \code{\link{scale_colour_steps}}, \code{\link{scale_colour_viridis_d}} } \concept{colour scales} diff --git a/man/scale_binned.Rd b/man/scale_binned.Rd new file mode 100644 index 0000000000..1227d3e7a1 --- /dev/null +++ b/man/scale_binned.Rd @@ -0,0 +1,123 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/scale-binned.R +\name{scale_binned} +\alias{scale_x_binned} +\alias{scale_y_binned} +\title{Positional scales for binning continuous data (x & y)} +\usage{ +scale_x_binned(name = waiver(), n.breaks = 10, nice.breaks = TRUE, + breaks = waiver(), labels = waiver(), limits = NULL, + expand = waiver(), oob = squish, na.value = NA_real_, + right = TRUE, show.limits = FALSE, trans = "identity", + position = "bottom") + +scale_y_binned(name = waiver(), n.breaks = 10, nice.breaks = TRUE, + breaks = waiver(), labels = waiver(), limits = NULL, + expand = waiver(), oob = squish, na.value = NA_real_, + right = TRUE, show.limits = FALSE, trans = "identity", + position = "left") +} +\arguments{ +\item{name}{The name of the scale. Used as the axis or legend title. If +\code{waiver()}, the default, the name of the scale is taken from the first +mapping used for that aesthetic. If \code{NULL}, the legend title will be +omitted.} + +\item{n.breaks}{The number of break points to create if breaks are not given +directly.} + +\item{nice.breaks}{Logical. Should breaks be attempted placed at nice values +instead of exactly evenly spaced between the limits. If \code{TRUE} (default) +the scale will ask the transformation object to create breaks, and this +may result in a different number of breaks than requested. Ignored if +breaks are given explicetly.} + +\item{breaks}{One of: +\itemize{ +\item \code{NULL} for no breaks +\item \code{waiver()} for the default breaks computed by the +\link[scales:trans_new]{transformation object} +\item A numeric vector of positions +\item A function that takes the limits as input and returns breaks +as output (e.g., a function returned by \code{\link[scales:extended_breaks]{scales::extended_breaks()}}) +}} + +\item{labels}{One of: +\itemize{ +\item \code{NULL} for no labels +\item \code{waiver()} for the default labels computed by the +transformation object +\item A character vector giving labels (must be same length as \code{breaks}) +\item A function that takes the breaks as input and returns labels +as output +}} + +\item{limits}{One of: +\itemize{ +\item \code{NULL} to use the default scale range +\item A numeric vector of length two providing limits of the scale. +Use \code{NA} to refer to the existing minimum or maximum +\item A function that accepts the existing (automatic) limits and returns +new limits +Note that setting limits on positional scales will \strong{remove} data outside of the limits. +If the purpose is to zoom, use the limit argument in the coordinate system +(see \code{\link[=coord_cartesian]{coord_cartesian()}}). +}} + +\item{expand}{For position scales, a vector of range expansion constants used to add some +padding around the data to ensure that they are placed some distance +away from the axes. Use the convenience function \code{\link[=expansion]{expansion()}} +to generate the values for the \code{expand} argument. The defaults are to +expand the scale by 5\% on each side for continuous variables, and by +0.6 units on each side for discrete variables.} + +\item{oob}{One of: +\itemize{ +\item Function that handles limits outside of the scale limits +(out of bounds). +\item The default (\code{\link[scales:censor]{scales::censor()}}) replaces out of +bounds values with \code{NA}. +\item \code{\link[scales:squish]{scales::squish()}} for squishing out of bounds values into range. +\item \code{\link[scales:squish_infinite]{scales::squish_infinite()}} for squishing infitite values into range. +}} + +\item{na.value}{Missing values will be replaced with this value.} + +\item{right}{Should values on the border between bins be part of the right +(upper) bin?} + +\item{show.limits}{should the limits of the scale appear as ticks} + +\item{trans}{For continuous scales, the name of a transformation object +or the object itself. Built-in transformations include "asn", "atanh", +"boxcox", "date", "exp", "hms", "identity", "log", "log10", "log1p", "log2", +"logit", "modulus", "probability", "probit", "pseudo_log", "reciprocal", +"reverse", "sqrt" and "time". + +A transformation object bundles together a transform, its inverse, +and methods for generating breaks and labels. Transformation objects +are defined in the scales package, and are called \code{_trans} (e.g., +\code{\link[scales:boxcox_trans]{scales::boxcox_trans()}}). You can create your own +transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} + +\item{position}{For position scales, The position of the axis. +\code{left} or \code{right} for y axes, \code{top} or \code{bottom} for x axes.} +} +\description{ +\code{scale_x_binned()} and \code{scale_y_binned()} are scales that discretize +continuous position data. You can use these scales to transform continuous +inputs before using it with a geom that requires discrete positions. An +example is using \code{scale_x_binned()} with \code{\link[=geom_bar]{geom_bar()}} to create a histogram. +} +\examples{ +# Create a histogram by binning the x-axis +ggplot(mtcars) + + geom_bar(aes(mpg)) + + scale_x_binned() +} +\seealso{ +Other position scales: \code{\link{scale_x_continuous}}, + \code{\link{scale_x_date}}, + \code{\link{scale_x_discrete}} +} +\concept{position scales} diff --git a/man/scale_brewer.Rd b/man/scale_brewer.Rd index c44e785402..dffed48fe3 100644 --- a/man/scale_brewer.Rd +++ b/man/scale_brewer.Rd @@ -5,8 +5,11 @@ \alias{scale_fill_brewer} \alias{scale_colour_distiller} \alias{scale_fill_distiller} +\alias{scale_colour_fermenter} +\alias{scale_fill_fermenter} \alias{scale_color_brewer} \alias{scale_color_distiller} +\alias{scale_color_fermenter} \title{Sequential, diverging and qualitative colour scales from colorbrewer.org} \usage{ scale_colour_brewer(..., type = "seq", palette = 1, direction = 1, @@ -22,11 +25,18 @@ scale_colour_distiller(..., type = "seq", palette = 1, scale_fill_distiller(..., type = "seq", palette = 1, direction = -1, values = NULL, space = "Lab", na.value = "grey50", guide = "colourbar", aesthetics = "fill") + +scale_colour_fermenter(..., type = "seq", palette = 1, + direction = -1, na.value = "grey50", guide = "coloursteps", + aesthetics = "colour") + +scale_fill_fermenter(..., type = "seq", palette = 1, direction = -1, + na.value = "grey50", guide = "coloursteps", aesthetics = "fill") } \arguments{ -\item{...}{Other arguments passed on to \code{\link[=discrete_scale]{discrete_scale()}} or, for -\code{distiller} scales, \code{\link[=continuous_scale]{continuous_scale()}} to control name, -limits, breaks, labels and so forth.} +\item{...}{Other arguments passed on to \code{\link[=discrete_scale]{discrete_scale()}}, \code{\link[=continuous_scale]{continuous_scale()}}, +or \code{\link[=binned_scale]{binned_scale()}}, for \code{brewer}, \code{distiller}, and \code{fermenter} variants +respectively, to control name, limits, breaks, labels and so forth.} \item{type}{One of seq (sequential), div (diverging) or qual (qualitative)} @@ -69,7 +79,8 @@ look good. Your mileage may vary. } \note{ The \code{distiller} scales extend brewer to continuous scales by smoothly -interpolating 7 colours from any palette to a continuous scale. +interpolating 7 colours from any palette to a continuous scale. The \code{fermenter} +scales provide binned versions of the brewer scales. } \section{Palettes}{ @@ -114,12 +125,17 @@ v <- ggplot(faithfuld) + v v + scale_fill_distiller() v + scale_fill_distiller(palette = "Spectral") + +# or use blender variants to discretize continuous data +v + scale_fill_fermenter() + } \seealso{ Other colour scales: \code{\link{scale_alpha}}, \code{\link{scale_colour_gradient}}, \code{\link{scale_colour_grey}}, \code{\link{scale_colour_hue}}, + \code{\link{scale_colour_steps}}, \code{\link{scale_colour_viridis_d}} } \concept{colour scales} diff --git a/man/scale_colour_continuous.Rd b/man/scale_colour_continuous.Rd index f0ad9fba5a..a1b5753848 100644 --- a/man/scale_colour_continuous.Rd +++ b/man/scale_colour_continuous.Rd @@ -3,8 +3,11 @@ \name{scale_colour_continuous} \alias{scale_colour_continuous} \alias{scale_fill_continuous} +\alias{scale_colour_binned} +\alias{scale_fill_binned} \alias{scale_color_continuous} -\title{Continuous colour scales} +\alias{scale_color_binned} +\title{Continuous and binned colour scales} \usage{ scale_colour_continuous(..., type = getOption("ggplot2.continuous.colour", default = "gradient")) @@ -57,5 +60,6 @@ v + scale_fill_viridis_c() } \seealso{ \code{\link[=scale_colour_gradient]{scale_colour_gradient()}}, \code{\link[=scale_colour_viridis_c]{scale_colour_viridis_c()}}, -\code{\link[=scale_fill_gradient]{scale_fill_gradient()}}, and \code{\link[=scale_fill_viridis_c]{scale_fill_viridis_c()}} +\code{\link[=scale_colour_steps]{scale_colour_steps()}}, \code{\link[=scale_colour_viridis_b]{scale_colour_viridis_b()}}, \code{\link[=scale_fill_gradient]{scale_fill_gradient()}}, +\code{\link[=scale_fill_viridis_c]{scale_fill_viridis_c()}}, \code{\link[=scale_fill_steps]{scale_fill_steps()}}, and \code{\link[=scale_fill_viridis_b]{scale_fill_viridis_b()}} } diff --git a/man/scale_continuous.Rd b/man/scale_continuous.Rd index d904a781fe..c853b8c83d 100644 --- a/man/scale_continuous.Rd +++ b/man/scale_continuous.Rd @@ -14,12 +14,14 @@ scale_x_continuous(name = waiver(), breaks = waiver(), minor_breaks = waiver(), labels = waiver(), limits = NULL, expand = waiver(), oob = censor, na.value = NA_real_, - trans = "identity", position = "bottom", sec.axis = waiver()) + trans = "identity", guide = waiver(), position = "bottom", + sec.axis = waiver()) scale_y_continuous(name = waiver(), breaks = waiver(), minor_breaks = waiver(), labels = waiver(), limits = NULL, expand = waiver(), oob = censor, na.value = NA_real_, - trans = "identity", position = "left", sec.axis = waiver()) + trans = "identity", guide = waiver(), position = "left", + sec.axis = waiver()) scale_x_log10(...) @@ -111,6 +113,9 @@ are defined in the scales package, and are called \code{_trans} (e.g., \code{\link[scales:boxcox_trans]{scales::boxcox_trans()}}). You can create your own transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} +\item{guide}{A function used to create a guide or its name. See +\code{\link[=guides]{guides()}} for more information.} + \item{position}{For position scales, The position of the axis. \code{left} or \code{right} for y axes, \code{top} or \code{bottom} for x axes.} @@ -183,7 +188,8 @@ p1 + scale_y_continuous(trans = scales::reciprocal_trans()) } \seealso{ -Other position scales: \code{\link{scale_x_date}}, +Other position scales: \code{\link{scale_x_binned}}, + \code{\link{scale_x_date}}, \code{\link{scale_x_discrete}} } \concept{position scales} diff --git a/man/scale_date.Rd b/man/scale_date.Rd index 3b9e123d5a..8e0391d7ce 100644 --- a/man/scale_date.Rd +++ b/man/scale_date.Rd @@ -12,36 +12,36 @@ scale_x_date(name = waiver(), breaks = waiver(), date_breaks = waiver(), labels = waiver(), date_labels = waiver(), minor_breaks = waiver(), date_minor_breaks = waiver(), - limits = NULL, expand = waiver(), position = "bottom", - sec.axis = waiver()) + limits = NULL, expand = waiver(), guide = waiver(), + position = "bottom", sec.axis = waiver()) scale_y_date(name = waiver(), breaks = waiver(), date_breaks = waiver(), labels = waiver(), date_labels = waiver(), minor_breaks = waiver(), date_minor_breaks = waiver(), - limits = NULL, expand = waiver(), position = "left", - sec.axis = waiver()) + limits = NULL, expand = waiver(), guide = waiver(), + position = "left", sec.axis = waiver()) scale_x_datetime(name = waiver(), breaks = waiver(), date_breaks = waiver(), labels = waiver(), date_labels = waiver(), minor_breaks = waiver(), date_minor_breaks = waiver(), timezone = NULL, limits = NULL, expand = waiver(), - position = "bottom", sec.axis = waiver()) + guide = waiver(), position = "bottom", sec.axis = waiver()) scale_y_datetime(name = waiver(), breaks = waiver(), date_breaks = waiver(), labels = waiver(), date_labels = waiver(), minor_breaks = waiver(), date_minor_breaks = waiver(), timezone = NULL, limits = NULL, expand = waiver(), - position = "left", sec.axis = waiver()) + guide = waiver(), position = "left", sec.axis = waiver()) scale_x_time(name = waiver(), breaks = waiver(), minor_breaks = waiver(), labels = waiver(), limits = NULL, expand = waiver(), oob = censor, na.value = NA_real_, - position = "bottom", sec.axis = waiver()) + guide = waiver(), position = "bottom", sec.axis = waiver()) scale_y_time(name = waiver(), breaks = waiver(), minor_breaks = waiver(), labels = waiver(), limits = NULL, expand = waiver(), oob = censor, na.value = NA_real_, - position = "left", sec.axis = waiver()) + guide = waiver(), position = "left", sec.axis = waiver()) } \arguments{ \item{name}{The name of the scale. Used as the axis or legend title. If @@ -107,6 +107,9 @@ to generate the values for the \code{expand} argument. The defaults are to expand the scale by 5\% on each side for continuous variables, and by 0.6 units on each side for discrete variables.} +\item{guide}{A function used to create a guide or its name. See +\code{\link[=guides]{guides()}} for more information.} + \item{position}{For position scales, The position of the axis. \code{left} or \code{right} for y axes, \code{top} or \code{bottom} for x axes.} @@ -157,7 +160,8 @@ base + scale_x_date(limits = c(Sys.Date() - 7, NA)) \seealso{ \code{\link[=sec_axis]{sec_axis()}} for how to specify secondary axes -Other position scales: \code{\link{scale_x_continuous}}, +Other position scales: \code{\link{scale_x_binned}}, + \code{\link{scale_x_continuous}}, \code{\link{scale_x_discrete}} } \concept{position scales} diff --git a/man/scale_discrete.Rd b/man/scale_discrete.Rd index b0f730cae2..3284d62b76 100644 --- a/man/scale_discrete.Rd +++ b/man/scale_discrete.Rd @@ -5,9 +5,11 @@ \alias{scale_y_discrete} \title{Position scales for discrete data} \usage{ -scale_x_discrete(..., expand = waiver(), position = "bottom") +scale_x_discrete(..., expand = waiver(), guide = waiver(), + position = "bottom") -scale_y_discrete(..., expand = waiver(), position = "left") +scale_y_discrete(..., expand = waiver(), guide = waiver(), + position = "left") } \arguments{ \item{...}{Arguments passed on to \code{discrete_scale} @@ -70,6 +72,9 @@ to generate the values for the \code{expand} argument. The defaults are to expand the scale by 5\% on each side for continuous variables, and by 0.6 units on each side for discrete variables.} +\item{guide}{A function used to create a guide or its name. See +\code{\link[=guides]{guides()}} for more information.} + \item{position}{For position scales, The position of the axis. \code{left} or \code{right} for y axes, \code{top} or \code{bottom} for x axes.} } @@ -119,7 +124,8 @@ ggplot(mpg, aes(reorder(manufacturer, displ), cty)) + } } \seealso{ -Other position scales: \code{\link{scale_x_continuous}}, +Other position scales: \code{\link{scale_x_binned}}, + \code{\link{scale_x_continuous}}, \code{\link{scale_x_date}} } \concept{position scales} diff --git a/man/scale_gradient.Rd b/man/scale_gradient.Rd index ad3ef69a5d..d59e93fff7 100644 --- a/man/scale_gradient.Rd +++ b/man/scale_gradient.Rd @@ -225,6 +225,7 @@ Other colour scales: \code{\link{scale_alpha}}, \code{\link{scale_colour_brewer}}, \code{\link{scale_colour_grey}}, \code{\link{scale_colour_hue}}, + \code{\link{scale_colour_steps}}, \code{\link{scale_colour_viridis_d}} } \concept{colour scales} diff --git a/man/scale_grey.Rd b/man/scale_grey.Rd index 0f4b1c491b..3e55326b3e 100644 --- a/man/scale_grey.Rd +++ b/man/scale_grey.Rd @@ -103,6 +103,7 @@ Other colour scales: \code{\link{scale_alpha}}, \code{\link{scale_colour_brewer}}, \code{\link{scale_colour_gradient}}, \code{\link{scale_colour_hue}}, + \code{\link{scale_colour_steps}}, \code{\link{scale_colour_viridis_d}} } \concept{colour scales} diff --git a/man/scale_hue.Rd b/man/scale_hue.Rd index e5c5d6ff36..6a5f5dcde5 100644 --- a/man/scale_hue.Rd +++ b/man/scale_hue.Rd @@ -136,6 +136,7 @@ Other colour scales: \code{\link{scale_alpha}}, \code{\link{scale_colour_brewer}}, \code{\link{scale_colour_gradient}}, \code{\link{scale_colour_grey}}, + \code{\link{scale_colour_steps}}, \code{\link{scale_colour_viridis_d}} } \concept{colour scales} diff --git a/man/scale_linetype.Rd b/man/scale_linetype.Rd index dd4588a11e..2a82557802 100644 --- a/man/scale_linetype.Rd +++ b/man/scale_linetype.Rd @@ -2,12 +2,15 @@ % Please edit documentation in R/scale-linetype.r \name{scale_linetype} \alias{scale_linetype} +\alias{scale_linetype_binned} \alias{scale_linetype_continuous} \alias{scale_linetype_discrete} \title{Scale for line patterns} \usage{ scale_linetype(..., na.value = "blank") +scale_linetype_binned(..., na.value = "blank") + scale_linetype_continuous(...) scale_linetype_discrete(..., na.value = "blank") @@ -60,7 +63,8 @@ as output \description{ Default line types based on a set supplied by Richard Pearson, University of Manchester. Continuous values can not be mapped to -line types. +line types unless \code{scale_linetype_binned()} is used. Still, as linetypes has +no inherent order, this use is not advised. } \examples{ base <- ggplot(economics_long, aes(date, value01)) diff --git a/man/scale_shape.Rd b/man/scale_shape.Rd index 2763e5e984..049aaf06ec 100644 --- a/man/scale_shape.Rd +++ b/man/scale_shape.Rd @@ -2,12 +2,15 @@ % Please edit documentation in R/scale-shape.r \name{scale_shape} \alias{scale_shape} +\alias{scale_shape_binned} \alias{scale_shape_discrete} \alias{scale_shape_ordinal} \alias{scale_shape_continuous} \title{Scales for shapes, aka glyphs} \usage{ scale_shape(..., solid = TRUE) + +scale_shape_binned(..., solid = TRUE) } \arguments{ \item{...}{Arguments passed on to \code{discrete_scale} @@ -63,7 +66,8 @@ as output If you have more than six levels, you will get a warning message, and the seventh and subsequence levels will not appear on the plot. Use \code{\link[=scale_shape_manual]{scale_shape_manual()}} to supply your own values. You can not map -a continuous variable to shape. +a continuous variable to shape unless \code{scale_shape_binned()} is used. Still, +as shape has no inherent order, this use is not advised.. } \examples{ dsmall <- diamonds[sample(nrow(diamonds), 100), ] diff --git a/man/scale_size.Rd b/man/scale_size.Rd index 17614721fc..31c659c4e7 100644 --- a/man/scale_size.Rd +++ b/man/scale_size.Rd @@ -4,22 +4,31 @@ \alias{scale_size} \alias{scale_size_continuous} \alias{scale_radius} +\alias{scale_size_binned} \alias{scale_size_discrete} \alias{scale_size_ordinal} \alias{scale_size_area} +\alias{scale_size_binned_area} \alias{scale_size_datetime} \alias{scale_size_date} \title{Scales for area or radius} \usage{ -scale_radius(name = waiver(), breaks = waiver(), labels = waiver(), +scale_size(name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, range = c(1, 6), trans = "identity", guide = "legend") -scale_size(name = waiver(), breaks = waiver(), labels = waiver(), +scale_radius(name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, range = c(1, 6), trans = "identity", guide = "legend") +scale_size_binned(name = waiver(), breaks = waiver(), + labels = waiver(), limits = NULL, range = c(1, 6), + n.breaks = NULL, nice.breaks = TRUE, trans = "identity", + guide = "bins") + scale_size_area(..., max_size = 6) + +scale_size_binned_area(..., max_size = 6) } \arguments{ \item{name}{The name of the scale. Used as the axis or legend title. If @@ -77,6 +86,15 @@ transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} \item{guide}{A function used to create a guide or its name. See \code{\link[=guides]{guides()}} for more information.} +\item{n.breaks}{The number of break points to create if breaks are not given +directly.} + +\item{nice.breaks}{Logical. Should breaks be attempted placed at nice values +instead of exactly evenly spaced between the limits. If \code{TRUE} (default) +the scale will ask the transformation object to create breaks, and this +may result in a different number of breaks than requested. Ignored if +breaks are given explicetly.} + \item{...}{Arguments passed on to \code{continuous_scale} \describe{ \item{name}{The name of the scale. Used as the axis or legend title. If @@ -161,7 +179,9 @@ expand the scale by 5\% on each side for continuous variables, and by aesthetic is most commonly used for points and text, and humans perceive the area of points (not their radius), so this provides for optimal perception. \code{scale_size_area} ensures that a value of 0 is mapped -to a size of 0. +to a size of 0. \code{scale_size_binned} is a binned version of \code{scale_size} that +scales by area (but does not ensure 0 equals an area of zero). For a binned +equivalent of \code{scale_size_area} use \code{scale_size_binned_area}. } \examples{ p <- ggplot(mpg, aes(displ, hwy, size = hwy)) + @@ -173,6 +193,9 @@ p + scale_size(range = c(0, 10)) # If you want zero value to have zero size, use scale_size_area: p + scale_size_area() +# Binning can sometimes make it easier to match the scaled data to the legend +p + scale_size_binned() + # This is most useful when size is a count ggplot(mpg, aes(class, cyl)) + geom_count() + diff --git a/man/scale_steps.Rd b/man/scale_steps.Rd new file mode 100644 index 0000000000..9155ee3357 --- /dev/null +++ b/man/scale_steps.Rd @@ -0,0 +1,195 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/scale-steps.R, R/zxx.r +\name{scale_colour_steps} +\alias{scale_colour_steps} +\alias{scale_colour_steps2} +\alias{scale_colour_stepsn} +\alias{scale_fill_steps} +\alias{scale_fill_steps2} +\alias{scale_fill_stepsn} +\alias{scale_color_steps} +\alias{scale_color_steps2} +\alias{scale_color_stepsn} +\title{Binned gradient colour scales} +\usage{ +scale_colour_steps(..., low = "#132B43", high = "#56B1F7", + space = "Lab", na.value = "grey50", guide = "coloursteps", + aesthetics = "colour") + +scale_colour_steps2(..., low = muted("red"), mid = "white", + high = muted("blue"), midpoint = 0, space = "Lab", + na.value = "grey50", guide = "coloursteps", aesthetics = "colour") + +scale_colour_stepsn(..., colours, values = NULL, space = "Lab", + na.value = "grey50", guide = "coloursteps", aesthetics = "colour", + colors) + +scale_fill_steps(..., low = "#132B43", high = "#56B1F7", + space = "Lab", na.value = "grey50", guide = "coloursteps", + aesthetics = "fill") + +scale_fill_steps2(..., low = muted("red"), mid = "white", + high = muted("blue"), midpoint = 0, space = "Lab", + na.value = "grey50", guide = "coloursteps", aesthetics = "fill") + +scale_fill_stepsn(..., colours, values = NULL, space = "Lab", + na.value = "grey50", guide = "coloursteps", aesthetics = "fill", + colors) +} +\arguments{ +\item{...}{Arguments passed on to \code{binned_scale} +\describe{ + \item{n.breaks}{The number of break points to create if breaks are not given +directly.} + \item{nice.breaks}{Logical. Should breaks be attempted placed at nice values +instead of exactly evenly spaced between the limits. If \code{TRUE} (default) +the scale will ask the transformation object to create breaks, and this +may result in a different number of breaks than requested. Ignored if +breaks are given explicetly.} + \item{right}{Should values on the border between bins be part of the right +(upper) bin?} + \item{show.limits}{should the limits of the scale appear as ticks} + \item{name}{The name of the scale. Used as the axis or legend title. If +\code{waiver()}, the default, the name of the scale is taken from the first +mapping used for that aesthetic. If \code{NULL}, the legend title will be +omitted.} + \item{breaks}{One of: +\itemize{ +\item \code{NULL} for no breaks +\item \code{waiver()} for the default breaks computed by the +\link[scales:trans_new]{transformation object} +\item A numeric vector of positions +\item A function that takes the limits as input and returns breaks +as output (e.g., a function returned by \code{\link[scales:extended_breaks]{scales::extended_breaks()}}) +}} + \item{labels}{One of: +\itemize{ +\item \code{NULL} for no labels +\item \code{waiver()} for the default labels computed by the +transformation object +\item A character vector giving labels (must be same length as \code{breaks}) +\item A function that takes the breaks as input and returns labels +as output +}} + \item{limits}{One of: +\itemize{ +\item \code{NULL} to use the default scale range +\item A numeric vector of length two providing limits of the scale. +Use \code{NA} to refer to the existing minimum or maximum +\item A function that accepts the existing (automatic) limits and returns +new limits +Note that setting limits on positional scales will \strong{remove} data outside of the limits. +If the purpose is to zoom, use the limit argument in the coordinate system +(see \code{\link[=coord_cartesian]{coord_cartesian()}}). +}} + \item{oob}{One of: +\itemize{ +\item Function that handles limits outside of the scale limits +(out of bounds). +\item The default (\code{\link[scales:censor]{scales::censor()}}) replaces out of +bounds values with \code{NA}. +\item \code{\link[scales:squish]{scales::squish()}} for squishing out of bounds values into range. +\item \code{\link[scales:squish_infinite]{scales::squish_infinite()}} for squishing infitite values into range. +}} + \item{expand}{For position scales, a vector of range expansion constants used to add some +padding around the data to ensure that they are placed some distance +away from the axes. Use the convenience function \code{\link[=expansion]{expansion()}} +to generate the values for the \code{expand} argument. The defaults are to +expand the scale by 5\% on each side for continuous variables, and by +0.6 units on each side for discrete variables.} + \item{trans}{For continuous scales, the name of a transformation object +or the object itself. Built-in transformations include "asn", "atanh", +"boxcox", "date", "exp", "hms", "identity", "log", "log10", "log1p", "log2", +"logit", "modulus", "probability", "probit", "pseudo_log", "reciprocal", +"reverse", "sqrt" and "time". + +A transformation object bundles together a transform, its inverse, +and methods for generating breaks and labels. Transformation objects +are defined in the scales package, and are called \code{_trans} (e.g., +\code{\link[scales:boxcox_trans]{scales::boxcox_trans()}}). You can create your own +transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} + \item{position}{For position scales, The position of the axis. +\code{left} or \code{right} for y axes, \code{top} or \code{bottom} for x axes.} + \item{super}{The super class to use for the constructed scale} +}} + +\item{low}{Colours for low and high ends of the gradient.} + +\item{high}{Colours for low and high ends of the gradient.} + +\item{space}{colour space in which to calculate gradient. Must be "Lab" - +other values are deprecated.} + +\item{na.value}{Colour to use for missing values} + +\item{guide}{Type of legend. Use \code{"colourbar"} for continuous +colour bar, or \code{"legend"} for discrete colour legend.} + +\item{aesthetics}{Character string or vector of character strings listing the +name(s) of the aesthetic(s) that this scale works with. This can be useful, for +example, to apply colour settings to the \code{colour} and \code{fill} aesthetics at the +same time, via \code{aesthetics = c("colour", "fill")}.} + +\item{mid}{colour for mid point} + +\item{midpoint}{The midpoint (in data value) of the diverging scale. +Defaults to 0.} + +\item{colours}{Vector of colours to use for n-colour gradient.} + +\item{values}{if colours should not be evenly positioned along the gradient +this vector gives the position (between 0 and 1) for each colour in the +\code{colours} vector. See \code{\link[=rescale]{rescale()}} for a convenience function +to map an arbitrary range to between 0 and 1.} + +\item{colors}{Vector of colours to use for n-colour gradient.} +} +\description{ +\code{scale_*_steps} creates a two colour binned gradient (low-high), +\code{scale_*_steps2} creates a diverging binned colour gradient (low-mid-high), +and \code{scale_*_stepsn} creates a n-colour binned gradient. These scales are +binned variants of the \link[=scale_colour_gradient]{gradient scale} family and +works in the same way. +} +\details{ +Default colours are generated with \pkg{munsell} and +\code{mnsl(c("2.5PB 2/4", "2.5PB 7/10"))}. Generally, for continuous +colour scales you want to keep hue constant, but vary chroma and +luminance. The \pkg{munsell} package makes this easy to do using the +Munsell colour system. +} +\examples{ +df <- data.frame( + x = runif(100), + y = runif(100), + z1 = rnorm(100) +) + +# Use scale_colour_steps for a standard binned gradient +ggplot(df, aes(x, y)) + + geom_point(aes(colour = z1)) + + scale_colour_steps() + +# Get a divergent binned scale with the *2 variant +ggplot(df, aes(x, y)) + + geom_point(aes(colour = z1)) + + scale_colour_steps2() + +# Define your own colour ramp to extract binned colours from +ggplot(df, aes(x, y)) + + geom_point(aes(colour = z1)) + + scale_colour_stepsn(colours = terrain.colors(10)) + +} +\seealso{ +\code{\link[scales:seq_gradient_pal]{scales::seq_gradient_pal()}} for details on underlying +palette + +Other colour scales: \code{\link{scale_alpha}}, + \code{\link{scale_colour_brewer}}, + \code{\link{scale_colour_gradient}}, + \code{\link{scale_colour_grey}}, + \code{\link{scale_colour_hue}}, + \code{\link{scale_colour_viridis_d}} +} +\concept{colour scales} diff --git a/man/scale_viridis.Rd b/man/scale_viridis.Rd index 6faca738fb..d266cab34b 100644 --- a/man/scale_viridis.Rd +++ b/man/scale_viridis.Rd @@ -5,6 +5,8 @@ \alias{scale_fill_viridis_d} \alias{scale_colour_viridis_c} \alias{scale_fill_viridis_c} +\alias{scale_colour_viridis_b} +\alias{scale_fill_viridis_b} \alias{scale_colour_ordinal} \alias{scale_color_ordinal} \alias{scale_fill_ordinal} @@ -25,10 +27,19 @@ scale_colour_viridis_c(..., alpha = 1, begin = 0, end = 1, scale_fill_viridis_c(..., alpha = 1, begin = 0, end = 1, direction = 1, option = "D", values = NULL, space = "Lab", na.value = "grey50", guide = "colourbar", aesthetics = "fill") + +scale_colour_viridis_b(..., alpha = 1, begin = 0, end = 1, + direction = 1, option = "D", values = NULL, space = "Lab", + na.value = "grey50", guide = "coloursteps", aesthetics = "colour") + +scale_fill_viridis_b(..., alpha = 1, begin = 0, end = 1, + direction = 1, option = "D", values = NULL, space = "Lab", + na.value = "grey50", guide = "coloursteps", aesthetics = "fill") } \arguments{ -\item{...}{Other arguments passed on to \code{\link[=discrete_scale]{discrete_scale()}} or -\code{\link[=continuous_scale]{continuous_scale()}} to control name, limits, breaks, labels and so forth.} +\item{...}{Other arguments passed on to \code{\link[=discrete_scale]{discrete_scale()}}, +\code{\link[=continuous_scale]{continuous_scale()}}, or \link{binned_scale} to control name, limits, breaks, +labels and so forth.} \item{alpha}{The alpha transparency, a number in [0,1], see argument alpha in \code{\link[grDevices]{hsv}}.} @@ -101,12 +112,17 @@ p + scale_fill_viridis_d(direction = -1) geom_tile(aes(waiting, eruptions, fill = density))) v + scale_fill_viridis_c() v + scale_fill_viridis_c(option = "plasma") + +# Use viridis_b to bin continuous data before mapping +v + scale_fill_viridis_b() + } \seealso{ Other colour scales: \code{\link{scale_alpha}}, \code{\link{scale_colour_brewer}}, \code{\link{scale_colour_gradient}}, \code{\link{scale_colour_grey}}, - \code{\link{scale_colour_hue}} + \code{\link{scale_colour_hue}}, + \code{\link{scale_colour_steps}} } \concept{colour scales} diff --git a/man/sec_axis.Rd b/man/sec_axis.Rd index f89a90c216..b57d45aaa7 100644 --- a/man/sec_axis.Rd +++ b/man/sec_axis.Rd @@ -7,10 +7,10 @@ \title{Specify a secondary axis} \usage{ sec_axis(trans = NULL, name = waiver(), breaks = waiver(), - labels = waiver()) + labels = waiver(), guide = waiver()) dup_axis(trans = ~., name = derive(), breaks = derive(), - labels = derive()) + labels = derive(), guide = derive()) derive() } @@ -34,6 +34,9 @@ derive() \item A character vector giving labels (must be same length as \code{breaks}) \item A function that takes the breaks as input and returns labels as output }} + +\item{guide}{A position guide that will be used to render +the axis on the plot. Usually this is \code{\link[=guide_axis]{guide_axis()}}.} } \description{ This function is used in conjunction with a position scale to create a diff --git a/man/stat_summary.Rd b/man/stat_summary.Rd index 3acd3a2588..6480650e9d 100644 --- a/man/stat_summary.Rd +++ b/man/stat_summary.Rd @@ -6,15 +6,16 @@ \title{Summarise y values at unique/binned x} \usage{ stat_summary_bin(mapping = NULL, data = NULL, geom = "pointrange", - position = "identity", ..., fun.data = NULL, fun.y = NULL, - fun.ymax = NULL, fun.ymin = NULL, fun.args = list(), bins = 30, - binwidth = NULL, breaks = NULL, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) + position = "identity", ..., fun.data = NULL, fun = NULL, + fun.max = NULL, fun.min = NULL, fun.args = list(), bins = 30, + binwidth = NULL, breaks = NULL, na.rm = FALSE, orientation = NA, + show.legend = NA, inherit.aes = TRUE, fun.y, fun.ymin, fun.ymax) stat_summary(mapping = NULL, data = NULL, geom = "pointrange", - position = "identity", ..., fun.data = NULL, fun.y = NULL, - fun.ymax = NULL, fun.ymin = NULL, fun.args = list(), - na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) + position = "identity", ..., fun.data = NULL, fun = NULL, + fun.max = NULL, fun.min = NULL, fun.args = list(), na.rm = FALSE, + orientation = NA, show.legend = NA, inherit.aes = TRUE, fun.y, + fun.ymin, fun.ymax) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[=aes]{aes()}} or @@ -51,8 +52,8 @@ to the paired geom/stat.} \item{fun.data}{A function that is given the complete data and should return a data frame with variables \code{ymin}, \code{y}, and \code{ymax}.} -\item{fun.ymin, fun.y, fun.ymax}{Alternatively, supply three individual -functions that are each passed a vector of x's and should return a +\item{fun.min, fun, fun.max}{Alternatively, supply three individual +functions that are each passed a vector of values and should return a single number.} \item{fun.args}{Optional additional arguments passed on to the functions.} @@ -79,6 +80,11 @@ and \code{boundary}.} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} +\item{orientation}{The orientation of the layer. The default (\code{NA}) +automatically determines the orientation from the aesthetic mapping. In the +rare event that this fails it can be given explicitly by setting \code{orientation} +to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} + \item{show.legend}{logical. Should this layer be included in the legends? \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. @@ -89,13 +95,21 @@ display.} rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link[=borders]{borders()}}.} + +\item{fun.ymin, fun.y, fun.ymax}{Deprecated, use the versions specified above +instead.} } \description{ -\code{stat_summary} operates on unique \code{x}; \code{stat_summary_bin} -operates on binned \code{x}. They are more flexible versions of +\code{stat_summary} operates on unique \code{x} or \code{y}; \code{stat_summary_bin} +operates on binned \code{x} or \code{y}. They are more flexible versions of \code{\link[=stat_bin]{stat_bin()}}: instead of just counting, they can compute any aggregate. } +\section{Orientation}{ + +This geom treats each axis differently and, thus, can thus have two orientations. Often the orientation is easy to deduce from a combination of the given mappings and the types of positional scales in use. Thus, ggplot2 will by default try to guess which orientation the layer should have. Under rare circumstances, the orientation is ambiguous and guessing may fail. In that case the orientation can be specified directly using the \code{orientation} parameter, which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom should run along, \code{"x"} being the default orientation you would expect for the geom. +} + \section{Aesthetics}{ \code{stat_summary()} understands the following aesthetics (required aesthetics are in bold): @@ -109,23 +123,28 @@ Learn more about setting these aesthetics in \code{vignette("ggplot2-specs")}. \section{Summary functions}{ -You can either supply summary functions individually (\code{fun.y}, -\code{fun.ymax}, \code{fun.ymin}), or as a single function (\code{fun.data}): +You can either supply summary functions individually (\code{fun}, +\code{fun.max}, \code{fun.min}), or as a single function (\code{fun.data}): \describe{ \item{fun.data}{Complete summary function. Should take numeric vector as input and return data frame as output} -\item{fun.ymin}{ymin summary function (should take numeric vector and +\item{fun.min}{min summary function (should take numeric vector and return single number)} -\item{fun.y}{y summary function (should take numeric vector and return +\item{fun}{main summary function (should take numeric vector and return single number)} -\item{fun.ymax}{ymax summary function (should take numeric vector and +\item{fun.max}{max summary function (should take numeric vector and return single number)} } A simple vector function is easiest to work with as you can return a single number, but is somewhat less flexible. If your summary function computes -multiple values at once (e.g. ymin and ymax), use \code{fun.data}. +multiple values at once (e.g. min and max), use \code{fun.data}. + +\code{fun.data} will recieve data as if it was oriented along the x-axis and +should return a data.frame that corresponds to that orientation. The layer +will take care of flipping the input and output if it is oriented along the +y-axis. If no aggregation functions are supplied, will default to \code{\link[=mean_se]{mean_se()}}. @@ -135,24 +154,33 @@ If no aggregation functions are supplied, will default to d <- ggplot(mtcars, aes(cyl, mpg)) + geom_point() d + stat_summary(fun.data = "mean_cl_boot", colour = "red", size = 2) +# Orientation follows the discrete axis +ggplot(mtcars, aes(mpg, cyl)) + + geom_point() + + stat_summary(fun.data = "mean_cl_boot", colour = "red", size = 2) + # You can supply individual functions to summarise the value at # each x: -d + stat_summary(fun.y = "median", colour = "red", size = 2, geom = "point") -d + stat_summary(fun.y = "mean", colour = "red", size = 2, geom = "point") -d + aes(colour = factor(vs)) + stat_summary(fun.y = mean, geom="line") +d + stat_summary(fun = "median", colour = "red", size = 2, geom = "point") +d + stat_summary(fun = "mean", colour = "red", size = 2, geom = "point") +d + aes(colour = factor(vs)) + stat_summary(fun = mean, geom="line") -d + stat_summary(fun.y = mean, fun.ymin = min, fun.ymax = max, +d + stat_summary(fun = mean, fun.min = min, fun.max = max, colour = "red") d <- ggplot(diamonds, aes(cut)) d + geom_bar() -d + stat_summary_bin(aes(y = price), fun.y = "mean", geom = "bar") +d + stat_summary(aes(y = price), fun = "mean", geom = "bar") + +# Orientation of stat_summary_bin is ambiguous and must be specified directly +ggplot(diamonds, aes(carat, price)) + + stat_summary_bin(fun = "mean", geom = "bar", orientation = 'y') \donttest{ # Don't use ylim to zoom into a summary plot - this throws the # data away p <- ggplot(mtcars, aes(cyl, mpg)) + - stat_summary(fun.y = "mean", geom = "point") + stat_summary(fun = "mean", geom = "point") p p + ylim(15, 30) # Instead use coord_cartesian diff --git a/man/txhousing.Rd b/man/txhousing.Rd index 5ae08e29fe..e9183ea37c 100644 --- a/man/txhousing.Rd +++ b/man/txhousing.Rd @@ -6,7 +6,7 @@ \title{Housing sales in TX} \format{A data frame with 8602 observations and 9 variables: \describe{ -\item{city}{Name of MLS area} +\item{city}{Name of multiple listing service (MLS) area} \item{year,month,date}{Date} \item{sales}{Number of sales} \item{volume}{Total value of sales} diff --git a/tests/figs/deps.txt b/tests/figs/deps.txt index 059d357267..0f64e23e67 100644 --- a/tests/figs/deps.txt +++ b/tests/figs/deps.txt @@ -1,3 +1,3 @@ - vdiffr-svg-engine: 1.0 -- vdiffr: 0.3.0 +- vdiffr: 0.3.1 - freetypeharfbuzz: 0.2.5 diff --git a/tests/figs/guides/guide-axis-customization.svg b/tests/figs/guides/guide-axis-customization.svg new file mode 100644 index 0000000000..a242c3b6a2 --- /dev/null +++ b/tests/figs/guides/guide-axis-customization.svg @@ -0,0 +1,292 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +30 +20 +40 + + + + + + +20 +40 +30 + + + + + + + +2seater +midsize +pickup +suv +compact +minivan +subcompact +class +hwy +hwy +guide_axis() customization + diff --git a/tests/figs/guides/guide-bins-can-remove-axis.svg b/tests/figs/guides/guide-bins-can-remove-axis.svg new file mode 100644 index 0000000000..383f841c10 --- /dev/null +++ b/tests/figs/guides/guide-bins-can-remove-axis.svg @@ -0,0 +1,67 @@ + + + + + + + + + + + + + + + + + + + + + + +5.0 +5.5 +6.0 +6.5 +7.0 + + + + + + + + + + +1.0 +1.5 +2.0 +2.5 +3.0 +x +y + +x + + + + + + + + +1.5 +2.0 +2.5 +guide_bins can remove axis + diff --git a/tests/figs/guides/guide-bins-can-show-arrows.svg b/tests/figs/guides/guide-bins-can-show-arrows.svg new file mode 100644 index 0000000000..3415446818 --- /dev/null +++ b/tests/figs/guides/guide-bins-can-show-arrows.svg @@ -0,0 +1,73 @@ + + + + + + + + + + + + + + + + + + + + + + +5.0 +5.5 +6.0 +6.5 +7.0 + + + + + + + + + + +1.0 +1.5 +2.0 +2.5 +3.0 +x +y + +x + + + + + + + + + + + + + + +1.5 +2.0 +2.5 +guide_bins can show arrows + diff --git a/tests/figs/guides/guide-bins-can-show-limits.svg b/tests/figs/guides/guide-bins-can-show-limits.svg new file mode 100644 index 0000000000..c4b804a4d4 --- /dev/null +++ b/tests/figs/guides/guide-bins-can-show-limits.svg @@ -0,0 +1,75 @@ + + + + + + + + + + + + + + + + + + + + + + +5.0 +5.5 +6.0 +6.5 +7.0 + + + + + + + + + + +1.0 +1.5 +2.0 +2.5 +3.0 +x +y + +x + + + + + + + + + + + + + + +1.0 +1.5 +2.0 +2.5 +3.0 +guide_bins can show limits + diff --git a/tests/figs/guides/guide-bins-can-show-ticks.svg b/tests/figs/guides/guide-bins-can-show-ticks.svg new file mode 100644 index 0000000000..3746b63a12 --- /dev/null +++ b/tests/figs/guides/guide-bins-can-show-ticks.svg @@ -0,0 +1,67 @@ + + + + + + + + + + + + + + + + + + + + + + +5.0 +5.5 +6.0 +6.5 +7.0 + + + + + + + + + +1 +2 +3 +4 +x +y + + + + + +1.5 +2.0 +3.0 +x + + + + + + +guide_bins can show ticks + diff --git a/tests/figs/guides/guide-bins-looks-as-it-should.svg b/tests/figs/guides/guide-bins-looks-as-it-should.svg new file mode 100644 index 0000000000..650baf4365 --- /dev/null +++ b/tests/figs/guides/guide-bins-looks-as-it-should.svg @@ -0,0 +1,71 @@ + + + + + + + + + + + + + + + + + + + + + + +5.0 +5.5 +6.0 +6.5 +7.0 + + + + + + + + + + +1.0 +1.5 +2.0 +2.5 +3.0 +x +y + +x + + + + + + + + + + + + +1.5 +2.0 +2.5 +guide_bins looks as it should + diff --git a/tests/figs/guides/guide-bins-work-horizontally.svg b/tests/figs/guides/guide-bins-work-horizontally.svg new file mode 100644 index 0000000000..7d5b3222bb --- /dev/null +++ b/tests/figs/guides/guide-bins-work-horizontally.svg @@ -0,0 +1,71 @@ + + + + + + + + + + + + + + + + + + + + + + +5.0 +5.5 +6.0 +6.5 +7.0 + + + + + + + + + + +1.0 +1.5 +2.0 +2.5 +3.0 +x +y + +x + + + + + + + + + + + + +1.5 +2.0 +2.5 +guide_bins work horizontally + diff --git a/tests/figs/guides/guide-coloursteps-can-have-bins-relative-to-binsize.svg b/tests/figs/guides/guide-coloursteps-can-have-bins-relative-to-binsize.svg new file mode 100644 index 0000000000..009180678b --- /dev/null +++ b/tests/figs/guides/guide-coloursteps-can-have-bins-relative-to-binsize.svg @@ -0,0 +1,157 @@ + + + + + + + + + + + + + + + + + + + + + + +5.0 +5.5 +6.0 +6.5 +7.0 + + + + + + + + + +1 +2 +3 +4 +x +y + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1.5 +2.0 +3.0 +x +guide_coloursteps can have bins relative to binsize + diff --git a/tests/figs/guides/guide-coloursteps-can-show-limits.svg b/tests/figs/guides/guide-coloursteps-can-show-limits.svg new file mode 100644 index 0000000000..a894fc9fcd --- /dev/null +++ b/tests/figs/guides/guide-coloursteps-can-show-limits.svg @@ -0,0 +1,63 @@ + + + + + + + + + + + + + + + + + + + + + + +5.0 +5.5 +6.0 +6.5 +7.0 + + + + + + + + + +1 +2 +3 +4 +x +y + + + + + +1 +1.5 +2.0 +3.0 +4 +x +guide_coloursteps can show limits + diff --git a/tests/figs/guides/guide-coloursteps-looks-as-it-should.svg b/tests/figs/guides/guide-coloursteps-looks-as-it-should.svg new file mode 100644 index 0000000000..ba8a0c49b2 --- /dev/null +++ b/tests/figs/guides/guide-coloursteps-looks-as-it-should.svg @@ -0,0 +1,61 @@ + + + + + + + + + + + + + + + + + + + + + + +5.0 +5.5 +6.0 +6.5 +7.0 + + + + + + + + + +1 +2 +3 +4 +x +y + + + + + +1.5 +2.0 +3.0 +x +guide_coloursteps looks as it should + diff --git a/tests/figs/guides/guides-specified-in-guides.svg b/tests/figs/guides/guides-specified-in-guides.svg new file mode 100644 index 0000000000..9d3274dabb --- /dev/null +++ b/tests/figs/guides/guides-specified-in-guides.svg @@ -0,0 +1,305 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +compact +minivan +subcompact +2seater +midsize +pickup +suv + + + + + + + +30 +20 +40 + + + + + + +20 +40 +30 + + + + + + + +2seater +midsize +pickup +suv +compact +minivan +subcompact +class +hwy +guides specified in guides() + diff --git a/tests/figs/guides/position-guide-titles.svg b/tests/figs/guides/position-guide-titles.svg new file mode 100644 index 0000000000..69f3b2e748 --- /dev/null +++ b/tests/figs/guides/position-guide-titles.svg @@ -0,0 +1,34 @@ + + + + + + + + + + + + + + + + + + + + +x (secondary) +x (primary) +y (primary) +y (secondary) +position guide titles + diff --git a/tests/figs/position-nudgestack/nudgestack-eustockmarkets-data.svg b/tests/figs/position-nudgestack/nudgestack-eustockmarkets-data.svg new file mode 100644 index 0000000000..326eed0610 --- /dev/null +++ b/tests/figs/position-nudgestack/nudgestack-eustockmarkets-data.svg @@ -0,0 +1,205 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +5000 +10000 +15000 + + + + + + + + +1995 +1996 +1997 +1998 +time +value + +id + + + + + + + + +CAC +DAX +FTSE +SMI +nudgestack EuStockMarkets data + diff --git a/tests/figs/sec-axis/sec-axis-custom-transform.svg b/tests/figs/sec-axis/sec-axis-custom-transform.svg index 9635517c6a..0dbe8af171 100644 --- a/tests/figs/sec-axis/sec-axis-custom-transform.svg +++ b/tests/figs/sec-axis/sec-axis-custom-transform.svg @@ -70,24 +70,24 @@ - - - - - - - - - -0.001 -0.010 -0.100 -0.250 -0.300 -0.350 -0.400 -0.450 -0.500 + + + + + + + + + +0.001 +0.010 +0.100 +0.250 +0.300 +0.350 +0.400 +0.450 +0.500 diff --git a/tests/figs/sec-axis/sec-axis-independent-transformations.svg b/tests/figs/sec-axis/sec-axis-independent-transformations.svg index e9fa100779..3e3764dffe 100644 --- a/tests/figs/sec-axis/sec-axis-independent-transformations.svg +++ b/tests/figs/sec-axis/sec-axis-independent-transformations.svg @@ -46,15 +46,15 @@ -5 -10 -15 -20 +5 +10 +15 +20 25 - - - - + + + + 0.2 0.3 diff --git a/tests/figs/sec-axis/sec-axis-monotonicity-test.svg b/tests/figs/sec-axis/sec-axis-monotonicity-test.svg index 09da192d8a..cd76b3c44e 100644 --- a/tests/figs/sec-axis/sec-axis-monotonicity-test.svg +++ b/tests/figs/sec-axis/sec-axis-monotonicity-test.svg @@ -52,14 +52,14 @@ - - - - -1 -2 -3 -4 + + + + +1 +2 +3 +4 diff --git a/tests/figs/sec-axis/sec-axis-sec-power-transform.svg b/tests/figs/sec-axis/sec-axis-sec-power-transform.svg index 7451419cde..19517dabc6 100644 --- a/tests/figs/sec-axis/sec-axis-sec-power-transform.svg +++ b/tests/figs/sec-axis/sec-axis-sec-power-transform.svg @@ -53,17 +53,17 @@ -0.25 -0.00 -0.25 -0.50 -0.75 -1.00 +0.00 +0.25 +0.50 +0.75 +1.00 - - - - - + + + + + 4.950 4.975 5.000 diff --git a/tests/figs/sec-axis/sec-axis-skewed-transform.svg b/tests/figs/sec-axis/sec-axis-skewed-transform.svg index 4e5e2630ec..c5b429b83a 100644 --- a/tests/figs/sec-axis/sec-axis-skewed-transform.svg +++ b/tests/figs/sec-axis/sec-axis-skewed-transform.svg @@ -147,16 +147,16 @@ -1e-01 -1e+00 -1e+01 -1e+02 -1e+03 - - - - - +1e-01 +1e+00 +1e+01 +1e+02 +1e+03 + + + + + 0.00 0.25 0.50 diff --git a/tests/figs/sec-axis/sec-axis-with-division.svg b/tests/figs/sec-axis/sec-axis-with-division.svg index a7dc81bcff..364b556ead 100644 --- a/tests/figs/sec-axis/sec-axis-with-division.svg +++ b/tests/figs/sec-axis/sec-axis-with-division.svg @@ -284,12 +284,12 @@ - - - -10 -15 -20 + + + +10 +15 +20 diff --git a/tests/figs/themes/axes-styling.svg b/tests/figs/themes/axes-styling.svg index e16319a8e5..b0ae37c5cc 100644 --- a/tests/figs/themes/axes-styling.svg +++ b/tests/figs/themes/axes-styling.svg @@ -51,14 +51,14 @@ -2.5 -5.0 -7.5 -10.0 - - - - +2.5 +5.0 +7.5 +10.0 + + + + 2.5 5.0 @@ -69,14 +69,14 @@ - - - - -2.5 -5.0 -7.5 -10.0 + + + + +2.5 +5.0 +7.5 +10.0 diff --git a/tests/figs/themes/ticks-length.svg b/tests/figs/themes/ticks-length.svg index 58e713674f..99e8d21ff9 100644 --- a/tests/figs/themes/ticks-length.svg +++ b/tests/figs/themes/ticks-length.svg @@ -35,14 +35,14 @@ -2.5 -5.0 -7.5 -10.0 - - - - +2.5 +5.0 +7.5 +10.0 + + + + 2.5 5.0 7.5 @@ -51,14 +51,14 @@ - - - - -2.5 -5.0 -7.5 -10.0 + + + + +2.5 +5.0 +7.5 +10.0 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..14c00b8279 100644 --- a/tests/testthat/test-geom-smooth.R +++ b/tests/testthat/test-geom-smooth.R @@ -9,6 +9,20 @@ test_that("data is ordered by x", { expect_equal(layer_data(ps)[c("x", "y")], df[order(df$x), ]) }) +test_that("geom_smooth works in both directions", { + p <- ggplot(mpg, aes(displ, hwy)) + geom_smooth() + x <- layer_data(p) + expect_false(x$flipped_aes[1]) + + p <- ggplot(mpg, aes(hwy, displ)) + geom_smooth(orientation = "y") + y <- layer_data(p) + expect_true(y$flipped_aes[1]) + + x$flipped_aes <- NULL + y$flipped_aes <- NULL + expect_identical(x, flip_data(y, TRUE)[,names(x)]) +}) + test_that("default smoothing methods for small and large data sets work", { # test small data set set.seed(6531) @@ -48,6 +62,15 @@ test_that("default smoothing methods for small and large data sets work", { "method = 'gam' and formula 'y ~ s\\(x, bs = \"cs\"\\)" ) expect_equal(plot_data$y, as.numeric(out)) + + # backwards compatibility of method = "auto" + p <- ggplot(df, aes(x, y)) + geom_smooth(method = "auto") + + expect_message( + plot_data <- layer_data(p), + "method = 'gam' and formula 'y ~ s\\(x, bs = \"cs\"\\)" + ) + expect_equal(plot_data$y, as.numeric(out)) }) 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-guides.R b/tests/testthat/test-guides.R index 6ef54fcaf5..87e3898f0d 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -65,6 +65,54 @@ test_that("axis_label_element_overrides errors when angles are outside the range expect_error(axis_label_element_overrides("bottom", -91), "`angle` must") }) +test_that("a warning is generated when guides are drawn at a location that doesn't make sense", { + plot <- ggplot(mpg, aes(class, hwy)) + + geom_point() + + scale_y_continuous(guide = guide_axis(position = "top")) + built <- expect_silent(ggplot_build(plot)) + expect_warning(ggplot_gtable(built), "Position guide is perpendicular") +}) + +test_that("a warning is generated when more than one position guide is drawn at a location", { + plot <- ggplot(mpg, aes(class, hwy)) + + geom_point() + + guides( + y = guide_axis(position = "left"), + y.sec = guide_axis(position = "left") + ) + built <- expect_silent(ggplot_build(plot)) + expect_warning(ggplot_gtable(built), "Discarding guide") +}) + +test_that("guide_none() can be used in non-position scales", { + p <- ggplot(mpg, aes(cty, hwy, colour = class)) + + geom_point() + + scale_color_discrete(guide = guide_none()) + + built <- ggplot_build(p) + plot <- built$plot + guides <- build_guides( + plot$scales, + plot$layers, + plot$mapping, + "right", + theme_gray(), + plot$guides, + plot$labels + ) + + expect_identical(guides, zeroGrob()) +}) + +test_that("Using non-position guides for position scales results in an informative error", { + p <- ggplot(mpg, aes(cty, hwy)) + + geom_point() + + scale_x_continuous(guide = guide_legend()) + + built <- ggplot_build(p) + expect_error(ggplot_gtable(built), "does not implement guide_transform()") +}) + # Visual tests ------------------------------------------------------------ test_that("axis guides are drawn correctly", { @@ -132,7 +180,7 @@ test_that("axis guides are drawn correctly", { # dodged text expect_doppelganger( "axis guides, text dodged into rows/cols", - function() test_draw_axis(10, labels = function(b) comma(b * 1e9), n_dodge = 2) + function() test_draw_axis(10, labels = function(b) comma(b * 1e9), n.dodge = 2) ) }) @@ -156,6 +204,45 @@ test_that("axis guides are drawn correctly in plots", { ) }) +test_that("axis guides can be customized", { + plot <- ggplot(mpg, aes(class, hwy)) + + geom_point() + + scale_y_continuous( + sec.axis = dup_axis(guide = guide_axis(n.dodge = 2)), + guide = guide_axis(n.dodge = 2) + ) + + scale_x_discrete(guide = guide_axis(n.dodge = 2)) + + expect_doppelganger("guide_axis() customization", plot) +}) + +test_that("guides can be specified in guides()", { + plot <- ggplot(mpg, aes(class, hwy)) + + geom_point() + + guides( + x = guide_axis(n.dodge = 2), + y = guide_axis(n.dodge = 2), + x.sec = guide_axis(n.dodge = 2), + y.sec = guide_axis(n.dodge = 2) + ) + + expect_doppelganger("guides specified in guides()", plot) +}) + +test_that("guides have the final say in x and y", { + df <- data_frame(x = 1, y = 1) + plot <- ggplot(df, aes(x, y)) + + geom_point() + + guides( + x = guide_none(title = "x (primary)"), + y = guide_none(title = "y (primary)"), + x.sec = guide_none(title = "x (secondary)"), + y.sec = guide_none(title = "y (secondary)") + ) + + expect_doppelganger("position guide titles", plot) +}) + test_that("guides are positioned correctly", { df <- data_frame(x = 1, y = 1, z = factor("a")) @@ -336,3 +423,46 @@ test_that("guides can handle multiple aesthetics for one scale", { expect_doppelganger("one combined colorbar for colour and fill aesthetics", p) }) + +test_that("bin guide can be styled correctly", { + df <- data_frame(x = c(1, 2, 3), + y = c(6, 5, 7)) + + p <- ggplot(df, aes(x, y, size = x)) + + geom_point() + + scale_size_binned() + + expect_doppelganger("guide_bins looks as it should", p) + expect_doppelganger("guide_bins can show limits", + p + guides(size = guide_bins(show.limits = TRUE)) + ) + expect_doppelganger("guide_bins can show arrows", + p + guides(size = guide_bins(axis.arrow = arrow(length = unit(1.5, "mm"), ends = "both"))) + ) + expect_doppelganger("guide_bins can remove axis", + p + guides(size = guide_bins(axis = FALSE)) + ) + expect_doppelganger("guide_bins work horizontally", + p + guides(size = guide_bins(direction = "horizontal")) + ) +}) + +test_that("coloursteps guide can be styled correctly", { + df <- data_frame(x = c(1, 2, 4), + y = c(6, 5, 7)) + + p <- ggplot(df, aes(x, y, colour = x)) + + geom_point() + + scale_colour_binned(breaks = c(1.5, 2, 3)) + + expect_doppelganger("guide_coloursteps looks as it should", p) + expect_doppelganger("guide_coloursteps can show limits", + p + guides(colour = guide_coloursteps(show.limits = TRUE)) + ) + expect_doppelganger("guide_coloursteps can have bins relative to binsize", + p + guides(colour = guide_coloursteps(even.steps = FALSE)) + ) + expect_doppelganger("guide_bins can show ticks", + p + guides(colour = guide_coloursteps(ticks = TRUE)) + ) +}) diff --git a/tests/testthat/test-position-nudgestack.R b/tests/testthat/test-position-nudgestack.R new file mode 100644 index 0000000000..85a11f197a --- /dev/null +++ b/tests/testthat/test-position-nudgestack.R @@ -0,0 +1,112 @@ +context("position_nudgestack") + +test_that("position_nudgestack draws correctly", { + ESM <- tsbox::ts_tbl(EuStockMarkets) + + ESM_prep <- ESM %>% + dplyr::mutate(time = as.Date(paste0(format(time, "%Y-%m"), "-1"))) %>% + dplyr::group_by(id, time) %>% + dplyr::summarize(value = mean(value)) %>% + dplyr::filter(time >= "1995-01-01" & time < "1998-01-01") + + stock_marked <- ggplot( + data = ESM_prep, + mapping = aes(x = time, y = value, fill = id) + ) + + geom_col(position = position_nudgestack(x = 15)) + + expect_doppelganger( + "nudgestack EuStockMarkets data", + stock_marked + ) +}) + + +test_that("nudging works in both dimensions simultaneously", { + # individual nudge value for continuous data + set.seed(111) + + df <- data_frame(x = 1:3) + + p <- ggplot(df, aes(x, x, xmax = x, xmin = x, ymax = x, ymin = x)) + + geom_col(position = position_nudgestack(x = 0.5, y = 2)) + + data <- layer_data(p) + + expect_equal(data$x, 1.5:3.5) + expect_equal(data$xmin, 1.05:3.05) + expect_equal(data$xmax, 1.95:3.95) + expect_equal(data$y, 3:5) + expect_equal(data$ymin, c(2, 2, 2)) + expect_equal(data$ymax, 3:5) +}) + +test_that("nudging works for discrete values correctly", { + set.seed(111) + + # x nudge value for discrete data + series <- data_frame( + time = factor(c(rep(1, 4), rep(2, 4), rep(3, 4), rep(4, 4))), + type = rep(c("a", "b", "c", "d"), 4), + value = rpois(16, 10) + ) + + p <- ggplot(series, aes(time, value, group = type)) + + geom_line(aes(colour = type), position = position_nudgestack(x = 0.5)) + + geom_point(aes(colour = type), position = position_nudgestack(x = 0.5)) + + data <- layer_data(p) + + expect_equal(data$x, c(rep(1.5, 4), rep(2.5, 4), rep(3.5, 4), rep(4.5, 4))) + expect_equal(data$xmin, c(rep(1.5, 4), rep(2.5, 4), rep(3.5, 4), rep(4.5, 4))) + expect_equal(data$xmax, c(rep(1.5, 4), rep(2.5, 4), rep(3.5, 4), rep(4.5, 4))) +}) + + +test_that("data is sorted prior to stacking", { + df <- data_frame( + x = rep(c(1:10), 3), + var = rep(c("a", "b", "c"), 10), + y = round(runif(30, 1, 5)) + ) + p <- ggplot(df, aes(x = x, y = y, fill = var)) + + geom_col(position = position_nudgestack(x = 0.5)) + + dat <- layer_data(p) + expect_true(all(dat$group == 3:1)) +}) + +test_that("negative and positive values are handled separately", { + df <- data_frame( + x = c(1, 1, 1, 2, 2), + g = c(1, 2, 3, 1, 2), + y = c(1, -1, 1, 2, -3) + ) + p <- ggplot(df, aes(x, y, fill = factor(g))) + + geom_col(position = position_nudgestack(x = 0.5)) + dat <- layer_data(p) + + expect_equal(dat$ymin[dat$x == 1.5], c(0, -1, 1)) + expect_equal(dat$ymax[dat$x == 1.5], c(1, 0, 2)) + + expect_equal(dat$ymin[dat$x == 2.5], c(0, -3)) + expect_equal(dat$ymax[dat$x == 2.5], c(2, 0)) +}) + +test_that("can request reverse stacking", { + df <- data_frame( + y = c(-2, 2, -1, 1), + g = c("a", "a", "b", "b") + ) + p <- ggplot(df, aes(1, y, fill = g)) + + geom_col(position = position_nudgestack(x = 0.5, reverse = TRUE)) + dat <- layer_data(p) + expect_equal(dat$ymin, c(-2, 0, -3, 2)) +}) + +test_that("position_nudgestack() can stack correctly when ymax is NA", { + df <- data_frame(x = c(1, 1), y = c(1, 1)) + p <- ggplot(df, aes(x, y, ymax = NA_real_)) + + geom_point(position = position_nudgestack(x = 0.5)) + expect_equal(layer_data(p)$y, c(1, 2)) +}) diff --git a/tests/testthat/test-stat-bin.R b/tests/testthat/test-stat-bin.R index c76520a4c6..818bb41135 100644 --- a/tests/testthat/test-stat-bin.R +++ b/tests/testthat/test-stat-bin.R @@ -4,7 +4,7 @@ test_that("stat_bin throws error when y aesthetic is present", { dat <- data_frame(x = c("a", "b", "c"), y = c(1, 5, 10)) expect_error(ggplot_build(ggplot(dat, aes(x, y)) + stat_bin()), - "must not be used with a y aesthetic.") + "can only have an x or y aesthetic.") expect_error( ggplot_build(ggplot(dat, aes(x)) + stat_bin(y = 5)), @@ -12,6 +12,20 @@ test_that("stat_bin throws error when y aesthetic is present", { ) }) +test_that("stat_bin works in both directions", { + p <- ggplot(mpg, aes(hwy)) + stat_bin() + x <- layer_data(p) + expect_false(x$flipped_aes[1]) + + p <- ggplot(mpg, aes(y = hwy)) + stat_bin() + y <- layer_data(p) + expect_true(y$flipped_aes[1]) + + x$flipped_aes <- NULL + y$flipped_aes <- NULL + expect_identical(x, flip_data(y, TRUE)[,names(x)]) +}) + test_that("bins specifies the number of bins", { df <- data_frame(x = 1:10) out <- function(x, ...) { @@ -144,7 +158,7 @@ test_that("stat_count throws error when y aesthetic present", { expect_error( ggplot_build(ggplot(dat, aes(x, y)) + stat_count()), - "must not be used with a y aesthetic.") + "can only have an x or y aesthetic.") expect_error( ggplot_build(ggplot(dat, aes(x)) + stat_count(y = 5)), diff --git a/tests/testthat/test-stat-density.R b/tests/testthat/test-stat-density.R index 9c4791e337..4a26927a0c 100644 --- a/tests/testthat/test-stat-density.R +++ b/tests/testthat/test-stat-density.R @@ -5,6 +5,20 @@ test_that("compute_density succeeds when variance is zero", { expect_equal(dens$n, rep(10, 512)) }) +test_that("stat_density works in both directions", { + p <- ggplot(mpg, aes(hwy)) + stat_density() + x <- layer_data(p) + expect_false(x$flipped_aes[1]) + + p <- ggplot(mpg, aes(y = hwy)) + stat_density() + y <- layer_data(p) + expect_true(y$flipped_aes[1]) + + x$flipped_aes <- NULL + y$flipped_aes <- NULL + expect_identical(x, flip_data(y, TRUE)[,names(x)]) +}) + test_that("compute_density returns useful df and throws warning when <2 values", { expect_warning(dens <- compute_density(1, NULL, from = 0, to = 0)) diff --git a/tests/testthat/test-stats.r b/tests/testthat/test-stats.r index 2374b9ee57..019d752fde 100644 --- a/tests/testthat/test-stats.r +++ b/tests/testthat/test-stats.r @@ -13,6 +13,6 @@ test_that("plot succeeds even if some computation fails", { }) test_that("error message is thrown when aesthetics are missing", { - p <- ggplot(mtcars) + stat_bin() - expect_error(ggplot_build(p), "x$") + p <- ggplot(mtcars) + stat_sum() + expect_error(ggplot_build(p), "x, y$") }) diff --git a/vignettes/extending-ggplot2.Rmd b/vignettes/extending-ggplot2.Rmd index a90aea4fb2..6719ee2639 100644 --- a/vignettes/extending-ggplot2.Rmd +++ b/vignettes/extending-ggplot2.Rmd @@ -489,6 +489,52 @@ This doesn't allow you to use different geoms with the stat, but that seems appr 1. Compare and contrast `GeomPolygon` with `GeomSimplePolygon`. +## Geoms and Stats with multiple orientation +Some layers have a specific orientation. `geom_bar()` e.g. have the bars along one axis, `geom_line()` will sort the input by one axis, etc. The original approach to using these geoms in the other orientation was to add `coord_flip()` to the plot to switch the position of the x and y axes. Following ggplot2 v3.3 all the geoms will natively work in both orientations without `coord_flip()`. The mechanism is that the layer will try to guess the orientation from the mapped data, or take direction from the user using the `orientation` parameter. To replicate this functionality in new stats and geoms there's a few steps to take. We wll look at the boxplot layer as an example instead of creating a new from scratch. + +### Omnidirectional stats +The actual guessing of orientation will happen in `setup_params()` using the `has_flipped_aes()` helper: + +```{r} +StatBoxplot$setup_params +``` + +Following this is a call to `flip_data()` which will make sure the data is in horizontal orientation. The rest of the code can then simply assume that the data is in a specific orientation. The same thing happens in `setup_data()`: + +```{r} +StatBoxplot$setup_data +``` + +The data is flipped (if needed), manipulated, and flipped back as it is returned. + +During the computation, this sandwiching between `flip_data()` is used as well, but right before the data is returned it will also get a `flipped_aes` column denoting if the data is flipped or not. This allow the +stat to communicate to the geom that orientation has already been determined. + +### Omnidirecitonal geoms +The setup for geoms is pretty much the same, with a few twists. `has_flipped_aes()` is also used in `setup_params()`, where it will usually be picked up from the `flipped_aes` column given by the stat. In `setup_data()` you will often see that `flipped_aes` is reassigned, to make sure it exist prior to position adjustment. This is needed if the geom is used together with a stat that doesn't handle orientation (often `stat_identity()`): + +```{r} +GeomBoxplot$setup_data +``` + +In the `draw_*()` method you will once again sandwich any data manipulation between `flip_data()` calls. It is important to make sure that the data is flipped back prior to creating the grob or calling draw methods from other geoms. + +### Dealing with required aesthetics +Omnidirectional layers usually have two different sets of required aesthetics. Which set is used is often how it knows the orientation. To handle this gracefully the `required_aes` field of `Stat` and `Geom` classes understands the `|` (or) operator. Looking at `GeomBoxplot` we can see how it is used: + +```{r} +GeomBoxplot$required_aes +``` + +This tells ggplot2 that either all the aesthetics before `|` are required or all the aesthetics after are required. + +### Ambiguous layers +Some layers will not have a clear interpretation of their data in terms of orientation. A classic example is `geom_line()` which just by convention runs along the x-axis. There is nothing in the data itself that indicates that. For these geoms the user must indicate a flipped orientation by setting `orientation = "y"`. The stat or geom will then call `has_flipped_aes()` with `ambiguous = TRUE` to cancel any guessing based on data format. As an example we can see the `setup_params()` method of `GeomLine`: + +```{r} +GeomLine$setup_params +``` + ## Creating your own theme If you're going to create your own complete theme, there are a few things you need to know: