diff --git a/DESCRIPTION b/DESCRIPTION index 1b869d4bdf..1481517272 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -40,7 +40,7 @@ Imports: MASS, mgcv, rlang (>= 1.1.0), - scales (>= 1.2.0), + scales (>= 1.3.0), stats, tibble, vctrs (>= 0.5.0), @@ -176,11 +176,13 @@ Collate: 'guide-.R' 'guide-axis.R' 'guide-axis-logticks.R' + 'guide-axis-stack.R' 'guide-axis-theta.R' 'guide-legend.R' 'guide-bins.R' 'guide-colorbar.R' 'guide-colorsteps.R' + 'guide-custom.R' 'layer.R' 'guide-none.R' 'guide-old.R' @@ -273,6 +275,7 @@ Collate: 'utilities-grid.R' 'utilities-help.R' 'utilities-matrix.R' + 'utilities-patterns.R' 'utilities-resolution.R' 'utilities-tidy-eval.R' 'zxx.R' diff --git a/NAMESPACE b/NAMESPACE index cb893f08e8..6a9893e917 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -95,6 +95,10 @@ S3method(makeContext,dotstackGrob) S3method(merge_element,default) S3method(merge_element,element) S3method(merge_element,element_blank) +S3method(pattern_alpha,GridPattern) +S3method(pattern_alpha,GridTilingPattern) +S3method(pattern_alpha,default) +S3method(pattern_alpha,list) S3method(plot,ggplot) S3method(predictdf,default) S3method(predictdf,glm) @@ -148,6 +152,8 @@ S3method(widthDetails,zeroGrob) export("%+%") export("%+replace%") export(.data) +export(.expose_data) +export(.ignore_data) export(.pt) export(.stroke) export(AxisSecondary) @@ -214,9 +220,11 @@ export(GeomVline) export(Guide) export(GuideAxis) export(GuideAxisLogticks) +export(GuideAxisStack) export(GuideBins) export(GuideColourbar) export(GuideColoursteps) +export(GuideCustom) export(GuideLegend) export(GuideNone) export(GuideOld) @@ -352,6 +360,7 @@ export(expr) export(facet_grid) export(facet_null) export(facet_wrap) +export(fill_alpha) export(find_panel) export(flip_data) export(flipped_names) @@ -423,12 +432,14 @@ export(ggsave) export(ggtitle) export(guide_axis) export(guide_axis_logticks) +export(guide_axis_stack) export(guide_axis_theta) export(guide_bins) export(guide_colorbar) export(guide_colorsteps) export(guide_colourbar) export(guide_coloursteps) +export(guide_custom) export(guide_gengrob) export(guide_geom) export(guide_legend) @@ -472,6 +483,7 @@ export(new_guide) export(old_guide) export(panel_cols) export(panel_rows) +export(pattern_alpha) export(position_dodge) export(position_dodge2) export(position_fill) diff --git a/NEWS.md b/NEWS.md index 7fa2f8161a..0b05e50440 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,32 @@ * `draw_key_label()` now better reflects the appearance of labels. +* The `minor_breaks` function argument in scales can now take a function with + two arguments: the scale's limits and the scale's major breaks (#3583). + +* (internal) The `ScaleContinuous$get_breaks()` method no longer censors + the computed breaks. + +* Plot scales now ignore `AsIs` objects constructed with `I(x)`, instead of + invoking the identity scale. This allows these columns to co-exist with other + layers that need a non-identity scale for the same aesthetic. Also, it makes + it easy to specify relative positions (@teunbrand, #5142). + +* The `fill` aesthetic in many geoms now accepts grid's patterns and gradients. + For developers of layer extensions, this feature can be enabled by switching + from `fill = alpha(fill, alpha)` to `fill = fill_alpha(fill, alpha)` when + providing fills to `grid::gpar()` (@teunbrand, #3997). + +* The plot's title, subtitle and caption now obey horizontal text margins + (#5533). + +* New `guide_axis_stack()` to combine other axis guides on top of one another. + +* New `guide_custom()` function for drawing custom graphical objects (grobs) + unrelated to scales in legend positions (#5416). + +* `theme()` now supports splicing a list of arguments (#5542). + * Contour functions will not fail when `options("OutDec")` is not `.` (@eliocamp, #5555). * The `legend.key` theme element is set to inherit from the `panel.background` diff --git a/R/aes.R b/R/aes.R index 9ce54cbd47..87870bccb1 100644 --- a/R/aes.R +++ b/R/aes.R @@ -425,7 +425,7 @@ alternative_aes_extract_usage <- function(x) { } else if (is_call(x, "$")) { as.character(x[[3]]) } else { - cli::cli_abort("Don't know how to get alternative usage for {.var {x}}") + cli::cli_abort("Don't know how to get alternative usage for {.var {x}}.") } } diff --git a/R/annotation-custom.R b/R/annotation-custom.R index e93fb717e3..4261526b89 100644 --- a/R/annotation-custom.R +++ b/R/annotation-custom.R @@ -71,7 +71,7 @@ GeomCustomAnn <- ggproto("GeomCustomAnn", Geom, draw_panel = function(data, panel_params, coord, grob, xmin, xmax, ymin, ymax) { if (!inherits(coord, "CoordCartesian")) { - cli::cli_abort("{.fn annotation_custom} only works with {.fn coord_cartesian}") + cli::cli_abort("{.fn annotation_custom} only works with {.fn coord_cartesian}.") } corners <- data_frame0( x = c(xmin, xmax), diff --git a/R/annotation-map.R b/R/annotation-map.R index d92195170c..86fd0e0952 100644 --- a/R/annotation-map.R +++ b/R/annotation-map.R @@ -63,7 +63,7 @@ annotation_map <- function(map, ...) { if (!is.null(map$long)) map$x <- map$long if (!is.null(map$region)) map$id <- map$region if (!all(c("x", "y", "id") %in% names(map))) { - cli::cli_abort("{.arg map} must have the columns {.col x}, {.col y}, and {.col id}") + cli::cli_abort("{.arg map} must have the columns {.col x}, {.col y}, and {.col id}.") } layer( diff --git a/R/annotation-raster.R b/R/annotation-raster.R index 21c038f773..8eb8685883 100644 --- a/R/annotation-raster.R +++ b/R/annotation-raster.R @@ -74,7 +74,7 @@ GeomRasterAnn <- ggproto("GeomRasterAnn", Geom, draw_panel = function(data, panel_params, coord, raster, xmin, xmax, ymin, ymax, interpolate = FALSE) { if (!inherits(coord, "CoordCartesian")) { - cli::cli_abort("{.fn annotation_raster} only works with {.fn coord_cartesian}") + cli::cli_abort("{.fn annotation_raster} only works with {.fn coord_cartesian}.") } corners <- data_frame0( x = c(xmin, xmax), diff --git a/R/annotation.R b/R/annotation.R index d185cf5698..00e96f64c7 100644 --- a/R/annotation.R +++ b/R/annotation.R @@ -13,7 +13,7 @@ #' #' @section Unsupported geoms: #' Due to their special nature, reference line geoms [geom_abline()], -#' [geom_hline()], and [geom_vline()] can't be used with [annotate()]. +#' [geom_hline()], and [geom_vline()] can't be used with `annotate()`. #' You can use these geoms directly for annotations. #' @param geom name of geom to use for annotation #' @param x,y,xmin,ymin,xmax,ymax,xend,yend positioning aesthetics - diff --git a/R/autolayer.R b/R/autolayer.R index a1f7d0ba15..88129ef212 100644 --- a/R/autolayer.R +++ b/R/autolayer.R @@ -15,5 +15,5 @@ autolayer <- function(object, ...) { #' @export autolayer.default <- function(object, ...) { - cli::cli_abort("No autolayer method available for {.cls {class(object)[1]}} objects") + cli::cli_abort("No autolayer method available for {.cls {class(object)[1]}} objects.") } diff --git a/R/autoplot.R b/R/autoplot.R index f31a411ac5..a2a36e972b 100644 --- a/R/autoplot.R +++ b/R/autoplot.R @@ -17,7 +17,7 @@ autoplot <- function(object, ...) { autoplot.default <- function(object, ...) { cli::cli_abort(c( "Objects of class {.cls {class(object)[[1]]}} are not supported by autoplot.", - "i" = "have you loaded the required package?" + "i" = "Have you loaded the required package?" )) } diff --git a/R/axis-secondary.R b/R/axis-secondary.R index 0edb9106fd..06565358c6 100644 --- a/R/axis-secondary.R +++ b/R/axis-secondary.R @@ -123,7 +123,7 @@ set_sec_axis <- function(sec.axis, scale) { if (!is.waive(sec.axis)) { if (is.formula(sec.axis)) sec.axis <- sec_axis(sec.axis) if (!is.sec_axis(sec.axis)) { - cli::cli_abort("Secondary axes must be specified using {.fn sec_axis}") + cli::cli_abort("Secondary axes must be specified using {.fn sec_axis}.") } scale$secondary.axis <- sec.axis } @@ -165,7 +165,7 @@ AxisSecondary <- ggproto("AxisSecondary", NULL, return() } if (!is.function(self$trans)) { - cli::cli_abort("Transformation for secondary axes must be a function") + cli::cli_abort("Transformation for secondary axes must be a function.") } if (is.derived(self$name) && !is.waive(scale$name)) self$name <- scale$name if (is.derived(self$breaks)) self$breaks <- scale$breaks @@ -194,7 +194,7 @@ AxisSecondary <- ggproto("AxisSecondary", NULL, # Test for monotonicity if (!is_unique(sign(diff(full_range)))) - cli::cli_abort("Transformation for secondary axes must be monotonic") + cli::cli_abort("Transformation for secondary axes must be monotonic.") }, break_info = function(self, range, scale) { @@ -280,7 +280,7 @@ AxisSecondary <- ggproto("AxisSecondary", NULL, }, # Temporary scale for the purpose of calling break_info() - create_scale = function(self, range, trans = identity_trans()) { + create_scale = function(self, range, trans = transform_identity()) { scale <- ggproto(NULL, ScaleContinuousPosition, name = self$name, breaks = self$breaks, diff --git a/R/backports.R b/R/backports.R index 4679be5680..0fe48cc3ac 100644 --- a/R/backports.R +++ b/R/backports.R @@ -22,3 +22,26 @@ if (getRversion() < "3.5") { isFALSE <- function(x) is.logical(x) && length(x) == 1L && !is.na(x) && !x isTRUE <- function(x) is.logical(x) && length(x) == 1L && !is.na(x) && x } + +version_unavailable <- function(...) { + fun <- as_label(current_call()[[1]]) + cli::cli_abort("{.fn {fun}} is not available in R version {getRversion()}.") +} + +# Ignore mask argument if on lower R version (<= 4.1) +viewport <- function(..., mask) grid::viewport(...) +pattern <- version_unavailable +as.mask <- version_unavailable +on_load({ + if ("mask" %in% fn_fmls_names(grid::viewport)) { + viewport <- grid::viewport + } + # Replace version unavailable functions if found + if ("pattern" %in% getNamespaceExports("grid")) { + pattern <- grid::pattern + } + if ("as.mask" %in% getNamespaceExports("grid")) { + as.mask <- grid::as.mask + } +}) + diff --git a/R/bin.R b/R/bin.R index 7244b9ffe1..5cb1a948ee 100644 --- a/R/bin.R +++ b/R/bin.R @@ -51,13 +51,11 @@ bin_breaks <- function(breaks, closed = c("right", "left")) { bin_breaks_width <- function(x_range, width = NULL, center = NULL, boundary = NULL, closed = c("right", "left")) { if (length(x_range) != 2) { - cli::cli_abort("{.arg x_range} must have two elements") + cli::cli_abort("{.arg x_range} must have two elements.") } - check_number_decimal(width) - if (width <= 0) { - cli::cli_abort("{.arg binwidth} must be positive") - } + # binwidth seems to be the argument name supplied to width. (stat-bin and stat-bindot) + check_number_decimal(width, min = 0, allow_infinite = FALSE, arg = "binwidth") if (!is.null(boundary) && !is.null(center)) { cli::cli_abort("Only one of {.arg boundary} and {.arg center} may be specified.") @@ -105,7 +103,7 @@ bin_breaks_width <- function(x_range, width = NULL, center = NULL, bin_breaks_bins <- function(x_range, bins = 30, center = NULL, boundary = NULL, closed = c("right", "left")) { if (length(x_range) != 2) { - cli::cli_abort("{.arg x_range} must have two elements") + cli::cli_abort("{.arg x_range} must have two elements.") } check_number_whole(bins, min = 1) diff --git a/R/compat-plyr.R b/R/compat-plyr.R index 0f8306a4ab..95c317a02c 100644 --- a/R/compat-plyr.R +++ b/R/compat-plyr.R @@ -19,7 +19,7 @@ unrowname <- function(x) { } else if (is.matrix(x)) { dimnames(x)[1] <- list(NULL) } else { - cli::cli_abort("Can only remove rownames from {.cls data.frame} and {.cls matrix} objects") + cli::cli_abort("Can only remove rownames from {.cls data.frame} and {.cls matrix} objects.") } x } @@ -239,7 +239,7 @@ as.quoted <- function(x, env = parent.frame()) { } else if (is.call(x)) { as.list(x)[-1] } else { - cli::cli_abort("Must be a character vector, call, or formula") + cli::cli_abort("Must be a character vector, call, or formula.") } attributes(x) <- list(env = env, class = 'quoted') x diff --git a/R/coord-.R b/R/coord-.R index d69248a2c6..8c4313baf7 100644 --- a/R/coord-.R +++ b/R/coord-.R @@ -66,27 +66,27 @@ Coord <- ggproto("Coord", render_fg = function(panel_params, theme) element_render(theme, "panel.border"), render_bg = function(self, panel_params, theme) { - cli::cli_abort("{.fn {snake_class(self)}} has not implemented a {.fn render_bg} method") + cli::cli_abort("{.fn {snake_class(self)}} has not implemented a {.fn render_bg} method.") }, render_axis_h = function(self, panel_params, theme) { - cli::cli_abort("{.fn {snake_class(self)}} has not implemented a {.fn render_axis_h} method") + cli::cli_abort("{.fn {snake_class(self)}} has not implemented a {.fn render_axis_h} method.") }, render_axis_v = function(self, panel_params, theme) { - cli::cli_abort("{.fn {snake_class(self)}} has not implemented a {.fn render_axis_v} method") + cli::cli_abort("{.fn {snake_class(self)}} has not implemented a {.fn render_axis_v} method.") }, # transform range given in transformed coordinates # back into range in given in (possibly scale-transformed) # data coordinates backtransform_range = function(self, panel_params) { - cli::cli_abort("{.fn {snake_class(self)}} has not implemented a {.fn backtransform_range} method") + cli::cli_abort("{.fn {snake_class(self)}} has not implemented a {.fn backtransform_range} method.") }, # return range stored in panel_params range = function(self, panel_params) { - cli::cli_abort("{.fn {snake_class(self)}} has not implemented a {.fn range} method") + cli::cli_abort("{.fn {snake_class(self)}} has not implemented a {.fn range} method.") }, setup_panel_params = function(scale_x, scale_y, params = list()) { diff --git a/R/coord-sf.R b/R/coord-sf.R index 9f323a42f3..331ca4f1f0 100644 --- a/R/coord-sf.R +++ b/R/coord-sf.R @@ -127,7 +127,7 @@ CoordSf <- ggproto("CoordSf", CoordCartesian, } if (length(x_labels) != length(x_breaks)) { - cli::cli_abort("Breaks and labels along x direction are different lengths") + cli::cli_abort("{.arg breaks} and {.arg labels} along {.code x} direction have different lengths.") } graticule$degree_label[graticule$type == "E"] <- x_labels @@ -152,7 +152,7 @@ CoordSf <- ggproto("CoordSf", CoordCartesian, } if (length(y_labels) != length(y_breaks)) { - cli::cli_abort("Breaks and labels along y direction are different lengths") + cli::cli_abort("{.arg breaks} and {.arg labels} along {.code y} direction have different lengths.") } graticule$degree_label[graticule$type == "N"] <- y_labels @@ -203,7 +203,7 @@ CoordSf <- ggproto("CoordSf", CoordCartesian, if (self$lims_method != "geometry_bbox") { cli::cli_warn(c( "Projection of {.field x} or {.field y} limits failed in {.fn coord_sf}.", - "i" = "Consider setting {.code lims_method = \"geometry_bbox\"} or {.code default_crs = NULL}." + "i" = "Consider setting {.code lims_method = {.val geometry_bbox}} or {.code default_crs = NULL}." )) } coord_bbox <- self$params$bbox @@ -409,7 +409,7 @@ sf_rescale01 <- function(x, x_range, y_range) { calc_limits_bbox <- function(method, xlim, ylim, crs, default_crs) { if (any(!is.finite(c(xlim, ylim))) && method != "geometry_bbox") { cli::cli_abort(c( - "Scale limits cannot be mapped onto spatial coordinates in {.fn coord_sf}", + "Scale limits cannot be mapped onto spatial coordinates in {.fn coord_sf}.", "i" = "Consider setting {.code lims_method = \"geometry_bbox\"} or {.code default_crs = NULL}." )) } @@ -542,14 +542,12 @@ coord_sf <- function(xlim = NULL, ylim = NULL, expand = TRUE, label_axes <- parse_axes_labeling(label_axes) } else if (!is.list(label_axes)) { cli::cli_abort("Panel labeling format not recognized.") - label_axes <- list(left = "N", bottom = "E") } if (is.character(label_graticule)) { label_graticule <- unlist(strsplit(label_graticule, "")) } else { cli::cli_abort("Graticule labeling format not recognized.") - label_graticule <- "" } # switch limit method to "orthogonal" if not specified and default_crs indicates projected coords diff --git a/R/coord-transform.R b/R/coord-transform.R index 5beaadf6d2..9fde8bb98e 100644 --- a/R/coord-transform.R +++ b/R/coord-transform.R @@ -5,7 +5,7 @@ #' no guarantee that straight lines will continue to be straight. #' #' Transformations only work with continuous values: see -#' [scales::trans_new()] for list of transformations, and instructions +#' [scales::new_transform()] for list of transformations, and instructions #' on how to create your own. #' #' @inheritParams coord_cartesian @@ -60,7 +60,7 @@ #' geom_smooth(method = "lm") + #' scale_x_log10() + #' scale_y_log10() + -#' coord_trans(x = scales::exp_trans(10), y = scales::exp_trans(10)) +#' coord_trans(x = scales::transform_exp(10), y = scales::transform_exp(10)) #' #' # cf. #' ggplot(diamonds, aes(carat, price)) + @@ -90,8 +90,8 @@ coord_trans <- function(x = "identity", y = "identity", xlim = NULL, ylim = NULL check_coord_limits(ylim) # resolve transformers - if (is.character(x)) x <- as.trans(x) - if (is.character(y)) y <- as.trans(y) + if (is.character(x)) x <- as.transform(x) + if (is.character(y)) y <- as.transform(y) ggproto(NULL, CoordTrans, trans = list(x = x, y = y), @@ -190,7 +190,7 @@ transform_value <- function(trans, value, range) { # TODO: can we merge this with view_scales_from_scale()? view_scales_from_scale_with_coord_trans <- function(scale, coord_limits, trans, expand = TRUE) { expansion <- default_expansion(scale, expand = expand) - scale_trans <- scale$trans %||% identity_trans() + scale_trans <- scale$trans %||% transform_identity() coord_limits <- coord_limits %||% scale_trans$inverse(c(NA, NA)) scale_limits <- scale$get_limits() diff --git a/R/facet-.R b/R/facet-.R index 46e5a1c61f..f26b602f89 100644 --- a/R/facet-.R +++ b/R/facet-.R @@ -83,10 +83,10 @@ Facet <- ggproto("Facet", NULL, params = list(), compute_layout = function(data, params) { - cli::cli_abort("Not implemented") + cli::cli_abort("Not implemented.") }, map_data = function(data, layout, params) { - cli::cli_abort("Not implemented") + cli::cli_abort("Not implemented.") }, init_scales = function(layout, x_scale = NULL, y_scale = NULL, params) { scales <- list() @@ -132,7 +132,7 @@ Facet <- ggproto("Facet", NULL, rep(list(zeroGrob()), vec_unique_count(layout$PANEL)) }, draw_panels = function(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) { - cli::cli_abort("Not implemented") + cli::cli_abort("Not implemented.") }, draw_labels = function(panels, layout, x_scales, y_scales, ranges, coord, data, theme, labels, params) { panel_dim <- find_panel(panels) @@ -323,13 +323,13 @@ as_facets_list <- function(x) { validate_facets <- function(x) { if (inherits(x, "uneval")) { - cli::cli_abort("Please use {.fn vars} to supply facet variables") + cli::cli_abort("Please use {.fn vars} to supply facet variables.") } # Native pipe have higher precedence than + so any type of gg object can be # expected here, not just ggplot if (inherits(x, "gg")) { cli::cli_abort(c( - "Please use {.fn vars} to supply facet variables", + "Please use {.fn vars} to supply facet variables.", "i" = "Did you use {.code %>%} or {.code |>} instead of {.code +}?" )) } @@ -500,7 +500,7 @@ check_layout <- function(x) { return() } - cli::cli_abort("Facet layout has a bad format. It must contain columns {.col PANEL}, {.col SCALE_X}, and {.col SCALE_Y}") + cli::cli_abort("Facet layout has a bad format. It must contain columns {.col PANEL}, {.col SCALE_X}, and {.col SCALE_Y}.") } check_facet_vars <- function(..., name) { @@ -509,8 +509,8 @@ check_facet_vars <- function(..., name) { problems <- intersect(vars_names, reserved_names) if (length(problems) != 0) { cli::cli_abort(c( - "{.val {problems}} {?is/are} not {?an/} allowed name{?/s} for faceting variables", - "i" = "Change the name of your data columns to not be {.or {.str {reserved_names}}}" + "{.val {problems}} {?is/are} not {?an/} allowed name{?/s} for faceting variables.", + "i" = "Change the name of your data columns to not be {.or {.str {reserved_names}}}." ), call = call2(name)) } } @@ -631,7 +631,7 @@ combine_vars <- function(data, env = emptyenv(), vars = NULL, drop = TRUE) { } if (empty(base)) { - cli::cli_abort("Faceting variables must have at least one value") + cli::cli_abort("Faceting variables must have at least one value.") } base diff --git a/R/facet-grid-.R b/R/facet-grid-.R index 3fa73f98f3..4afccc71f8 100644 --- a/R/facet-grid-.R +++ b/R/facet-grid-.R @@ -137,8 +137,8 @@ facet_grid <- function(rows = NULL, cols = NULL, scales = "fixed", y = any(space %in% c("free_y", "free")) ) - if (!is.null(switch) && !switch %in% c("both", "x", "y")) { - cli::cli_abort("{.arg switch} must be either {.val both}, {.val x}, or {.val y}") + if (!is.null(switch)) { + arg_match0(switch, c("both", "x", "y")) } facets_list <- grid_as_facets_list(rows, cols) @@ -159,7 +159,7 @@ grid_as_facets_list <- function(rows, cols) { is_rows_vars <- is.null(rows) || is_quosures(rows) if (!is_rows_vars) { if (!is.null(cols)) { - msg <- "{.arg rows} must be {.val NULL} or a {.fn vars} list if {.arg cols} is a {.fn vars} list" + msg <- "{.arg rows} must be {.code NULL} or a {.fn vars} list if {.arg cols} is a {.fn vars} list." # Native pipe have higher precedence than + so any type of gg object can be # expected here, not just ggplot if (inherits(rows, "gg")) { @@ -173,7 +173,7 @@ grid_as_facets_list <- function(rows, cols) { # For backward-compatibility facets_list <- as_facets_list(rows) if (length(facets_list) > 2L) { - cli::cli_abort("A grid facet specification can't have more than two dimensions") + cli::cli_abort("A grid facet specification can't have more than two dimensions.") } # Fill with empty quosures facets <- list(rows = quos(), cols = quos()) @@ -206,7 +206,7 @@ FacetGrid <- ggproto("FacetGrid", Facet, dups <- intersect(names(rows), names(cols)) if (length(dups) > 0) { cli::cli_abort(c( - "Faceting variables can only appear in {.arg rows} or {.arg cols}, not both.\n", + "Faceting variables can only appear in {.arg rows} or {.arg cols}, not both.", "i" = "Duplicated variables: {.val {dups}}" ), call = call2(snake_class(self))) } @@ -303,7 +303,7 @@ FacetGrid <- ggproto("FacetGrid", Facet, }, draw_panels = function(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) { if ((params$free$x || params$free$y) && !coord$is_free()) { - cli::cli_abort("{.fn {snake_class(coord)}} doesn't support free scales") + cli::cli_abort("{.fn {snake_class(coord)}} doesn't support free scales.") } cols <- which(layout$ROW == 1) @@ -321,7 +321,7 @@ FacetGrid <- ggproto("FacetGrid", Facet, aspect_ratio <- theme$aspect.ratio if (!is.null(aspect_ratio) && (params$space_free$x || params$space_free$y)) { - cli::cli_abort("Free scales cannot be mixed with a fixed aspect ratio") + cli::cli_abort("Free scales cannot be mixed with a fixed aspect ratio.") } if (is.null(aspect_ratio) && !params$free$x && !params$free$y) { aspect_ratio <- coord$aspect(ranges[[1]]) diff --git a/R/facet-wrap.R b/R/facet-wrap.R index b7c19a05f3..00c65dd49a 100644 --- a/R/facet-wrap.R +++ b/R/facet-wrap.R @@ -217,7 +217,7 @@ FacetWrap <- ggproto("FacetWrap", Facet, }, draw_panels = function(self, panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) { if ((params$free$x || params$free$y) && !coord$is_free()) { - cli::cli_abort("{.fn {snake_class(self)}} can't use free scales with {.fn {snake_class(coord)}}") + cli::cli_abort("{.fn {snake_class(self)}} can't use free scales with {.fn {snake_class(coord)}}.") } if (inherits(coord, "CoordFlip")) { @@ -470,8 +470,8 @@ wrap_dims <- function(n, nrow = NULL, ncol = NULL) { } if (nrow * ncol < n) { cli::cli_abort(c( - "Need {n} panels, but together {.arg nrow} and {.arg ncol} only provide {nrow * ncol}", - i = "Please increase {.arg ncol} and/or {.arg nrow}" + "Need {n} panel{?s}, but together {.arg nrow} and {.arg ncol} only provide {nrow * ncol}.", + i = "Please increase {.arg ncol} and/or {.arg nrow}." )) } diff --git a/R/fortify.R b/R/fortify.R index 292928bba5..bc046f2400 100644 --- a/R/fortify.R +++ b/R/fortify.R @@ -78,8 +78,8 @@ validate_as_data_frame <- function(data) { fortify.default <- function(model, data, ...) { msg0 <- paste0( "{{.arg data}} must be a {{.cls data.frame}}, ", - "or an object coercible by {{.code fortify()}}, or a valid ", - "{{.cls data.frame}}-like object coercible by {{.code as.data.frame()}}" + "or an object coercible by {{.fn fortify}}, or a valid ", + "{{.cls data.frame}}-like object coercible by {{.fn as.data.frame}}" ) if (inherits(model, "uneval")) { msg <- c( diff --git a/R/geom-.R b/R/geom-.R index b9ff98a71f..6d4ed6fc55 100644 --- a/R/geom-.R +++ b/R/geom-.R @@ -126,6 +126,10 @@ Geom <- ggproto("Geom", deprecate_soft0("3.4.0", I("Using the `size` aesthetic in this geom"), I("`linewidth` in the `default_aes` field and elsewhere")) default_aes$linewidth <- default_aes$size } + if (is_pattern(params$fill)) { + params$fill <- list(params$fill) + } + # Fill in missing aesthetics with their defaults missing_aes <- setdiff(names(default_aes), names(data)) @@ -239,8 +243,8 @@ check_aesthetics <- function(x, n) { } cli::cli_abort(c( - "Aesthetics must be either length 1 or the same as the data ({n})", - "x" = "Fix the following mappings: {.col {names(which(!good))}}" + "Aesthetics must be either length 1 or the same as the data ({n}).", + "x" = "Fix the following mappings: {.col {names(which(!good))}}." )) } diff --git a/R/geom-boxplot.R b/R/geom-boxplot.R index 2be6c25d69..289c10cd97 100644 --- a/R/geom-boxplot.R +++ b/R/geom-boxplot.R @@ -230,7 +230,7 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, # this may occur when using geom_boxplot(stat = "identity") if (nrow(data) != 1) { cli::cli_abort(c( - "Can only draw one boxplot per group", + "Can only draw one boxplot per group.", "i"= "Did you forget {.code aes(group = ...)}?" )) } @@ -239,7 +239,7 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, colour = data$colour, linewidth = data$linewidth, linetype = data$linetype, - fill = alpha(data$fill, data$alpha), + fill = fill_alpha(data$fill, data$alpha), group = data$group ) diff --git a/R/geom-dotplot.R b/R/geom-dotplot.R index 802a717c28..120fb80109 100644 --- a/R/geom-dotplot.R +++ b/R/geom-dotplot.R @@ -294,7 +294,7 @@ GeomDotplot <- ggproto("GeomDotplot", Geom, stackposition = tdata$stackpos, stackdir = stackdir, stackratio = stackratio, default.units = "npc", gp = gpar(col = alpha(tdata$colour, tdata$alpha), - fill = alpha(tdata$fill, tdata$alpha), + fill = fill_alpha(tdata$fill, tdata$alpha), lwd = tdata$stroke, lty = tdata$linetype, lineend = lineend)) ) diff --git a/R/geom-hex.R b/R/geom-hex.R index a882979bf1..e3027096f1 100644 --- a/R/geom-hex.R +++ b/R/geom-hex.R @@ -90,7 +90,7 @@ GeomHex <- ggproto("GeomHex", Geom, coords$x, coords$y, gp = gpar( col = data$colour, - fill = alpha(data$fill, data$alpha), + fill = fill_alpha(data$fill, data$alpha), lwd = data$linewidth * .pt, lty = data$linetype, lineend = lineend, diff --git a/R/geom-jitter.R b/R/geom-jitter.R index d6ff8eba9a..52f017dccd 100644 --- a/R/geom-jitter.R +++ b/R/geom-jitter.R @@ -44,8 +44,8 @@ geom_jitter <- function(mapping = NULL, data = NULL, if (!missing(width) || !missing(height)) { if (!missing(position)) { cli::cli_abort(c( - "both {.arg position} and {.arg width}/{.arg height} are supplied", - "i" = "Only use one approach to alter the position" + "Both {.arg position} and {.arg width}/{.arg height} were supplied.", + "i" = "Choose a single approach to alter the position." )) } diff --git a/R/geom-label.R b/R/geom-label.R index be6560b7e6..d83434b386 100644 --- a/R/geom-label.R +++ b/R/geom-label.R @@ -19,8 +19,8 @@ geom_label <- function(mapping = NULL, data = NULL, if (!missing(nudge_x) || !missing(nudge_y)) { if (!missing(position)) { cli::cli_abort(c( - "both {.arg position} and {.arg nudge_x}/{.arg nudge_y} are supplied", - "i" = "Only use one approach to alter the position" + "Both {.arg position} and {.arg nudge_x}/{.arg nudge_y} are supplied.", + "i" = "Choose one approach to alter the position." )) } @@ -103,7 +103,7 @@ GeomLabel <- ggproto("GeomLabel", Geom, ), rect.gp = gpar( col = if (isTRUE(all.equal(label.size, 0))) NA else row$colour, - fill = alpha(row$fill, row$alpha), + fill = fill_alpha(row$fill, row$alpha), lwd = label.size * .pt ) ) @@ -122,7 +122,7 @@ labelGrob <- function(label, x = unit(0.5, "npc"), y = unit(0.5, "npc"), text.gp = gpar(), rect.gp = gpar(fill = "white"), vp = NULL) { if (length(label) != 1) { - cli::cli_abort("{.arg label} must be of length 1") + cli::cli_abort("{.arg label} must be of length 1.") } if (!is.unit(x)) diff --git a/R/geom-linerange.R b/R/geom-linerange.R index 1f2c086010..7144d0084a 100644 --- a/R/geom-linerange.R +++ b/R/geom-linerange.R @@ -101,7 +101,7 @@ GeomLinerange <- ggproto("GeomLinerange", Geom, params$flipped_aes <- has_flipped_aes(data, params, range_is_orthogonal = TRUE) # if flipped_aes == TRUE then y, xmin, xmax is present if (!(params$flipped_aes || all(c("x", "ymin", "ymax") %in% c(names(data), names(params))))) { - cli::cli_abort("Either, {.field x}, {.field ymin}, and {.field ymax} {.emph or} {.field y}, {.field xmin}, and {.field xmax} must be supplied") + cli::cli_abort("Either, {.field x}, {.field ymin}, and {.field ymax} {.emph or} {.field y}, {.field xmin}, and {.field xmax} must be supplied.") } params }, diff --git a/R/geom-map.R b/R/geom-map.R index 987ee864b4..01024ebeff 100644 --- a/R/geom-map.R +++ b/R/geom-map.R @@ -102,7 +102,7 @@ geom_map <- function(mapping = NULL, data = NULL, if (!is.null(map$long)) map$x <- map$long if (!is.null(map$region)) map$id <- map$region if (!all(c("x", "y", "id") %in% names(map))) { - cli::cli_abort("{.arg map} must have the columns {.col x}, {.col y}, and {.col id}") + cli::cli_abort("{.arg map} must have the columns {.col x}, {.col y}, and {.col id}.") } layer( @@ -146,7 +146,7 @@ GeomMap <- ggproto("GeomMap", GeomPolygon, polygonGrob(coords$x, coords$y, default.units = "native", id = grob_id, gp = gpar( col = data$colour, - fill = alpha(data$fill, data$alpha), + fill = fill_alpha(data$fill, data$alpha), lwd = data$linewidth * .pt, lineend = lineend, linejoin = linejoin, diff --git a/R/geom-path.R b/R/geom-path.R index 35d69e06fd..cf9e59976c 100644 --- a/R/geom-path.R +++ b/R/geom-path.R @@ -184,7 +184,7 @@ GeomPath <- ggproto("GeomPath", Geom, solid_lines <- all(attr$solid) constant <- all(attr$constant) if (!solid_lines && !constant) { - cli::cli_abort("{.fn {snake_class(self)}} can't have varying {.field colour}, {.field linewidth}, and/or {.field alpha} along the line when {.field linetype} isn't solid") + cli::cli_abort("{.fn {snake_class(self)}} can't have varying {.field colour}, {.field linewidth}, and/or {.field alpha} along the line when {.field linetype} isn't solid.") } # Work out grouping variables for grobs @@ -351,11 +351,6 @@ stairstep <- function(data, direction = "hv") { } else if (direction == "mid") { xs <- rep(1:(n-1), each = 2) ys <- rep(1:n, each = 2) - } else { - cli::cli_abort(c( - "{.arg direction} is invalid.", - "i" = "Use either {.val vh}, {.val hv}, or {.va mid}" - )) } if (direction == "mid") { diff --git a/R/geom-point.R b/R/geom-point.R index 28e688545c..1b39a11d46 100644 --- a/R/geom-point.R +++ b/R/geom-point.R @@ -131,7 +131,7 @@ GeomPoint <- ggproto("GeomPoint", Geom, pch = coords$shape, gp = gpar( col = alpha(coords$colour, coords$alpha), - fill = alpha(coords$fill, coords$alpha), + fill = fill_alpha(coords$fill, coords$alpha), # Stroke is added around the outside of the point fontsize = coords$size * .pt + stroke_size * .stroke / 2, lwd = coords$stroke * .stroke / 2 @@ -203,14 +203,14 @@ translate_shape_string <- function(shape_string) { if (any(invalid_strings)) { bad_string <- unique0(shape_string[invalid_strings]) - cli::cli_abort("Shape aesthetic contains invalid value{?s}: {.val {bad_string}}") + cli::cli_abort("Shape aesthetic contains invalid value{?s}: {.val {bad_string}}.") } if (any(nonunique_strings)) { bad_string <- unique0(shape_string[nonunique_strings]) cli::cli_abort(c( - "shape names must be given unambiguously", - "i" = "Fix {.val {bad_string}}" + "Shape names must be given unambiguously.", + "i" = "Fix {.val {bad_string}}." )) } diff --git a/R/geom-polygon.R b/R/geom-polygon.R index cfeefa1d12..c644d9daad 100644 --- a/R/geom-polygon.R +++ b/R/geom-polygon.R @@ -132,7 +132,7 @@ GeomPolygon <- ggproto("GeomPolygon", Geom, id = munched$group, gp = gpar( col = first_rows$colour, - fill = alpha(first_rows$fill, first_rows$alpha), + fill = fill_alpha(first_rows$fill, first_rows$alpha), lwd = first_rows$linewidth * .pt, lty = first_rows$linetype, lineend = lineend, @@ -142,8 +142,8 @@ GeomPolygon <- ggproto("GeomPolygon", Geom, ) ) } else { - if (utils::packageVersion('grid') < "3.6") { - cli::cli_abort("Polygons with holes requires R 3.6 or above") + if (getRversion() < "3.6") { + cli::cli_abort("Polygons with holes requires R 3.6 or above.") } # Sort by group to make sure that colors, fill, etc. come in same order munched <- munched[order(munched$group, munched$subgroup), ] @@ -163,7 +163,7 @@ GeomPolygon <- ggproto("GeomPolygon", Geom, rule = rule, gp = gpar( col = first_rows$colour, - fill = alpha(first_rows$fill, first_rows$alpha), + fill = fill_alpha(first_rows$fill, first_rows$alpha), lwd = first_rows$linewidth * .pt, lty = first_rows$linetype, lineend = lineend, diff --git a/R/geom-raster.R b/R/geom-raster.R index b725584082..2cd591d879 100644 --- a/R/geom-raster.R +++ b/R/geom-raster.R @@ -89,7 +89,7 @@ GeomRaster <- ggproto("GeomRaster", Geom, hjust = 0.5, vjust = 0.5) { if (!inherits(coord, "CoordCartesian")) { cli::cli_abort(c( - "{.fn {snake_class(self)}} only works with {.fn coord_cartesian}" + "{.fn {snake_class(self)}} only works with {.fn coord_cartesian}." )) } @@ -102,6 +102,10 @@ GeomRaster <- ggproto("GeomRaster", Geom, nrow <- max(y_pos) + 1 ncol <- max(x_pos) + 1 + if (is.list(data$fill) && is_pattern(data$fill[[1]])) { + cli::cli_abort("{.fn {snake_class(self)}} cannot render pattern fills.") + } + raster <- matrix(NA_character_, nrow = nrow, ncol = ncol) raster[cbind(nrow - y_pos, x_pos + 1)] <- alpha(data$fill, data$alpha) diff --git a/R/geom-rect.R b/R/geom-rect.R index 1d4108345d..d39978897a 100644 --- a/R/geom-rect.R +++ b/R/geom-rect.R @@ -59,7 +59,7 @@ GeomRect <- ggproto("GeomRect", Geom, just = c("left", "top"), gp = gpar( col = coords$colour, - fill = alpha(coords$fill, coords$alpha), + fill = fill_alpha(coords$fill, coords$alpha), lwd = coords$linewidth * .pt, lty = coords$linetype, linejoin = linejoin, diff --git a/R/geom-ribbon.R b/R/geom-ribbon.R index e889bb78a1..d93df77850 100644 --- a/R/geom-ribbon.R +++ b/R/geom-ribbon.R @@ -137,7 +137,7 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, # Check that aesthetics are constant aes <- unique0(data[names(data) %in% c("colour", "fill", "linewidth", "linetype", "alpha")]) if (nrow(aes) > 1) { - cli::cli_abort("Aesthetics can not vary along a ribbon") + cli::cli_abort("Aesthetics can not vary along a ribbon.") } aes <- as.list(aes) @@ -183,7 +183,7 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, munched_poly$x, munched_poly$y, id = munched_poly$id, default.units = "native", gp = gpar( - fill = alpha(aes$fill, aes$alpha), + fill = fill_alpha(aes$fill, aes$alpha), col = if (is_full_outline) aes$colour else NA, lwd = if (is_full_outline) aes$linewidth * .pt else 0, lty = if (is_full_outline) aes$linetype else 1, @@ -200,14 +200,15 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, # Increment the IDs of the lower line so that they will be drawn as separate lines munched_lower$id <- munched_lower$id + max(ids, na.rm = TRUE) + arg_match0( + outline.type, + c("both", "upper", "lower") + ) + munched_lines <- switch(outline.type, both = vec_rbind0(munched_upper, munched_lower), upper = munched_upper, - lower = munched_lower, - cli::cli_abort(c( - "invalid {.arg outline.type}: {.val {outline.type}}", - "i" = "use either {.val upper}, {.val lower}, or {.val both}" - )) + lower = munched_lower ) g_lines <- polylineGrob( munched_lines$x, munched_lines$y, id = munched_lines$id, diff --git a/R/geom-segment.R b/R/geom-segment.R index 611ba85e2c..f32b61f876 100644 --- a/R/geom-segment.R +++ b/R/geom-segment.R @@ -103,7 +103,7 @@ geom_segment <- function(mapping = NULL, data = NULL, #' @export GeomSegment <- ggproto("GeomSegment", Geom, required_aes = c("x", "y", "xend|yend"), - non_missing_aes = c("linetype", "linewidth", "shape"), + non_missing_aes = c("linetype", "linewidth"), default_aes = aes(colour = "black", linewidth = 0.5, linetype = 1, alpha = NA), draw_panel = function(self, data, panel_params, coord, arrow = NULL, arrow.fill = NULL, lineend = "butt", linejoin = "round", na.rm = FALSE) { @@ -111,7 +111,7 @@ GeomSegment <- ggproto("GeomSegment", Geom, data$yend <- data$yend %||% data$y data <- check_linewidth(data, snake_class(self)) data <- remove_missing(data, na.rm = na.rm, - c("x", "y", "xend", "yend", "linetype", "linewidth", "shape"), + c("x", "y", "xend", "yend", "linetype", "linewidth"), name = "geom_segment" ) diff --git a/R/geom-sf.R b/R/geom-sf.R index d641121682..882da40a64 100644 --- a/R/geom-sf.R +++ b/R/geom-sf.R @@ -131,7 +131,7 @@ GeomSf <- ggproto("GeomSf", Geom, lineend = "butt", linejoin = "round", linemitre = 10, arrow = NULL, na.rm = TRUE) { if (!inherits(coord, "CoordSf")) { - cli::cli_abort("{.fn {snake_class(self)}} can only be used with {.fn coord_sf}") + cli::cli_abort("{.fn {snake_class(self)}} can only be used with {.fn coord_sf}.") } # Need to refactor this to generate one grob per geometry type @@ -267,8 +267,8 @@ geom_sf_label <- function(mapping = aes(), data = NULL, if (!missing(nudge_x) || !missing(nudge_y)) { if (!missing(position)) { cli::cli_abort(c( - "both {.arg position} and {.arg nudge_x}/{.arg nudge_y} are supplied", - "i" = "Only use one approach to alter the position" + "Both {.arg position} and {.arg nudge_x}/{.arg nudge_y} are supplied.", + "i" = "Only use one approach to alter the position." )) } @@ -314,8 +314,8 @@ geom_sf_text <- function(mapping = aes(), data = NULL, if (!missing(nudge_x) || !missing(nudge_y)) { if (!missing(position)) { cli::cli_abort(c( - "both {.arg position} and {.arg nudge_x}/{.arg nudge_y} are supplied", - "i" = "Only use one approach to alter the position" + "Both {.arg position} and {.arg nudge_x}/{.arg nudge_y} are supplied.", + "i" = "Only use one approach to alter the position." )) } diff --git a/R/geom-text.R b/R/geom-text.R index 0f4ed1918e..b8c98f7fba 100644 --- a/R/geom-text.R +++ b/R/geom-text.R @@ -170,8 +170,8 @@ geom_text <- function(mapping = NULL, data = NULL, if (!missing(nudge_x) || !missing(nudge_y)) { if (!missing(position)) { cli::cli_abort(c( - "both {.arg position} and {.arg nudge_x}/{.arg nudge_y} are supplied", - "i" = "Only use one approach to alter the position" + "Both {.arg position} and {.arg nudge_x}/{.arg nudge_y} are supplied.", + "i" = "Only use one approach to alter the position." )) } diff --git a/R/geom-tile.R b/R/geom-tile.R index 02a696f430..8bc95fef12 100644 --- a/R/geom-tile.R +++ b/R/geom-tile.R @@ -5,7 +5,8 @@ #' corners (`xmin`, `xmax`, `ymin` and `ymax`), while #' `geom_tile()` uses the center of the tile and its size (`x`, #' `y`, `width`, `height`). `geom_raster()` is a high -#' performance special case for when all the tiles are the same size. +#' performance special case for when all the tiles are the same size, and no +#' pattern fills are applied. #' #' @eval rd_aesthetics("geom", "tile", "Note that `geom_raster()` ignores `colour`.") #' @inheritParams layer diff --git a/R/geom-violin.R b/R/geom-violin.R index c2bfc9f087..4b73100f5d 100644 --- a/R/geom-violin.R +++ b/R/geom-violin.R @@ -164,7 +164,7 @@ GeomViolin <- ggproto("GeomViolin", Geom, # Draw quantiles if requested, so long as there is non-zero y range if (length(draw_quantiles) > 0 & !scales::zero_range(range(data$y))) { if (!(all(draw_quantiles >= 0) && all(draw_quantiles <= 1))) { - cli::cli_abort("{.arg draw_quantiles} must be between 0 and 1") + cli::cli_abort("{.arg draw_quantiles} must be between 0 and 1.") } # Compute the quantile segments and combine with existing aesthetics diff --git a/R/ggproto.R b/R/ggproto.R index 5df2f1d116..e9ccfcf997 100644 --- a/R/ggproto.R +++ b/R/ggproto.R @@ -118,9 +118,9 @@ fetch_ggproto <- function(x, name) { res <- fetch_ggproto(super(), name) } else { cli::cli_abort(c( - "{class(x)[[1]]} was built with an incompatible version of ggproto.", - "i" = "Please reinstall the package that provides this extension. - ")) + "{class(x)[[1]]} was built with an incompatible version of ggproto.", + "i" = "Please reinstall the package that provides this extension." + )) } } diff --git a/R/guide-.R b/R/guide-.R index cdb750ce56..85fb5ee942 100644 --- a/R/guide-.R +++ b/R/guide-.R @@ -224,7 +224,8 @@ Guide <- ggproto( key$.label <- labels if (is.numeric(breaks)) { - vec_slice(key, is.finite(breaks)) + range <- scale$continuous_range %||% scale$get_limits() + key <- vec_slice(key, is.finite(oob_censor_any(breaks, range))) } else { key } diff --git a/R/guide-axis-logticks.R b/R/guide-axis-logticks.R index 5e97d3f193..699b52aee2 100644 --- a/R/guide-axis-logticks.R +++ b/R/guide-axis-logticks.R @@ -154,7 +154,7 @@ GuideAxisLogticks <- ggproto( "{.field {trans_name}} transformation in log-tick positioning." )) } - trans <- log_trans(base = params$prescale_base) + trans <- transform_log(base = params$prescale_base) } else { trans <- scale$scale$trans } diff --git a/R/guide-axis-stack.R b/R/guide-axis-stack.R new file mode 100644 index 0000000000..2fdd73b34e --- /dev/null +++ b/R/guide-axis-stack.R @@ -0,0 +1,242 @@ +#' @include guide-axis.R +NULL + +#' Stacked axis guides +#' +#' This guide can stack other position guides that represent position scales, +#' like those created with [scale_(x|y)_continuous()][scale_x_continuous()] and +#' [scale_(x|y)_discrete()][scale_x_discrete()]. +#' +#' @inheritParams guide_axis +#' @param first A position guide given as one of the following: +#' * A string, for example `"axis"`. +#' * A call to a guide function, for example `guide_axis()`. +#' @param ... Additional guides to stack given in the same manner as `first`. +#' @param spacing A [unit()] objects that determines how far separate guides are +#' spaced apart. +#' +#' @details +#' The `first` guide will be placed closest to the panel and any subsequent +#' guides provided through `...` will follow in the given order. +#' +#' @export +#' +#' @examples +#' #' # A standard plot +#' p <- ggplot(mpg, aes(displ, hwy)) + +#' geom_point() + +#' theme(axis.line = element_line()) +#' +#' # A normal axis first, then a capped axis +#' p + guides(x = guide_axis_stack("axis", guide_axis(cap = "both"))) +guide_axis_stack <- function(first = "axis", ..., title = waiver(), + spacing = NULL, order = 0, position = waiver()) { + + check_object(spacing, is.unit, "{.cls unit}", allow_null = TRUE) + + # Validate guides + axes <- list2(first, ...) + axes <- lapply(axes, validate_guide) + + # Check available aesthetics + available <- lapply(axes, `[[`, name = "available_aes") + available <- vapply(available, function(x) all(c("x", "y") %in% x), logical(1)) + if (all(!available)) { + cli::cli_abort(paste0( + "{.fn guide_axis_stack} can only use guides that handle {.field x} and ", + "{.field y} aesthetics." + )) + } + + # Remove guides that don't support x/y aesthetics + if (any(!available)) { + remove <- which(!available) + removed <- vapply(axes[remove], snake_class, character(1)) + axes[remove] <- NULL + cli::cli_warn(c(paste0( + "{.fn guide_axis_stack} cannot use the following guide{?s}: ", + "{.and {.fn {removed}}}." + ), i = "Guides need to handle {.field x} and {.field y} aesthetics.")) + } + + params <- lapply(axes, `[[`, name = "params") + + new_guide( + title = title, + guides = axes, + guide_params = params, + available_aes = c("x", "y", "theta", "r"), + order = order, + position = position, + name = "stacked_axis", + super = GuideAxisStack + ) +} + +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +GuideAxisStack <- ggproto( + "GuideAxisStack", GuideAxis, + + params = list( + # List of guides to track the guide objects + guides = list(), + # List of parameters to each guide + guide_params = list(), + # Standard guide stuff + name = "stacked_axis", + title = waiver(), + angle = waiver(), + hash = character(), + position = waiver(), + direction = NULL, + order = 0 + ), + + available_aes = c("x", "y", "theta", "r"), + + # Doesn't depend on keys, but on member axis' class + hashables = exprs(title, lapply(guides, snake_class), name), + + # Sets position, loops through guides to train + train = function(self, params = self$params, scale, aesthetic = NULL, ...) { + position <- arg_match0( + params$position, c(.trbl, "theta", "theta.sec"), + arg_nm = "position" + ) + for (i in seq_along(params$guides)) { + params$guide_params[[i]]$position <- position + params$guide_params[[i]]$angle <- params$guide_params[[i]]$angle %|W|% params$angle + params$guide_params[[i]] <- params$guides[[i]]$train( + params = params$guide_params[[i]], + scale = scale, aesthetic = aesthetic, + ... + ) + } + params + }, + + # Just loops through guides + transform = function(self, params, coord, panel_params) { + for (i in seq_along(params$guides)) { + params$guide_params[[i]] <- params$guides[[i]]$transform( + params = params$guide_params[[i]], + coord = coord, panel_params = panel_params + ) + } + params + }, + + # Just loops through guides + get_layer_key = function(params, layers) { + for (i in seq_along(params$guides)) { + params$guide_params[[i]] <- params$guides[[i]]$get_layer_key( + params = params$guide_params[[i]], + layers = layers + ) + } + params + }, + + draw = function(self, theme, position = NULL, direction = NULL, + params = self$params) { + + position <- params$position %||% position + direction <- params$direction %||% direction + + if (position %in% c("theta", "theta.sec")) { + # If we are a theta guide, we need to keep track how much space in the + # radial direction a guide occupies, and add that as an offset to the + # next guide. + offset <- unit(0, "cm") + spacing <- params$spacing %||% unit(2.25, "pt") + grobs <- list() + for (i in seq_along(params$guides)) { + # Add offset to params + pars <- params$guide_params[[i]] + pars$stack_offset <- offset + # Draw guide + grobs[[i]] <- params$guides[[i]]$draw( + theme, position = position, direction = direction, + params = pars + ) + # Increment offset + if (!is.null(grobs[[i]]$offset)) { + offset <- offset + spacing + grobs[[i]]$offset + offset <- convertUnit(offset, "cm") + } + } + grob <- inject(grobTree(!!!grobs)) + return(grob) + } + + # Loop through every guide's draw method + grobs <- list() + for (i in seq_along(params$guides)) { + grobs[[i]] <- params$guides[[i]]$draw( + theme, position = position, direction = direction, + params = params$guide_params[[i]] + ) + } + + # Remove empty grobs + grobs <- grobs[!vapply(grobs, is.zero, logical(1))] + if (length(grobs) == 0) { + return(zeroGrob()) + } + along <- seq_along(grobs) + + # Get sizes + widths <- inject(unit.c(!!!lapply(grobs, grobWidth))) + heights <- inject(unit.c(!!!lapply(grobs, grobHeight))) + + # Set spacing + if (is.null(params$spacing)) { + aes <- if (position %in% c("top", "bottom")) "x" else "y" + spacing <- paste("axis.ticks.length", aes, position, sep = ".") + spacing <- calc_element(spacing, theme) + } else { + spacing <- params$spacing + } + + # Reorder grobs/sizes if necessary + if (position %in% c("top", "left")) { + along <- rev(along) + widths <- rev(widths) + heights <- rev(heights) + } + + # Place guides in a gtable, apply spacing + if (position %in% c("bottom", "top")) { + gt <- gtable(widths = unit(1, "npc"), heights = heights) + gt <- gtable_add_grob(gt, grobs, t = along, l = 1, name = "axis", clip = "off") + gt <- gtable_add_row_space(gt, height = spacing) + vp <- exec( + viewport, + y = unit(as.numeric(position == "bottom"), "npc"), + height = grobHeight(gt), + just = opposite_position(position) + ) + } else { + gt <- gtable(widths = widths, heights = unit(1, "npc")) + gt <- gtable_add_grob(gt, grobs, t = 1, l = along, name = "axis", clip = "off") + gt <- gtable_add_col_space(gt, width = spacing) + vp <- exec( + viewport, + x = unit(as.numeric(position == "left"), "npc"), + width = grobWidth(gt), + just = opposite_position(position) + ) + } + + absoluteGrob( + grob = gList(gt), + width = gtable_width(gt), + height = gtable_height(gt), + vp = vp + ) + } +) + diff --git a/R/guide-axis-theta.R b/R/guide-axis-theta.R index abdc9277c1..c8c8fa3619 100644 --- a/R/guide-axis-theta.R +++ b/R/guide-axis-theta.R @@ -158,6 +158,24 @@ GuideAxisTheta <- ggproto( elements }, + build_decor = function(decor, grobs, elements, params) { + if (is.null(params$stack_offset) || !("theta" %in% names(decor))) { + # Just use regular method if we do not need to offset the guide + decor <- GuideAxis$build_decor(decor, grobs, elements, params) + return(decor) + } + if (empty(decor)) { + return(zeroGrob()) + } + if (params$position == "theta.sec") { + decor$theta <- decor$theta + pi + } + # Add the stacking offset to positions + x <- unit(decor$x, "npc") + sin(decor$theta) * params$stack_offset + y <- unit(decor$y, "npc") + cos(decor$theta) * params$stack_offset + element_grob(elements$line, x = x, y = y) + }, + build_labels = function(key, elements, params) { if (inherits(elements$text, "element_blank")) { @@ -183,9 +201,15 @@ GuideAxisTheta <- ggproto( # Position angle in radians theta <- key$theta + # Add the stacking offset if necessary + offset <- elements$offset + if (!is.null(params$stack_offset)) { + offset <- offset + params$stack_offset + } + # Offset distance to displace text away from outer circle line - xoffset <- elements$offset * sin(theta) - yoffset <- elements$offset * cos(theta) + xoffset <- offset * sin(theta) + yoffset <- offset * cos(theta) # Note that element_grob expects 1 angle for *all* labels, so we're # rendering one grob per label to propagate angle properly @@ -201,14 +225,14 @@ GuideAxisTheta <- ggproto( }, build_ticks = function(key, elements, params, position = params$position) { - + offset <- params$stack_offset major <- theta_tickmarks( vec_slice(key, (key$.type %||% "major") == "major"), - elements$ticks, elements$major_length + elements$ticks, elements$major_length, offset = offset ) minor <- theta_tickmarks( vec_slice(key, (key$.type %||% "major") == "minor"), - elements$minor, elements$minor_length + elements$minor, elements$minor_length, offset = offset ) grobTree(major, minor, name = "ticks") @@ -219,7 +243,63 @@ GuideAxisTheta <- ggproto( # we don't need to measure grob sizes nor arrange the layout. # There is a fallback in `$assemble_drawing()` that takes care of this # for non-polar coordinates. - NULL + if (is.null(params$stack_offset)) { + return(NULL) + } + + # However, when this guide is part of a stacked axis guide, we need to + # know the width of the 'ring' that this guide occupies to correctly + # position the next guide + + offset <- convertUnit(elements$offset, "cm", valueOnly = TRUE) + + key <- params$key + key <- vec_slice(key, !is.na(key$.label) & nzchar(key$.label)) + labels <- key$.label + if (length(labels) == 0 || inherits(elements$text, "element_blank")) { + return(list(offset = offset)) + } + + # Resolve text angle + if (is.waive(params$angle %||% waiver())) { + angle <- elements$text$angle + } else { + angle <- flip_text_angle(params$angle - rad2deg(key$theta)) + } + angle <- key$theta + deg2rad(angle) + + # Set margin + margin <- rep(max(elements$text$margin), length.out = 4) + + # Measure size of each individual label + single_labels <- lapply(labels, function(lab) { + element_grob( + elements$text, label = lab, + margin = margin, margin_x = TRUE, margin_y = TRUE + ) + }) + widths <- width_cm(single_labels) + heights <- height_cm(single_labels) + + # Set text justification + hjust <- 0.5 - sin(angle) / 2 + vjust <- 0.5 - cos(angle) / 2 + + # Calculate text bounding box + xmin <- widths * -hjust + xmax <- widths * (1 - hjust) + + ymin <- heights * -vjust + ymax <- heights * (1 - vjust) + + # Convert to corner coordinates + x <- vec_interleave(xmin, xmin, xmax, xmax) + y <- vec_interleave(ymin, ymax, ymax, ymin) + + # Rotate y coordinate to get maximum height + rotate <- rep(angle, each = 4) + height <- x * sin(rotate) + y * cos(rotate) + list(offset = max(height)) }, arrange_layout = function(key, sizes, params) { @@ -227,8 +307,13 @@ GuideAxisTheta <- ggproto( }, assemble_drawing = function(grobs, layout, sizes, params, elements) { + if (params$position %in% c("theta", "theta.sec")) { - return(inject(grobTree(!!!grobs))) + # We append an 'offset' slot in case this guide is part + # of a stacked guide + grobs <- inject(gList(!!!grobs)) + offset <- unit(sizes$offset %||% 0, "cm") + return(gTree(offset = offset, children = grobs)) } # As a fallback, we adjust the viewport to act like regular axes. @@ -263,7 +348,7 @@ GuideAxisTheta <- ggproto( } ) -theta_tickmarks <- function(key, element, length) { +theta_tickmarks <- function(key, element, length, offset = NULL) { n_breaks <- nrow(key) if (n_breaks < 1 || inherits(element, "element_blank")) { return(zeroGrob()) @@ -274,6 +359,9 @@ theta_tickmarks <- function(key, element, length) { x <- rep(key$x, each = 2) y <- rep(key$y, each = 2) length <- rep(c(0, 1), times = n_breaks) * length + if (!is.null(offset)) { + length <- length + offset + } minor <- element_grob( element, diff --git a/R/guide-axis.R b/R/guide-axis.R index 0e8e49215c..efca81c08e 100644 --- a/R/guide-axis.R +++ b/R/guide-axis.R @@ -570,6 +570,10 @@ axis_label_element_overrides <- function(axis_position, angle = NULL) { check_number_decimal(angle) angle <- angle %% 360 + arg_match0( + axis_position, + c("bottom", "left", "top", "right") + ) if (axis_position == "bottom") { @@ -591,13 +595,6 @@ axis_label_element_overrides <- function(axis_position, angle = NULL) { hjust = if (angle %in% c(90, 270)) 0.5 else if (angle > 90 & angle < 270) 1 else 0 vjust = if (angle %in% c(0, 180)) 0.5 else if (angle < 180) 1 else 0 - } else { - - cli::cli_abort(c( - "Unrecognized {.arg axis_position}: {.val {axis_position}}", - "i" = "Use one of {.val top}, {.val bottom}, {.val left} or {.val right}" - )) - } element_text(angle = angle, hjust = hjust, vjust = vjust) diff --git a/R/guide-bins.R b/R/guide-bins.R index 77ea847b53..54676378bb 100644 --- a/R/guide-bins.R +++ b/R/guide-bins.R @@ -100,6 +100,7 @@ guide_bins <- function( ticks.length = unit(0.2, "npc"), # general + position = NULL, direction = NULL, default.unit = "line", override.aes = list(), @@ -121,6 +122,9 @@ guide_bins <- function( if (!is.null(title.position)) { title.position <- arg_match0(title.position, .trbl) } + if (!is.null(position)) { + position <- arg_match0(position, c(.trbl, "inside")) + } if (!is.null(direction)) { direction <- arg_match0(direction, c("horizontal", "vertical")) } @@ -169,6 +173,7 @@ guide_bins <- function( ticks_length = ticks.length, # general + position = position, direction = direction, override.aes = rename_aes(override.aes), reverse = reverse, @@ -262,6 +267,7 @@ GuideBins <- ggproto( } key$.label <- labels + key <- vec_slice(key, !is.na(oob_censor_any(key$.value))) return(key) }, diff --git a/R/guide-colorbar.R b/R/guide-colorbar.R index 6e2206a26e..374f8ac92e 100644 --- a/R/guide-colorbar.R +++ b/R/guide-colorbar.R @@ -151,6 +151,7 @@ guide_colourbar <- function( draw.llim = TRUE, # general + position = NULL, direction = NULL, default.unit = "line", reverse = FALSE, @@ -171,6 +172,9 @@ guide_colourbar <- function( if (!is.null(title.position)) { title.position <- arg_match0(title.position, .trbl) } + if (!is.null(position)) { + position <- arg_match0(position, c(.trbl, "inside")) + } if (!is.null(direction)) { direction <- arg_match0(direction, c("horizontal", "vertical")) } @@ -240,6 +244,7 @@ guide_colourbar <- function( draw_lim = c(isTRUE(draw.llim), isTRUE(draw.ulim)), # general + position = position, direction = direction, reverse = reverse, order = order, diff --git a/R/guide-colorsteps.R b/R/guide-colorsteps.R index c5315e6da6..7206a4c19e 100644 --- a/R/guide-colorsteps.R +++ b/R/guide-colorsteps.R @@ -181,6 +181,8 @@ GuideColoursteps <- ggproto( params$key$.value <- rescale(params$key$.value, from = limits) params$decor$min <- rescale(params$decor$min, from = limits) params$decor$max <- rescale(params$decor$max, from = limits) + params$key <- + vec_slice(params$key, !is.na(oob_censor_any(params$key$.value))) params }, diff --git a/R/guide-custom.R b/R/guide-custom.R new file mode 100644 index 0000000000..bca9e0214d --- /dev/null +++ b/R/guide-custom.R @@ -0,0 +1,159 @@ +#' Custom guides +#' +#' This is a special guide that can be used to display any graphical object +#' (grob) along with the regular guides. This guide has no associated scale. +#' +#' @param grob A grob to display. +#' @param width,height The allocated width and height to display the grob, given +#' in [grid::unit()]s. +#' @param title A character string or expression indicating the title of guide. +#' If `NULL` (default), no title is shown. +#' @param title.position A character string indicating the position of a title. +#' One of `"top"` (default), `"bottom"`, `"left"` or `"right"`. +#' @param margin Margins around the guide. See [margin()] for more details. If +#' `NULL` (default), margins are taken from the `legend.margin` theme setting. +#' @param position Currently not in use. +#' @inheritParams guide_legend +#' +#' @export +#' +#' @examples +#' # A standard plot +#' p <- ggplot(mpg, aes(displ, hwy)) + +#' geom_point() +#' +#' # Define a graphical object +#' circle <- grid::circleGrob() +#' +#' # Rendering a grob as a guide +#' p + guides(custom = guide_custom(circle, title = "My circle")) +#' +#' # Controlling the size of the grob defined in relative units +#' p + guides(custom = guide_custom( +#' circle, title = "My circle", +#' width = unit(2, "cm"), height = unit(2, "cm")) +#' ) +#' +#' # Size of grobs in absolute units is taken directly without the need to +#' # set these manually +#' p + guides(custom = guide_custom( +#' title = "My circle", +#' grob = grid::circleGrob(r = unit(1, "cm")) +#' )) +guide_custom <- function( + grob, width = grobWidth(grob), height = grobHeight(grob), + title = NULL, title.position = "top", margin = NULL, + position = NULL, order = 0 +) { + check_object(grob, is.grob, "a {.cls grob} object") + check_object(width, is.unit, "a {.cls unit} object") + check_object(height, is.unit, "a {.cls unit} object") + check_object(margin, is.margin, "a {.cls margin} object", allow_null = TRUE) + if (length(width) != 1) { + cli::cli_abort("{.arg width} must be a single {.cls unit}, not a unit vector.") + } + if (length(height) != 1) { + cli::cli_abort("{.arg height} must be a single {.cls unit}, not a unit vector.") + } + title.position <- arg_match0(title.position, .trbl) + + new_guide( + grob = grob, + width = width, + height = height, + title = title, + title.position = title.position, + margin = margin, + hash = hash(list(title, grob)), # hash is already known + position = position, + order = order, + available_aes = "any", + super = GuideCustom + ) +} + +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +GuideCustom <- ggproto( + "GuideCustom", Guide, + + params = c(Guide$params, list( + grob = NULL, width = NULL, height = NULL, + margin = NULL, + title = NULL, + title.position = "top" + )), + + hashables = exprs(title, grob), + + elements = list( + background = "legend.background", + theme.margin = "legend.margin", + theme.title = "legend.title" + ), + + train = function(...) { + params + }, + + transform = function(...) { + params + }, + + override_elements = function(params, elements, theme) { + elements$title <- elements$theme.title + elements$margin <- params$margin %||% elements$theme.margin + elements + }, + + draw = function(self, theme, position = NULL, direction = NULL, + params = self$params) { + + # Render title + elems <- self$setup_elements(params, self$elements, theme) + elems <- self$override_elements(params, elems, theme) + if (!is.waive(params$title) && !is.null(params$title)) { + title <- self$build_title(params$title, elems, params) + } else { + title <- zeroGrob() + } + title.position <- params$title.position + if (is.zero(title)) { + title.position <- "none" + } + + width <- convertWidth(params$width, "cm") + height <- convertHeight(params$height, "cm") + gt <- gtable(widths = width, heights = height) + gt <- gtable_add_grob(gt, params$grob, t = 1, l = 1, clip = "off") + + if (params$title.position == "top") { + gt <- gtable_add_rows(gt, elems$margin[1], pos = 0) + gt <- gtable_add_rows(gt, unit(height_cm(title), "cm"), pos = 0) + gt <- gtable_add_grob(gt, title, t = 1, l = 1, name = "title", clip = "off") + } else if (params$title.position == "bottom") { + gt <- gtable_add_rows(gt, elems$margin[3], pos = -1) + gt <- gtable_add_rows(gt, unit(height_cm(title), "cm"), pos = -1) + gt <- gtable_add_grob(gt, title, t = -1, l = 1, name = "title", clip = "off") + } else if (params$title.position == "left") { + gt <- gtable_add_cols(gt, elems$margin[4], pos = 0) + gt <- gtable_add_cols(gt, unit(width_cm(title), "cm"), pos = 0) + gt <- gtable_add_grob(gt, title, t = 1, l = 1, name = "title", clip = "off") + } else if (params$title.position == "right") { + gt <- gtable_add_cols(gt, elems$margin[2], pos = -1) + gt <- gtable_add_cols(gt, unit(width_cm(title), "cm"), pos = 0) + gt <- gtable_add_grob(gt, title, t = 1, l = -1, name = "title", clip = "off") + } + gt <- gtable_add_padding(gt, elems$margin) + + background <- element_grob(elems$background) + gt <- gtable_add_grob( + gt, background, + t = 1, l = 1, r = -1, b = -1, + z = -Inf, clip = "off" + ) + gt + } +) diff --git a/R/guide-legend.R b/R/guide-legend.R index cb5d671393..910ef12cc3 100644 --- a/R/guide-legend.R +++ b/R/guide-legend.R @@ -46,6 +46,8 @@ #' object specifying the distance between key-label pairs in the horizontal #' direction (`key.spacing.x`), vertical direction (`key.spacing.y`) or both #' (`key.spacing`). +#' @param position A character string indicating where the legend should be +#' placed relative to the plot panels. #' @param direction A character string indicating the direction of the guide. #' One of "horizontal" or "vertical." #' @param default.unit A character string indicating [grid::unit()] @@ -152,6 +154,7 @@ guide_legend <- function( key.spacing.y = NULL, # General + position = NULL, direction = NULL, default.unit = "line", override.aes = list(), @@ -187,6 +190,9 @@ guide_legend <- function( if (!is.null(label.position)) { label.position <- arg_match0(label.position, .trbl) } + if (!is.null(position)) { + position <- arg_match0(position, c(.trbl, "inside")) + } new_guide( # Title @@ -217,6 +223,7 @@ guide_legend <- function( byrow = byrow, reverse = reverse, order = order, + position = position, # Fixed parameters available_aes = "any", @@ -395,7 +402,7 @@ GuideLegend <- ggproto( params$nrow * params$ncol < n_breaks) { cli::cli_abort(paste0( "{.arg nrow} * {.arg ncol} needs to be larger than the number of ", - "breaks ({n_breaks})" + "breaks ({n_breaks})." )) } if (is.null(params$nrow) && is.null(params$ncol)) { diff --git a/R/guides-.R b/R/guides-.R index 19348ec157..c44fc06907 100644 --- a/R/guides-.R +++ b/R/guides-.R @@ -248,10 +248,22 @@ Guides <- ggproto( ) }, + get_custom = function(self) { + custom <- vapply(self$guides, inherits, logical(1), what = "GuideCustom") + n_custom <- sum(custom) + if (n_custom < 1) { + return(guides_list()) + } + custom <- guides_list(self$guides[custom]) + custom$params <- lapply(custom$guides, `[[`, "params") + custom$merge() + custom + }, + ## Building ------------------------------------------------------------------ - # The `Guides$build()` method is called in ggplotGrob (plot-build.R) and makes - # the guide box for *non-position* scales. + # The `Guides$build()` method is called in ggplot_build (plot-build.R) and + # collects all information needed from the plot. # Note that position scales are handled in `Coord`s, which have their own # procedures to do equivalent steps. # @@ -271,17 +283,13 @@ Guides <- ggproto( # 3. Guides$process_layers() # process layer information and generate geom info. # - # 4. Guides$draw() - # generate guide grob from each guide object - # one guide grob for one guide object - # - # 5. Guides$assemble() - # arrange all guide grobs + # The resulting guide is then drawn in ggplot_gtable build = function(self, scales, layers, labels, layer_data) { # Empty guides list - no_guides <- guides_list() + custom <- self$get_custom() + no_guides <- custom # Extract the non-position scales scales <- scales$non_position_scales()$scales @@ -308,6 +316,10 @@ Guides <- ggproto( if (length(guides$guides) == 0) { return(no_guides) } + + guides$guides <- c(guides$guides, custom$guides) + guides$params <- c(guides$params, custom$params) + guides }, @@ -413,11 +425,6 @@ Guides <- ggproto( # Bundle together guides and their parameters pairs <- Map(list, guide = self$guides, params = self$params) - # If there is only one guide, we can exit early, because nothing to merge - if (length(pairs) == 1) { - return() - } - # The `{order}_{hash}` combination determines groups of guides orders <- vapply(self$params, `[[`, 0, "order") orders[orders == 0] <- 99 @@ -425,10 +432,16 @@ Guides <- ggproto( hashes <- vapply(self$params, `[[`, "", "hash") hashes <- paste(orders, hashes, sep = "_") + # If there is only one guide, we can exit early, because nothing to merge + if (length(pairs) == 1) { + names(self$guides) <- hashes + return() + } + # Split by hashes indices <- split(seq_along(pairs), hashes) indices <- vapply(indices, `[[`, 0L, 1L, USE.NAMES = FALSE) # First index - groups <- unname(split(pairs, hashes)) + groups <- split(pairs, hashes) lens <- lengths(groups) # Merge groups with >1 member @@ -458,48 +471,105 @@ Guides <- ggproto( invisible() }, - # Loop over every guide, let them draw their grobs - draw = function(self, theme, position, direction) { - Map( - function(guide, params) guide$draw(theme, position, direction, params), - guide = self$guides, - params = self$params - ) - }, - + # The `Guides$assemble()` method is called in ggplot_gtable (plot-build.R) and + # applies the styling from the theme to render each guide and package them + # into guide boxes. + # + # The procedure is as follows + # + # 1. Guides$draw() + # for every guide object, draw one grob, + # then group the grobs in a list per position + # + # 2. Guides$package_box() + # for every position, collect all individual guides and arrange them + # into a guide box which will be inserted into the main gtable # Combining multiple guides in a guide box - assemble = function(self, theme, position) { + assemble = function(self, theme) { if (length(self$guides) < 1) { return(zeroGrob()) } - position <- legend_position(position) - if (position == "none") { + default_position <- theme$legend.position %||% "right" + if (length(default_position) == 2) { + default_position <- "inside" + } + if (default_position == "none") { return(zeroGrob()) } - default_direction <- if (position == "inside") "vertical" else position - theme$legend.key.width <- theme$legend.key.width %||% theme$legend.key.size - theme$legend.key.height <- theme$legend.key.height %||% theme$legend.key.size - theme$legend.box <- theme$legend.box %||% default_direction - theme$legend.direction <- theme$legend.direction %||% default_direction - theme$legend.box.just <- theme$legend.box.just %||% switch( - position, - inside = c("center", "center"), - vertical = c("left", "top"), - horizontal = c("center", "top") - ) + # Populate key sizes + theme$legend.key.width <- calc_element("legend.key.width", theme) + theme$legend.key.height <- calc_element("legend.key.height", theme) - grobs <- self$draw(theme, position, theme$legend.direction) + grobs <- self$draw(theme, default_position, theme$legend.direction) if (length(grobs) < 1) { return(zeroGrob()) } + grobs <- grobs[order(names(grobs))] # Set spacing - theme$legend.spacing <- theme$legend.spacing %||% unit(0.5, "lines") - theme$legend.spacing.y <- theme$legend.spacing.y %||% theme$legend.spacing - theme$legend.spacing.x <- theme$legend.spacing.x %||% theme$legend.spacing + theme$legend.spacing <- theme$legend.spacing %||% unit(0.5, "lines") + theme$legend.spacing.y <- calc_element("legend.spacing.y", theme) + theme$legend.spacing.x <- calc_element("legend.spacing.x", theme) + + Map( + grobs = grobs, + position = names(grobs), + self$package_box, + MoreArgs = list(theme = theme) + ) + }, + + # Render the guides into grobs + draw = function(self, theme, + default_position = "right", + direction = NULL, + params = self$params, + guides = self$guides) { + positions <- vapply( + params, + function(p) p$position[1] %||% default_position, + character(1) + ) + positions <- factor(positions, levels = c(.trbl, "inside")) + + directions <- rep(direction %||% "vertical", length(positions)) + if (is.null(direction)) { + directions[positions %in% c("top", "bottom")] <- "horizontal" + } + + grobs <- vector("list", length(guides)) + for (i in seq_along(grobs)) { + grobs[[i]] <- guides[[i]]$draw( + theme = theme, position = as.character(positions[i]), + direction = directions[i], params = params[[i]] + ) + } + split(grobs, positions) + }, + + package_box = function(grobs, position, theme) { + + if (is.zero(grobs) || length(grobs) == 0) { + return(zeroGrob()) + } + + # Determine default direction + direction <- switch( + position, + inside = , left = , right = "vertical", + top = , bottom = "horizontal" + ) + + # Populate missing theme arguments + theme$legend.box <- theme$legend.box %||% direction + theme$legend.box.just <- theme$legend.box.just %||% switch( + direction, + vertical = c("left", "top"), + horizontal = c("center", "top") + ) # Measure guides widths <- lapply(grobs, function(g) sum(g$widths)) @@ -507,54 +577,95 @@ Guides <- ggproto( heights <- lapply(grobs, function(g) sum(g$heights)) heights <- inject(unit.c(!!!heights)) + # Global justification of the complete legend box + global_just <- paste0("legend.justification.", position) + global_just <- valid.just(calc_element(global_just, theme)) + + if (position == "inside") { + # The position of inside legends are set by their justification + inside_position <- theme$legend.position.inside %||% global_just + global_xjust <- inside_position[1] + global_yjust <- inside_position[2] + global_margin <- margin() + } else { + global_xjust <- global_just[1] + global_yjust <- global_just[2] + # Legends to the side of the plot need a margin for justification + # relative to the plot panel + global_margin <- margin( + t = 1 - global_yjust, b = global_yjust, + r = 1 - global_xjust, l = global_xjust, + unit = "null" + ) + } + # Set the justification of each legend within the legend box # First value is xjust, second value is yjust - just <- valid.just(theme$legend.box.just) - xjust <- just[1] - yjust <- just[2] + box_just <- valid.just(theme$legend.box.just) + box_xjust <- box_just[1] + box_yjust <- box_just[2] # setting that is different for vertical and horizontal guide-boxes. if (identical(theme$legend.box, "horizontal")) { - # Set justification for each legend + # Set justification for each legend within the box for (i in seq_along(grobs)) { grobs[[i]] <- editGrob( grobs[[i]], - vp = viewport(x = xjust, y = yjust, just = c(xjust, yjust), + vp = viewport(x = box_xjust, y = box_yjust, just = box_just, height = heightDetails(grobs[[i]])) ) } + spacing <- theme$legend.spacing.x - guides <- gtable_row(name = "guides", - grobs = grobs, - widths = widths, height = max(heights)) + # Set global justification + vp <- viewport( + x = global_xjust, y = global_yjust, just = global_just, + height = max(heights), + width = sum(widths, spacing * (length(grobs) - 1L)) + ) + + # Initialise gtable as legends in a row + guides <- gtable_row( + name = "guides", grobs = grobs, + widths = widths, height = max(heights), + vp = vp + ) - # add space between the guide-boxes - guides <- gtable_add_col_space(guides, theme$legend.spacing.x) + # Add space between the guide-boxes + guides <- gtable_add_col_space(guides, spacing) } else { # theme$legend.box == "vertical" - # Set justification for each legend + # Set justification for each legend within the box for (i in seq_along(grobs)) { grobs[[i]] <- editGrob( grobs[[i]], - vp = viewport(x = xjust, y = yjust, just = c(xjust, yjust), + vp = viewport(x = box_xjust, y = box_yjust, just = box_just, width = widthDetails(grobs[[i]])) ) } + spacing <- theme$legend.spacing.y + + # Set global justification + vp <- viewport( + x = global_xjust, y = global_yjust, just = global_just, + height = sum(heights, spacing * (length(grobs) - 1L)), + width = max(widths) + ) - guides <- gtable_col(name = "guides", - grobs = grobs, - width = max(widths), heights = heights) + # Initialise gtable as legends in a column + guides <- gtable_col( + name = "guides", grobs = grobs, + width = max(widths), heights = heights, + vp = vp + ) - # add space between the guide-boxes - guides <- gtable_add_row_space(guides, theme$legend.spacing.y) + # Add space between the guide-boxes + guides <- gtable_add_row_space(guides, spacing) } # Add margins around the guide-boxes. margin <- theme$legend.box.margin %||% margin() - guides <- gtable_add_cols(guides, margin[4], pos = 0) - guides <- gtable_add_cols(guides, margin[2], pos = ncol(guides)) - guides <- gtable_add_rows(guides, margin[1], pos = 0) - guides <- gtable_add_rows(guides, margin[3], pos = nrow(guides)) + guides <- gtable_add_padding(guides, margin) # Add legend box background background <- element_grob(theme$legend.box.background %||% element_blank()) @@ -565,6 +676,10 @@ Guides <- ggproto( z = -Inf, clip = "off", name = "legend.box.background" ) + + # Set global margin + guides <- gtable_add_padding(guides, global_margin) + guides$name <- "guide-box" guides }, diff --git a/R/labeller.R b/R/labeller.R index 8d2a3884be..442f05d496 100644 --- a/R/labeller.R +++ b/R/labeller.R @@ -241,12 +241,12 @@ is_labeller <- function(x) inherits(x, "labeller") resolve_labeller <- function(rows, cols, labels) { if (is.null(cols) && is.null(rows)) { - cli::cli_abort("Supply one of {.arg rows} or {.arg cols}") + cli::cli_abort("Supply one of {.arg rows} or {.arg cols}.") } if (attr(labels, "facet") == "wrap") { # Return either rows or cols for facet_wrap() if (!is.null(cols) && !is.null(rows)) { - cli::cli_abort("Cannot supply both {.arg rows} and {.arg cols} to {.fn facet_wrap}") + cli::cli_abort("Cannot supply both {.arg rows} and {.arg cols} to {.fn facet_wrap}.") } cols %||% rows } else { @@ -441,7 +441,7 @@ labeller <- function(..., .rows = NULL, .cols = NULL, # Check that variable-specific labellers do not overlap with # margin-wide labeller if (any(names(dots) %in% names(labels))) { - cli::cli_abort("Conflict between {.var {paste0('.', attr(labels, 'type'))}} and {.var {names(dots)}}") + cli::cli_abort("Conflict between {.var {paste0('.', attr(labels, 'type'))}} and {.var {names(dots)}}.") } } diff --git a/R/layer.R b/R/layer.R index 9686aec881..eb590f8dea 100644 --- a/R/layer.R +++ b/R/layer.R @@ -171,7 +171,7 @@ layer <- function(geom = NULL, stat = NULL, validate_mapping <- function(mapping, call = caller_env()) { if (!inherits(mapping, "uneval")) { - msg <- paste0("{.arg mapping} must be created by {.fn aes}") + msg <- "{.arg mapping} must be created by {.fn aes}." # Native pipe have higher precedence than + so any type of gg object can be # expected here, not just ggplot if (inherits(mapping, "gg")) { @@ -221,7 +221,7 @@ Layer <- ggproto("Layer", NULL, } else if (is.function(self$data)) { data <- self$data(plot_data) if (!is.data.frame(data)) { - cli::cli_abort("{.fn layer_data} must return a {.cls data.frame}") + cli::cli_abort("{.fn layer_data} must return a {.cls data.frame}.") } } else { data <- self$data @@ -445,7 +445,7 @@ check_subclass <- function(x, subclass, obj <- find_global(name, env = env) if (is.null(obj) || !inherits(obj, subclass)) { - cli::cli_abort("Can't find {argname} called {.val {x}}", call = call) + cli::cli_abort("Can't find {argname} called {.val {x}}.", call = call) } else { obj } diff --git a/R/layout.R b/R/layout.R index e6a292932c..150d9abe59 100644 --- a/R/layout.R +++ b/R/layout.R @@ -306,8 +306,8 @@ scale_apply <- function(data, vars, method, scale_id, scales) { if (length(vars) == 0) return() if (nrow(data) == 0) return() - if (any(is.na(scale_id))) { - cli::cli_abort("{.arg scale_id} must not contain any {.val NA}") + if (anyNA(scale_id)) { + cli::cli_abort("{.arg scale_id} must not contain any {.val NA}.") } scale_index <- split_with_index(seq_along(scale_id), scale_id, length(scales)) diff --git a/R/legend-draw.R b/R/legend-draw.R index 3cc22857f9..8ee116f65c 100644 --- a/R/legend-draw.R +++ b/R/legend-draw.R @@ -38,7 +38,7 @@ draw_key_point <- function(data, params, size) { pch = data$shape, gp = gpar( col = alpha(data$colour %||% "black", data$alpha), - fill = alpha(data$fill %||% "black", data$alpha), + fill = fill_alpha(data$fill %||% "black", data$alpha), fontsize = (data$size %||% 1.5) * .pt + stroke_size * .stroke / 2, lwd = stroke_size * .stroke / 2 ) @@ -63,7 +63,7 @@ draw_key_abline <- function(data, params, size) { draw_key_rect <- function(data, params, size) { rectGrob(gp = gpar( col = NA, - fill = alpha(data$fill %||% data$colour %||% "grey20", data$alpha), + fill = fill_alpha(data$fill %||% data$colour %||% "grey20", data$alpha), lty = data$linetype %||% 1 )) } @@ -81,7 +81,7 @@ draw_key_polygon <- function(data, params, size) { height = unit(1, "npc") - unit(lwd, "mm"), gp = gpar( col = data$colour %||% NA, - fill = alpha(data$fill %||% "grey20", data$alpha), + fill = fill_alpha(data$fill %||% "grey20", data$alpha), lty = data$linetype %||% 1, lwd = lwd * .pt, linejoin = params$linejoin %||% "mitre", @@ -100,7 +100,7 @@ draw_key_blank <- function(data, params, size) { draw_key_boxplot <- function(data, params, size) { gp <- gpar( col = data$colour %||% "grey20", - fill = alpha(data$fill %||% "white", data$alpha), + fill = fill_alpha(data$fill %||% "white", data$alpha), lwd = (data$linewidth %||% 0.5) * .pt, lty = data$linetype %||% 1, lineend = params$lineend %||% "butt", @@ -131,7 +131,7 @@ draw_key_boxplot <- function(data, params, size) { draw_key_crossbar <- function(data, params, size) { gp <- gpar( col = data$colour %||% "grey20", - fill = alpha(data$fill %||% "white", data$alpha), + fill = fill_alpha(data$fill %||% "white", data$alpha), lwd = (data$linewidth %||% 0.5) * .pt, lty = data$linetype %||% 1, lineend = params$lineend %||% "butt", @@ -195,7 +195,7 @@ draw_key_dotplot <- function(data, params, size) { pch = 21, gp = gpar( col = alpha(data$colour %||% "black", data$alpha), - fill = alpha(data$fill %||% "black", data$alpha), + fill = fill_alpha(data$fill %||% "black", data$alpha), lty = data$linetype %||% 1, lineend = params$lineend %||% "butt" ) diff --git a/R/limits.R b/R/limits.R index 727df98326..be1a42ba6f 100644 --- a/R/limits.R +++ b/R/limits.R @@ -80,8 +80,8 @@ lims <- function(...) { args <- list2(...) - if (any(!has_name(args))) { - cli::cli_abort("All arguments must be named") + if (!all(has_name(args))) { + cli::cli_abort("All arguments must be named.") } env <- current_env() Map(limits, args, names(args), rep(list(env), length(args))) @@ -114,7 +114,7 @@ limits <- function(lims, var, call = caller_env()) UseMethod("limits") #' @export limits.numeric <- function(lims, var, call = caller_env()) { if (length(lims) != 2) { - cli::cli_abort("{.arg {var}} must be a two-element vector", call = call) + cli::cli_abort("{.arg {var}} must be a two-element vector.", call = call) } if (!any(is.na(lims)) && lims[1] > lims[2]) { trans <- "reverse" @@ -144,21 +144,21 @@ limits.factor <- function(lims, var, call = caller_env()) { #' @export limits.Date <- function(lims, var, call = caller_env()) { if (length(lims) != 2) { - cli::cli_abort("{.arg {var}} must be a two-element vector", call = call) + cli::cli_abort("{.arg {var}} must be a two-element vector.", call = call) } make_scale("date", var, limits = lims, call = call) } #' @export limits.POSIXct <- function(lims, var, call = caller_env()) { if (length(lims) != 2) { - cli::cli_abort("{.arg {var}} must be a two-element vector", call = call) + cli::cli_abort("{.arg {var}} must be a two-element vector.", call = call) } make_scale("datetime", var, limits = lims, call = call) } #' @export limits.POSIXlt <- function(lims, var, call = caller_env()) { if (length(lims) != 2) { - cli::cli_abort("{.arg {var}} must be a two-element vector", call = call) + cli::cli_abort("{.arg {var}} must be a two-element vector.", call = call) } make_scale("datetime", var, limits = as.POSIXct(lims), call = call) } diff --git a/R/plot-build.R b/R/plot-build.R index 10ffaa9ae5..2a46b31514 100644 --- a/R/plot-build.R +++ b/R/plot-build.R @@ -51,6 +51,7 @@ ggplot_build.ggplot <- function(plot) { # Compute aesthetics to produce data with generalised variable names data <- by_layer(function(l, d) l$compute_aesthetics(d, plot), layers, data, "computing aesthetics") + data <- .ignore_data(data) # Transform all scales data <- lapply(data, scales$transform_df) @@ -62,6 +63,7 @@ ggplot_build.ggplot <- function(plot) { layout$train_position(data, scale_x(), scale_y()) data <- layout$map_position(data) + data <- .expose_data(data) # Apply and map statistics data <- by_layer(function(l, d) l$compute_statistic(d, layout), layers, data, "computing stat") @@ -79,6 +81,7 @@ ggplot_build.ggplot <- function(plot) { # Reset position scales, then re-train and map. This ensures that facets # have control over the range of a plot: is it generated from what is # displayed, or does it include the range of underlying data + data <- .ignore_data(data) layout$reset_scales() layout$train_position(data, scale_x(), scale_y()) layout$setup_panel_params() @@ -94,9 +97,10 @@ ggplot_build.ggplot <- function(plot) { plot$guides <- plot$guides$build(npscales, plot$layers, plot$labels, data) data <- lapply(data, npscales$map_df) } else { - # Assign empty guides if there are no non-position scales - plot$guides <- guides_list() + # Only keep custom guides if there are no non-position scales + plot$guides <- plot$guides$get_custom() } + data <- .expose_data(data) # Fill in defaults etc. data <- by_layer(function(l, d) l$compute_geom_2(d), layers, data, "setting up geom aesthetics") @@ -178,102 +182,28 @@ ggplot_gtable.ggplot_built <- function(data) { plot_table <- layout$render(geom_grobs, data, theme, plot$labels) # Legends - position <- theme$legend.position %||% "right" - if (length(position) == 2) { - position <- "manual" - } - - legend_box <- plot$guides$assemble(theme, position) - - if (is.zero(legend_box)) { - position <- "none" - } else { - # these are a bad hack, since it modifies the contents of viewpoint directly... - legend_width <- gtable_width(legend_box) - legend_height <- gtable_height(legend_box) - - # Set the justification of the legend box - # First value is xjust, second value is yjust - just <- valid.just(theme$legend.justification) - xjust <- just[1] - yjust <- just[2] - - if (position == "manual") { - xpos <- theme$legend.position[1] - ypos <- theme$legend.position[2] - - # x and y are specified via theme$legend.position (i.e., coords) - legend_box <- editGrob( - legend_box, - vp = viewport( - x = xpos, - y = ypos, - just = c(xjust, yjust), - height = legend_height, - width = legend_width - ) - ) - } else { - # x and y are adjusted using justification of legend box (i.e., theme$legend.justification) - legend_box <- editGrob( - legend_box, - vp = viewport( - x = xjust, - y = yjust, - just = c(xjust, yjust), - height = legend_height, - width = legend_width - ) - ) - legend_box <- gtable_add_rows(legend_box, unit(yjust, 'null')) - legend_box <- gtable_add_rows(legend_box, unit(1 - yjust, 'null'), 0) - legend_box <- gtable_add_cols(legend_box, unit(xjust, 'null'), 0) - legend_box <- gtable_add_cols(legend_box, unit(1 - xjust, 'null')) - } - } - - panel_dim <- find_panel(plot_table) - # for align-to-device, use this: - # panel_dim <- summarise(plot_table$layout, t = min(t), r = max(r), b = max(b), l = min(l)) - - theme$legend.box.spacing <- theme$legend.box.spacing %||% unit(0.2, 'cm') - if (position == "left") { - plot_table <- gtable_add_cols(plot_table, theme$legend.box.spacing, pos = 0) - plot_table <- gtable_add_cols(plot_table, legend_width, pos = 0) - plot_table <- gtable_add_grob(plot_table, legend_box, clip = "off", - t = panel_dim$t, b = panel_dim$b, l = 1, r = 1, name = "guide-box") - } else if (position == "right") { - plot_table <- gtable_add_cols(plot_table, theme$legend.box.spacing, pos = -1) - plot_table <- gtable_add_cols(plot_table, legend_width, pos = -1) - plot_table <- gtable_add_grob(plot_table, legend_box, clip = "off", - t = panel_dim$t, b = panel_dim$b, l = -1, r = -1, name = "guide-box") - } else if (position == "bottom") { - plot_table <- gtable_add_rows(plot_table, theme$legend.box.spacing, pos = -1) - plot_table <- gtable_add_rows(plot_table, legend_height, pos = -1) - plot_table <- gtable_add_grob(plot_table, legend_box, clip = "off", - t = -1, b = -1, l = panel_dim$l, r = panel_dim$r, name = "guide-box") - } else if (position == "top") { - plot_table <- gtable_add_rows(plot_table, theme$legend.box.spacing, pos = 0) - plot_table <- gtable_add_rows(plot_table, legend_height, pos = 0) - plot_table <- gtable_add_grob(plot_table, legend_box, clip = "off", - t = 1, b = 1, l = panel_dim$l, r = panel_dim$r, name = "guide-box") - } else if (position == "manual") { - # should guide box expand whole region or region without margin? - plot_table <- gtable_add_grob(plot_table, legend_box, - t = panel_dim$t, b = panel_dim$b, l = panel_dim$l, r = panel_dim$r, - clip = "off", name = "guide-box") - } + legend_box <- plot$guides$assemble(theme) + plot_table <- table_add_legends(plot_table, legend_box, theme) # Title - title <- element_render(theme, "plot.title", plot$labels$title, margin_y = TRUE) + title <- element_render( + theme, "plot.title", plot$labels$title, + margin_y = TRUE, margin_x = TRUE + ) title_height <- grobHeight(title) # Subtitle - subtitle <- element_render(theme, "plot.subtitle", plot$labels$subtitle, margin_y = TRUE) + subtitle <- element_render( + theme, "plot.subtitle", plot$labels$subtitle, + margin_y = TRUE, margin_x = TRUE + ) subtitle_height <- grobHeight(subtitle) # whole plot annotation - caption <- element_render(theme, "plot.caption", plot$labels$caption, margin_y = TRUE) + caption <- element_render( + theme, "plot.caption", plot$labels$caption, + margin_y = TRUE, margin_x = TRUE + ) caption_height <- grobHeight(caption) # positioning of title and subtitle is governed by plot.title.position @@ -362,7 +292,12 @@ by_layer <- function(f, layers, data, step = NULL) { out[[i]] <- f(l = layers[[i]], d = data[[i]]) }, error = function(cnd) { - cli::cli_abort(c("Problem while {step}.", "i" = "Error occurred in the {ordinal(i)} layer."), call = layers[[i]]$constructor, parent = cnd) + cli::cli_abort(c( + "Problem while {step}.", + "i" = "Error occurred in the {ordinal(i)} layer."), + call = layers[[i]]$constructor, + parent = cnd + ) } ) out @@ -391,14 +326,16 @@ table_add_tag <- function(table, label, theme) { if (location == "margin") { cli::cli_abort(paste0( "A {.cls numeric} {.arg plot.tag.position} cannot be used with ", - "{.code \"margin\"} as {.arg plot.tag.location}." - )) + "`{.val margin}` as {.arg plot.tag.location}." + ), + call = expr(theme())) } if (length(position) != 2) { cli::cli_abort(paste0( "A {.cls numeric} {.arg plot.tag.position} ", "theme setting must have length 2." - )) + ), + call = expr(theme())) } top <- left <- right <- bottom <- FALSE } else { @@ -407,7 +344,8 @@ table_add_tag <- function(table, label, theme) { position[1], c("topleft", "top", "topright", "left", "right", "bottomleft", "bottom", "bottomright"), - arg_nm = "plot.tag.position" + arg_nm = "plot.tag.position", + error_call = expr(theme()) ) top <- position %in% c("topleft", "top", "topright") left <- position %in% c("topleft", "left", "bottomleft") @@ -481,3 +419,94 @@ table_add_tag <- function(table, label, theme) { t = place$t, l = place$l, b = place$b, r = place$r ) } + +# Add the legends to the gtable +table_add_legends <- function(table, legends, theme) { + + if (is.zero(legends)) { + legends <- rep(list(zeroGrob()), 5) + names(legends) <- c(.trbl, "inside") + } + + # Extract sizes + widths <- heights <- set_names( + rep(list(unit(0, "cm")), length(legends)), + names(legends) + ) + + empty <- vapply(legends, is.zero, logical(1)) + widths[!empty] <- lapply(legends[!empty], gtable_width) + heights[!empty] <- lapply(legends[!empty], gtable_height) + spacing <- theme$legend.box.spacing %||% unit(0.2, "cm") + + # If legend is missing, set spacing to zero for that legend + zero <- unit(0, "pt") + spacing <- lapply(empty, function(is_empty) if (is_empty) zero else spacing) + + location <- switch( + theme$legend.location %||% "panel", + "plot" = plot_extent, + find_panel + ) + + place <- location(table) + + # Add right legend + table <- gtable_add_cols(table, spacing$right, pos = -1) + table <- gtable_add_cols(table, widths$right, pos = -1) + table <- gtable_add_grob( + table, legends$right, clip = "off", + t = place$t, b = place$b, l = -1, r = -1, + name = "guide-box-right" + ) + + # Add left legend + table <- gtable_add_cols(table, spacing$left, pos = 0) + table <- gtable_add_cols(table, widths$left, pos = 0) + table <- gtable_add_grob( + table, legends$left, clip = "off", + t = place$t, b = place$b, l = 1, r = 1, + name = "guide-box-left" + ) + + place <- location(table) + + # Add bottom legend + table <- gtable_add_rows(table, spacing$bottom, pos = -1) + table <- gtable_add_rows(table, heights$bottom, pos = -1) + table <- gtable_add_grob( + table, legends$bottom, clip = "off", + t = -1, b = -1, l = place$l, r = place$r, + name = "guide-box-bottom" + ) + + # Add top legend + table <- gtable_add_rows(table, spacing$top, pos = 0) + table <- gtable_add_rows(table, heights$top, pos = 0) + table <- gtable_add_grob( + table, legends$top, clip = "off", + t = 1, b = 1, l = place$l, r = place$r, + name = "guide-box-top" + ) + + # Add manual legend + place <- find_panel(table) + table <- gtable_add_grob( + table, legends$inside, clip = "off", + t = place$t, b = place$b, l = place$l, r = place$r, + name = "guide-box-inside" + ) + + table +} + +plot_extent <- function(table) { + layout <- table$layout + data_frame0( + t = min(layout[["t"]]), + r = max(layout[["r"]]), + b = max(layout[["b"]]), + l = min(layout[["l"]]), + .size = 1L + ) +} diff --git a/R/plot-construction.R b/R/plot-construction.R index c4cafd2dc8..b6d83fe1f0 100644 --- a/R/plot-construction.R +++ b/R/plot-construction.R @@ -42,7 +42,7 @@ "+.gg" <- function(e1, e2) { if (missing(e2)) { cli::cli_abort(c( - "Cannot use {.code +} with a single argument", + "Cannot use {.code +} with a single argument.", "i" = "Did you accidentally put {.code +} on a new line?" )) } @@ -55,7 +55,7 @@ else if (is.ggplot(e1)) add_ggplot(e1, e2, e2name) else if (is.ggproto(e1)) { cli::cli_abort(c( - "Cannot add {.cls ggproto} objects together", + "Cannot add {.cls ggproto} objects together.", "i" = "Did you forget to add this object to a {.cls ggplot} object?" )) } diff --git a/R/plot.R b/R/plot.R index 4494b774bc..7adbbfd4de 100644 --- a/R/plot.R +++ b/R/plot.R @@ -18,12 +18,12 @@ #' The first pattern is recommended if all layers use the same #' data and the same set of aesthetics, although this method #' can also be used when adding a layer using data from another -#' data frame. +#' data frame. #' #' The second pattern specifies the default data frame to use #' for the plot, but no aesthetics are defined up front. This #' is useful when one data frame is used predominantly for the -#' plot, but the aesthetics vary from one layer to another. +#' plot, but the aesthetics vary from one layer to another. #' #' The third pattern initializes a skeleton `ggplot` object, which #' is fleshed out as layers are added. This is useful when @@ -48,22 +48,22 @@ #' # Create a data frame with some sample data, then create a data frame #' # containing the mean value for each group in the sample data. #' set.seed(1) -#' +#' #' sample_df <- data.frame( #' group = factor(rep(letters[1:3], each = 10)), #' value = rnorm(30) #' ) -#' +#' #' group_means_df <- setNames( #' aggregate(value ~ group, sample_df, mean), #' c("group", "group_mean") #' ) -#' +#' #' # The following three code blocks create the same graphic, each using one #' # of the three patterns specified above. In each graphic, the sample data #' # are plotted in the first layer and the group means data frame is used to #' # plot larger red points on top of the sample data in the second layer. -#' +#' #' # Pattern 1 #' # Both the `data` and `mapping` arguments are passed into the `ggplot()` #' # call. Those arguments are omitted in the first `geom_point()` layer @@ -76,7 +76,7 @@ #' mapping = aes(y = group_mean), data = group_means_df, #' colour = 'red', size = 3 #' ) -#' +#' #' # Pattern 2 #' # Same plot as above, passing only the `data` argument into the `ggplot()` #' # call. The `mapping` arguments are now required in each `geom_point()` @@ -88,7 +88,7 @@ #' mapping = aes(x = group, y = group_mean), data = group_means_df, #' colour = 'red', size = 3 #' ) -#' +#' #' # Pattern 3 #' # Same plot as above, passing neither the `data` or `mapping` arguments #' # into the `ggplot()` call. Both those arguments are now required in @@ -111,8 +111,8 @@ ggplot.default <- function(data = NULL, mapping = aes(), ..., environment = parent.frame()) { if (!missing(mapping) && !inherits(mapping, "uneval")) { cli::cli_abort(c( - "{.arg mapping} should be created with {.fn aes}.", - "x" = "You've supplied a {.cls {class(mapping)[1]}} object" + "{.arg mapping} must be created with {.fn aes}.", + "x" = "You've supplied {.obj_type_friendly {mapping}}." )) } diff --git a/R/position-.R b/R/position-.R index e9ea2ddf6f..23d66579b4 100644 --- a/R/position-.R +++ b/R/position-.R @@ -63,7 +63,7 @@ Position <- ggproto("Position", }, compute_panel = function(self, data, params, scales) { - cli::cli_abort("Not implemented") + cli::cli_abort("Not implemented.") } ) diff --git a/R/position-collide.R b/R/position-collide.R index 731f467b00..402f6ad7eb 100644 --- a/R/position-collide.R +++ b/R/position-collide.R @@ -5,12 +5,12 @@ collide_setup <- function(data, width = NULL, name, strategy, # Determine width if (!is.null(width)) { # Width set manually - if (!(all(c("xmin", "xmax") %in% names(data)))) { + if (!all(c("xmin", "xmax") %in% names(data))) { data$xmin <- data$x - width / 2 data$xmax <- data$x + width / 2 } } else { - if (!(all(c("xmin", "xmax") %in% names(data)))) { + if (!all(c("xmin", "xmax") %in% names(data))) { data$xmin <- data$x data$xmax <- data$x } @@ -49,7 +49,7 @@ collide <- function(data, width = NULL, name, strategy, intervals <- intervals[!is.na(intervals)] if (vec_unique_count(intervals) > 1 & any(diff(scale(intervals)) < -1e-6)) { - cli::cli_warn("{.fn {name}} requires non-overlapping {.field x} intervals") + cli::cli_warn("{.fn {name}} requires non-overlapping {.field x} intervals.") # This is where the algorithm from [L. Wilkinson. Dot plots. # The American Statistician, 1999.] should be used } @@ -61,7 +61,7 @@ collide <- function(data, width = NULL, name, strategy, data <- dapply(data, "xmin", strategy, ..., width = width) data$y <- data$ymax } else { - cli::cli_abort("Neither {.field y} nor {.field ymax} defined") + cli::cli_abort("{.field y} and {.field ymax} are undefined.") } data[match(seq_along(ord), ord), ] } diff --git a/R/position-jitterdodge.R b/R/position-jitterdodge.R index 937da31298..8aadb2baf0 100644 --- a/R/position-jitterdodge.R +++ b/R/position-jitterdodge.R @@ -48,9 +48,13 @@ PositionJitterdodge <- ggproto("PositionJitterdodge", Position, 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)) + possible_dodge <- c("fill", "colour", "linetype", "shape", "size", "alpha") + dodgecols <- intersect(possible_dodge, colnames(data)) if (length(dodgecols) == 0) { - cli::cli_abort("{.fn position_jitterdodge} requires at least one aesthetic to dodge by") + cli::cli_abort(c( + "{.fn position_jitterdodge} requires at least one aesthetic to dodge by.", + i = "Use one of {.or {.val {possible_dodge}}} aesthetics." + )) } ndodge <- lapply(data[dodgecols], levels) # returns NULL for numeric, i.e. non-dodge layers ndodge <- vec_unique_count(unlist(ndodge)) diff --git a/R/position-stack.R b/R/position-stack.R index 7be91d3abf..2aacb638bb 100644 --- a/R/position-stack.R +++ b/R/position-stack.R @@ -202,7 +202,7 @@ PositionStack <- ggproto("PositionStack", Position, reverse = params$reverse ) } - if (any(!negative)) { + if (!all(negative)) { pos <- collide(pos, NULL, "position_stack", pos_stack, vjust = params$vjust, fill = params$fill, diff --git a/R/save.R b/R/save.R index e4f7398155..c35a969cd5 100644 --- a/R/save.R +++ b/R/save.R @@ -171,14 +171,12 @@ check_path <- function(path, filename, create.dir, #' @noRd parse_dpi <- function(dpi, call = caller_env()) { if (is_scalar_character(dpi)) { + arg_match0(dpi, c("screen", "print", "retina"), error_call = call) + switch(dpi, screen = 72, print = 300, retina = 320, - cli::cli_abort(c( - "Unknown {.arg dpi} string", - "i" = "Use either {.val screen}, {.val print}, or {.val retina}" - ), call = call) ) } else if (is_scalar_numeric(dpi)) { dpi @@ -290,7 +288,10 @@ plot_dev <- function(device, filename = NULL, dpi = 300, call = caller_env()) { if (is.null(device)) { device <- to_lower_ascii(tools::file_ext(filename)) if (identical(device, "")) { - cli::cli_abort("{.arg filename} has no file extension and {.arg device} is {.val NULL}.", call = call) + cli::cli_abort(c( + "Can't save to {filename}.", + i = "Either supply {.arg filename} with a file extension or supply {.arg device}."), + call = call) } } diff --git a/R/scale-.R b/R/scale-.R index eb4248048d..d4a4eaa857 100644 --- a/R/scale-.R +++ b/R/scale-.R @@ -7,7 +7,7 @@ #' that should be used for error messages associated with this scale. #' @param palette A palette function that when called with a numeric vector with #' values between 0 and 1 returns the corresponding output values -#' (e.g., [scales::area_pal()]). +#' (e.g., [scales::pal_area()]). #' @param name The name of the scale. Used as the axis or legend title. If #' `waiver()`, the default, the name of the scale is taken from the first #' mapping used for that aesthetic. If `NULL`, the legend title will be @@ -15,7 +15,7 @@ #' @param breaks One of: #' - `NULL` for no breaks #' - `waiver()` for the default breaks computed by the -#' [transformation object][scales::trans_new()] +#' [transformation object][scales::new_transform()] #' - A numeric vector of positions #' - A function that takes the limits as input and returns breaks #' as output (e.g., a function returned by [scales::extended_breaks()]). @@ -26,7 +26,9 @@ #' each major break) #' - A numeric vector of positions #' - A function that given the limits returns a vector of minor breaks. Also -#' accepts rlang [lambda][rlang::as_function()] function notation. +#' accepts rlang [lambda][rlang::as_function()] function notation. When +#' the function has two arguments, it will be given the limits and major +#' breaks. #' @param n.breaks An integer guiding the number of major breaks. The algorithm #' may choose a slightly different number to ensure nice break labels. Will #' only have an effect if `breaks = waiver()`. Use `NULL` to use the default @@ -75,8 +77,8 @@ #' and methods for generating breaks and labels. Transformation objects #' are defined in the scales package, and are called `_trans`. If #' transformations require arguments, you can call them from the scales -#' package, e.g. [`scales::boxcox_trans(p = 2)`][scales::boxcox_trans]. -#' You can create your own transformation with [scales::trans_new()]. +#' package, e.g. [`scales::transform_boxcox(p = 2)`][scales::transform_boxcox]. +#' You can create your own transformation with [scales::new_transform()]. #' @param guide A function used to create a guide or its name. See #' [guides()] for more information. #' @param expand For position scales, a vector of range expansion constants used to add some @@ -113,7 +115,7 @@ continuous_scale <- function(aesthetics, scale_name = deprecated(), palette, nam guide <- "none" } - trans <- as.trans(trans) + trans <- as.transform(trans) if (!is.null(limits) && !is.function(limits)) { limits <- trans$transform(limits) } @@ -157,7 +159,7 @@ continuous_scale <- function(aesthetics, scale_name = deprecated(), palette, nam #' @inheritParams continuous_scale #' @param palette A palette function that when called with a single integer #' argument (the number of levels in the scale) returns the values that -#' they should take (e.g., [scales::hue_pal()]). +#' they should take (e.g., [scales::pal_hue()]). #' @param breaks One of: #' - `NULL` for no breaks #' - `waiver()` for the default breaks (the scale limits) @@ -278,7 +280,7 @@ binned_scale <- function(aesthetics, scale_name = deprecated(), palette, name = guide <- "none" } - trans <- as.trans(trans) + trans <- as.transform(trans) if (!is.null(limits)) { limits <- trans$transform(limits) } @@ -573,7 +575,7 @@ check_breaks_labels <- function(breaks, labels, call = NULL) { length(breaks) != length(labels) if (bad_labels) { cli::cli_abort( - "{.arg breaks} and {.arg labels} must have the same length", + "{.arg breaks} and {.arg labels} must have the same length.", call = call ) } @@ -603,7 +605,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, oob = censor, minor_breaks = waiver(), n.breaks = NULL, - trans = identity_trans(), + trans = transform_identity(), is_discrete = function() FALSE, @@ -614,7 +616,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, # Intercept error here to give examples and mention scale in call if (is.factor(x) || !typeof(x) %in% c("integer", "double")) { cli::cli_abort( - c("Discrete values supplied to continuous scale", + c("Discrete values supplied to continuous scale.", i = "Example values: {.and {.val {head(x, 5)}}}"), call = self$call ) @@ -686,7 +688,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, if (identical(self$breaks, NA)) { cli::cli_abort( - "Invalid {.arg breaks} specification. Use {.val NULL}, not {.val NA}.", + "Invalid {.arg breaks} specification. Use {.code NULL}, not {.code NA}.", call = self$call ) } @@ -714,11 +716,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, } # Breaks in data space need to be converted back to transformed space - breaks <- self$trans$transform(breaks) - # Any breaks outside the dimensions are flagged as missing - breaks <- censor(breaks, self$trans$transform(limits), only.finite = FALSE) - - breaks + self$trans$transform(breaks) }, get_breaks_minor = function(self, n = 2, b = self$break_positions(), limits = self$get_limits()) { @@ -732,10 +730,13 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, if (identical(self$minor_breaks, NA)) { cli::cli_abort( - "Invalid {.arg minor_breaks} specification. Use {.val NULL}, not {.val NA}.", + "Invalid {.arg minor_breaks} specification. Use {.code NULL}, not {.code NA}.", call = self$call ) } + # major breaks are not censored, however; + # some transforms assume finite major breaks + b <- b[is.finite(b)] if (is.waive(self$minor_breaks)) { if (is.null(b)) { @@ -744,8 +745,18 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, breaks <- self$trans$minor_breaks(b, limits, n) } } else if (is.function(self$minor_breaks)) { - # Find breaks in data space, and convert to numeric - breaks <- self$minor_breaks(self$trans$inverse(limits)) + # Using `fetch_ggproto` here to avoid auto-wrapping the user-supplied + # breaks function as a ggproto method. + break_fun <- fetch_ggproto(self, "minor_breaks") + arg_names <- fn_fmls_names(break_fun) + + # Find breaks in data space + if (length(arg_names) == 1L) { + breaks <- break_fun(self$trans$inverse(limits)) + } else { + breaks <- break_fun(self$trans$inverse(limits), self$trans$inverse(b)) + } + # Convert breaks to numeric breaks <- self$trans$transform(breaks) } else { breaks <- self$trans$transform(self$minor_breaks) @@ -768,7 +779,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, if (identical(self$labels, NA)) { cli::cli_abort( - "Invalid {.arg labels} specification. Use {.val NULL}, not {.val NA}.", + "Invalid {.arg labels} specification. Use {.code NULL}, not {.code NA}.", call = self$call ) } @@ -783,7 +794,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, if (length(labels) != length(breaks)) { cli::cli_abort( - "{.arg breaks} and {.arg labels} are different lengths.", + "{.arg breaks} and {.arg labels} have different lengths.", call = self$call ) } @@ -819,14 +830,16 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, # labels labels <- self$get_labels(major) - # drop oob breaks/labels by testing major == NA - if (!is.null(labels)) labels <- labels[!is.na(major)] - if (!is.null(major)) major <- major[!is.na(major)] - # minor breaks minor <- self$get_breaks_minor(b = major, limits = range) if (!is.null(minor)) minor <- minor[!is.na(minor)] + major <- oob_censor_any(major, range) + + # drop oob breaks/labels by testing major == NA + if (!is.null(labels)) labels <- labels[!is.na(major)] + if (!is.null(major)) major <- major[!is.na(major)] + # rescale breaks [0, 1], which are used by coord/guide major_n <- rescale(major, from = range) minor_n <- rescale(minor, from = range) @@ -874,7 +887,7 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale, # Intercept error here to give examples and mention scale in call if (!is.discrete(x)) { cli::cli_abort( - c("Continuous values supplied to discrete scale", + c("Continuous values supplied to discrete scale.", i = "Example values: {.and {.val {head(x, 5)}}}"), call = self$call ) @@ -938,7 +951,7 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale, if (identical(self$breaks, NA)) { cli::cli_abort( - "Invalid {.arg breaks} specification. Use {.val NULL}, not {.val NA}.", + "Invalid {.arg breaks} specification. Use {.code NULL}, not {.code NA}.", call = self$call ) } @@ -973,7 +986,7 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale, if (identical(self$labels, NA)) { cli::cli_abort( - "Invalid {.arg labels} specification. Use {.val NULL}, not {.val NA}.", + "Invalid {.arg labels} specification. Use {.code NULL}, not {.code NA}.", call = self$call ) } @@ -1133,7 +1146,7 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, return(NULL) } else if (identical(self$breaks, NA)) { cli::cli_abort( - "Invalid {.arg breaks} specification. Use {.val NULL}, not {.val NA}.", + "Invalid {.arg breaks} specification. Use {.code NULL}, not {.code NA}.", call = self$call ) } else if (is.waive(self$breaks)) { @@ -1222,7 +1235,7 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, return(NULL) } else if (identical(self$labels, NA)) { cli::cli_abort( - "Invalid {.arg labels} specification. Use {.val NULL}, not {.val NA}.", + "Invalid {.arg labels} specification. Use {.code NULL}, not {.code NA}.", call = self$call ) } else if (is.waive(self$labels)) { @@ -1234,7 +1247,7 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, } if (length(labels) != length(breaks)) { cli::cli_abort( - "{.arg breaks} and {.arg labels} are different lengths.", + "{.arg breaks} and {.arg labels} have different lengths.", call = self$call ) } diff --git a/R/scale-alpha.R b/R/scale-alpha.R index 8be2925c58..9271bd0b5b 100644 --- a/R/scale-alpha.R +++ b/R/scale-alpha.R @@ -24,7 +24,7 @@ #' p + scale_alpha("cylinders") #' p + scale_alpha(range = c(0.4, 0.8)) scale_alpha <- function(..., range = c(0.1, 1)) { - continuous_scale("alpha", palette = rescale_pal(range), ...) + continuous_scale("alpha", palette = pal_rescale(range), ...) } #' @rdname scale_alpha @@ -34,7 +34,7 @@ scale_alpha_continuous <- scale_alpha #' @rdname scale_alpha #' @export scale_alpha_binned <- function(..., range = c(0.1, 1)) { - binned_scale("alpha", palette = rescale_pal(range), ...) + binned_scale("alpha", palette = pal_rescale(range), ...) } #' @rdname scale_alpha @@ -60,12 +60,12 @@ scale_alpha_ordinal <- function(..., range = c(0.1, 1)) { #' @export #' @usage NULL scale_alpha_datetime <- function(..., range = c(0.1, 1)) { - datetime_scale("alpha", "time", palette = rescale_pal(range), ...) + datetime_scale("alpha", "time", palette = pal_rescale(range), ...) } #' @rdname scale_alpha #' @export #' @usage NULL scale_alpha_date <- function(..., range = c(0.1, 1)){ - datetime_scale("alpha", "date", palette = rescale_pal(range), ...) + datetime_scale("alpha", "date", palette = pal_rescale(range), ...) } diff --git a/R/scale-brewer.R b/R/scale-brewer.R index 6ecc12ba95..f01daff81c 100644 --- a/R/scale-brewer.R +++ b/R/scale-brewer.R @@ -8,7 +8,7 @@ #' #' @note #' The `distiller` scales extend `brewer` scales by smoothly -#' interpolating 7 colours from any palette to a continuous scale. +#' interpolating 7 colours from any palette to a continuous scale. #' The `distiller` scales have a default direction = -1. To reverse, use direction = 1. #' The `fermenter` scales provide binned versions of the `brewer` scales. #' @@ -27,10 +27,10 @@ #' } #' Modify the palette through the `palette` argument. #' -#' @inheritParams scales::brewer_pal +#' @inheritParams scales::pal_brewer #' @inheritParams scale_colour_hue #' @inheritParams scale_colour_gradient -#' @inheritParams scales::gradient_n_pal +#' @inheritParams scales::pal_gradient_n #' @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. @@ -52,7 +52,7 @@ #' # Change scale label #' d + scale_colour_brewer("Diamond\nclarity") #' -#' # Select brewer palette to use, see ?scales::brewer_pal for more details +#' # Select brewer palette to use, see ?scales::pal_brewer for more details #' d + scale_colour_brewer(palette = "Greens") #' d + scale_colour_brewer(palette = "Set1") #' @@ -84,13 +84,13 @@ #' v + scale_fill_fermenter() #' scale_colour_brewer <- function(..., type = "seq", palette = 1, direction = 1, aesthetics = "colour") { - discrete_scale(aesthetics, palette = brewer_pal(type, palette, direction), ...) + discrete_scale(aesthetics, palette = pal_brewer(type, palette, direction), ...) } #' @export #' @rdname scale_brewer scale_fill_brewer <- function(..., type = "seq", palette = 1, direction = 1, aesthetics = "fill") { - discrete_scale(aesthetics, palette = brewer_pal(type, palette, direction), ...) + discrete_scale(aesthetics, palette = pal_brewer(type, palette, direction), ...) } #' @export @@ -106,7 +106,7 @@ scale_colour_distiller <- function(..., type = "seq", palette = 1, direction = - } continuous_scale( aesthetics, - palette = gradient_n_pal(brewer_pal(type, palette, direction)(7), values, space), + palette = pal_gradient_n(pal_brewer(type, palette, direction)(7), values, space), na.value = na.value, guide = guide, ... ) # NB: 6-7 colours per palette gives nice gradients; more results in more saturated colours which do not look as good @@ -125,7 +125,7 @@ scale_fill_distiller <- function(..., type = "seq", palette = 1, direction = -1, } continuous_scale( aesthetics, - palette = gradient_n_pal(brewer_pal(type, palette, direction)(7), values, space), + palette = pal_gradient_n(pal_brewer(type, palette, direction)(7), values, space), na.value = na.value, guide = guide, ... ) } @@ -141,7 +141,7 @@ scale_colour_fermenter <- function(..., type = "seq", palette = 1, direction = - "i" = "Consider using {.code type = \"seq\"} or {.code type = \"div\"} instead" )) } - binned_scale(aesthetics, palette = binned_pal(brewer_pal(type, palette, direction)), na.value = na.value, guide = guide, ...) + binned_scale(aesthetics, palette = pal_binned(pal_brewer(type, palette, direction)), na.value = na.value, guide = guide, ...) } #' @export @@ -154,5 +154,5 @@ scale_fill_fermenter <- function(..., type = "seq", palette = 1, direction = -1, "i" = "Consider using {.code type = \"seq\"} or {.code type = \"div\"} instead" )) } - binned_scale(aesthetics, palette = binned_pal(brewer_pal(type, palette, direction)), na.value = na.value, guide = guide, ...) + binned_scale(aesthetics, palette = pal_binned(pal_brewer(type, palette, direction)), na.value = na.value, guide = guide, ...) } diff --git a/R/scale-colour.R b/R/scale-colour.R index a3084ec7df..2831e51ade 100644 --- a/R/scale-colour.R +++ b/R/scale-colour.R @@ -93,7 +93,7 @@ scale_colour_continuous <- function(..., } else { cli::cli_abort(c( "Unknown scale type: {.val {type}}", - "i" = "Use either {.val gradient} or {.val viridis}" + "i" = "Use either {.val gradient} or {.val viridis}." )) } } @@ -118,7 +118,7 @@ scale_fill_continuous <- function(..., } else { cli::cli_abort(c( "Unknown scale type: {.val {type}}", - "i" = "Use either {.val gradient} or {.val viridis}" + "i" = "Use either {.val gradient} or {.val viridis}." )) } } @@ -151,7 +151,7 @@ scale_colour_binned <- function(..., } else { cli::cli_abort(c( "Unknown scale type: {.val {type}}", - "i" = "Use either {.val gradient} or {.val viridis}" + "i" = "Use either {.val gradient} or {.val viridis}." )) } } @@ -185,7 +185,7 @@ scale_fill_binned <- function(..., } else { cli::cli_abort(c( "Unknown scale type: {.val {type}}", - "i" = "Use either {.val gradient} or {.val viridis}" + "i" = "Use either {.val gradient} or {.val viridis}." )) } } @@ -204,7 +204,7 @@ check_scale_type <- function(scale, name, aesthetic, scale_is_discrete = FALSE, if (!isTRUE(aesthetic %in% scale$aesthetics)) { cli::cli_abort(c( "The {.arg type} argument must return a continuous scale for the {.field {aesthetic}} aesthetic.", - "x" = "The provided scale works with the following aesthetics: {.field {scale$aesthetics}}" + "x" = "The provided scale works with the following aesthetics: {.field {scale$aesthetics}}." ), call = call) } if (isTRUE(scale$is_discrete()) != scale_is_discrete) { diff --git a/R/scale-continuous.R b/R/scale-continuous.R index 265364e778..002e03316a 100644 --- a/R/scale-continuous.R +++ b/R/scale-continuous.R @@ -64,9 +64,9 @@ #' p1 + scale_y_reverse() #' #' # Or you can supply a transformation in the `trans` argument: -#' p1 + scale_y_continuous(trans = scales::reciprocal_trans()) +#' p1 + scale_y_continuous(trans = scales::transform_reciprocal()) #' -#' # You can also create your own. See ?scales::trans_new +#' # You can also create your own. See ?scales::new_transform #' #' @name scale_continuous #' @aliases NULL @@ -169,30 +169,30 @@ ScaleContinuousPosition <- ggproto("ScaleContinuousPosition", ScaleContinuous, #' @rdname scale_continuous #' @export scale_x_log10 <- function(...) { - scale_x_continuous(..., trans = log10_trans()) + scale_x_continuous(..., trans = transform_log10()) } #' @rdname scale_continuous #' @export scale_y_log10 <- function(...) { - scale_y_continuous(..., trans = log10_trans()) + scale_y_continuous(..., trans = transform_log10()) } #' @rdname scale_continuous #' @export scale_x_reverse <- function(...) { - scale_x_continuous(..., trans = reverse_trans()) + scale_x_continuous(..., trans = transform_reverse()) } #' @rdname scale_continuous #' @export scale_y_reverse <- function(...) { - scale_y_continuous(..., trans = reverse_trans()) + scale_y_continuous(..., trans = transform_reverse()) } #' @rdname scale_continuous #' @export scale_x_sqrt <- function(...) { - scale_x_continuous(..., trans = sqrt_trans()) + scale_x_continuous(..., trans = transform_sqrt()) } #' @rdname scale_continuous #' @export scale_y_sqrt <- function(...) { - scale_y_continuous(..., trans = sqrt_trans()) + scale_y_continuous(..., trans = transform_sqrt()) } diff --git a/R/scale-date.R b/R/scale-date.R index 3824d232a1..6dfc419a1a 100644 --- a/R/scale-date.R +++ b/R/scale-date.R @@ -242,7 +242,7 @@ scale_x_time <- function(name = waiver(), na.value = na.value, guide = guide, position = position, - trans = scales::hms_trans(), + trans = scales::transform_hms(), sec.axis = sec.axis ) } @@ -273,7 +273,7 @@ scale_y_time <- function(name = waiver(), na.value = na.value, guide = guide, position = position, - trans = scales::hms_trans(), + trans = scales::transform_hms(), sec.axis = sec.axis ) } @@ -326,8 +326,8 @@ datetime_scale <- function(aesthetics, trans, palette, } trans <- switch(trans, - date = date_trans(), - time = time_trans(timezone) + date = transform_date(), + time = transform_time(timezone) ) sc <- continuous_scale( @@ -357,7 +357,7 @@ ScaleContinuousDatetime <- ggproto("ScaleContinuousDatetime", ScaleContinuous, tz <- attr(x, "tzone") if (is.null(self$timezone) && !is.null(tz)) { self$timezone <- tz - self$trans <- time_trans(self$timezone) + self$trans <- transform_time(self$timezone) } ggproto_parent(ScaleContinuous, self)$transform(x) }, diff --git a/R/scale-expansion.R b/R/scale-expansion.R index dd31ac3275..5518e9f012 100644 --- a/R/scale-expansion.R +++ b/R/scale-expansion.R @@ -37,7 +37,7 @@ #' expansion <- function(mult = 0, add = 0) { if (!(is.numeric(mult) && (length(mult) %in% 1:2) && is.numeric(add) && (length(add) %in% 1:2))) { - cli::cli_abort("{.arg mult} and {.arg add} must be numeric vectors with 1 or 2 elements") + cli::cli_abort("{.arg mult} and {.arg add} must be numeric vectors with 1 or 2 elements.") } mult <- rep(mult, length.out = 2) @@ -66,7 +66,7 @@ expand_scale <- function(mult = 0, add = 0) { #' expand_range4 <- function(limits, expand) { if (!(is.numeric(expand) && length(expand) %in% c(2,4))) { - cli::cli_abort("{.arg expand} must be a numeric vector with 2 or 4 elements") + cli::cli_abort("{.arg expand} must be a numeric vector with 2 or 4 elements.") } if (all(!is.finite(limits))) { @@ -168,7 +168,7 @@ expand_limits_discrete <- function(limits, expand = expansion(0, 0), coord_limit } expand_limits_continuous_trans <- function(limits, expand = expansion(0, 0), - coord_limits = c(NA, NA), trans = identity_trans()) { + coord_limits = c(NA, NA), trans = transform_identity()) { # let non-NA coord_limits override the scale limits limits <- ifelse(is.na(coord_limits), limits, coord_limits) @@ -198,7 +198,7 @@ expand_limits_continuous_trans <- function(limits, expand = expansion(0, 0), } expand_limits_discrete_trans <- function(limits, expand = expansion(0, 0), - coord_limits = c(NA, NA), trans = identity_trans(), + coord_limits = c(NA, NA), trans = transform_identity(), range_continuous = NULL) { if (is.discrete(limits)) { n_discrete_limits <- length(limits) diff --git a/R/scale-gradient.R b/R/scale-gradient.R index 95ee2824b2..16461e2ca4 100644 --- a/R/scale-gradient.R +++ b/R/scale-gradient.R @@ -11,13 +11,13 @@ #' luminance. The \pkg{munsell} package makes this easy to do using the #' Munsell colour system. #' -#' @inheritParams scales::seq_gradient_pal +#' @inheritParams scales::pal_seq_gradient #' @inheritParams scale_colour_hue #' @param low,high Colours for low and high ends of the gradient. #' @param guide Type of legend. Use `"colourbar"` for continuous #' colour bar, or `"legend"` for discrete colour legend. #' @inheritDotParams continuous_scale -na.value -guide -aesthetics -#' @seealso [scales::seq_gradient_pal()] for details on underlying +#' @seealso [scales::pal_seq_gradient()] for details on underlying #' palette, [scale_colour_steps()] for binned variants of these scales. #' #' The documentation on [colour aesthetics][aes_colour_fill_alpha]. @@ -77,7 +77,7 @@ #' scale_colour_gradient <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab", na.value = "grey50", guide = "colourbar", aesthetics = "colour") { - continuous_scale(aesthetics, palette = seq_gradient_pal(low, high, space), + continuous_scale(aesthetics, palette = pal_seq_gradient(low, high, space), na.value = na.value, guide = guide, ...) } @@ -85,11 +85,11 @@ scale_colour_gradient <- function(..., low = "#132B43", high = "#56B1F7", space #' @export scale_fill_gradient <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab", na.value = "grey50", guide = "colourbar", aesthetics = "fill") { - continuous_scale(aesthetics, palette = seq_gradient_pal(low, high, space), + continuous_scale(aesthetics, palette = pal_seq_gradient(low, high, space), na.value = na.value, guide = guide, ...) } -#' @inheritParams scales::div_gradient_pal +#' @inheritParams scales::pal_div_gradient #' @param midpoint The midpoint (in data value) of the diverging scale. #' Defaults to 0. #' @rdname scale_gradient @@ -99,7 +99,7 @@ scale_colour_gradient2 <- function(..., low = muted("red"), mid = "white", high aesthetics = "colour") { continuous_scale( aesthetics, - palette = div_gradient_pal(low, mid, high, space), + palette = pal_div_gradient(low, mid, high, space), na.value = na.value, guide = guide, ..., rescaler = mid_rescaler(mid = midpoint) ) @@ -112,7 +112,7 @@ scale_fill_gradient2 <- function(..., low = muted("red"), mid = "white", high = aesthetics = "fill") { continuous_scale( aesthetics, - palette = div_gradient_pal(low, mid, high, space), + palette = pal_div_gradient(low, mid, high, space), na.value = na.value, guide = guide, ..., rescaler = mid_rescaler(mid = midpoint) ) @@ -124,7 +124,7 @@ mid_rescaler <- function(mid) { } } -#' @inheritParams scales::gradient_n_pal +#' @inheritParams scales::pal_gradient_n #' @param colours,colors Vector of colours to use for n-colour gradient. #' @rdname scale_gradient #' @export @@ -134,7 +134,7 @@ scale_colour_gradientn <- function(..., colours, values = NULL, space = "Lab", n continuous_scale( aesthetics, - palette = gradient_n_pal(colours, values, space), + palette = pal_gradient_n(colours, values, space), na.value = na.value, guide = guide, ... ) } @@ -146,7 +146,7 @@ scale_fill_gradientn <- function(..., colours, values = NULL, space = "Lab", na. continuous_scale( aesthetics, - palette = gradient_n_pal(colours, values, space), + palette = pal_gradient_n(colours, values, space), na.value = na.value, guide = guide, ... ) } diff --git a/R/scale-grey.R b/R/scale-grey.R index c71dd444ef..d32437606f 100644 --- a/R/scale-grey.R +++ b/R/scale-grey.R @@ -3,7 +3,7 @@ #' Based on [gray.colors()]. This is black and white equivalent #' of [scale_colour_gradient()]. #' -#' @inheritParams scales::grey_pal +#' @inheritParams scales::pal_grey #' @inheritParams scale_colour_hue #' @inheritDotParams discrete_scale #' @family colour scales @@ -28,13 +28,13 @@ #' geom_point(aes(colour = miss)) + #' scale_colour_grey(na.value = "green") scale_colour_grey <- function(..., start = 0.2, end = 0.8, na.value = "red", aesthetics = "colour") { - discrete_scale(aesthetics, palette = grey_pal(start, end), + discrete_scale(aesthetics, palette = pal_grey(start, end), na.value = na.value, ...) } #' @rdname scale_grey #' @export scale_fill_grey <- function(..., start = 0.2, end = 0.8, na.value = "red", aesthetics = "fill") { - discrete_scale(aesthetics, palette = grey_pal(start, end), + discrete_scale(aesthetics, palette = pal_grey(start, end), na.value = na.value, ...) } diff --git a/R/scale-hue.R b/R/scale-hue.R index 0e0d796537..64ca050e53 100644 --- a/R/scale-hue.R +++ b/R/scale-hue.R @@ -9,7 +9,7 @@ #' 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 #' same time, via `aesthetics = c("colour", "fill")`. -#' @inheritParams scales::hue_pal +#' @inheritParams scales::pal_hue #' @rdname scale_hue #' @export #' @family colour scales @@ -55,7 +55,7 @@ #' } scale_colour_hue <- function(..., h = c(0, 360) + 15, c = 100, l = 65, h.start = 0, direction = 1, na.value = "grey50", aesthetics = "colour") { - discrete_scale(aesthetics, palette = hue_pal(h, c, l, h.start, direction), + discrete_scale(aesthetics, palette = pal_hue(h, c, l, h.start, direction), na.value = na.value, ...) } @@ -63,7 +63,7 @@ scale_colour_hue <- function(..., h = c(0, 360) + 15, c = 100, l = 65, h.start = #' @export scale_fill_hue <- function(..., h = c(0, 360) + 15, c = 100, l = 65, h.start = 0, direction = 1, na.value = "grey50", aesthetics = "fill") { - discrete_scale(aesthetics, palette = hue_pal(h, c, l, h.start, direction), + discrete_scale(aesthetics, palette = pal_hue(h, c, l, h.start, direction), na.value = na.value, ...) } @@ -168,7 +168,7 @@ scale_fill_discrete <- function(..., type = getOption("ggplot2.discrete.fill")) scale_colour_qualitative <- function(..., type = NULL, h = c(0, 360) + 15, c = 100, l = 65, h.start = 0, direction = 1, na.value = "grey50", aesthetics = "colour") { discrete_scale( - aesthetics, palette = qualitative_pal(type, h, c, l, h.start, direction), + aesthetics, palette = pal_qualitative(type, h, c, l, h.start, direction), na.value = na.value, ... ) } @@ -176,7 +176,7 @@ scale_colour_qualitative <- function(..., type = NULL, h = c(0, 360) + 15, c = 1 scale_fill_qualitative <- function(..., type = NULL, h = c(0, 360) + 15, c = 100, l = 65, h.start = 0, direction = 1, na.value = "grey50", aesthetics = "fill") { discrete_scale( - aesthetics, palette = qualitative_pal(type, h, c, l, h.start, direction), + aesthetics, palette = pal_qualitative(type, h, c, l, h.start, direction), na.value = na.value, ... ) } @@ -184,16 +184,16 @@ scale_fill_qualitative <- function(..., type = NULL, h = c(0, 360) + 15, c = 100 #' Given set(s) of colour codes (i.e., type), find the smallest set that can support n levels #' @param type a character vector or a list of character vectors #' @noRd -qualitative_pal <- function(type, h, c, l, h.start, direction) { +pal_qualitative <- function(type, h, c, l, h.start, direction) { function(n) { type_list <- if (!is.list(type)) list(type) else type if (!all(vapply(type_list, is.character, logical(1)))) { - cli::cli_abort("{.arg type} must be a character vector or a list of character vectors") + cli::cli_abort("{.arg type} must be a character vector or a list of character vectors.") } type_lengths <- lengths(type_list) - # If there are more levels than color codes default to hue_pal() + # If there are more levels than color codes default to pal_hue() if (max(type_lengths) < n) { - return(scales::hue_pal(h, c, l, h.start, direction)(n)) + return(scales::pal_hue(h, c, l, h.start, direction)(n)) } # Use the minimum length vector that exceeds the number of levels (n) type_list <- type_list[order(type_lengths)] diff --git a/R/scale-identity.R b/R/scale-identity.R index 9a3ace41a0..b070d04c4b 100644 --- a/R/scale-identity.R +++ b/R/scale-identity.R @@ -63,7 +63,7 @@ NULL #' @rdname scale_identity #' @export scale_colour_identity <- function(..., guide = "none", aesthetics = "colour") { - sc <- discrete_scale(aesthetics, palette = identity_pal(), ..., guide = guide, + sc <- discrete_scale(aesthetics, palette = pal_identity(), ..., guide = guide, super = ScaleDiscreteIdentity) sc @@ -72,7 +72,7 @@ scale_colour_identity <- function(..., guide = "none", aesthetics = "colour") { #' @rdname scale_identity #' @export scale_fill_identity <- function(..., guide = "none", aesthetics = "fill") { - sc <- discrete_scale(aesthetics, palette = identity_pal(), ..., guide = guide, + sc <- discrete_scale(aesthetics, palette = pal_identity(), ..., guide = guide, super = ScaleDiscreteIdentity) sc @@ -83,7 +83,7 @@ scale_fill_identity <- function(..., guide = "none", aesthetics = "fill") { #' Other shape scales: [scale_shape()], [scale_shape_manual()]. #' @export scale_shape_identity <- function(..., guide = "none") { - sc <- continuous_scale("shape", palette = identity_pal(), ..., guide = guide, + sc <- continuous_scale("shape", palette = pal_identity(), ..., guide = guide, super = ScaleContinuousIdentity) sc @@ -94,7 +94,7 @@ scale_shape_identity <- function(..., guide = "none") { #' Other linetype scales: [scale_linetype()], [scale_linetype_manual()]. #' @export scale_linetype_identity <- function(..., guide = "none") { - sc <- discrete_scale("linetype", palette = identity_pal(), ..., guide = guide, + sc <- discrete_scale("linetype", palette = pal_identity(), ..., guide = guide, super = ScaleDiscreteIdentity) sc @@ -105,7 +105,7 @@ scale_linetype_identity <- function(..., guide = "none") { #' Other alpha scales: [scale_alpha()], [scale_alpha_manual()]. #' @export scale_linewidth_identity <- function(..., guide = "none") { - sc <- continuous_scale("linewidth", palette = identity_pal(), ..., + sc <- continuous_scale("linewidth", palette = pal_identity(), ..., guide = guide, super = ScaleContinuousIdentity) sc @@ -114,7 +114,7 @@ scale_linewidth_identity <- function(..., guide = "none") { #' @rdname scale_identity #' @export scale_alpha_identity <- function(..., guide = "none") { - sc <- continuous_scale("alpha", palette = identity_pal(), ..., guide = guide, + sc <- continuous_scale("alpha", palette = pal_identity(), ..., guide = guide, super = ScaleContinuousIdentity) sc @@ -125,7 +125,7 @@ scale_alpha_identity <- function(..., guide = "none") { #' Other size scales: [scale_size()], [scale_size_manual()]. #' @export scale_size_identity <- function(..., guide = "none") { - sc <- continuous_scale("size", palette = identity_pal(), ..., guide = guide, + sc <- continuous_scale("size", palette = pal_identity(), ..., guide = guide, super = ScaleContinuousIdentity) sc @@ -134,7 +134,7 @@ scale_size_identity <- function(..., guide = "none") { #' @rdname scale_identity #' @export scale_discrete_identity <- function(aesthetics, ..., guide = "none") { - sc <- discrete_scale(aesthetics, palette = identity_pal(), ..., guide = guide, + sc <- discrete_scale(aesthetics, palette = pal_identity(), ..., guide = guide, super = ScaleDiscreteIdentity) sc @@ -143,7 +143,7 @@ scale_discrete_identity <- function(aesthetics, ..., guide = "none") { #' @rdname scale_identity #' @export scale_continuous_identity <- function(aesthetics, ..., guide = "none") { - sc <- continuous_scale(aesthetics, palette = identity_pal(), ..., guide = guide, + sc <- continuous_scale(aesthetics, palette = pal_identity(), ..., guide = guide, super = ScaleContinuousIdentity) sc diff --git a/R/scale-linetype.R b/R/scale-linetype.R index 494abc5d55..bf382c985a 100644 --- a/R/scale-linetype.R +++ b/R/scale-linetype.R @@ -34,22 +34,22 @@ #' facet_grid(linetype ~ .) + #' theme_void(20) scale_linetype <- function(..., na.value = "blank") { - discrete_scale("linetype", palette = linetype_pal(), + discrete_scale("linetype", palette = pal_linetype(), na.value = na.value, ...) } #' @rdname scale_linetype #' @export scale_linetype_binned <- function(..., na.value = "blank") { - binned_scale("linetype", palette = binned_pal(linetype_pal()), ...) + binned_scale("linetype", palette = pal_binned(pal_linetype()), ...) } #' @rdname scale_linetype #' @export scale_linetype_continuous <- function(...) { cli::cli_abort(c( - "A continuous variable cannot be mapped to the {.field linetype} aesthetic", - "i" = "choose a different aesthetic or use {.fn scale_linetype_binned}" + "A continuous variable cannot be mapped to the {.field linetype} aesthetic.", + "i" = "Choose a different aesthetic or use {.fn scale_linetype_binned}." )) } #' @rdname scale_linetype diff --git a/R/scale-linewidth.R b/R/scale-linewidth.R index 61f4dc1c0c..71c87b199c 100644 --- a/R/scale-linewidth.R +++ b/R/scale-linewidth.R @@ -31,7 +31,7 @@ scale_linewidth_continuous <- function(name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, range = c(1, 6), trans = "identity", guide = "legend") { - continuous_scale("linewidth", palette = rescale_pal(range), name = name, + continuous_scale("linewidth", palette = pal_rescale(range), name = name, breaks = breaks, labels = labels, limits = limits, trans = trans, guide = guide) } @@ -45,7 +45,7 @@ scale_linewidth <- scale_linewidth_continuous scale_linewidth_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("linewidth", palette = rescale_pal(range), name = name, + binned_scale("linewidth", palette = pal_rescale(range), name = name, breaks = breaks, labels = labels, limits = limits, trans = trans, n.breaks = n.breaks, nice.breaks = nice.breaks, guide = guide) } @@ -77,12 +77,12 @@ scale_linewidth_ordinal <- function(..., range = c(2, 6)) { #' @export #' @usage NULL scale_linewidth_datetime <- function(..., range = c(1, 6)) { - datetime_scale("linewidth", "time", palette = rescale_pal(range), ...) + datetime_scale("linewidth", "time", palette = pal_rescale(range), ...) } #' @rdname scale_linewidth #' @export #' @usage NULL scale_linewidth_date <- function(..., range = c(1, 6)) { - datetime_scale("linewidth", "date", palette = rescale_pal(range), ...) + datetime_scale("linewidth", "date", palette = pal_rescale(range), ...) } diff --git a/R/scale-shape.R b/R/scale-shape.R index cc293174ef..4942ebbdef 100644 --- a/R/scale-shape.R +++ b/R/scale-shape.R @@ -41,13 +41,13 @@ #' facet_wrap(~shape) + #' theme_void() scale_shape <- function(..., solid = TRUE) { - discrete_scale("shape", palette = shape_pal(solid), ...) + discrete_scale("shape", palette = pal_shape(solid), ...) } #' @rdname scale_shape #' @export scale_shape_binned <- function(..., solid = TRUE) { - binned_scale("shape", palette = binned_pal(shape_pal(solid)), ...) + binned_scale("shape", palette = pal_binned(pal_shape(solid)), ...) } #' @rdname scale_shape @@ -70,7 +70,7 @@ scale_shape_ordinal <- function(...) { #' @usage NULL scale_shape_continuous <- function(...) { cli::cli_abort(c( - "A continuous variable cannot be mapped to the {.field shape} aesthetic", - "i" = "choose a different aesthetic or use {.fn scale_shape_binned}" + "A continuous variable cannot be mapped to the {.field shape} aesthetic.", + "i" = "Choose a different aesthetic or use {.fn scale_shape_binned}." )) } diff --git a/R/scale-size.R b/R/scale-size.R index c75a22fa3e..07fd89f442 100644 --- a/R/scale-size.R +++ b/R/scale-size.R @@ -52,7 +52,7 @@ NULL scale_size_continuous <- function(name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, range = c(1, 6), trans = "identity", guide = "legend") { - continuous_scale("size", palette = area_pal(range), name = name, + continuous_scale("size", palette = pal_area(range), name = name, breaks = breaks, labels = labels, limits = limits, trans = trans, guide = guide) } @@ -66,7 +66,7 @@ scale_size <- scale_size_continuous scale_radius <- function(name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, range = c(1, 6), trans = "identity", guide = "legend") { - continuous_scale("size", palette = rescale_pal(range), name = name, + continuous_scale("size", palette = pal_rescale(range), name = name, breaks = breaks, labels = labels, limits = limits, trans = trans, guide = guide) } @@ -76,7 +76,7 @@ scale_radius <- function(name = waiver(), breaks = waiver(), labels = waiver(), 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", palette = area_pal(range), name = name, + binned_scale("size", palette = pal_area(range), name = name, breaks = breaks, labels = labels, limits = limits, trans = trans, n.breaks = n.breaks, nice.breaks = nice.breaks, guide = guide) } @@ -129,12 +129,12 @@ scale_size_binned_area <- function(..., max_size = 6) { #' @export #' @usage NULL scale_size_datetime <- function(..., range = c(1, 6)) { - datetime_scale("size", "time", palette = area_pal(range), ...) + datetime_scale("size", "time", palette = pal_area(range), ...) } #' @rdname scale_size #' @export #' @usage NULL scale_size_date <- function(..., range = c(1, 6)) { - datetime_scale("size", "date", palette = area_pal(range), ...) + datetime_scale("size", "date", palette = pal_area(range), ...) } diff --git a/R/scale-steps.R b/R/scale-steps.R index 5bbba07cb9..b5a1b2fb37 100644 --- a/R/scale-steps.R +++ b/R/scale-steps.R @@ -15,7 +15,7 @@ #' @inheritParams scale_colour_gradient #' @inheritDotParams binned_scale -aesthetics -scale_name -palette -na.value -guide -rescaler #' -#' @seealso [scales::seq_gradient_pal()] for details on underlying +#' @seealso [scales::pal_seq_gradient()] for details on underlying #' palette, [scale_colour_gradient()] for continuous scales without binning. #' #' The documentation on [colour aesthetics][aes_colour_fill_alpha]. @@ -46,7 +46,7 @@ #' @rdname scale_steps scale_colour_steps <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab", na.value = "grey50", guide = "coloursteps", aesthetics = "colour") { - binned_scale(aesthetics, palette = seq_gradient_pal(low, high, space), + binned_scale(aesthetics, palette = pal_seq_gradient(low, high, space), na.value = na.value, guide = guide, ...) } #' @rdname scale_steps @@ -54,7 +54,7 @@ scale_colour_steps <- function(..., low = "#132B43", high = "#56B1F7", space = " 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, palette = div_gradient_pal(low, mid, high, space), + binned_scale(aesthetics, palette = pal_div_gradient(low, mid, high, space), na.value = na.value, guide = guide, rescaler = mid_rescaler(mid = midpoint), ...) } #' @rdname scale_steps @@ -62,14 +62,14 @@ scale_colour_steps2 <- function(..., low = muted("red"), mid = "white", high = m 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, palette = gradient_n_pal(colours, values, space), + binned_scale(aesthetics, palette = pal_gradient_n(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, palette = seq_gradient_pal(low, high, space), + binned_scale(aesthetics, palette = pal_seq_gradient(low, high, space), na.value = na.value, guide = guide, ...) } #' @rdname scale_steps @@ -77,7 +77,7 @@ scale_fill_steps <- function(..., low = "#132B43", high = "#56B1F7", space = "La 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, palette = div_gradient_pal(low, mid, high, space), + binned_scale(aesthetics, palette = pal_div_gradient(low, mid, high, space), na.value = na.value, guide = guide, rescaler = mid_rescaler(mid = midpoint), ...) } #' @rdname scale_steps @@ -85,6 +85,6 @@ scale_fill_steps2 <- function(..., low = muted("red"), mid = "white", high = mut 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, palette = gradient_n_pal(colours, values, space), + binned_scale(aesthetics, palette = pal_gradient_n(colours, values, space), na.value = na.value, guide = guide, ...) } diff --git a/R/scale-view.R b/R/scale-view.R index 6de692abfe..1402a3ffee 100644 --- a/R/scale-view.R +++ b/R/scale-view.R @@ -21,10 +21,12 @@ view_scale_primary <- function(scale, limits = scale$get_limits(), continuous_scale_sorted <- sort(continuous_range) breaks <- scale$get_breaks(continuous_scale_sorted) minor_breaks <- scale$get_breaks_minor(b = breaks, limits = continuous_scale_sorted) + breaks <- censor(breaks, continuous_scale_sorted, only.finite = FALSE) } else { breaks <- scale$get_breaks(limits) minor_breaks <- scale$get_breaks_minor(b = breaks, limits = limits) } + minor_breaks <- censor(minor_breaks, continuous_range, only.finite = FALSE) ggproto(NULL, ViewScale, scale = scale, @@ -76,7 +78,7 @@ view_scale_secondary <- function(scale, limits = scale$get_limits(), aesthetics = scale$aesthetics, name = scale$sec_name(), make_title = function(self, title) self$scale$make_sec_title(title), - + continuous_range = sort(continuous_range), dimension = function(self) self$break_info$range, get_limits = function(self) self$break_info$range, get_breaks = function(self) self$break_info$major_source, @@ -98,8 +100,8 @@ view_scale_empty <- function() { get_breaks = function() NULL, get_breaks_minor = function() NULL, get_labels = function(breaks = NULL) breaks, - rescale = function(x) cli::cli_abort("Not implemented"), - map = function(x) cli::cli_abort("Not implemented"), + rescale = function(x) cli::cli_abort("Not implemented."), + map = function(x) cli::cli_abort("Not implemented."), make_title = function(title) title, break_positions = function() NULL, break_positions_minor = function() NULL diff --git a/R/scale-viridis.R b/R/scale-viridis.R index 72ecd4a491..4647d8f1e7 100644 --- a/R/scale-viridis.R +++ b/R/scale-viridis.R @@ -5,8 +5,8 @@ #' with common forms of colour blindness. See also #' . #' -#' @inheritParams scales::viridis_pal -#' @inheritParams scales::gradient_n_pal +#' @inheritParams scales::pal_viridis +#' @inheritParams scales::pal_gradient_n #' @inheritParams continuous_scale #' @param ... Other arguments passed on to [discrete_scale()], #' [continuous_scale()], or [binned_scale()] to control name, limits, breaks, @@ -37,7 +37,7 @@ #' # Change scale label #' d + scale_colour_viridis_d("City\nCenter") #' -#' # Select palette to use, see ?scales::viridis_pal for more details +#' # Select palette to use, see ?scales::pal_viridis for more details #' d + scale_colour_viridis_d(option = "plasma") #' d + scale_colour_viridis_d(option = "inferno") #' @@ -62,7 +62,7 @@ scale_colour_viridis_d <- function(..., alpha = 1, begin = 0, end = 1, direction = 1, option = "D", aesthetics = "colour") { discrete_scale( aesthetics, - palette = viridis_pal(alpha, begin, end, direction, option), + palette = pal_viridis(alpha, begin, end, direction, option), ... ) } @@ -73,7 +73,7 @@ scale_fill_viridis_d <- function(..., alpha = 1, begin = 0, end = 1, direction = 1, option = "D", aesthetics = "fill") { discrete_scale( aesthetics, - palette = viridis_pal(alpha, begin, end, direction, option), + palette = pal_viridis(alpha, begin, end, direction, option), ... ) } @@ -86,8 +86,8 @@ scale_colour_viridis_c <- function(..., alpha = 1, begin = 0, end = 1, guide = "colourbar", aesthetics = "colour") { continuous_scale( aesthetics, - palette = gradient_n_pal( - viridis_pal(alpha, begin, end, direction, option)(6), + palette = pal_gradient_n( + pal_viridis(alpha, begin, end, direction, option)(6), values, space ), @@ -105,8 +105,8 @@ scale_fill_viridis_c <- function(..., alpha = 1, begin = 0, end = 1, guide = "colourbar", aesthetics = "fill") { continuous_scale( aesthetics, - palette = gradient_n_pal( - viridis_pal(alpha, begin, end, direction, option)(6), + palette = pal_gradient_n( + pal_viridis(alpha, begin, end, direction, option)(6), values, space ), @@ -122,8 +122,8 @@ 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") { - pal <- binned_pal( - viridis_pal(alpha, begin, end, direction, option) + pal <- pal_binned( + pal_viridis(alpha, begin, end, direction, option) ) binned_scale( @@ -141,8 +141,8 @@ 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") { - pal <- binned_pal( - viridis_pal(alpha, begin, end, direction, option) + pal <- pal_binned( + pal_viridis(alpha, begin, end, direction, option) ) binned_scale( diff --git a/R/stat-.R b/R/stat-.R index 2a87f4197c..33b59391ef 100644 --- a/R/stat-.R +++ b/R/stat-.R @@ -105,7 +105,7 @@ Stat <- ggproto("Stat", try_fetch( inject(self$compute_panel(data = data, scales = scales, !!!params)), error = function(cnd) { - cli::cli_warn("Computation failed in {.fn {snake_class(self)}}", parent = cnd) + cli::cli_warn("Computation failed in {.fn {snake_class(self)}}.", parent = cnd) data_frame0() } ) @@ -166,7 +166,7 @@ Stat <- ggproto("Stat", dropped <- non_constant_columns[!non_constant_columns %in% self$dropped_aes] if (length(dropped) > 0) { cli::cli_warn(c( - "The following aesthetics were dropped during statistical transformation: {.field {glue_collapse(dropped, sep = ', ')}}", + "The following aesthetics were dropped during statistical transformation: {.field {dropped}}.", "i" = "This can happen when ggplot fails to infer the correct grouping structure in the data.", "i" = "Did you forget to specify a {.code group} aesthetic or to convert a numerical variable into a factor?" )) @@ -178,7 +178,7 @@ Stat <- ggproto("Stat", }, compute_group = function(self, data, scales) { - cli::cli_abort("Not implemented") + cli::cli_abort("Not implemented.") }, finish_layer = function(self, data, params) { diff --git a/R/stat-bin.R b/R/stat-bin.R index 04cbc30ce0..4f35d83a84 100644 --- a/R/stat-bin.R +++ b/R/stat-bin.R @@ -103,7 +103,7 @@ StatBin <- ggproto("StatBin", Stat, x <- flipped_names(params$flipped_aes)$x if (is_mapped_discrete(data[[x]])) { cli::cli_abort(c( - "{.fn {snake_class(self)}} requires a continuous {.field {x}} aesthetic", + "{.fn {snake_class(self)}} requires a continuous {.field {x}} aesthetic.", "x" = "the {.field {x}} aesthetic is discrete.", "i" = "Perhaps you want {.code stat=\"count\"}?" )) diff --git a/R/stat-density-2d.R b/R/stat-density-2d.R index 0569acc20a..3fd6cf60ee 100644 --- a/R/stat-density-2d.R +++ b/R/stat-density-2d.R @@ -146,12 +146,10 @@ StatDensity2d <- ggproto("StatDensity2d", Stat, # set up data and parameters for contouring contour_var <- params$contour_var %||% "density" - if (!isTRUE(contour_var %in% c("density", "ndensity", "count"))) { - cli::cli_abort(c( - "Invalid value of {.arg contour_var} ({.val {contour_var}})", - "i" = "Supported values are {.val density}, {.val ndensity}, and {.val count}." - )) - } + arg_match0( + contour_var, + c("density", "ndensity", "count") + ) data$z <- data[[contour_var]] z.range <- range(data$z, na.rm = TRUE, finite = TRUE) params <- params[intersect(names(params), c("bins", "binwidth", "breaks"))] @@ -170,7 +168,7 @@ StatDensity2d <- ggproto("StatDensity2d", Stat, try_fetch( inject(contour_stat$compute_panel(data = data, scales = scales, !!!params)), error = function(cnd) { - cli::cli_warn("Computation failed in {.fn {snake_class(self)}}", parent = cnd) + cli::cli_warn("Computation failed in {.fn {snake_class(self)}}.", parent = cnd) data_frame0() } ) diff --git a/R/stat-density.R b/R/stat-density.R index b075952886..4bf28f797b 100644 --- a/R/stat-density.R +++ b/R/stat-density.R @@ -167,7 +167,7 @@ compute_density <- function(x, w, from, to, bw = "nrd0", adjust = 1, fit_data_to_bounds <- function(bounds, x, w) { is_inside_bounds <- (bounds[1] <= x) & (x <= bounds[2]) - if (any(!is_inside_bounds)) { + if (!all(is_inside_bounds)) { cli::cli_warn("Some data points are outside of `bounds`. Removing them.") x <- x[is_inside_bounds] w <- w[is_inside_bounds] diff --git a/R/stat-qq-line.R b/R/stat-qq-line.R index 8e763bbdcd..67b0da407d 100644 --- a/R/stat-qq-line.R +++ b/R/stat-qq-line.R @@ -66,7 +66,7 @@ StatQqLine <- ggproto("StatQqLine", Stat, if (is.null(quantiles)) { quantiles <- stats::ppoints(n) } else if (length(quantiles) != n) { - cli::cli_abort("{.arg quantiles} must have the same length as the data") + cli::cli_abort("{.arg quantiles} must have the same length as the data.") } theoretical <- inject(distribution(p = quantiles, !!!dparams)) diff --git a/R/stat-qq.R b/R/stat-qq.R index e1ea8c66cf..dc3762dacd 100644 --- a/R/stat-qq.R +++ b/R/stat-qq.R @@ -95,7 +95,7 @@ StatQq <- ggproto("StatQq", Stat, if (is.null(quantiles)) { quantiles <- stats::ppoints(n) } else if (length(quantiles) != n) { - cli::cli_abort("The length of {.arg quantiles} must match the length of the data") + cli::cli_abort("The length of {.arg quantiles} must match the length of the data.") } theoretical <- inject(distribution(p = quantiles, !!!dparams)) diff --git a/R/stat-ydensity.R b/R/stat-ydensity.R index 6156922883..4eadd8ca58 100644 --- a/R/stat-ydensity.R +++ b/R/stat-ydensity.R @@ -155,7 +155,7 @@ StatYdensity <- ggproto("StatYdensity", Stat, calc_bw <- function(x, bw) { if (is.character(bw)) { if (length(x) < 2) { - cli::cli_abort("{.arg x} must contain at least 2 elements to select a bandwidth automatically") + cli::cli_abort("{.arg x} must contain at least 2 elements to select a bandwidth automatically.") } bw <- switch( @@ -167,7 +167,7 @@ calc_bw <- function(x, bw) { sj = , `sj-ste` = stats::bw.SJ(x, method = "ste"), `sj-dpi` = stats::bw.SJ(x, method = "dpi"), - cli::cli_abort("{.var {bw}} is not a valid bandwidth rule") + cli::cli_abort("{.var {bw}} is not a valid bandwidth rule.") ) } bw diff --git a/R/theme-elements.R b/R/theme-elements.R index d671ec2900..448aa4763a 100644 --- a/R/theme-elements.R +++ b/R/theme-elements.R @@ -502,9 +502,34 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) { legend.key.width = el_def(c("unit", "rel"), "legend.key.size"), legend.text = el_def("element_text", "text"), legend.title = el_def("element_text", "title"), - legend.position = el_def(c("character", "numeric", "integer")), + legend.position = el_def("character"), + legend.position.inside = el_def(c("numeric", "integer")), legend.direction = el_def("character"), + legend.justification = el_def(c("character", "numeric", "integer")), + legend.justification.top = el_def( + c("character", "numeric", "integer"), + "legend.justification" + ), + legend.justification.bottom = el_def( + c("character", "numeric", "integer"), + "legend.justification" + ), + legend.justification.left = el_def( + c("character", "numeric", "integer"), + "legend.justification" + ), + legend.justification.right = el_def( + c("character", "numeric", "integer"), + "legend.justification" + ), + legend.justification.inside = el_def( + c("character", "numeric", "integer"), + "legend.justification" + ), + + legend.location = el_def("character"), + legend.box = el_def("character"), legend.box.just = el_def("character"), legend.box.margin = el_def("margin"), diff --git a/R/theme.R b/R/theme.R index 1774a23e08..6def5d7ab5 100644 --- a/R/theme.R +++ b/R/theme.R @@ -78,13 +78,20 @@ #' `text`) #' @param legend.title title of legend ([element_text()]; inherits from #' `title`) -#' @param legend.position the position of legends ("none", "left", "right", -#' "bottom", "top", or two-element numeric vector) +#' @param legend.position the default position of legends ("none", "left", +#' "right", "bottom", "top", "inside") +#' @param legend.position.inside A numeric vector of length two setting the +#' placement of legends that have the `"inside"` position. #' @param legend.direction layout of items in legends ("horizontal" or #' "vertical") #' @param legend.justification anchor point for positioning legend inside plot #' ("center" or two-element numeric vector) or the justification according to #' the plot area when positioned outside the plot +#' @param legend.justification.top,legend.justification.bottom,legend.justification.left,legend.justification.right,legend.justification.inside +#' Same as `legend.justification` but specified per `legend.position` option. +#' @param legend.location Relative placement of legends outside the plot as a +#' string. Can be `"panel"` (default) to align legends to the panels or +#' `"plot"` to align legends to the plot as a whole. #' @param legend.box arrangement of multiple legends ("horizontal" or #' "vertical") #' @param legend.box.just justification of each legend within the overall @@ -281,7 +288,8 @@ #' p3 + theme(strip.text.x.top = element_text(colour = "white", face = "bold")) #' p3 + theme(panel.spacing = unit(1, "lines")) #' } -theme <- function(line, +theme <- function(..., + line, rect, text, title, @@ -344,8 +352,15 @@ theme <- function(line, legend.text, legend.title, legend.position, + legend.position.inside, legend.direction, legend.justification, + legend.justification.top, + legend.justification.bottom, + legend.justification.left, + legend.justification.right, + legend.justification.inside, + legend.location, legend.box, legend.box.just, legend.box.margin, @@ -388,7 +403,6 @@ theme <- function(line, strip.text.y.right, strip.switch.pad.grid, strip.switch.pad.wrap, - ..., complete = FALSE, validate = TRUE) { elements <- find_args(..., complete = NULL, validate = NULL) @@ -455,6 +469,14 @@ theme <- function(line, } elements$legend.text.align <- NULL } + if (is.numeric(elements[["legend.position"]])) { + deprecate_soft0( + "3.5.0", I("A numeric `legend.position` argument in `theme()`"), + "theme(legend.position.inside)" + ) + elements$legend.position.inside <- elements$legend.position + elements$legend.position <- "inside" + } # If complete theme set all non-blank elements to inherit from blanks if (complete) { @@ -545,7 +567,7 @@ add_theme <- function(t1, t2, t2name, call = caller_env()) { t1[item] <- list(x) }, error = function(cnd) { - cli::cli_abort("Problem merging the {.var {item}} theme element", parent = cnd, call = call) + cli::cli_abort("Can't merge the {.var {item}} theme element.", parent = cnd, call = call) } ) @@ -585,7 +607,7 @@ add_theme <- function(t1, t2, t2name, call = caller_env()) { #' t$text calc_element <- function(element, theme, verbose = FALSE, skip_blank = FALSE, call = caller_env()) { - if (verbose) message(element, " --> ", appendLF = FALSE) + if (verbose) cli::cli_inform(paste0(element, " --> ")) el_out <- theme[[element]] @@ -595,7 +617,7 @@ calc_element <- function(element, theme, verbose = FALSE, skip_blank = FALSE, if (isTRUE(skip_blank)) { el_out <- NULL } else { - if (verbose) message("element_blank (no inheritance)") + if (verbose) cli::cli_inform("{.fn element_blank} (no inheritance)") return(el_out) } } @@ -607,7 +629,7 @@ calc_element <- function(element, theme, verbose = FALSE, skip_blank = FALSE, # it is of the class specified in element_tree if (!is.null(el_out) && !inherits(el_out, element_tree[[element]]$class)) { - cli::cli_abort("Theme element {.var {element}} must have class {.cls {ggplot_global$element_tree[[element]]$class}}", call = call) + cli::cli_abort("Theme element {.var {element}} must have class {.cls {ggplot_global$element_tree[[element]]$class}}.", call = call) } # Get the names of parents from the inheritance tree @@ -615,7 +637,7 @@ calc_element <- function(element, theme, verbose = FALSE, skip_blank = FALSE, # If no parents, this is a "root" node. Just return this element. if (is.null(pnames)) { - if (verbose) message("nothing (top level)") + if (verbose) cli::cli_inform("nothing (top level)") # Check that all the properties of this element are non-NULL nullprops <- vapply(el_out, is.null, logical(1)) @@ -630,11 +652,11 @@ calc_element <- function(element, theme, verbose = FALSE, skip_blank = FALSE, return(el_out) # no null properties remaining, return element } - cli::cli_abort("Theme element {.var {element}} has {.val NULL} property without default: {.field {names(nullprops)[nullprops]}}", call = call) + cli::cli_abort("Theme element {.var {element}} has {.code NULL} property without default: {.field {names(nullprops)[nullprops]}}.", call = call) } # Calculate the parent objects' inheritance - if (verbose) message(paste(pnames, collapse = ", ")) + if (verbose) cli::cli_inform("{pnames}") parents <- lapply( pnames, calc_element, @@ -686,7 +708,7 @@ merge_element.default <- function(new, old) { } # otherwise we can't merge - cli::cli_abort("No method for merging {.cls {class(new)[1]}} into {.cls {class(old)[1]}}") + cli::cli_abort("No method for merging {.cls {class(new)[1]}} into {.cls {class(old)[1]}}.") } #' @rdname merge_element @@ -706,7 +728,7 @@ merge_element.element <- function(new, old) { # actual merging can only happen if classes match if (!inherits(new, class(old)[1])) { - cli::cli_abort("Only elements of the same class can be merged") + cli::cli_abort("Only elements of the same class can be merged.") } # Override NULL properties of new with the values in old diff --git a/R/utilities-break.R b/R/utilities-break.R index c809a940b5..1bcce62ec3 100644 --- a/R/utilities-break.R +++ b/R/utilities-break.R @@ -95,7 +95,7 @@ find_origin <- function(x_range, width, boundary) { breaks <- function(x, equal, nbins = NULL, binwidth = NULL) { equal <- arg_match0(equal, c("numbers", "width")) if ((!is.null(nbins) && !is.null(binwidth)) || (is.null(nbins) && is.null(binwidth))) { - cli::cli_abort("Specify exactly one of {.arg n} and {.arg width}") + cli::cli_abort("Specify exactly one of {.arg n} and {.arg width}.") } rng <- range(x, na.rm = TRUE, finite = TRUE) diff --git a/R/utilities-checks.R b/R/utilities-checks.R index 418268a832..db5fee2353 100644 --- a/R/utilities-checks.R +++ b/R/utilities-checks.R @@ -89,7 +89,8 @@ check_inherits <- function(x, #' either `"blending"` or `"compositing"`. If `NULL` (default), support for #' all known blending or compositing operations is queried. #' @param maybe A logical of length 1 determining what the return value should -#' be in case the device capabilities cannot be assessed. +#' be in case the device capabilities cannot be assessed. When the current +#' device is the 'null device', `maybe` is returned. #' @param call The execution environment of a currently running function, e.g. #' [`caller_env()`][rlang::caller_env()]. The function will be mentioned in #' warnings and error messages as the source of the warning or error. See @@ -186,6 +187,14 @@ check_device = function(feature, action = "warn", op = NULL, maybe = FALSE, check_bool(maybe, allow_na = TRUE) + # Grab device for checking + dev_cur <- grDevices::dev.cur() + dev_name <- names(dev_cur) + + if (dev_name == "null device") { + return(maybe) + } + action <- arg_match0(action, c("test", "warn", "abort")) action_fun <- switch( action, @@ -233,10 +242,6 @@ check_device = function(feature, action = "warn", op = NULL, maybe = FALSE, return(FALSE) } - # Grab device for checking - dev_cur <- grDevices::dev.cur() - dev_name <- names(dev_cur) - if (dev_name == "RStudioGD") { # RStudio opens RStudioGD as the active graphics device, but the back-end # appears to be the *next* device. Temporarily set the next device as the diff --git a/R/utilities-patterns.R b/R/utilities-patterns.R new file mode 100644 index 0000000000..e7cdd308bc --- /dev/null +++ b/R/utilities-patterns.R @@ -0,0 +1,115 @@ + +#' Modify fill transparency +#' +#' This works much like [alpha()][scales::alpha] in that it modifies the +#' transparency of fill colours. It differs in that `fill_alpha()` also attempts +#' to set the transparency of `` objects. +#' +#' @param fill A fill colour given as a `character` or `integer` vector, or as a +#' (list of) `` object(s). +#' @param alpha A transparency value between 0 (transparent) and 1 (opaque), +#' parallel to `fill`. +#' +#' @return A `character` vector of colours, or list of `` objects. +#' @export +#' @keywords internal +#' +#' @examples +#' # Typical colour input +#' fill_alpha("red", 0.5) +#' +#' if (utils::packageVersion("grid") > "4.2") { +#' # Pattern input +#' fill_alpha(list(grid::linearGradient()), 0.5) +#' } +fill_alpha <- function(fill, alpha) { + if (!is.list(fill)) { + # Happy path for no patterns + return(alpha(fill, alpha)) + } + if (is_pattern(fill) || any(vapply(fill, is_pattern, logical(1)))) { + check_device("patterns", action = "warn") + fill <- pattern_alpha(fill, alpha) + return(fill) + } else { + # We are either dealing with faulty fill specification, or we have a legend + # key that is trying to draw a single colour. It can be given that colour + # as a list due to patterns in other keys. + msg <- paste0( + "{.field fill} must be a vector of colours or list of ", + "{.cls GridPattern} objects." + ) + # If single colour list, try applying `alpha()` + fill <- try_fetch( + Map(alpha, colour = fill, alpha = alpha), + error = function(cnd) { + cli::cli_abort(msg, call = expr(fill_alpha())) + } + ) + # `length(input)` must be same as `length(output)` + if (!all(lengths(fill) == 1)) { + cli::cli_abort(msg) + } + return(unlist(fill)) + } +} + +# Similar to grid:::is.pattern +is_pattern <- function(x) { + inherits(x, "GridPattern") +} + +#' Modify transparency for patterns +#' +#' This generic allows you to add your own methods for adding transparency to +#' pattern-like objects. +#' +#' @param x Object to be interpreted as pattern. +#' @param alpha A `numeric` vector between 0 and 1. If `NA`, alpha values +#' are preserved. +#' +#' @return `x` with modified transparency +#' @export +#' @keywords internal +pattern_alpha <- function(x, alpha) { + UseMethod("pattern_alpha") +} + +#' @export +pattern_alpha.default <- function(x, alpha) { + if (!is.atomic(x)) { + cli::cli_abort("Can't apply {.arg alpha} to {obj_type_friendly(x)}.") + } + pattern(rectGrob(), gp = gpar(fill = alpha(x, alpha))) +} + +#' @export +pattern_alpha.GridPattern <- function(x, alpha) { + x$colours <- alpha(x$colours, alpha[1]) + x +} + +#' @export +pattern_alpha.GridTilingPattern <- function(x, alpha) { + if (all(is.na(alpha) | alpha == 1)) { + return(x) + } + check_device("alpha_masks", "warn") + grob <- env_get(environment(x$f), "grob") + mask <- as.mask(rectGrob(gp = gpar(fill = alpha("white", alpha)))) + if (is.null(grob$vp)) { + grob$vp <- viewport(mask = mask) + } else { + grob$vp <- editViewport(grob$vp, mask = mask) + } + new_env <- new.env(parent = environment(x$f)) + env_bind(new_env, grob = grob) + environment(x$f) <- new_env + x +} + +#' @export +pattern_alpha.list <- function(x, alpha) { + Map(pattern_alpha, x = x, alpha = alpha) +} + diff --git a/R/utilities.R b/R/utilities.R index 1efbc121ff..5888423cea 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -42,7 +42,7 @@ check_required_aesthetics <- function(required, present, name, call = caller_env if (length(missing_aes) > 1) { message <- paste0(message, " {.strong or} {.field {missing_aes[[2]]}}") } - cli::cli_abort(message, call = call) + cli::cli_abort(paste0(message, "."), call = call) } # Concatenate a named list for output @@ -62,7 +62,7 @@ clist <- function(l) { # @keyword internal uniquecols <- function(df) { df <- df[1, sapply(df, is_unique), drop = FALSE] - rownames(df) <- 1:nrow(df) + rownames(df) <- seq_len(nrow(df)) df } @@ -178,7 +178,7 @@ rescale01 <- function(x) { (x - rng[1]) / (rng[2] - rng[1]) } -binned_pal <- function(palette) { +pal_binned <- function(palette) { function(x) { palette(length(x)) } @@ -199,7 +199,7 @@ gg_dep <- function(version, msg) { .Deprecated() v <- as.package_version(version) cv <- utils::packageVersion("ggplot2") - text <- "{msg} (Defunct; last used in version {version})" + text <- "{msg} (Defunct; last used in version {version})." # If current major number is greater than last-good major number, or if # current minor number is more than 1 greater than last-good minor number, @@ -320,7 +320,7 @@ find_args <- function(...) { vals <- mget(args, envir = env) vals <- vals[!vapply(vals, is_missing_arg, logical(1))] - modify_list(vals, list(..., `...` = NULL)) + modify_list(vals, list2(..., `...` = NULL)) } # Used in annotations to ensure printed even when no @@ -598,6 +598,69 @@ is_bang <- function(x) { is_call(x, "!", n = 1) } +# Puts all columns with 'AsIs' type in a '.ignore' column. + + + +#' Ignoring and exposing data +#' +#' The `.ignore_data()` function is used to hide `` columns during +#' scale interactions in `ggplot_build()`. The `.expose_data()` function is +#' used to restore hidden columns. +#' +#' @param data A list of ``s. +#' +#' @return A modified list of `s` +#' @export +#' @keywords internal +#' @name ignoring_data +#' +#' @examples +#' data <- list( +#' data.frame(x = 1:3, y = I(1:3)), +#' data.frame(w = I(1:3), z = 1:3) +#' ) +#' +#' ignored <- .ignore_data(data) +#' str(ignored) +#' +#' .expose_data(ignored) +.ignore_data <- function(data) { + if (!is_bare_list(data)) { + data <- list(data) + } + lapply(data, function(df) { + is_asis <- vapply(df, inherits, logical(1), what = "AsIs") + if (!any(is_asis)) { + return(df) + } + df <- unclass(df) + # We trust that 'df' is a valid data.frame with equal length columns etc, + # so we can use the more performant `new_data_frame()` + new_data_frame(c( + df[!is_asis], + list(.ignored = new_data_frame(df[is_asis])) + )) + }) +} + +# Restores all columns packed into the '.ignored' column. +#' @rdname ignoring_data +#' @export +.expose_data <- function(data) { + if (!is_bare_list(data)) { + data <- list(data) + } + lapply(data, function(df) { + is_ignored <- which(names(df) == ".ignored") + if (length(is_ignored) == 0) { + return(df) + } + df <- unclass(df) + new_data_frame(c(df[-is_ignored], df[[is_ignored[1]]])) + }) +} + is_triple_bang <- function(x) { if (!is_bang(x)) { return(FALSE) diff --git a/R/zxx.R b/R/zxx.R index 369f7c532c..080bdfceb2 100644 --- a/R/zxx.R +++ b/R/zxx.R @@ -16,7 +16,7 @@ scale_colour_ordinal <- function(..., type = getOption("ggplot2.ordinal.colour", exec( discrete_scale, aesthetics = "colour", - palette = ordinal_pal(type), + palette = pal_ordinal(type), !!!args ) } @@ -40,7 +40,7 @@ scale_colour_datetime <- function(..., datetime_scale( "colour", "time", - palette = seq_gradient_pal(low, high, space), + palette = pal_seq_gradient(low, high, space), na.value = na.value, guide = guide, ... @@ -64,7 +64,7 @@ scale_colour_date <- function(..., datetime_scale( "colour", "date", - palette = seq_gradient_pal(low, high, space), + palette = pal_seq_gradient(low, high, space), na.value = na.value, guide = guide, ... @@ -94,13 +94,13 @@ scale_fill_ordinal <- function(..., type = getOption("ggplot2.ordinal.fill", get exec( discrete_scale, aesthetics = "fill", - palette = ordinal_pal(type), + palette = pal_ordinal(type), !!!args ) } } -ordinal_pal <- function(colours, na.color = "grey50", alpha = TRUE) { +pal_ordinal <- function(colours, na.color = "grey50", alpha = TRUE) { pal <- scales::colour_ramp(colours, na.color = na.color, alpha = alpha) function(n) { pal(seq(0, 1, length.out = n)) @@ -119,7 +119,7 @@ scale_fill_datetime <- function(..., datetime_scale( "fill", "time", - palette = seq_gradient_pal(low, high, space), + palette = pal_seq_gradient(low, high, space), na.value = na.value, guide = guide, ... @@ -138,7 +138,7 @@ scale_fill_date <- function(..., datetime_scale( "fill", "date", - palette = seq_gradient_pal(low, high, space), + palette = pal_seq_gradient(low, high, space), na.value = na.value, guide = guide, ... diff --git a/R/zzz.R b/R/zzz.R index 0dcfd407cf..4d6755b53b 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -11,11 +11,11 @@ random_tip <- function() { tips <- c( "RStudio Community is a great place to get help: https://community.rstudio.com/c/tidyverse", "Learn more about the underlying theory at https://ggplot2-book.org/", - "Keep up to date with changes at https://www.tidyverse.org/blog/", + "Keep up to date with changes at https://tidyverse.org/blog/", "Use suppressPackageStartupMessages() to eliminate package startup messages", "Need help? Try Stackoverflow: https://stackoverflow.com/tags/ggplot2", "Need help getting started? Try the R Graphics Cookbook: https://r-graphics.org", - "Want to understand how all the pieces fit together? Read R for Data Science: https://r4ds.had.co.nz/" + "Want to understand how all the pieces fit together? Read R for Data Science: https://r4ds.hadley.nz/" ) sample(tips, 1) diff --git a/_pkgdown.yml b/_pkgdown.yml index 1bbe6e33ef..1bf6161b79 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -127,9 +127,11 @@ reference: - guide_legend - guide_axis - guide_axis_logticks + - guide_axis_stack - guide_axis_theta - guide_bins - guide_coloursteps + - guide_custom - guide_none - guides - sec_axis diff --git a/icons/icons.R b/icons/icons.R index 23464aa818..36ed8bfa8d 100644 --- a/icons/icons.R +++ b/icons/icons.R @@ -139,7 +139,7 @@ write_icon("geom_bin2d", { out <- expand.grid(x = x, y = x) fill <- sqrt((out$x - 0.5) ^ 2 + (out$y - 0.5) ^ 2) - pal <- scales::seq_gradient_pal("#56B1F7", "#132B43") + pal <- scales::pal_seq_gradient("#56B1F7", "#132B43") rectGrob( out$x + 1/n/2, out$y + 1/n/2, diff --git a/man/annotate.Rd b/man/annotate.Rd index 63e29580cf..a282c9eb09 100644 --- a/man/annotate.Rd +++ b/man/annotate.Rd @@ -48,7 +48,7 @@ affect the legend. \section{Unsupported geoms}{ Due to their special nature, reference line geoms \code{\link[=geom_abline]{geom_abline()}}, -\code{\link[=geom_hline]{geom_hline()}}, and \code{\link[=geom_vline]{geom_vline()}} can't be used with \code{\link[=annotate]{annotate()}}. +\code{\link[=geom_hline]{geom_hline()}}, and \code{\link[=geom_vline]{geom_vline()}} can't be used with \code{annotate()}. You can use these geoms directly for annotations. } diff --git a/man/binned_scale.Rd b/man/binned_scale.Rd index e242ee7a6b..31d70663f0 100644 --- a/man/binned_scale.Rd +++ b/man/binned_scale.Rd @@ -35,7 +35,7 @@ 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()}}).} +(e.g., \code{\link[scales:pal_area]{scales::pal_area()}}).} \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 @@ -46,7 +46,7 @@ omitted.} \itemize{ \item \code{NULL} for no breaks \item \code{waiver()} for the default breaks computed by the -\link[scales:trans_new]{transformation object} +\link[scales:new_transform]{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:breaks_extended]{scales::extended_breaks()}}). @@ -130,8 +130,8 @@ 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 \verb{_trans}. If transformations require arguments, you can call them from the scales -package, e.g. \code{\link[scales:boxcox_trans]{scales::boxcox_trans(p = 2)}}. -You can create your own transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} +package, e.g. \code{\link[scales:transform_boxcox]{scales::transform_boxcox(p = 2)}}. +You can create your own transformation with \code{\link[scales:new_transform]{scales::new_transform()}}.} \item{show.limits}{should the limits of the scale appear as ticks} diff --git a/man/check_device.Rd b/man/check_device.Rd index cc09a1de67..906d3ce6e9 100644 --- a/man/check_device.Rd +++ b/man/check_device.Rd @@ -33,7 +33,8 @@ either \code{"blending"} or \code{"compositing"}. If \code{NULL} (default), supp all known blending or compositing operations is queried.} \item{maybe}{A logical of length 1 determining what the return value should -be in case the device capabilities cannot be assessed.} +be in case the device capabilities cannot be assessed. When the current +device is the 'null device', \code{maybe} is returned.} \item{call}{The execution environment of a currently running function, e.g. \code{\link[rlang:stack]{caller_env()}}. The function will be mentioned in diff --git a/man/continuous_scale.Rd b/man/continuous_scale.Rd index 530d96e525..6bdc511f13 100644 --- a/man/continuous_scale.Rd +++ b/man/continuous_scale.Rd @@ -33,7 +33,7 @@ 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()}}).} +(e.g., \code{\link[scales:pal_area]{scales::pal_area()}}).} \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 @@ -44,7 +44,7 @@ omitted.} \itemize{ \item \code{NULL} for no breaks \item \code{waiver()} for the default breaks computed by the -\link[scales:trans_new]{transformation object} +\link[scales:new_transform]{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:breaks_extended]{scales::extended_breaks()}}). @@ -58,7 +58,9 @@ Also accepts rlang \link[rlang:as_function]{lambda} function notation. each major break) \item A numeric vector of positions \item A function that given the limits returns a vector of minor breaks. Also -accepts rlang \link[rlang:as_function]{lambda} function notation. +accepts rlang \link[rlang:as_function]{lambda} function notation. When +the function has two arguments, it will be given the limits and major +breaks. }} \item{n.breaks}{An integer guiding the number of major breaks. The algorithm @@ -128,8 +130,8 @@ 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 \verb{_trans}. If transformations require arguments, you can call them from the scales -package, e.g. \code{\link[scales:boxcox_trans]{scales::boxcox_trans(p = 2)}}. -You can create your own transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} +package, e.g. \code{\link[scales:transform_boxcox]{scales::transform_boxcox(p = 2)}}. +You can create your own transformation with \code{\link[scales:new_transform]{scales::new_transform()}}.} \item{guide}{A function used to create a guide or its name. See \code{\link[=guides]{guides()}} for more information.} diff --git a/man/coord_trans.Rd b/man/coord_trans.Rd index 46574c61f6..c1b6285b10 100644 --- a/man/coord_trans.Rd +++ b/man/coord_trans.Rd @@ -42,7 +42,7 @@ no guarantee that straight lines will continue to be straight. } \details{ Transformations only work with continuous values: see -\code{\link[scales:trans_new]{scales::trans_new()}} for list of transformations, and instructions +\code{\link[scales:new_transform]{scales::new_transform()}} for list of transformations, and instructions on how to create your own. } \examples{ @@ -93,7 +93,7 @@ ggplot(diamonds, aes(carat, price)) + geom_smooth(method = "lm") + scale_x_log10() + scale_y_log10() + - coord_trans(x = scales::exp_trans(10), y = scales::exp_trans(10)) + coord_trans(x = scales::transform_exp(10), y = scales::transform_exp(10)) # cf. ggplot(diamonds, aes(carat, price)) + diff --git a/man/datetime_scale.Rd b/man/datetime_scale.Rd index c3a2f778a1..117d04b013 100644 --- a/man/datetime_scale.Rd +++ b/man/datetime_scale.Rd @@ -28,7 +28,7 @@ the object itself. Built-in transformations include "hms", "date" and "time".} \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()}}).} +(e.g., \code{\link[scales:pal_area]{scales::pal_area()}}).} \item{breaks}{One of: \itemize{ diff --git a/man/discrete_scale.Rd b/man/discrete_scale.Rd index b2047dcbde..09989073e0 100644 --- a/man/discrete_scale.Rd +++ b/man/discrete_scale.Rd @@ -30,7 +30,7 @@ that should be used for error messages associated with this scale.} \item{palette}{A palette function that when called with a single integer argument (the number of levels in the scale) returns the values that -they should take (e.g., \code{\link[scales:hue_pal]{scales::hue_pal()}}).} +they should take (e.g., \code{\link[scales:pal_hue]{scales::pal_hue()}}).} \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 diff --git a/man/fill_alpha.Rd b/man/fill_alpha.Rd new file mode 100644 index 0000000000..8902d4cd38 --- /dev/null +++ b/man/fill_alpha.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities-patterns.R +\name{fill_alpha} +\alias{fill_alpha} +\title{Modify fill transparency} +\usage{ +fill_alpha(fill, alpha) +} +\arguments{ +\item{fill}{A fill colour given as a \code{character} or \code{integer} vector, or as a +(list of) \verb{} object(s).} + +\item{alpha}{A transparency value between 0 (transparent) and 1 (opaque), +parallel to \code{fill}.} +} +\value{ +A \code{character} vector of colours, or list of \verb{} objects. +} +\description{ +This works much like \link[scales:alpha]{alpha()} in that it modifies the +transparency of fill colours. It differs in that \code{fill_alpha()} also attempts +to set the transparency of \verb{} objects. +} +\examples{ +# Typical colour input +fill_alpha("red", 0.5) + +if (utils::packageVersion("grid") > "4.2") { + # Pattern input + fill_alpha(list(grid::linearGradient()), 0.5) +} +} +\keyword{internal} diff --git a/man/geom_tile.Rd b/man/geom_tile.Rd index 39a6128cf7..00903da7f6 100644 --- a/man/geom_tile.Rd +++ b/man/geom_tile.Rd @@ -109,7 +109,8 @@ parameterised differently: \code{geom_rect()} uses the locations of the four corners (\code{xmin}, \code{xmax}, \code{ymin} and \code{ymax}), while \code{geom_tile()} uses the center of the tile and its size (\code{x}, \code{y}, \code{width}, \code{height}). \code{geom_raster()} is a high -performance special case for when all the tiles are the same size. +performance special case for when all the tiles are the same size, and no +pattern fills are applied. } \details{ \code{geom_rect()} and \code{geom_tile()}'s respond differently to scale diff --git a/man/ggplot2-ggproto.Rd b/man/ggplot2-ggproto.Rd index 728fcb2410..789a28db3c 100644 --- a/man/ggplot2-ggproto.Rd +++ b/man/ggplot2-ggproto.Rd @@ -12,20 +12,20 @@ % R/geom-errorbarh.R, R/geom-function.R, R/geom-hex.R, R/geom-hline.R, % R/geom-label.R, R/geom-linerange.R, R/geom-point.R, R/geom-pointrange.R, % R/geom-quantile.R, R/geom-rug.R, R/geom-smooth.R, R/geom-spoke.R, -% R/geom-text.R, R/geom-tile.R, R/geom-violin.R, R/geom-vline.R, R/guide-.R, -% R/guide-axis.R, R/guide-axis-logticks.R, R/guide-legend.R, R/guide-bins.R, -% R/guide-colorbar.R, R/guide-colorsteps.R, R/guide-none.R, R/guide-old.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-binned.R, -% R/scale-continuous.R, R/scale-date.R, R/scale-discrete-.R, -% R/scale-identity.R, R/stat-align.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-quantilemethods.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/geom-text.R, R/geom-tile.R, R/geom-violin.R, R/geom-vline.R, +% R/guide-.R, R/guide-axis.R, R/guide-axis-logticks.R, R/guide-axis-stack.R, +% R/guide-legend.R, R/guide-bins.R, R/guide-colorbar.R, R/guide-colorsteps.R, +% R/guide-custom.R, R/guide-none.R, R/guide-old.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-binned.R, R/scale-continuous.R, +% R/scale-date.R, R/scale-discrete-.R, R/scale-identity.R, R/stat-align.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-quantilemethods.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} @@ -92,10 +92,12 @@ \alias{Guide} \alias{GuideAxis} \alias{GuideAxisLogticks} +\alias{GuideAxisStack} \alias{GuideLegend} \alias{GuideBins} \alias{GuideColourbar} \alias{GuideColoursteps} +\alias{GuideCustom} \alias{GuideNone} \alias{GuideOld} \alias{Layout} diff --git a/man/guide_axis_stack.Rd b/man/guide_axis_stack.Rd new file mode 100644 index 0000000000..63ae75b003 --- /dev/null +++ b/man/guide_axis_stack.Rd @@ -0,0 +1,58 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/guide-axis-stack.R +\name{guide_axis_stack} +\alias{guide_axis_stack} +\title{Stacked axis guides} +\usage{ +guide_axis_stack( + first = "axis", + ..., + title = waiver(), + spacing = NULL, + order = 0, + position = waiver() +) +} +\arguments{ +\item{first}{A position guide given as one of the following: +\itemize{ +\item A string, for example \code{"axis"}. +\item A call to a guide function, for example \code{guide_axis()}. +}} + +\item{...}{Additional guides to stack given in the same manner as \code{first}.} + +\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{spacing}{A \code{\link[=unit]{unit()}} objects that determines how far separate guides are +spaced apart.} + +\item{order}{A positive \code{integer} of length 1 that specifies the order of +this guide among multiple guides. This controls in which order guides are +merged if there are multiple guides for the same position. If 0 (default), +the order is determined by a secret algorithm.} + +\item{position}{Where this guide should be drawn: one of top, bottom, +left, or right.} +} +\description{ +This guide can stack other position guides that represent position scales, +like those created with \link[=scale_x_continuous]{scale_(x|y)_continuous()} and +\link[=scale_x_discrete]{scale_(x|y)_discrete()}. +} +\details{ +The \code{first} guide will be placed closest to the panel and any subsequent +guides provided through \code{...} will follow in the given order. +} +\examples{ +#' # A standard plot +p <- ggplot(mpg, aes(displ, hwy)) + + geom_point() + + theme(axis.line = element_line()) + +# A normal axis first, then a capped axis +p + guides(x = guide_axis_stack("axis", guide_axis(cap = "both"))) +} diff --git a/man/guide_bins.Rd b/man/guide_bins.Rd index 6eeada9598..811037d474 100644 --- a/man/guide_bins.Rd +++ b/man/guide_bins.Rd @@ -23,6 +23,7 @@ guide_bins( axis.arrow = NULL, ticks = NULL, ticks.length = unit(0.2, "npc"), + position = NULL, direction = NULL, default.unit = "line", override.aes = list(), @@ -98,6 +99,9 @@ re-used as \code{ticks} argument (without arrow).} \item{ticks.length}{A numeric or a \code{\link[grid:unit]{grid::unit()}} object specifying the length of tick marks between the keys.} +\item{position}{A character string indicating where the legend should be +placed relative to the plot panels.} + \item{direction}{A character string indicating the direction of the guide. One of "horizontal" or "vertical."} diff --git a/man/guide_colourbar.Rd b/man/guide_colourbar.Rd index 7813c12b1c..8273ec4326 100644 --- a/man/guide_colourbar.Rd +++ b/man/guide_colourbar.Rd @@ -30,6 +30,7 @@ guide_colourbar( ticks.length = unit(0.2, "npc"), draw.ulim = TRUE, draw.llim = TRUE, + position = NULL, direction = NULL, default.unit = "line", reverse = FALSE, @@ -63,6 +64,7 @@ guide_colorbar( ticks.length = unit(0.2, "npc"), draw.ulim = TRUE, draw.llim = TRUE, + position = NULL, direction = NULL, default.unit = "line", reverse = FALSE, @@ -159,6 +161,9 @@ be visible.} \item{draw.llim}{A logical specifying if the lower limit tick marks should be visible.} +\item{position}{A character string indicating where the legend should be +placed relative to the plot panels.} + \item{direction}{A character string indicating the direction of the guide. One of "horizontal" or "vertical."} diff --git a/man/guide_coloursteps.Rd b/man/guide_coloursteps.Rd index e97230b6f4..d77895415e 100644 --- a/man/guide_coloursteps.Rd +++ b/man/guide_coloursteps.Rd @@ -96,6 +96,8 @@ label text. The default for standard text is 0 (left-aligned) and 1 (right-aligned) for expressions.} \item{\code{label.vjust}}{A numeric specifying vertical justification of the label text.} + \item{\code{position}}{A character string indicating where the legend should be +placed relative to the plot panels.} \item{\code{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. diff --git a/man/guide_custom.Rd b/man/guide_custom.Rd new file mode 100644 index 0000000000..ad8a77b80b --- /dev/null +++ b/man/guide_custom.Rd @@ -0,0 +1,67 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/guide-custom.R +\name{guide_custom} +\alias{guide_custom} +\title{Custom guides} +\usage{ +guide_custom( + grob, + width = grobWidth(grob), + height = grobHeight(grob), + title = NULL, + title.position = "top", + margin = NULL, + position = NULL, + order = 0 +) +} +\arguments{ +\item{grob}{A grob to display.} + +\item{width, height}{The allocated width and height to display the grob, given +in \code{\link[grid:unit]{grid::unit()}}s.} + +\item{title}{A character string or expression indicating the title of guide. +If \code{NULL} (default), no title is shown.} + +\item{title.position}{A character string indicating the position of a title. +One of \code{"top"} (default), \code{"bottom"}, \code{"left"} or \code{"right"}.} + +\item{margin}{Margins around the guide. See \code{\link[=margin]{margin()}} for more details. If +\code{NULL} (default), margins are taken from the \code{legend.margin} theme setting.} + +\item{position}{Currently not in use.} + +\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.} +} +\description{ +This is a special guide that can be used to display any graphical object +(grob) along with the regular guides. This guide has no associated scale. +} +\examples{ +# A standard plot +p <- ggplot(mpg, aes(displ, hwy)) + + geom_point() + +# Define a graphical object +circle <- grid::circleGrob() + +# Rendering a grob as a guide +p + guides(custom = guide_custom(circle, title = "My circle")) + +# Controlling the size of the grob defined in relative units +p + guides(custom = guide_custom( + circle, title = "My circle", + width = unit(2, "cm"), height = unit(2, "cm")) +) + +# Size of grobs in absolute units is taken directly without the need to +# set these manually +p + guides(custom = guide_custom( + title = "My circle", + grob = grid::circleGrob(r = unit(1, "cm")) +)) +} diff --git a/man/guide_legend.Rd b/man/guide_legend.Rd index 224de5587a..75e965adfc 100644 --- a/man/guide_legend.Rd +++ b/man/guide_legend.Rd @@ -20,6 +20,7 @@ guide_legend( key.spacing = NULL, key.spacing.x = NULL, key.spacing.y = NULL, + position = NULL, direction = NULL, default.unit = "line", override.aes = list(), @@ -82,6 +83,9 @@ object specifying the distance between key-label pairs in the horizontal direction (\code{key.spacing.x}), vertical direction (\code{key.spacing.y}) or both (\code{key.spacing}).} +\item{position}{A character string indicating where the legend should be +placed relative to the plot panels.} + \item{direction}{A character string indicating the direction of the guide. One of "horizontal" or "vertical."} diff --git a/man/hmisc.Rd b/man/hmisc.Rd index 40fe36ca41..96fd7bba30 100644 --- a/man/hmisc.Rd +++ b/man/hmisc.Rd @@ -29,10 +29,10 @@ These are wrappers around functions from \pkg{Hmisc} designed to make them easier to use with \code{\link[=stat_summary]{stat_summary()}}. See the Hmisc documentation for more details: \itemize{ -\item \code{\link[Hmisc:smean.cl.boot]{Hmisc::smean.cl.boot()}} -\item \code{\link[Hmisc:smean.cl.normal]{Hmisc::smean.cl.normal()}} -\item \code{\link[Hmisc:smean.sdl]{Hmisc::smean.sdl()}} -\item \code{\link[Hmisc:smedian.hilow]{Hmisc::smedian.hilow()}} +\item \code{\link[Hmisc:smean.sd]{Hmisc::smean.cl.boot()}} +\item \code{\link[Hmisc:smean.sd]{Hmisc::smean.cl.normal()}} +\item \code{\link[Hmisc:smean.sd]{Hmisc::smean.sdl()}} +\item \code{\link[Hmisc:smean.sd]{Hmisc::smedian.hilow()}} } } \examples{ diff --git a/man/ignoring_data.Rd b/man/ignoring_data.Rd new file mode 100644 index 0000000000..4f1e0817d8 --- /dev/null +++ b/man/ignoring_data.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities.R +\name{ignoring_data} +\alias{ignoring_data} +\alias{.ignore_data} +\alias{.expose_data} +\title{Ignoring and exposing data} +\usage{ +.ignore_data(data) + +.expose_data(data) +} +\arguments{ +\item{data}{A list of \verb{}s.} +} +\value{ +A modified list of \verb{s} +} +\description{ +The \code{.ignore_data()} function is used to hide \verb{} columns during +scale interactions in \code{ggplot_build()}. The \code{.expose_data()} function is +used to restore hidden columns. +} +\examples{ +data <- list( + data.frame(x = 1:3, y = I(1:3)), + data.frame(w = I(1:3), z = 1:3) +) + +ignored <- .ignore_data(data) +str(ignored) + +.expose_data(ignored) +} +\keyword{internal} diff --git a/man/pattern_alpha.Rd b/man/pattern_alpha.Rd new file mode 100644 index 0000000000..3c481d23b1 --- /dev/null +++ b/man/pattern_alpha.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities-patterns.R +\name{pattern_alpha} +\alias{pattern_alpha} +\title{Modify transparency for patterns} +\usage{ +pattern_alpha(x, alpha) +} +\arguments{ +\item{x}{Object to be interpreted as pattern.} + +\item{alpha}{A \code{numeric} vector between 0 and 1. If \code{NA}, alpha values +are preserved.} +} +\value{ +\code{x} with modified transparency +} +\description{ +This generic allows you to add your own methods for adding transparency to +pattern-like objects. +} +\keyword{internal} diff --git a/man/scale_binned.Rd b/man/scale_binned.Rd index 7949c45f13..0046d8fbcd 100644 --- a/man/scale_binned.Rd +++ b/man/scale_binned.Rd @@ -58,7 +58,7 @@ breaks are given explicitly.} \itemize{ \item \code{NULL} for no breaks \item \code{waiver()} for the default breaks computed by the -\link[scales:trans_new]{transformation object} +\link[scales:new_transform]{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:breaks_extended]{scales::extended_breaks()}}). @@ -128,8 +128,8 @@ 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 \verb{_trans}. If transformations require arguments, you can call them from the scales -package, e.g. \code{\link[scales:boxcox_trans]{scales::boxcox_trans(p = 2)}}. -You can create your own transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} +package, e.g. \code{\link[scales:transform_boxcox]{scales::transform_boxcox(p = 2)}}. +You can create your own transformation with \code{\link[scales:new_transform]{scales::new_transform()}}.} \item{guide}{A function used to create a guide or its name. See \code{\link[=guides]{guides()}} for more information.} diff --git a/man/scale_brewer.Rd b/man/scale_brewer.Rd index 428aef60b5..d63941e0b3 100644 --- a/man/scale_brewer.Rd +++ b/man/scale_brewer.Rd @@ -145,7 +145,7 @@ d + scale_colour_brewer() # Change scale label d + scale_colour_brewer("Diamond\nclarity") -# Select brewer palette to use, see ?scales::brewer_pal for more details +# Select brewer palette to use, see ?scales::pal_brewer for more details d + scale_colour_brewer(palette = "Greens") d + scale_colour_brewer(palette = "Set1") diff --git a/man/scale_continuous.Rd b/man/scale_continuous.Rd index 1d376ef051..da226139d7 100644 --- a/man/scale_continuous.Rd +++ b/man/scale_continuous.Rd @@ -65,7 +65,7 @@ omitted.} \itemize{ \item \code{NULL} for no breaks \item \code{waiver()} for the default breaks computed by the -\link[scales:trans_new]{transformation object} +\link[scales:new_transform]{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:breaks_extended]{scales::extended_breaks()}}). @@ -79,7 +79,9 @@ Also accepts rlang \link[rlang:as_function]{lambda} function notation. each major break) \item A numeric vector of positions \item A function that given the limits returns a vector of minor breaks. Also -accepts rlang \link[rlang:as_function]{lambda} function notation. +accepts rlang \link[rlang:as_function]{lambda} function notation. When +the function has two arguments, it will be given the limits and major +breaks. }} \item{n.breaks}{An integer guiding the number of major breaks. The algorithm @@ -142,8 +144,8 @@ 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 \verb{_trans}. If transformations require arguments, you can call them from the scales -package, e.g. \code{\link[scales:boxcox_trans]{scales::boxcox_trans(p = 2)}}. -You can create your own transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} +package, e.g. \code{\link[scales:transform_boxcox]{scales::transform_boxcox(p = 2)}}. +You can create your own transformation with \code{\link[scales:new_transform]{scales::new_transform()}}.} \item{guide}{A function used to create a guide or its name. See \code{\link[=guides]{guides()}} for more information.} @@ -215,9 +217,9 @@ p1 + scale_y_sqrt() p1 + scale_y_reverse() # Or you can supply a transformation in the `trans` argument: -p1 + scale_y_continuous(trans = scales::reciprocal_trans()) +p1 + scale_y_continuous(trans = scales::transform_reciprocal()) -# You can also create your own. See ?scales::trans_new +# You can also create your own. See ?scales::new_transform } \seealso{ diff --git a/man/scale_discrete.Rd b/man/scale_discrete.Rd index af686fe8a8..0333e4b60a 100644 --- a/man/scale_discrete.Rd +++ b/man/scale_discrete.Rd @@ -15,7 +15,7 @@ scale_y_discrete(..., expand = waiver(), guide = waiver(), position = "left") \describe{ \item{\code{palette}}{A palette function that when called with a single integer argument (the number of levels in the scale) returns the values that -they should take (e.g., \code{\link[scales:hue_pal]{scales::hue_pal()}}).} +they should take (e.g., \code{\link[scales:pal_hue]{scales::pal_hue()}}).} \item{\code{breaks}}{One of: \itemize{ \item \code{NULL} for no breaks diff --git a/man/scale_gradient.Rd b/man/scale_gradient.Rd index 35d57f2b68..379476681b 100644 --- a/man/scale_gradient.Rd +++ b/man/scale_gradient.Rd @@ -92,7 +92,7 @@ scale_fill_gradientn( that should be used for error messages associated with this scale.} \item{\code{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()}}).} +(e.g., \code{\link[scales:pal_area]{scales::pal_area()}}).} \item{\code{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 @@ -101,7 +101,7 @@ omitted.} \itemize{ \item \code{NULL} for no breaks \item \code{waiver()} for the default breaks computed by the -\link[scales:trans_new]{transformation object} +\link[scales:new_transform]{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:breaks_extended]{scales::extended_breaks()}}). @@ -114,7 +114,9 @@ Also accepts rlang \link[rlang:as_function]{lambda} function notation. each major break) \item A numeric vector of positions \item A function that given the limits returns a vector of minor breaks. Also -accepts rlang \link[rlang:as_function]{lambda} function notation. +accepts rlang \link[rlang:as_function]{lambda} function notation. When +the function has two arguments, it will be given the limits and major +breaks. }} \item{\code{n.breaks}}{An integer guiding the number of major breaks. The algorithm may choose a slightly different number to ensure nice break labels. Will @@ -169,8 +171,8 @@ 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 \verb{_trans}. If transformations require arguments, you can call them from the scales -package, e.g. \code{\link[scales:boxcox_trans]{scales::boxcox_trans(p = 2)}}. -You can create your own transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} +package, e.g. \code{\link[scales:transform_boxcox]{scales::transform_boxcox(p = 2)}}. +You can create your own transformation with \code{\link[scales:new_transform]{scales::new_transform()}}.} \item{\code{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()}} @@ -276,7 +278,7 @@ ggplot(df_na, aes(x = value, y)) + } \seealso{ -\code{\link[scales:seq_gradient_pal]{scales::seq_gradient_pal()}} for details on underlying +\code{\link[scales:pal_seq_gradient]{scales::pal_seq_gradient()}} for details on underlying palette, \code{\link[=scale_colour_steps]{scale_colour_steps()}} for binned variants of these scales. The documentation on \link[=aes_colour_fill_alpha]{colour aesthetics}. diff --git a/man/scale_grey.Rd b/man/scale_grey.Rd index b25989858c..16cbf37e69 100644 --- a/man/scale_grey.Rd +++ b/man/scale_grey.Rd @@ -28,7 +28,7 @@ scale_fill_grey( \describe{ \item{\code{palette}}{A palette function that when called with a single integer argument (the number of levels in the scale) returns the values that -they should take (e.g., \code{\link[scales:hue_pal]{scales::hue_pal()}}).} +they should take (e.g., \code{\link[scales:pal_hue]{scales::pal_hue()}}).} \item{\code{breaks}}{One of: \itemize{ \item \code{NULL} for no breaks diff --git a/man/scale_hue.Rd b/man/scale_hue.Rd index 73c1fe0ade..480f8434af 100644 --- a/man/scale_hue.Rd +++ b/man/scale_hue.Rd @@ -34,7 +34,7 @@ scale_fill_hue( \describe{ \item{\code{palette}}{A palette function that when called with a single integer argument (the number of levels in the scale) returns the values that -they should take (e.g., \code{\link[scales:hue_pal]{scales::hue_pal()}}).} +they should take (e.g., \code{\link[scales:pal_hue]{scales::pal_hue()}}).} \item{\code{breaks}}{One of: \itemize{ \item \code{NULL} for no breaks diff --git a/man/scale_linetype.Rd b/man/scale_linetype.Rd index 961064ea4d..21f079255c 100644 --- a/man/scale_linetype.Rd +++ b/man/scale_linetype.Rd @@ -21,7 +21,7 @@ scale_linetype_discrete(..., na.value = "blank") \describe{ \item{\code{palette}}{A palette function that when called with a single integer argument (the number of levels in the scale) returns the values that -they should take (e.g., \code{\link[scales:hue_pal]{scales::hue_pal()}}).} +they should take (e.g., \code{\link[scales:pal_hue]{scales::pal_hue()}}).} \item{\code{breaks}}{One of: \itemize{ \item \code{NULL} for no breaks diff --git a/man/scale_linewidth.Rd b/man/scale_linewidth.Rd index 153ac04fdf..e699c24441 100644 --- a/man/scale_linewidth.Rd +++ b/man/scale_linewidth.Rd @@ -42,7 +42,7 @@ omitted.} \itemize{ \item \code{NULL} for no breaks \item \code{waiver()} for the default breaks computed by the -\link[scales:trans_new]{transformation object} +\link[scales:new_transform]{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:breaks_extended]{scales::extended_breaks()}}). @@ -87,8 +87,8 @@ 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 \verb{_trans}. If transformations require arguments, you can call them from the scales -package, e.g. \code{\link[scales:boxcox_trans]{scales::boxcox_trans(p = 2)}}. -You can create your own transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} +package, e.g. \code{\link[scales:transform_boxcox]{scales::transform_boxcox(p = 2)}}. +You can create your own transformation with \code{\link[scales:new_transform]{scales::new_transform()}}.} \item{guide}{A function used to create a guide or its name. See \code{\link[=guides]{guides()}} for more information.} diff --git a/man/scale_manual.Rd b/man/scale_manual.Rd index 7a3f7402cf..f39e9db7fc 100644 --- a/man/scale_manual.Rd +++ b/man/scale_manual.Rd @@ -46,7 +46,7 @@ scale_discrete_manual(aesthetics, ..., values, breaks = waiver()) \describe{ \item{\code{palette}}{A palette function that when called with a single integer argument (the number of levels in the scale) returns the values that -they should take (e.g., \code{\link[scales:hue_pal]{scales::hue_pal()}}).} +they should take (e.g., \code{\link[scales:pal_hue]{scales::pal_hue()}}).} \item{\code{limits}}{One of: \itemize{ \item \code{NULL} to use the default scale values diff --git a/man/scale_shape.Rd b/man/scale_shape.Rd index 367aef2238..045c726e46 100644 --- a/man/scale_shape.Rd +++ b/man/scale_shape.Rd @@ -18,7 +18,7 @@ scale_shape_binned(..., solid = TRUE) \describe{ \item{\code{palette}}{A palette function that when called with a single integer argument (the number of levels in the scale) returns the values that -they should take (e.g., \code{\link[scales:hue_pal]{scales::hue_pal()}}).} +they should take (e.g., \code{\link[scales:pal_hue]{scales::pal_hue()}}).} \item{\code{breaks}}{One of: \itemize{ \item \code{NULL} for no breaks diff --git a/man/scale_size.Rd b/man/scale_size.Rd index ac7d79021f..d8b92414c7 100644 --- a/man/scale_size.Rd +++ b/man/scale_size.Rd @@ -59,7 +59,7 @@ omitted.} \itemize{ \item \code{NULL} for no breaks \item \code{waiver()} for the default breaks computed by the -\link[scales:trans_new]{transformation object} +\link[scales:new_transform]{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:breaks_extended]{scales::extended_breaks()}}). @@ -104,8 +104,8 @@ 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 \verb{_trans}. If transformations require arguments, you can call them from the scales -package, e.g. \code{\link[scales:boxcox_trans]{scales::boxcox_trans(p = 2)}}. -You can create your own transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} +package, e.g. \code{\link[scales:transform_boxcox]{scales::transform_boxcox(p = 2)}}. +You can create your own transformation with \code{\link[scales:new_transform]{scales::new_transform()}}.} \item{guide}{A function used to create a guide or its name. See \code{\link[=guides]{guides()}} for more information.} @@ -131,7 +131,9 @@ breaks are given explicitly.} each major break) \item A numeric vector of positions \item A function that given the limits returns a vector of minor breaks. Also -accepts rlang \link[rlang:as_function]{lambda} function notation. +accepts rlang \link[rlang:as_function]{lambda} function notation. When +the function has two arguments, it will be given the limits and major +breaks. }} \item{\code{oob}}{One of: \itemize{ diff --git a/man/scale_steps.Rd b/man/scale_steps.Rd index 4ce18b6839..a7906d8c4a 100644 --- a/man/scale_steps.Rd +++ b/man/scale_steps.Rd @@ -103,7 +103,7 @@ omitted.} \itemize{ \item \code{NULL} for no breaks \item \code{waiver()} for the default breaks computed by the -\link[scales:trans_new]{transformation object} +\link[scales:new_transform]{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:breaks_extended]{scales::extended_breaks()}}). @@ -152,8 +152,8 @@ 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 \verb{_trans}. If transformations require arguments, you can call them from the scales -package, e.g. \code{\link[scales:boxcox_trans]{scales::boxcox_trans(p = 2)}}. -You can create your own transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} +package, e.g. \code{\link[scales:transform_boxcox]{scales::transform_boxcox(p = 2)}}. +You can create your own transformation with \code{\link[scales:new_transform]{scales::new_transform()}}.} \item{\code{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()}} @@ -231,7 +231,7 @@ ggplot(df, aes(x, y)) + scale_colour_stepsn(colours = terrain.colors(10)) } \seealso{ -\code{\link[scales:seq_gradient_pal]{scales::seq_gradient_pal()}} for details on underlying +\code{\link[scales:pal_seq_gradient]{scales::pal_seq_gradient()}} for details on underlying palette, \code{\link[=scale_colour_gradient]{scale_colour_gradient()}} for continuous scales without binning. The documentation on \link[=aes_colour_fill_alpha]{colour aesthetics}. diff --git a/man/scale_viridis.Rd b/man/scale_viridis.Rd index 4550146e7e..aaa029c763 100644 --- a/man/scale_viridis.Rd +++ b/man/scale_viridis.Rd @@ -109,14 +109,14 @@ reversed.} \item{option}{A character string indicating the color map option to use. Eight options are available: \itemize{ - \item "magma" (or "A") - \item "inferno" (or "B") - \item "plasma" (or "C") - \item "viridis" (or "D") - \item "cividis" (or "E") - \item "rocket" (or "F") - \item "mako" (or "G") - \item "turbo" (or "H") +\item \code{"magma"} (or \code{"A"}) +\item \code{"inferno"} (or \code{"B"}) +\item \code{"plasma"} (or \code{"C"}) +\item \code{"viridis"} (or \code{"D"}) +\item \code{"cividis"} (or \code{"E"}) +\item \code{"rocket"} (or \code{"F"}) +\item \code{"mako"} (or \code{"G"}) +\item \code{"turbo"} (or \code{"H"}) }} \item{aesthetics}{Character string or vector of character strings listing the @@ -160,7 +160,7 @@ d + scale_colour_viridis_d() # Change scale label d + scale_colour_viridis_d("City\nCenter") -# Select palette to use, see ?scales::viridis_pal for more details +# Select palette to use, see ?scales::pal_viridis for more details d + scale_colour_viridis_d(option = "plasma") d + scale_colour_viridis_d(option = "inferno") diff --git a/man/theme.Rd b/man/theme.Rd index 7672d42c5a..f0f7b179e1 100644 --- a/man/theme.Rd +++ b/man/theme.Rd @@ -5,6 +5,7 @@ \title{Modify components of a theme} \usage{ theme( + ..., line, rect, text, @@ -68,8 +69,15 @@ theme( legend.text, legend.title, legend.position, + legend.position.inside, legend.direction, legend.justification, + legend.justification.top, + legend.justification.bottom, + legend.justification.left, + legend.justification.right, + legend.justification.inside, + legend.location, legend.box, legend.box.just, legend.box.margin, @@ -112,12 +120,14 @@ theme( strip.text.y.right, strip.switch.pad.grid, strip.switch.pad.wrap, - ..., complete = FALSE, validate = TRUE ) } \arguments{ +\item{...}{additional element specifications not part of base ggplot2. In general, +these should also be defined in the \verb{element tree} argument.} + \item{line}{all line elements (\code{\link[=element_line]{element_line()}})} \item{rect}{all rectangular elements (\code{\link[=element_rect]{element_rect()}})} @@ -184,8 +194,11 @@ inherits from \code{rect})} \item{legend.title}{title of legend (\code{\link[=element_text]{element_text()}}; inherits from \code{title})} -\item{legend.position}{the position of legends ("none", "left", "right", -"bottom", "top", or two-element numeric vector)} +\item{legend.position}{the default position of legends ("none", "left", +"right", "bottom", "top", "inside")} + +\item{legend.position.inside}{A numeric vector of length two setting the +placement of legends that have the \code{"inside"} position.} \item{legend.direction}{layout of items in legends ("horizontal" or "vertical")} @@ -194,6 +207,12 @@ inherits from \code{rect})} ("center" or two-element numeric vector) or the justification according to the plot area when positioned outside the plot} +\item{legend.justification.top, legend.justification.bottom, legend.justification.left, legend.justification.right, legend.justification.inside}{Same as \code{legend.justification} but specified per \code{legend.position} option.} + +\item{legend.location}{Relative placement of legends outside the plot as a +string. Can be \code{"panel"} (default) to align legends to the panels or +\code{"plot"} to align legends to the plot as a whole.} + \item{legend.box}{arrangement of multiple legends ("horizontal" or "vertical")} @@ -298,9 +317,6 @@ switched (\code{unit})} \item{strip.switch.pad.wrap}{space between strips and axes when strips are switched (\code{unit})} -\item{...}{additional element specifications not part of base ggplot2. In general, -these should also be defined in the \verb{element tree} argument.} - \item{complete}{set this to \code{TRUE} if this is a complete theme, such as the one returned by \code{\link[=theme_grey]{theme_grey()}}. Complete themes behave differently when added to a ggplot object. Also, when setting diff --git a/tests/testthat/_snaps/aes.md b/tests/testthat/_snaps/aes.md index 356b8fdc19..7f7f3ddc89 100644 --- a/tests/testthat/_snaps/aes.md +++ b/tests/testthat/_snaps/aes.md @@ -12,7 +12,7 @@ # alternative_aes_extract_usage() can inspect the call - Don't know how to get alternative usage for `foo` + Don't know how to get alternative usage for `foo`. # new_aes() checks its inputs diff --git a/tests/testthat/_snaps/annotate.md b/tests/testthat/_snaps/annotate.md index 22f7005c0a..d453866100 100644 --- a/tests/testthat/_snaps/annotate.md +++ b/tests/testthat/_snaps/annotate.md @@ -3,14 +3,14 @@ Problem while converting geom to grob. i Error occurred in the 1st layer. Caused by error in `draw_panel()`: - ! `annotation_raster()` only works with `coord_cartesian()` + ! `annotation_raster()` only works with `coord_cartesian()`. --- Problem while converting geom to grob. i Error occurred in the 1st layer. Caused by error in `draw_panel()`: - ! `annotation_custom()` only works with `coord_cartesian()` + ! `annotation_custom()` only works with `coord_cartesian()`. # annotation_map() checks the input data @@ -18,7 +18,7 @@ --- - `map` must have the columns `x`, `y`, and `id` + `map` must have the columns `x`, `y`, and `id`. # unsupported geoms signal a warning (#4719) diff --git a/tests/testthat/_snaps/autolayer.md b/tests/testthat/_snaps/autolayer.md index cb27e7aebc..23fea920ca 100644 --- a/tests/testthat/_snaps/autolayer.md +++ b/tests/testthat/_snaps/autolayer.md @@ -1,4 +1,4 @@ # autolayers default error looks correct - No autolayer method available for objects + No autolayer method available for objects. diff --git a/tests/testthat/_snaps/autoplot.md b/tests/testthat/_snaps/autoplot.md index 37dc7f4163..5f872f476f 100644 --- a/tests/testthat/_snaps/autoplot.md +++ b/tests/testthat/_snaps/autoplot.md @@ -1,5 +1,5 @@ # autoplot throws helpful error on default Objects of class are not supported by autoplot. - i have you loaded the required package? + i Have you loaded the required package? diff --git a/tests/testthat/_snaps/compat-plyr.md b/tests/testthat/_snaps/compat-plyr.md index 83f3ac29fb..d31d586cc8 100644 --- a/tests/testthat/_snaps/compat-plyr.md +++ b/tests/testthat/_snaps/compat-plyr.md @@ -1,6 +1,6 @@ # input checks work in compat functions - Can only remove rownames from and objects + Can only remove rownames from and objects. --- @@ -8,7 +8,7 @@ --- - Must be a character vector, call, or formula + Must be a character vector, call, or formula. --- diff --git a/tests/testthat/_snaps/coord-.md b/tests/testthat/_snaps/coord-.md index cf2c6984c2..c4f74d626c 100644 --- a/tests/testthat/_snaps/coord-.md +++ b/tests/testthat/_snaps/coord-.md @@ -1,20 +1,20 @@ # Coord errors on missing methods - `coord()` has not implemented a `render_bg()` method + `coord()` has not implemented a `render_bg()` method. --- - `coord()` has not implemented a `render_axis_h()` method + `coord()` has not implemented a `render_axis_h()` method. --- - `coord()` has not implemented a `render_axis_v()` method + `coord()` has not implemented a `render_axis_v()` method. --- - `coord()` has not implemented a `backtransform_range()` method + `coord()` has not implemented a `backtransform_range()` method. --- - `coord()` has not implemented a `range()` method + `coord()` has not implemented a `range()` method. diff --git a/tests/testthat/_snaps/coord_sf.md b/tests/testthat/_snaps/coord_sf.md index c53025f074..486763d781 100644 --- a/tests/testthat/_snaps/coord_sf.md +++ b/tests/testthat/_snaps/coord_sf.md @@ -1,10 +1,10 @@ # axis labels can be set manually - Breaks and labels along x direction are different lengths + `breaks` and `labels` along `x` direction have different lengths. --- - Breaks and labels along y direction are different lengths + `breaks` and `labels` along `y` direction have different lengths. --- @@ -16,7 +16,7 @@ # default crs works - Scale limits cannot be mapped onto spatial coordinates in `coord_sf()` + Scale limits cannot be mapped onto spatial coordinates in `coord_sf()`. i Consider setting `lims_method = "geometry_bbox"` or `default_crs = NULL`. # coord_sf() throws error when limits are badly specified diff --git a/tests/testthat/_snaps/error.md b/tests/testthat/_snaps/error.md index c3f91fd3df..a8cb5172df 100644 --- a/tests/testthat/_snaps/error.md +++ b/tests/testthat/_snaps/error.md @@ -1,10 +1,10 @@ # various misuses of +.gg (#2638) - Cannot use `+` with a single argument + Cannot use `+` with a single argument. i Did you accidentally put `+` on a new line? --- - Cannot add objects together + Cannot add objects together. i Did you forget to add this object to a object? diff --git a/tests/testthat/_snaps/facet-.md b/tests/testthat/_snaps/facet-.md index 3fda69b2c6..2efa86bc64 100644 --- a/tests/testthat/_snaps/facet-.md +++ b/tests/testthat/_snaps/facet-.md @@ -1,6 +1,6 @@ # facet_grid() fails if passed both a formula and a vars() - `rows` must be "NULL" or a `vars()` list if `cols` is a `vars()` list + `rows` must be `NULL` or a `vars()` list if `cols` is a `vars()` list. # can't pass formulas to `cols` @@ -13,12 +13,12 @@ --- - `rows` must be "NULL" or a `vars()` list if `cols` is a `vars()` list + `rows` must be `NULL` or a `vars()` list if `cols` is a `vars()` list. i Did you use `%>%` or `|>` instead of `+`? --- - A grid facet specification can't have more than two dimensions + A grid facet specification can't have more than two dimensions. --- @@ -38,18 +38,18 @@ --- - Faceting variables must have at least one value + Faceting variables must have at least one value. # validate_facets() provide meaningful errors - Please use `vars()` to supply facet variables + Please use `vars()` to supply facet variables. --- - Please use `vars()` to supply facet variables + Please use `vars()` to supply facet variables. i Did you use `%>%` or `|>` instead of `+`? # check_layout() throws meaningful errors - Facet layout has a bad format. It must contain columns `PANEL`, `SCALE_X`, and `SCALE_Y` + Facet layout has a bad format. It must contain columns `PANEL`, `SCALE_X`, and `SCALE_Y`. diff --git a/tests/testthat/_snaps/facet-layout.md b/tests/testthat/_snaps/facet-layout.md index d45f2c1f7d..03cdcbe8b3 100644 --- a/tests/testthat/_snaps/facet-layout.md +++ b/tests/testthat/_snaps/facet-layout.md @@ -24,33 +24,33 @@ --- - Need 3 panels, but together `nrow` and `ncol` only provide 1 - i Please increase `ncol` and/or `nrow` + Need 3 panels, but together `nrow` and `ncol` only provide 1. + i Please increase `ncol` and/or `nrow`. --- - `facet_wrap()` can't use free scales with `coord_fixed()` + `facet_wrap()` can't use free scales with `coord_fixed()`. # facet_grid throws errors at bad layout specs - `coord_fixed()` doesn't support free scales + `coord_fixed()` doesn't support free scales. --- - Free scales cannot be mixed with a fixed aspect ratio + Free scales cannot be mixed with a fixed aspect ratio. # facet_wrap and facet_grid throws errors when using reserved words - "ROW" is not an allowed name for faceting variables - i Change the name of your data columns to not be "PANEL", "ROW", "COL", "SCALE_X", or "SCALE_Y" + "ROW" is not an allowed name for faceting variables. + i Change the name of your data columns to not be "PANEL", "ROW", "COL", "SCALE_X", or "SCALE_Y". --- - "ROW" and "PANEL" are not allowed names for faceting variables - i Change the name of your data columns to not be "PANEL", "ROW", "COL", "SCALE_X", or "SCALE_Y" + "ROW" and "PANEL" are not allowed names for faceting variables. + i Change the name of your data columns to not be "PANEL", "ROW", "COL", "SCALE_X", or "SCALE_Y". --- - "ROW" is not an allowed name for faceting variables - i Change the name of your data columns to not be "PANEL", "ROW", "COL", "SCALE_X", or "SCALE_Y" + "ROW" is not an allowed name for faceting variables. + i Change the name of your data columns to not be "PANEL", "ROW", "COL", "SCALE_X", or "SCALE_Y". diff --git a/tests/testthat/_snaps/facet-strips.md b/tests/testthat/_snaps/facet-strips.md index 2bc6ad8d09..e6a72d047c 100644 --- a/tests/testthat/_snaps/facet-strips.md +++ b/tests/testthat/_snaps/facet-strips.md @@ -1,4 +1,4 @@ # facet_grid() warns about bad switch input - `switch` must be either "both", "x", or "y" + `switch` must be one of "both", "x", or "y", not "z". diff --git a/tests/testthat/_snaps/geom-.md b/tests/testthat/_snaps/geom-.md index 46be5c85c3..0eae2d74ba 100644 --- a/tests/testthat/_snaps/geom-.md +++ b/tests/testthat/_snaps/geom-.md @@ -10,6 +10,6 @@ --- - Aesthetics must be either length 1 or the same as the data (4) - x Fix the following mappings: `d` and `e` + Aesthetics must be either length 1 or the same as the data (4). + x Fix the following mappings: `d` and `e`. diff --git a/tests/testthat/_snaps/geom-boxplot.md b/tests/testthat/_snaps/geom-boxplot.md index 6ae492646a..d50a9db5e9 100644 --- a/tests/testthat/_snaps/geom-boxplot.md +++ b/tests/testthat/_snaps/geom-boxplot.md @@ -1,5 +1,5 @@ # boxplots with a group size >1 error - Can only draw one boxplot per group + Can only draw one boxplot per group. i Did you forget `aes(group = ...)`? diff --git a/tests/testthat/_snaps/geom-dotplot.md b/tests/testthat/_snaps/geom-dotplot.md index 859bad859c..ba2fa8558c 100644 --- a/tests/testthat/_snaps/geom-dotplot.md +++ b/tests/testthat/_snaps/geom-dotplot.md @@ -4,13 +4,13 @@ # weight aesthetic is checked - Computation failed in `stat_bindot()` + Computation failed in `stat_bindot()`. Caused by error in `compute_group()`: ! `weight` must be nonnegative integers, not a double vector. --- - Computation failed in `stat_bindot()` + Computation failed in `stat_bindot()`. Caused by error in `compute_group()`: ! `weight` must be nonnegative integers, not a double vector. diff --git a/tests/testthat/_snaps/geom-jitter.md b/tests/testthat/_snaps/geom-jitter.md index 972ddc90e0..ee198b595c 100644 --- a/tests/testthat/_snaps/geom-jitter.md +++ b/tests/testthat/_snaps/geom-jitter.md @@ -1,5 +1,5 @@ # geom_jitter() throws relevant errors - both `position` and `width`/`height` are supplied - i Only use one approach to alter the position + Both `position` and `width`/`height` were supplied. + i Choose a single approach to alter the position. diff --git a/tests/testthat/_snaps/geom-label.md b/tests/testthat/_snaps/geom-label.md index 73fcb48b0e..2ea8c33c06 100644 --- a/tests/testthat/_snaps/geom-label.md +++ b/tests/testthat/_snaps/geom-label.md @@ -1,9 +1,9 @@ # geom_label() throws meaningful errors - both `position` and `nudge_x`/`nudge_y` are supplied - i Only use one approach to alter the position + Both `position` and `nudge_x`/`nudge_y` are supplied. + i Choose one approach to alter the position. --- - `label` must be of length 1 + `label` must be of length 1. diff --git a/tests/testthat/_snaps/geom-linerange.md b/tests/testthat/_snaps/geom-linerange.md index 840ed7d604..8fb6cc7daa 100644 --- a/tests/testthat/_snaps/geom-linerange.md +++ b/tests/testthat/_snaps/geom-linerange.md @@ -3,5 +3,5 @@ Problem while setting up geom. i Error occurred in the 1st layer. Caused by error in `compute_geom_1()`: - ! `geom_linerange()` requires the following missing aesthetics: ymax or xmin and xmax + ! `geom_linerange()` requires the following missing aesthetics: ymax or xmin and xmax. diff --git a/tests/testthat/_snaps/geom-map.md b/tests/testthat/_snaps/geom-map.md index f669e05c9d..03bef91fa5 100644 --- a/tests/testthat/_snaps/geom-map.md +++ b/tests/testthat/_snaps/geom-map.md @@ -4,5 +4,5 @@ --- - `map` must have the columns `x`, `y`, and `id` + `map` must have the columns `x`, `y`, and `id`. diff --git a/tests/testthat/_snaps/geom-path.md b/tests/testthat/_snaps/geom-path.md index e5c4d0eb4f..6516134f98 100644 --- a/tests/testthat/_snaps/geom-path.md +++ b/tests/testthat/_snaps/geom-path.md @@ -3,5 +3,5 @@ Problem while converting geom to grob. i Error occurred in the 1st layer. Caused by error in `draw_panel()`: - ! `geom_path()` can't have varying colour, linewidth, and/or alpha along the line when linetype isn't solid + ! `geom_path()` can't have varying colour, linewidth, and/or alpha along the line when linetype isn't solid. diff --git a/tests/testthat/_snaps/geom-point.md b/tests/testthat/_snaps/geom-point.md index c5baaefa2a..e50798c2f5 100644 --- a/tests/testthat/_snaps/geom-point.md +++ b/tests/testthat/_snaps/geom-point.md @@ -1,9 +1,9 @@ # invalid shape names raise an error - Shape aesthetic contains invalid value: "void" + Shape aesthetic contains invalid value: "void". --- - shape names must be given unambiguously - i Fix "tri" + Shape names must be given unambiguously. + i Fix "tri". diff --git a/tests/testthat/_snaps/geom-raster.md b/tests/testthat/_snaps/geom-raster.md index 3458e9971b..16da7d9d54 100644 --- a/tests/testthat/_snaps/geom-raster.md +++ b/tests/testthat/_snaps/geom-raster.md @@ -19,5 +19,12 @@ Problem while converting geom to grob. i Error occurred in the 1st layer. Caused by error in `draw_panel()`: - ! `geom_raster()` only works with `coord_cartesian()` + ! `geom_raster()` only works with `coord_cartesian()`. + +# geom_raster() fails with pattern fills + + Problem while converting geom to grob. + i Error occurred in the 1st layer. + Caused by error in `draw_panel()`: + ! `geom_raster()` cannot render pattern fills. diff --git a/tests/testthat/_snaps/geom-ribbon.md b/tests/testthat/_snaps/geom-ribbon.md index af4c34752f..ae45d533f0 100644 --- a/tests/testthat/_snaps/geom-ribbon.md +++ b/tests/testthat/_snaps/geom-ribbon.md @@ -17,7 +17,7 @@ Problem while converting geom to grob. i Error occurred in the 1st layer. Caused by error in `draw_group()`: - ! Aesthetics can not vary along a ribbon + ! Aesthetics can not vary along a ribbon. --- diff --git a/tests/testthat/_snaps/geom-sf.md b/tests/testthat/_snaps/geom-sf.md index b65a327f8a..1cc4fbb7d1 100644 --- a/tests/testthat/_snaps/geom-sf.md +++ b/tests/testthat/_snaps/geom-sf.md @@ -3,15 +3,19 @@ Problem while converting geom to grob. i Error occurred in the 1st layer. Caused by error in `draw_panel()`: - ! `geom_sf()` can only be used with `coord_sf()` + ! `geom_sf()` can only be used with `coord_sf()`. --- - both `position` and `nudge_x`/`nudge_y` are supplied - i Only use one approach to alter the position + Both `position` and `nudge_x`/`nudge_y` are supplied. + i Only use one approach to alter the position. --- - both `position` and `nudge_x`/`nudge_y` are supplied - i Only use one approach to alter the position + Both `position` and `nudge_x`/`nudge_y` are supplied. + i Only use one approach to alter the position. + +--- + + Removed 1 row containing missing values or values outside the scale range (`geom_sf()`). diff --git a/tests/testthat/_snaps/geom-text.md b/tests/testthat/_snaps/geom-text.md index 7c49514b8b..c9d11b2bc7 100644 --- a/tests/testthat/_snaps/geom-text.md +++ b/tests/testthat/_snaps/geom-text.md @@ -1,5 +1,5 @@ # geom_text() checks input - both `position` and `nudge_x`/`nudge_y` are supplied - i Only use one approach to alter the position + Both `position` and `nudge_x`/`nudge_y` are supplied. + i Only use one approach to alter the position. diff --git a/tests/testthat/_snaps/geom-violin.md b/tests/testthat/_snaps/geom-violin.md index fff4046b0d..80da5aad02 100644 --- a/tests/testthat/_snaps/geom-violin.md +++ b/tests/testthat/_snaps/geom-violin.md @@ -3,12 +3,12 @@ Problem while converting geom to grob. i Error occurred in the 1st layer. Caused by error in `draw_group()`: - ! `draw_quantiles` must be between 0 and 1 + ! `draw_quantiles` must be between 0 and 1. --- Problem while converting geom to grob. i Error occurred in the 1st layer. Caused by error in `draw_group()`: - ! `draw_quantiles` must be between 0 and 1 + ! `draw_quantiles` must be between 0 and 1. diff --git a/tests/testthat/_snaps/ggsave.md b/tests/testthat/_snaps/ggsave.md index 97cf92d361..8a16fc672b 100644 --- a/tests/testthat/_snaps/ggsave.md +++ b/tests/testthat/_snaps/ggsave.md @@ -4,8 +4,7 @@ # invalid single-string DPI values throw an error - Unknown `dpi` string - i Use either "screen", "print", or "retina" + `dpi` must be one of "screen", "print", or "retina", not "abc". # invalid non-single-string DPI values throw an error diff --git a/tests/testthat/_snaps/guides.md b/tests/testthat/_snaps/guides.md index 6e49237a76..3703c52d09 100644 --- a/tests/testthat/_snaps/guides.md +++ b/tests/testthat/_snaps/guides.md @@ -40,7 +40,7 @@ --- - `nrow` * `ncol` needs to be larger than the number of breaks (5) + `nrow` * `ncol` needs to be larger than the number of breaks (5). # colorsteps and bins checks the breaks format diff --git a/tests/testthat/_snaps/guides/stacked-axes.svg b/tests/testthat/_snaps/guides/stacked-axes.svg new file mode 100644 index 0000000000..6d66656927 --- /dev/null +++ b/tests/testthat/_snaps/guides/stacked-axes.svg @@ -0,0 +1,148 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +100 +200 +300 + + + + +100 +200 +300 + +100 +200 +300 +400 + + + + + +100 +200 +300 +400 + + + + + + + + + +100 +200 +300 +400 + + + + + +100 +200 +300 +400 + + + + +100 +200 +300 + + + + +100 +200 +300 +top +bottom +left +right +stacked axes + + diff --git a/tests/testthat/_snaps/guides/stacked-radial-axes.svg b/tests/testthat/_snaps/guides/stacked-radial-axes.svg new file mode 100644 index 0000000000..240e16d958 --- /dev/null +++ b/tests/testthat/_snaps/guides/stacked-radial-axes.svg @@ -0,0 +1,143 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +100 +200 +300 + + + + +100 +200 +300 + + + + +100 +200 +300 + + + + +100 +200 +300 + + + + + +100 +200 +300 +400 + + + + + +100 +200 +300 +400 + + + + + + + + + +100 +200 +300 +400 + + + + + +100 +200 +300 +400 +hp +left +right +stacked radial axes + + diff --git a/tests/testthat/_snaps/labellers.md b/tests/testthat/_snaps/labellers.md index 667fc9aa8c..8887717d9d 100644 --- a/tests/testthat/_snaps/labellers.md +++ b/tests/testthat/_snaps/labellers.md @@ -1,12 +1,12 @@ # resolve_labeller() provide meaningful errors - Supply one of `rows` or `cols` + Supply one of `rows` or `cols`. --- - Cannot supply both `rows` and `cols` to `facet_wrap()` + Cannot supply both `rows` and `cols` to `facet_wrap()`. # labeller function catches overlap in names - Conflict between `.rows` and `vs` + Conflict between `.rows` and `vs`. diff --git a/tests/testthat/_snaps/layer.md b/tests/testthat/_snaps/layer.md index 641c3d3dc3..fc9cabc49a 100644 --- a/tests/testthat/_snaps/layer.md +++ b/tests/testthat/_snaps/layer.md @@ -12,16 +12,16 @@ --- - `mapping` must be created by `aes()` + `mapping` must be created by `aes()`. --- - `mapping` must be created by `aes()` + `mapping` must be created by `aes()`. i Did you use `%>%` or `|>` instead of `+`? --- - Can't find geom called "test" + Can't find geom called "test". --- @@ -74,14 +74,14 @@ Problem while setting up geom. i Error occurred in the 1st layer. Caused by error in `compute_geom_1()`: - ! `geom_linerange()` requires the following missing aesthetics: ymax or xmin and xmax + ! `geom_linerange()` requires the following missing aesthetics: ymax or xmin and xmax. --- Problem while converting geom to grob. i Error occurred in the 2nd layer. Caused by error in `draw_group()`: - ! Can only draw one boxplot per group + ! Can only draw one boxplot per group. i Did you forget `aes(group = ...)`? # layer warns for constant aesthetics @@ -91,5 +91,5 @@ # layer_data returns a data.frame - `layer_data()` must return a + `layer_data()` must return a . diff --git a/tests/testthat/_snaps/limits.md b/tests/testthat/_snaps/limits.md index b5a400b89c..b7f4ffd960 100644 --- a/tests/testthat/_snaps/limits.md +++ b/tests/testthat/_snaps/limits.md @@ -1,8 +1,8 @@ # limits() throw meaningful errors - All arguments must be named + All arguments must be named. --- - `linewidth` must be a two-element vector + `linewidth` must be a two-element vector. diff --git a/tests/testthat/_snaps/patterns.md b/tests/testthat/_snaps/patterns.md new file mode 100644 index 0000000000..5a9374a4d6 --- /dev/null +++ b/tests/testthat/_snaps/patterns.md @@ -0,0 +1,8 @@ +# fill_alpha works as expected + + fill must be a vector of colours or list of objects. + +--- + + fill must be a vector of colours or list of objects. + diff --git a/tests/testthat/_snaps/patterns/pattern-fills-no-alpha.svg b/tests/testthat/_snaps/patterns/pattern-fills-no-alpha.svg new file mode 100644 index 0000000000..bdf29df500 --- /dev/null +++ b/tests/testthat/_snaps/patterns/pattern-fills-no-alpha.svg @@ -0,0 +1,115 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +1 +2 +3 +4 +5 + + + + + + + + + + +A +B +C +D +x +y +pattern fills, no alpha + + diff --git a/tests/testthat/_snaps/patterns/pattern-fills-through-scale.svg b/tests/testthat/_snaps/patterns/pattern-fills-through-scale.svg new file mode 100644 index 0000000000..a703f46c91 --- /dev/null +++ b/tests/testthat/_snaps/patterns/pattern-fills-through-scale.svg @@ -0,0 +1,155 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +1 +2 +3 +4 +5 + + + + + + + + + + +A +B +C +D +x +y + +x + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A +B +C +D +pattern fills through scale + + diff --git a/tests/testthat/_snaps/patterns/pattern-fills-with-alpha.svg b/tests/testthat/_snaps/patterns/pattern-fills-with-alpha.svg new file mode 100644 index 0000000000..964a5b714b --- /dev/null +++ b/tests/testthat/_snaps/patterns/pattern-fills-with-alpha.svg @@ -0,0 +1,120 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +1 +2 +3 +4 +5 + + + + + + + + + + +A +B +C +D +x +y +pattern fills, with alpha + + diff --git a/tests/testthat/_snaps/patterns/single-pattern-fill.svg b/tests/testthat/_snaps/patterns/single-pattern-fill.svg new file mode 100644 index 0000000000..9126ab0c7f --- /dev/null +++ b/tests/testthat/_snaps/patterns/single-pattern-fill.svg @@ -0,0 +1,120 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +1 +2 +3 +4 +5 + + + + + + + + + + +A +B +C +D +x +y +single pattern fill + + diff --git a/tests/testthat/_snaps/plot.md b/tests/testthat/_snaps/plot.md index 6dd7cfd427..6035364389 100644 --- a/tests/testthat/_snaps/plot.md +++ b/tests/testthat/_snaps/plot.md @@ -1,7 +1,7 @@ # ggplot() throws informative errors - `mapping` should be created with `aes()`. - x You've supplied a object + `mapping` must be created with `aes()`. + x You've supplied a character vector. --- @@ -10,12 +10,12 @@ # construction have user friendly errors - Cannot use `+` with a single argument + Cannot use `+` with a single argument. i Did you accidentally put `+` on a new line? --- - Cannot add objects together + Cannot add objects together. i Did you forget to add this object to a object? --- diff --git a/tests/testthat/_snaps/position-collide.md b/tests/testthat/_snaps/position-collide.md index 9f31dc4898..55032f0a58 100644 --- a/tests/testthat/_snaps/position-collide.md +++ b/tests/testthat/_snaps/position-collide.md @@ -1,8 +1,8 @@ # collide() checks the input data - Neither y nor ymax defined + y and ymax are undefined. --- - `test()` requires non-overlapping x intervals + `test()` requires non-overlapping x intervals. diff --git a/tests/testthat/_snaps/position-jitterdodge.md b/tests/testthat/_snaps/position-jitterdodge.md index 068f546f5b..1a387e880e 100644 --- a/tests/testthat/_snaps/position-jitterdodge.md +++ b/tests/testthat/_snaps/position-jitterdodge.md @@ -3,5 +3,6 @@ Problem while computing position. i Error occurred in the 1st layer. Caused by error in `setup_params()`: - ! `position_jitterdodge()` requires at least one aesthetic to dodge by + ! `position_jitterdodge()` requires at least one aesthetic to dodge by. + i Use one of "fill", "colour", "linetype", "shape", "size", or "alpha" aesthetics. diff --git a/tests/testthat/_snaps/scale-colour-continuous.md b/tests/testthat/_snaps/scale-colour-continuous.md index cea6a4ed43..a5410a8799 100644 --- a/tests/testthat/_snaps/scale-colour-continuous.md +++ b/tests/testthat/_snaps/scale-colour-continuous.md @@ -11,7 +11,7 @@ --- The `type` argument must return a continuous scale for the colour aesthetic. - x The provided scale works with the following aesthetics: fill and point_colour + x The provided scale works with the following aesthetics: fill and point_colour. --- @@ -21,10 +21,10 @@ --- Unknown scale type: "abc" - i Use either "gradient" or "viridis" + i Use either "gradient" or "viridis". --- Unknown scale type: "abc" - i Use either "gradient" or "viridis" + i Use either "gradient" or "viridis". diff --git a/tests/testthat/_snaps/scale-discrete.md b/tests/testthat/_snaps/scale-discrete.md index d00d91938b..c668bceba9 100644 --- a/tests/testthat/_snaps/scale-discrete.md +++ b/tests/testthat/_snaps/scale-discrete.md @@ -1,10 +1,10 @@ # Aesthetics with no continuous interpretation fails when called - A continuous variable cannot be mapped to the linetype aesthetic - i choose a different aesthetic or use `scale_linetype_binned()` + A continuous variable cannot be mapped to the linetype aesthetic. + i Choose a different aesthetic or use `scale_linetype_binned()`. --- - A continuous variable cannot be mapped to the shape aesthetic - i choose a different aesthetic or use `scale_shape_binned()` + A continuous variable cannot be mapped to the shape aesthetic. + i Choose a different aesthetic or use `scale_shape_binned()`. diff --git a/tests/testthat/_snaps/scale-expansion.md b/tests/testthat/_snaps/scale-expansion.md index 719559d8f5..41a54fcd6b 100644 --- a/tests/testthat/_snaps/scale-expansion.md +++ b/tests/testthat/_snaps/scale-expansion.md @@ -1,8 +1,8 @@ # expansion() checks input - `mult` and `add` must be numeric vectors with 1 or 2 elements + `mult` and `add` must be numeric vectors with 1 or 2 elements. --- - `mult` and `add` must be numeric vectors with 1 or 2 elements + `mult` and `add` must be numeric vectors with 1 or 2 elements. diff --git a/tests/testthat/_snaps/scale-hue.md b/tests/testthat/_snaps/scale-hue.md index c63e0ec179..bccf63c43a 100644 --- a/tests/testthat/_snaps/scale-hue.md +++ b/tests/testthat/_snaps/scale-hue.md @@ -1,4 +1,4 @@ # scale_hue() checks the type input - `type` must be a character vector or a list of character vectors + `type` must be a character vector or a list of character vectors. diff --git a/tests/testthat/_snaps/scale_date/scale-x-date-labels-date-format-m-d.svg b/tests/testthat/_snaps/scale_date/scale-x-date-labels-label-date-m-d.svg similarity index 97% rename from tests/testthat/_snaps/scale_date/scale-x-date-labels-date-format-m-d.svg rename to tests/testthat/_snaps/scale_date/scale-x-date-labels-label-date-m-d.svg index 49346a1c5e..1fef513fa1 100644 --- a/tests/testthat/_snaps/scale_date/scale-x-date-labels-date-format-m-d.svg +++ b/tests/testthat/_snaps/scale_date/scale-x-date-labels-label-date-m-d.svg @@ -51,6 +51,6 @@ 06/01 dx price -scale_x_date(labels = date_format("%m/%d")) +scale_x_date(labels = label_date("%m/%d")) diff --git a/tests/testthat/_snaps/scale_date/scale-x-date-labels-date-format-w-week.svg b/tests/testthat/_snaps/scale_date/scale-x-date-labels-label-date-w-week.svg similarity index 97% rename from tests/testthat/_snaps/scale_date/scale-x-date-labels-date-format-w-week.svg rename to tests/testthat/_snaps/scale_date/scale-x-date-labels-label-date-w-week.svg index fa832b94e5..1748ed74f5 100644 --- a/tests/testthat/_snaps/scale_date/scale-x-date-labels-date-format-w-week.svg +++ b/tests/testthat/_snaps/scale_date/scale-x-date-labels-label-date-w-week.svg @@ -51,6 +51,6 @@ 22 week price -scale_x_date(labels = date_format("%W"), "week") +scale_x_date(labels = label_date("%W"), "week") diff --git a/tests/testthat/_snaps/scales.md b/tests/testthat/_snaps/scales.md index 0f83d92c63..61754a645a 100644 --- a/tests/testthat/_snaps/scales.md +++ b/tests/testthat/_snaps/scales.md @@ -1,46 +1,46 @@ # scale_apply preserves class and attributes - `scale_id` must not contain any "NA" + `scale_id` must not contain any "NA". # breaks and labels are correctly checked - `breaks` and `labels` must have the same length + `breaks` and `labels` must have the same length. --- - Invalid `breaks` specification. Use "NULL", not "NA". + Invalid `breaks` specification. Use `NULL`, not `NA`. --- - Invalid `minor_breaks` specification. Use "NULL", not "NA". + Invalid `minor_breaks` specification. Use `NULL`, not `NA`. --- - Invalid `labels` specification. Use "NULL", not "NA". + Invalid `labels` specification. Use `NULL`, not `NA`. --- - `breaks` and `labels` are different lengths. + `breaks` and `labels` have different lengths. --- - Invalid `breaks` specification. Use "NULL", not "NA". + Invalid `breaks` specification. Use `NULL`, not `NA`. --- - Invalid `labels` specification. Use "NULL", not "NA". + Invalid `labels` specification. Use `NULL`, not `NA`. --- - Invalid `breaks` specification. Use "NULL", not "NA". + Invalid `breaks` specification. Use `NULL`, not `NA`. --- - Invalid `labels` specification. Use "NULL", not "NA". + Invalid `labels` specification. Use `NULL`, not `NA`. --- - `breaks` and `labels` are different lengths. + `breaks` and `labels` have different lengths. # numeric scale transforms can produce breaks @@ -51,12 +51,12 @@ # training incorrectly appropriately communicates the offenders - Continuous values supplied to discrete scale + Continuous values supplied to discrete scale. i Example values: 1, 2, 3, 4, and 5 --- - Discrete values supplied to continuous scale + Discrete values supplied to continuous scale. i Example values: "A", "B", "C", "D", and "E" # Using `scale_name` prompts deprecation message diff --git a/tests/testthat/_snaps/sec-axis.md b/tests/testthat/_snaps/sec-axis.md index f6b607372b..1e1c8f1c9f 100644 --- a/tests/testthat/_snaps/sec-axis.md +++ b/tests/testthat/_snaps/sec-axis.md @@ -1,12 +1,12 @@ # sec_axis checks the user input - Secondary axes must be specified using `sec_axis()` + Secondary axes must be specified using `sec_axis()`. --- - Transformation for secondary axes must be a function + Transformation for secondary axes must be a function. --- - Transformation for secondary axes must be monotonic + Transformation for secondary axes must be monotonic. diff --git a/tests/testthat/_snaps/stat-bin.md b/tests/testthat/_snaps/stat-bin.md index c68603756b..dd7a8127bf 100644 --- a/tests/testthat/_snaps/stat-bin.md +++ b/tests/testthat/_snaps/stat-bin.md @@ -17,39 +17,39 @@ Problem while computing stat. i Error occurred in the 1st layer. Caused by error in `setup_params()`: - ! `stat_bin()` requires a continuous x aesthetic + ! `stat_bin()` requires a continuous x aesthetic. x the x aesthetic is discrete. i Perhaps you want `stat="count"`? # inputs to binning are checked - Computation failed in `stat_bin()` + Computation failed in `stat_bin()`. Caused by error in `bins()`: ! `breaks` must be a vector, not a character vector. --- - `x_range` must have two elements + `x_range` must have two elements. --- - Computation failed in `stat_bin()` + Computation failed in `stat_bin()`. Caused by error in `bin_breaks_width()`: - ! `width` must be a number, not a character vector. + ! `binwidth` must be a number, not a character vector. --- - Computation failed in `stat_bin()` + Computation failed in `stat_bin()`. Caused by error in `bin_breaks_width()`: - ! `binwidth` must be positive + ! `binwidth` must be a number larger than or equal to 0, not the number -4. --- - `x_range` must have two elements + `x_range` must have two elements. --- - Computation failed in `stat_bin()` + Computation failed in `stat_bin()`. Caused by error in `bin_breaks_bins()`: ! `bins` must be a whole number larger than or equal to 1, not the number -4. diff --git a/tests/testthat/_snaps/stat-bin2d.md b/tests/testthat/_snaps/stat-bin2d.md index 260722e175..ffc60d7f92 100644 --- a/tests/testthat/_snaps/stat-bin2d.md +++ b/tests/testthat/_snaps/stat-bin2d.md @@ -1,12 +1,12 @@ # binwidth is respected - Computation failed in `stat_bin2d()` + Computation failed in `stat_bin2d()`. Caused by error in `bin2d_breaks()`: ! `binwidth` must be a number, not a double vector. --- - Computation failed in `stat_bin2d()` + Computation failed in `stat_bin2d()`. Caused by error in `bin2d_breaks()`: ! `origin` must be a number, not a double vector. diff --git a/tests/testthat/_snaps/stat-density2d.md b/tests/testthat/_snaps/stat-density2d.md index c1bf610cc0..a8840aaa76 100644 --- a/tests/testthat/_snaps/stat-density2d.md +++ b/tests/testthat/_snaps/stat-density2d.md @@ -3,6 +3,5 @@ Problem while computing stat. i Error occurred in the 1st layer. Caused by error in `compute_layer()`: - ! Invalid value of `contour_var` ("abcd") - i Supported values are "density", "ndensity", and "count". + ! `contour_var` must be one of "density", "ndensity", or "count", not "abcd". diff --git a/tests/testthat/_snaps/stat-qq.md b/tests/testthat/_snaps/stat-qq.md index 24f4890db7..3be2b1b4e4 100644 --- a/tests/testthat/_snaps/stat-qq.md +++ b/tests/testthat/_snaps/stat-qq.md @@ -1,18 +1,18 @@ # error is thrown with wrong quantile input - Computation failed in `stat_qq()` + Computation failed in `stat_qq()`. Caused by error in `compute_group()`: - ! The length of `quantiles` must match the length of the data + ! The length of `quantiles` must match the length of the data. --- - Computation failed in `stat_qq_line()` + Computation failed in `stat_qq_line()`. Caused by error in `compute_group()`: - ! `quantiles` must have the same length as the data + ! `quantiles` must have the same length as the data. --- - Computation failed in `stat_qq_line()` + Computation failed in `stat_qq_line()`. Caused by error in `compute_group()`: ! Cannot fit line quantiles 0.15. `line.p` must have length 2. diff --git a/tests/testthat/_snaps/stat-ydensity.md b/tests/testthat/_snaps/stat-ydensity.md index 06c9915c9c..1511b0b462 100644 --- a/tests/testthat/_snaps/stat-ydensity.md +++ b/tests/testthat/_snaps/stat-ydensity.md @@ -1,8 +1,8 @@ # calc_bw() requires at least two values and correct method - `x` must contain at least 2 elements to select a bandwidth automatically + `x` must contain at least 2 elements to select a bandwidth automatically. --- - `test` is not a valid bandwidth rule + `test` is not a valid bandwidth rule. diff --git a/tests/testthat/_snaps/stats.md b/tests/testthat/_snaps/stats.md new file mode 100644 index 0000000000..92a4296185 --- /dev/null +++ b/tests/testthat/_snaps/stats.md @@ -0,0 +1,6 @@ +# erroneously dropped aesthetics are found and issue a warning + + The following aesthetics were dropped during statistical transformation: colour and fill. + i This can happen when ggplot fails to infer the correct grouping structure in the data. + i Did you forget to specify a `group` aesthetic or to convert a numerical variable into a factor? + diff --git a/tests/testthat/_snaps/theme.md b/tests/testthat/_snaps/theme.md index af1b3d4744..259a887c1a 100644 --- a/tests/testthat/_snaps/theme.md +++ b/tests/testthat/_snaps/theme.md @@ -4,21 +4,21 @@ --- - Theme element `text` must have class + Theme element `text` must have class . # incorrect theme specifications throw meaningful errors - Problem merging the `line` theme element + Can't merge the `line` theme element. Caused by error in `merge_element()`: - ! Only elements of the same class can be merged + ! Only elements of the same class can be merged. --- - Theme element `line` must have class + Theme element `line` must have class . --- - Theme element `test` has "NULL" property without default: fill, colour, linewidth, and linetype + Theme element `test` has `NULL` property without default: fill, colour, linewidth, and linetype. --- diff --git a/tests/testthat/_snaps/theme/legends-at-all-sides-with-justification.svg b/tests/testthat/_snaps/theme/legends-at-all-sides-with-justification.svg new file mode 100644 index 0000000000..9847f9f0c9 --- /dev/null +++ b/tests/testthat/_snaps/theme/legends-at-all-sides-with-justification.svg @@ -0,0 +1,157 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +10 +15 +20 +25 +30 +35 + + + + + + + + + + +100 +200 +300 +400 +disp +mpg + +wt + + + + + + + + +2 +3 +4 +5 + +drat + + + + + + + + +3.0 +3.5 +4.0 +4.5 + +hp + + + + + + + + + + + +100 +150 +200 +250 +300 + +factor(cyl) + + + + + + +4 +6 +8 + +factor(gear) + + + + + + +3 +4 +5 +legends at all sides with justification + + diff --git a/tests/testthat/_snaps/utilities.md b/tests/testthat/_snaps/utilities.md index 06692d753b..804ce1ad27 100644 --- a/tests/testthat/_snaps/utilities.md +++ b/tests/testthat/_snaps/utilities.md @@ -1,18 +1,18 @@ # check_required_aesthetics() errors on missing - `test()` requires the following missing aesthetics: y + `test()` requires the following missing aesthetics: y. --- - `test()` requires the following missing aesthetics: x and y + `test()` requires the following missing aesthetics: x and y. --- - `test()` requires the following missing aesthetics: x or y + `test()` requires the following missing aesthetics: x or y. --- - `test()` requires the following missing aesthetics: x and fill or y and fill + `test()` requires the following missing aesthetics: x and fill or y and fill. # remove_missing checks input @@ -44,7 +44,7 @@ --- - Specify exactly one of `n` and `width` + Specify exactly one of `n` and `width`. --- diff --git a/tests/testthat/test-coord-transform.R b/tests/testthat/test-coord-transform.R index 559ea74e88..1f58bdd5fe 100644 --- a/tests/testthat/test-coord-transform.R +++ b/tests/testthat/test-coord-transform.R @@ -1,4 +1,4 @@ -test_that("warnings are generated when cord_trans() results in new infinite values", { +test_that("warnings are generated when coord_trans() results in new infinite values", { p <- ggplot(head(diamonds, 20)) + geom_bar(aes(x = cut)) + coord_trans(y = "log10") @@ -59,7 +59,7 @@ test_that("coord_trans(y = 'log10') expands the x axis identically to scale_y_lo }) test_that("coord_trans() expands axes outside the domain of the axis trans", { - # sqrt_trans() has a lower limit of 0 + # transform_sqrt() has a lower limit of 0 df <- data_frame(x = 1, y = c(0, 1, 2)) p <- ggplot(df, aes(x, y)) + geom_point() built_cartesian <- ggplot_build(p + scale_y_sqrt()) diff --git a/tests/testthat/test-facet-strips.R b/tests/testthat/test-facet-strips.R index a56f5644cb..1ee8792e99 100644 --- a/tests/testthat/test-facet-strips.R +++ b/tests/testthat/test-facet-strips.R @@ -154,19 +154,19 @@ test_that("padding is only added if axis is present", { strip.switch.pad.grid = unit(10, "mm") ) pg <- ggplotGrob(p) - expect_equal(length(pg$heights), 13) + expect_equal(length(pg$heights), 17) pg <- ggplotGrob(p + scale_x_continuous(position = "top")) - expect_equal(length(pg$heights), 14) - expect_equal(as.character(pg$heights[7]), "1cm") + expect_equal(length(pg$heights), 18) + expect_equal(as.character(pg$heights[9]), "1cm") # Also add padding with negative ticks and no text (#5251) pg <- ggplotGrob( p + scale_x_continuous(labels = NULL, position = "top") + theme(axis.ticks.length.x.top = unit(-2, "mm")) ) - expect_equal(length(pg$heights), 14) - expect_equal(as.character(pg$heights[7]), "1cm") + expect_equal(length(pg$heights), 18) + expect_equal(as.character(pg$heights[9]), "1cm") }) test_that("y strip labels are rotated when strips are switched", { diff --git a/tests/testthat/test-fortify.R b/tests/testthat/test-fortify.R index 43b7adb74c..03980c19c1 100644 --- a/tests/testthat/test-fortify.R +++ b/tests/testthat/test-fortify.R @@ -1,5 +1,8 @@ test_that("spatial polygons have correct ordering", { - skip_if_not_installed("sp") + suppressPackageStartupMessages({ + skip_if_not_installed("sp") + }) + make_square <- function(x = 0, y = 0, height = 1, width = 1){ delx <- width/2 @@ -30,12 +33,14 @@ test_that("spatial polygons have correct ordering", { polys2_sp <- sp::SpatialPolygons(polys2) fake_sp2 <- sp::SpatialPolygonsDataFrame(polys2_sp, fake_data) lifecycle::expect_deprecated( - expected <- fortify(fake_sp2) + # supressing: Regions defined for each Polygons + expected <- suppressMessages(fortify(fake_sp2)) ) expected <- expected[order(expected$id, expected$order), ] lifecycle::expect_deprecated( - actual <- fortify(fake_sp) + # supressing: Regions defined for each Polygons + actual <- suppressMessages(fortify(fake_sp)) ) # the levels are different, so these columns need to be converted to character to compare diff --git a/tests/testthat/test-function-args.R b/tests/testthat/test-function-args.R index 6be2567689..2a78bf9f50 100644 --- a/tests/testthat/test-function-args.R +++ b/tests/testthat/test-function-args.R @@ -50,8 +50,8 @@ test_that("stat_xxx and StatXxx$compute_panel arg defaults match", { stat_fun_names, c("stat_function", "stat_sf") ) - # Remove stat_spoke as it has been deprecated - stat_fun_names <- setdiff(stat_fun_names, "stat_spoke") + # Remove deprecated stats + stat_fun_names <- setdiff(stat_fun_names, c("stat_spoke", "stat_summary2d")) # For each stat_xxx function and the corresponding StatXxx$compute_panel and # StatXxx$compute_group functions, make sure that if they have same args, that diff --git a/tests/testthat/test-geom-dotplot.R b/tests/testthat/test-geom-dotplot.R index a095158937..69b7d65a75 100644 --- a/tests/testthat/test-geom-dotplot.R +++ b/tests/testthat/test-geom-dotplot.R @@ -63,7 +63,7 @@ test_that("NA's result in warning from stat_bindot", { test_that("when binning on y-axis, limits depend on the panel", { p <- ggplot(mtcars, aes(factor(cyl), mpg)) + - geom_dotplot(binaxis='y') + geom_dotplot(binaxis='y', binwidth = 1/30 * diff(range(mtcars$mpg))) b1 <- ggplot_build(p + facet_wrap(~am)) b2 <- ggplot_build(p + facet_wrap(~am, scales = "free_y")) @@ -77,10 +77,10 @@ test_that("when binning on y-axis, limits depend on the panel", { test_that("weight aesthetic is checked", { p <- ggplot(mtcars, aes(x = mpg, weight = gear/3)) + - geom_dotplot() + geom_dotplot(binwidth = 1/30 * diff(range(mtcars$mpg))) expect_snapshot_warning(ggplot_build(p)) p <- ggplot(mtcars, aes(x = mpg, weight = -gear)) + - geom_dotplot() + geom_dotplot(binwidth = 1/30 * diff(range(mtcars$mpg))) expect_snapshot_warning(ggplot_build(p)) }) diff --git a/tests/testthat/test-geom-hline-vline-abline.R b/tests/testthat/test-geom-hline-vline-abline.R index 61510a3c7c..b637cd0a2f 100644 --- a/tests/testthat/test-geom-hline-vline-abline.R +++ b/tests/testthat/test-geom-hline-vline-abline.R @@ -9,12 +9,11 @@ test_that("check h/v/abline transformed on basic projections", { geom_vline(xintercept = 3, colour = "red") + geom_hline(yintercept = 3, colour = "blue") + geom_abline(intercept = 0, slope = 1, colour = "purple") + - labs(x = NULL, y = NULL) + - coord_cartesian(expand = FALSE) + labs(x = NULL, y = NULL) expect_doppelganger( "cartesian lines intersect mid-bars", - plot + plot + coord_cartesian(expand = FALSE) ) expect_doppelganger( "flipped lines intersect mid-bars", @@ -34,11 +33,10 @@ test_that("curved lines in map projections", { nzmap <- ggplot(nz, aes(long, lat, group = group)) + geom_path() + geom_hline(yintercept = -38.6) + # roughly Taupo - geom_vline(xintercept = 176) + - coord_map() + geom_vline(xintercept = 176) expect_doppelganger("straight lines in mercator", - nzmap + nzmap + coord_map() ) expect_doppelganger("lines curved in azequalarea", nzmap + coord_map(projection = 'azequalarea', orientation = c(-36.92, 174.6, 0)) diff --git a/tests/testthat/test-geom-quantile.R b/tests/testthat/test-geom-quantile.R index 710f88436d..d9eaf84184 100644 --- a/tests/testthat/test-geom-quantile.R +++ b/tests/testthat/test-geom-quantile.R @@ -13,7 +13,7 @@ test_that("geom_quantile matches quantile regression", { y = x^2 + 0.5 * rnorm(10) ) - ps <- ggplot(df, aes(x, y)) + geom_quantile() + ps <- ggplot(df, aes(x, y)) + geom_quantile(formula = y ~ x) quants <- c(0.25, 0.5, 0.75) diff --git a/tests/testthat/test-geom-raster.R b/tests/testthat/test-geom-raster.R index 081abc5c20..2dfa1106e3 100644 --- a/tests/testthat/test-geom-raster.R +++ b/tests/testthat/test-geom-raster.R @@ -9,6 +9,13 @@ test_that("geom_raster() checks input and coordinate system", { expect_snapshot_error(ggplotGrob(p)) }) +test_that("geom_raster() fails with pattern fills", { + skip_if_not(getRversion() > "4.2", message = "pattern fills are unavailalbe") + df <- data.frame(x = 1) + p <- ggplot(df, aes(x, x)) + geom_raster(fill = linearGradient()) + expect_snapshot_error(ggplotGrob(p)) +}) + # Visual tests ------------------------------------------------------------ test_that("geom_raster draws correctly", { diff --git a/tests/testthat/test-geom-smooth.R b/tests/testthat/test-geom-smooth.R index ca57bd2e38..e71df88485 100644 --- a/tests/testthat/test-geom-smooth.R +++ b/tests/testthat/test-geom-smooth.R @@ -8,11 +8,13 @@ test_that("data is ordered by x", { }) test_that("geom_smooth works in both directions", { - p <- ggplot(mpg, aes(displ, hwy)) + geom_smooth() + p <- ggplot(mpg, aes(displ, hwy)) + + geom_smooth(method = 'loess', formula = y ~ x) x <- layer_data(p) expect_false(x$flipped_aes[1]) - p <- ggplot(mpg, aes(hwy, displ)) + geom_smooth(orientation = "y") + p <- ggplot(mpg, aes(hwy, displ)) + + geom_smooth(orientation = "y", method = 'loess', formula = y ~ x) y <- layer_data(p) expect_true(y$flipped_aes[1]) @@ -103,11 +105,11 @@ test_that("geom_smooth() works with alternative stats", { expect_doppelganger("ribbon turned on in geom_smooth", { ggplot(df, aes(x, y, color = fill, fill = fill)) + - geom_smooth(stat = "summary") # ribbon on by default + geom_smooth(stat = "summary", fun.data = mean_se) # ribbon on by default }) expect_doppelganger("ribbon turned off in geom_smooth", { ggplot(df, aes(x, y, color = fill, fill = fill)) + - geom_smooth(stat = "summary", se = FALSE) # ribbon is turned off via `se = FALSE` + geom_smooth(stat = "summary", se = FALSE, fun.data = mean_se) # ribbon is turned off via `se = FALSE` }) }) diff --git a/tests/testthat/test-ggsave.R b/tests/testthat/test-ggsave.R index 4e53dc39d3..a5d7a5283c 100644 --- a/tests/testthat/test-ggsave.R +++ b/tests/testthat/test-ggsave.R @@ -93,7 +93,7 @@ test_that("ggsave fails informatively for no-extension filenames", { plot <- ggplot(mtcars, aes(disp, mpg)) + geom_point() expect_error( ggsave(tempfile(), plot), - '`filename` has no file extension and `device` is "NULL"' + "Can't save to" ) }) diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index c8ee9b2bb8..69b7bb558c 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -51,22 +51,21 @@ test_that("Colorbar respects show.legend in layer", { df <- data_frame(x = 1:3, y = 1) p <- ggplot(df, aes(x = x, y = y, color = x)) + geom_point(size = 20, shape = 21, show.legend = FALSE) - expect_false("guide-box" %in% ggplotGrob(p)$layout$name) + expect_length(ggplot_build(p)$plot$guides$guides, 0L) p <- ggplot(df, aes(x = x, y = y, color = x)) + geom_point(size = 20, shape = 21, show.legend = TRUE) - expect_true("guide-box" %in% ggplotGrob(p)$layout$name) + expect_length(ggplot_build(p)$plot$guides$guides, 1L) }) test_that("show.legend handles named vectors", { n_legends <- function(p) { g <- ggplotGrob(p) - gb <- which(g$layout$name == "guide-box") - if (length(gb) > 0) { - n <- length(g$grobs[[gb]]) - 1 - } else { - n <- 0 - } - n + gb <- grep("guide-box", g$layout$name) + n <- vapply(g$grobs[gb], function(x) { + if (is.zero(x)) return(0) + length(x$grobs) - 1 + }, numeric(1)) + sum(n) } df <- data_frame(x = 1:3, y = 20:22) @@ -350,7 +349,7 @@ test_that("legend directions are set correctly", { test_that("guide_axis_logticks calculates appropriate ticks", { - test_scale <- function(trans = identity_trans(), limits = c(NA, NA)) { + test_scale <- function(trans = transform_identity(), limits = c(NA, NA)) { scale <- scale_x_continuous(trans = trans) scale$train(scale$transform(limits)) view_scale_primary(scale) @@ -366,28 +365,28 @@ test_that("guide_axis_logticks calculates appropriate ticks", { outcome <- c((1:10)*10, (2:10)*100) # Test the classic log10 transformation - scale <- test_scale(log10_trans(), c(10, 1000)) + scale <- test_scale(transform_log10(), c(10, 1000)) key <- train_guide(guide, scale)$logkey expect_equal(sort(key$x), log10(outcome)) expect_equal(key$.type, rep(c(1,2,3), c(3, 2, 14))) # Test compound transformation - scale <- test_scale(compose_trans(log10_trans(), reverse_trans()), c(10, 1000)) + scale <- test_scale(transform_compose(transform_log10(), transform_reverse()), c(10, 1000)) key <- train_guide(guide, scale)$logkey expect_equal(sort(key$x), -log10(rev(outcome))) # Test transformation with negatives - scale <- test_scale(pseudo_log_trans(), c(-1000, 1000)) + scale <- test_scale(transform_pseudo_log(), c(-1000, 1000)) key <- train_guide(guide, scale)$logkey - unlog <- sort(pseudo_log_trans()$inverse(key$x)) + unlog <- sort(transform_pseudo_log()$inverse(key$x)) expect_equal(unlog, c(-rev(outcome), 0, outcome)) expect_equal(key$.type, rep(c(1,2,3), c(7, 4, 28))) # Test expanded argument - scale <- test_scale(log10_trans(), c(20, 900)) + scale <- test_scale(transform_log10(), c(20, 900)) scale$continuous_range <- c(1, 3) guide <- guide_axis_logticks(expanded = TRUE) @@ -408,7 +407,7 @@ test_that("guide_axis_logticks calculates appropriate ticks", { expect_equal(sort(key$x), log2(outcome)) # Should warn when scale also has transformation - scale <- test_scale(log10_trans(), limits = c(10, 1000)) + scale <- test_scale(transform_log10(), limits = c(10, 1000)) expect_snapshot_warning(train_guide(guide, scale)$logkey) }) @@ -627,16 +626,41 @@ test_that("axis guides can be capped", { expect_doppelganger("axis guides with capped ends", p) }) +test_that("guide_axis_stack stacks axes", { + + left <- guide_axis_stack("axis", guide_axis(cap = "both"), title = "left") + right <- guide_axis_stack("axis", guide_axis(cap = "both"), title = "right") + bottom <- guide_axis_stack("axis", guide_axis(cap = "both"), title = "bottom") + top <- guide_axis_stack("axis", guide_axis(cap = "both"), title = "top") + + p <- ggplot(mtcars, aes(hp, disp)) + + geom_point() + + theme(axis.line = element_line()) + + guides(x = bottom, x.sec = top, y = left, y.sec = right) + expect_doppelganger("stacked axes", p) + + bottom <- guide_axis_stack("axis_theta", guide_axis_theta(cap = "both")) + top <- guide_axis_stack("axis_theta", guide_axis_theta(cap = "both")) + + p <- ggplot(mtcars, aes(hp, disp)) + + geom_point() + + theme(axis.line = element_line()) + + coord_radial(start = 0.25 * pi, end = 1.75 * pi, donut = 0.5) + + guides(theta = top, theta.sec = bottom, r = left, r.sec = right) + expect_doppelganger("stacked radial axes", p) + +}) + test_that("logticks look as they should", { p <- ggplot(data.frame(x = c(-100, 100), y = c(10, 1000)), aes(x, y)) + geom_point() + - scale_y_continuous(trans = compose_trans(log10_trans(), reverse_trans()), + scale_y_continuous(trans = transform_compose(transform_log10(), transform_reverse()), expand = expansion(add = 0.5)) + scale_x_continuous( breaks = c(-100, -10, -1, 0, 1, 10, 100) ) + - coord_trans(x = pseudo_log_trans()) + + coord_trans(x = transform_pseudo_log()) + theme_test() + theme(axis.line = element_line(colour = "black"), panel.border = element_blank(), @@ -660,7 +684,6 @@ test_that("logticks look as they should", { ) ) expect_doppelganger("logtick axes with customisation", p) - }) test_that("guides are positioned correctly", { @@ -725,18 +748,19 @@ test_that("guides are positioned correctly", { expect_doppelganger("padding in legend box", p2) + p2 <- p2 + theme(legend.position = "inside") # Placement of legend inside expect_doppelganger("legend inside plot, centered", - p2 + theme(legend.position = c(.5, .5)) + p2 + theme(legend.position.inside = c(.5, .5)) ) expect_doppelganger("legend inside plot, bottom left", - p2 + theme(legend.justification = c(0,0), legend.position = c(0,0)) + p2 + theme(legend.justification = c(0,0), legend.position.inside = c(0,0)) ) expect_doppelganger("legend inside plot, top right", - p2 + theme(legend.justification = c(1,1), legend.position = c(1,1)) + p2 + theme(legend.justification = c(1,1), legend.position.inside = c(1,1)) ) expect_doppelganger("legend inside plot, bottom left of legend at center", - p2 + theme(legend.justification = c(0,0), legend.position = c(.5,.5)) + p2 + theme(legend.justification = c(0,0), legend.position.inside = c(.5,.5)) ) }) diff --git a/tests/testthat/test-layer.R b/tests/testthat/test-layer.R index 58ae5051bd..b0507cf7ae 100644 --- a/tests/testthat/test-layer.R +++ b/tests/testthat/test-layer.R @@ -26,10 +26,13 @@ test_that("unknown aesthetics create warning", { }) test_that("invalid aesthetics throws errors", { - p <- ggplot(mtcars) + geom_point(aes(disp, mpg, fill = data)) - expect_snapshot_error(ggplot_build(p)) - p <- ggplot(mtcars) + geom_point(aes(disp, mpg, fill = after_stat(data))) - expect_snapshot_error(ggplot_build(p)) + # We want to test error and ignore the scale search message + suppressMessages({ + p <- ggplot(mtcars) + geom_point(aes(disp, mpg, fill = data)) + expect_snapshot_error(ggplot_build(p)) + p <- ggplot(mtcars) + geom_point(aes(disp, mpg, fill = after_stat(data))) + expect_snapshot_error(ggplot_build(p)) + }) }) test_that("unknown NULL aesthetic doesn't create warning (#1909)", { @@ -57,8 +60,12 @@ test_that("missing aesthetics trigger informative error", { test_that("function aesthetics are wrapped with after_stat()", { df <- data_frame(x = 1:10) - expect_snapshot_error( - ggplot_build(ggplot(df, aes(colour = density, fill = density)) + geom_point()) + suppressMessages( + expect_snapshot_error( + ggplot_build( + ggplot(df, aes(colour = density, fill = density)) + geom_point() + ) + ) ) }) diff --git a/tests/testthat/test-patterns.R b/tests/testthat/test-patterns.R new file mode 100644 index 0000000000..8e2b64d82e --- /dev/null +++ b/tests/testthat/test-patterns.R @@ -0,0 +1,118 @@ +test_that("fill_alpha works as expected", { + + expect_snapshot_error( + fill_alpha(data.frame(x = 1:10, y = LETTERS[1:10]), 0.5) + ) + + expect_snapshot_error( + fill_alpha(list(list("red", "blue"), list("green", "orange")), 0.5) + ) + + # Vector input + expect_identical( + fill_alpha(c("red", "green"), 0.5), + c("#FF000080", "#00FF0080") + ) + + # List input + expect_identical( + fill_alpha(list("red", "green"), 0.5), + c("#FF000080", "#00FF0080") + ) + + skip_if_not_installed("grid", "4.2.0") + + # Linear gradients + expect_identical( + fill_alpha(list(linearGradient()), 0.5)[[1]]$colours, + c("#00000080", "#FFFFFF80") + ) + + # Radial gradients + expect_identical( + fill_alpha(list(radialGradient()), 0.5)[[1]]$colours, + c("#00000080", "#FFFFFF80") + ) + + # Tiled pattern + pat <- pattern( + rectGrob(c(0.25, 0.75), c(0.25, 0.75), width = 0.5, height = 0.5, + gp = gpar(fill = "black", col = NA)), + width = unit(1, "cm"), height = unit(1, "cm"), + extend = "repeat" + ) + # Constructed with empty viewport + expect_null(environment(pat$f)$grob$vp) + + ans <- fill_alpha(list(pat), 0.5) + + # Viewport should have mask + expect_s3_class(environment(ans[[1]]$f)$grob$vp$mask, "GridMask") + # Should not have altered original environment + expect_null(environment(pat$f)$grob$vp) + + # Handles plain, unlisted patterns + expect_identical( + fill_alpha(linearGradient(), 0.5)$colours, + c("#00000080", "#FFFFFF80") + ) +}) + +test_that("geoms can use pattern fills", { + + skip_if_not_installed("grid", "4.2.0") + skip_if_not_installed("svglite", "2.1.0") + + # Workaround for vdiffr's lack of pattern support + # See also https://github.com/r-lib/vdiffr/issues/132 + custom_svg <- function(plot, file, title = "") { + svglite::svglite(file) + on.exit(grDevices::dev.off()) + print( + plot + ggtitle(title) + theme_test() + ) + } + + patterns <- list( + linearGradient(group = FALSE), + radialGradient(group = FALSE), + pattern( + rectGrob(c(0.25, 0.75), c(0.25, 0.75), width = 0.5, height = 0.5, + gp = gpar(fill = "black", col = NA)), + width = unit(1, "cm"), height = unit(1, "cm"), + extend = "repeat" + ), + "black" + ) + + df <- data.frame(x = LETTERS[1:4], y = 2:5) + + expect_doppelganger( + "single pattern fill", + ggplot(df, aes(x, y)) + + geom_col(fill = patterns[3]), + writer = custom_svg + ) + + expect_doppelganger( + "pattern fills, no alpha", + ggplot(df, aes(x, y)) + + geom_col(fill = patterns), + writer = custom_svg + ) + + expect_doppelganger( + "pattern fills, with alpha", + ggplot(df, aes(x, y)) + + geom_col(fill = patterns, alpha = c(0.8, 0.6, 0.4, 0.2)), + writer = custom_svg + ) + + expect_doppelganger( + "pattern fills through scale", + ggplot(df, aes(x, y, fill = x)) + + geom_col() + + scale_fill_manual(values = rev(patterns)), + writer = custom_svg + ) +}) diff --git a/tests/testthat/test-scale-expansion.R b/tests/testthat/test-scale-expansion.R index 13f7297727..7d1b5b30ae 100644 --- a/tests/testthat/test-scale-expansion.R +++ b/tests/testthat/test-scale-expansion.R @@ -31,7 +31,7 @@ test_that("expand_limits_continuous_trans() expands limits in coordinate space", limit_info <- expand_limits_continuous_trans( c(1, 2), expand = expansion(add = 0.5), - trans = log10_trans() + trans = transform_log10() ) expect_identical( @@ -49,7 +49,7 @@ test_that("introduced non-finite values fall back on scale limits", { limit_info <- expand_limits_continuous_trans( c(1, 100), expand = expansion(add = 2), - trans = sqrt_trans() + trans = transform_sqrt() ) expect_identical(limit_info$continuous_range, c(1, (sqrt(100) + 2)^2)) @@ -102,7 +102,7 @@ test_that("expand_limits_continuous_trans() works with inverted transformations" limit_info <- expand_limits_continuous_trans( c(1, 2), expand = expansion(add = 1), - trans = reverse_trans() + trans = transform_reverse() ) expect_identical(limit_info$continuous_range, c(0, 3)) diff --git a/tests/testthat/test-scale-hue.R b/tests/testthat/test-scale-hue.R index 5f3cc779e8..12568590a8 100644 --- a/tests/testthat/test-scale-hue.R +++ b/tests/testthat/test-scale-hue.R @@ -1,8 +1,8 @@ test_that("scale_hue() checks the type input", { - pal <- qualitative_pal(type = 1:4) + pal <- pal_qualitative(type = 1:4) expect_snapshot_error(pal(4)) - pal <- qualitative_pal(type = colors()) + pal <- pal_qualitative(type = colors()) expect_silent(pal(4)) - pal <- qualitative_pal(type = list(colors()[1:10], colors()[11:30])) + pal <- pal_qualitative(type = list(colors()[1:10], colors()[11:30])) expect_silent(pal(4)) }) diff --git a/tests/testthat/test-scales-breaks-labels.R b/tests/testthat/test-scales-breaks-labels.R index 1516519512..a83ed63498 100644 --- a/tests/testthat/test-scales-breaks-labels.R +++ b/tests/testthat/test-scales-breaks-labels.R @@ -1,7 +1,7 @@ test_that("labels match breaks, even when outside limits", { sc <- scale_y_continuous(breaks = 1:4, labels = 1:4, limits = c(1, 3)) - expect_equal(sc$get_breaks(), c(1:3, NA)) + expect_equal(sc$get_breaks(), 1:4) expect_equal(sc$get_labels(), 1:4) expect_equal(sc$get_breaks_minor(), c(1, 1.5, 2, 2.5, 3)) }) @@ -115,7 +115,7 @@ test_that("discrete labels match breaks", { }) test_that("scale breaks work with numeric log transformation", { - sc <- scale_x_continuous(limits = c(1, 1e5), trans = log10_trans()) + sc <- scale_x_continuous(limits = c(1, 1e5), trans = transform_log10()) expect_equal(sc$get_breaks(), c(0, 2, 4)) # 1, 100, 10000 expect_equal(sc$get_breaks_minor(), c(0, 1, 2, 3, 4, 5)) }) @@ -231,7 +231,7 @@ test_that("breaks can be specified by names of labels", { test_that("only finite or NA values for breaks for transformed scales (#871)", { sc <- scale_y_continuous(limits = c(0.01, 0.99), trans = "probit", breaks = seq(0, 1, 0.2)) - breaks <- sc$get_breaks() + breaks <- sc$break_info()$major_source expect_true(all(is.finite(breaks) | is.na(breaks))) }) @@ -257,7 +257,7 @@ test_that("equal length breaks and labels can be passed to ViewScales with limit limits = c(10, 30) ) - expect_identical(test_scale$get_breaks(), c(NA, 20, NA)) + expect_identical(test_scale$get_breaks(), c(0, 20, 40)) expect_identical(test_scale$get_labels(), c(c("0", "20", "40"))) test_view_scale <- view_scale_primary(test_scale) @@ -297,15 +297,15 @@ test_that("minor breaks draw correctly", { expect_doppelganger("numeric-log", ggplot(df, aes(x_log, x_log)) + - scale_x_continuous(trans = log2_trans()) + + scale_x_continuous(trans = transform_log2()) + scale_y_log10() + labs(x = NULL, y = NULL) + theme ) expect_doppelganger("numeric-exp", ggplot(df, aes(x_num, x_num)) + - scale_x_continuous(trans = exp_trans(2)) + - scale_y_continuous(trans = exp_trans(2)) + + scale_x_continuous(trans = transform_exp(2)) + + scale_y_continuous(trans = transform_exp(2)) + labs(x = NULL, y = NULL) + theme ) diff --git a/tests/testthat/test-scales.R b/tests/testthat/test-scales.R index 2b1c80729d..70d5b7dd27 100644 --- a/tests/testthat/test-scales.R +++ b/tests/testthat/test-scales.R @@ -476,13 +476,13 @@ test_that("numeric scale transforms can produce breaks", { expect_equal(test_breaks("atanh", limits = c(-0.9, 0.9)), c(NA, -0.5, 0, 0.5, NA)) - # Broken, should fix on {scale}'s side - # expect_equal(test_breaks(boxcox_trans(0), limits = c(0, 10)), ...) + expect_equal(test_breaks(transform_boxcox(0), limits = c(1, 10)), + c(NA, 2.5, 5.0, 7.5, 10)) - expect_equal(test_breaks(modulus_trans(0), c(-10, 10)), + expect_equal(test_breaks(transform_modulus(0), c(-10, 10)), seq(-10, 10, by = 5)) - expect_equal(test_breaks(yj_trans(0), c(-10, 10)), + expect_equal(test_breaks(transform_yj(0), c(-10, 10)), seq(-10, 10, by = 5)) expect_equal(test_breaks("exp", c(-10, 10)), @@ -707,8 +707,8 @@ test_that("find_scale appends appropriate calls", { test_that("Using `scale_name` prompts deprecation message", { - expect_snapshot_warning(continuous_scale("x", "foobar", identity_pal())) - expect_snapshot_warning(discrete_scale("x", "foobar", identity_pal())) - expect_snapshot_warning(binned_scale("x", "foobar", identity_pal())) + expect_snapshot_warning(continuous_scale("x", "foobar", pal_identity())) + expect_snapshot_warning(discrete_scale("x", "foobar", pal_identity())) + expect_snapshot_warning(binned_scale("x", "foobar", pal_identity())) }) diff --git a/tests/testthat/test-sec-axis.R b/tests/testthat/test-sec-axis.R index d77ee102bf..7dcba15139 100644 --- a/tests/testthat/test-sec-axis.R +++ b/tests/testthat/test-sec-axis.R @@ -231,7 +231,7 @@ test_that("sec_axis() respects custom transformations", { } }) - trans_new(name = "customlog", transform = trans, inverse = inv, domain = c(1e-16, Inf)) + new_transform(name = "customlog", transform = trans, inverse = inv, domain = c(1e-16, Inf)) } # Create data @@ -335,7 +335,7 @@ test_that("sec.axis allows independent trans btwn primary and secondary axes", { "sec_axis, independent transformations", ggplot(data = data, aes(Probability, Value)) + geom_point() + scale_x_continuous( - trans = scales::probability_trans(distribution = "norm", lower.tail = FALSE), + trans = scales::transform_probability(distribution = "norm", lower.tail = FALSE), sec.axis = sec_axis(trans = ~ 1 / ., name = "Return Period") ) + theme_linedraw() ) diff --git a/tests/testthat/test-stat-bin.R b/tests/testthat/test-stat-bin.R index 24aa21ec6a..d15a19fcff 100644 --- a/tests/testthat/test-stat-bin.R +++ b/tests/testthat/test-stat-bin.R @@ -9,11 +9,11 @@ test_that("stat_bin throws error when wrong combination of aesthetic is present" }) test_that("stat_bin works in both directions", { - p <- ggplot(mpg, aes(hwy)) + stat_bin() + p <- ggplot(mpg, aes(hwy)) + stat_bin(bins = 30) x <- layer_data(p) expect_false(x$flipped_aes[1]) - p <- ggplot(mpg, aes(y = hwy)) + stat_bin() + p <- ggplot(mpg, aes(y = hwy)) + stat_bin(bins = 30) y <- layer_data(p) expect_true(y$flipped_aes[1]) @@ -81,7 +81,7 @@ test_that("breaks are transformed by the scale", { test_that("geom_histogram() can be drawn over a 0-width range (#3043)", { df <- data_frame(x = rep(1, 100)) - out <- layer_data(ggplot(df, aes(x)) + geom_histogram()) + out <- layer_data(ggplot(df, aes(x)) + geom_histogram(bins = 30)) expect_equal(nrow(out), 1) expect_equal(out$xmin, 0.95) diff --git a/tests/testthat/test-stats.R b/tests/testthat/test-stats.R index 6c46bb38df..b1acda601e 100644 --- a/tests/testthat/test-stats.R +++ b/tests/testthat/test-stats.R @@ -13,7 +13,7 @@ test_that("plot succeeds even if some computation fails", { test_that("error message is thrown when aesthetics are missing", { p <- ggplot(mtcars) + stat_sum() - expect_error(ggplot_build(p), "x and y$") + expect_error(ggplot_build(p), "x and y\\.$") }) test_that("erroneously dropped aesthetics are found and issue a warning", { @@ -40,9 +40,8 @@ test_that("erroneously dropped aesthetics are found and issue a warning", { ) p2 <- ggplot(df2, aes(id, colour = colour, fill = fill)) + geom_bar() - expect_warning( - b2 <- ggplot_build(p2), - "The following aesthetics were dropped during statistical transformation: .*colour.*, .*fill.*" + expect_snapshot_warning( + b2 <- ggplot_build(p2) ) # colour is dropped because group a's colour is not constant (GeomBar$default_aes$colour is NA) diff --git a/tests/testthat/test-theme.R b/tests/testthat/test-theme.R index ab54bf9764..af6a4b670a 100644 --- a/tests/testthat/test-theme.R +++ b/tests/testthat/test-theme.R @@ -6,6 +6,13 @@ test_that("dollar subsetting the theme does no partial matching", { expect_equal(t$foobar, 12) }) +test_that("theme argument splicing works", { + l <- list(a = 10, b = "c", d = c("foo", "bar")) + test <- theme(!!!l) + ref <- theme(a = 10, b = "c", d = c("foo", "bar")) + expect_equal(test, ref) +}) + test_that("modifying theme element properties with + operator works", { # Changing a "leaf node" works @@ -736,6 +743,38 @@ test_that("plot titles and caption can be aligned to entire plot", { }) +test_that("Legends can on all sides of the plot with custom justification", { + + plot <- ggplot(mtcars) + + aes( + disp, mpg, + colour = hp, + fill = factor(gear), + shape = factor(cyl), + size = drat, + alpha = wt + ) + + geom_point() + + guides( + shape = guide_legend(position = "top"), + colour = guide_colourbar(position = "bottom"), + size = guide_legend(position = "left"), + alpha = guide_legend(position = "right"), + fill = guide_legend(position = "inside", override.aes = list(shape = 21)) + ) + + theme_test() + + theme( + legend.justification.top = "left", + legend.justification.bottom = c(1, 0), + legend.justification.left = c(0, 1), + legend.justification.right = "bottom", + legend.justification.inside = c(0.75, 0.75), + legend.location = "plot" + ) + + expect_doppelganger("legends at all sides with justification", plot) +}) + test_that("Strips can render custom elements", { element_test <- function(...) { el <- element_text(...) diff --git a/tests/testthat/test-utilities-checks.R b/tests/testthat/test-utilities-checks.R index 04dbd79f52..0619ccc707 100644 --- a/tests/testthat/test-utilities-checks.R +++ b/tests/testthat/test-utilities-checks.R @@ -2,7 +2,8 @@ test_that("check_device checks R versions correctly", { # Most widely supported device - withr::local_pdf() + file <- withr::local_tempfile(fileext = ".pdf") + withr::local_pdf(file) # R 4.0.0 doesn't support any new features with_mocked_bindings( @@ -45,7 +46,8 @@ test_that("check_device finds device capabilities", { getRversion() < "4.2.0", "R version < 4.2.0 does doesn't have proper `dev.capabilities()`." ) - withr::local_pdf() + file <- withr::local_tempfile(fileext = ".pdf") + withr::local_pdf(file) with_mocked_bindings( dev.capabilities = function() list(clippingPaths = TRUE), expect_true(check_device("clippingPaths")), diff --git a/tests/testthat/test-utilities.R b/tests/testthat/test-utilities.R index 2a695d0117..9604303df9 100644 --- a/tests/testthat/test-utilities.R +++ b/tests/testthat/test-utilities.R @@ -177,3 +177,21 @@ test_that("resolution() gives correct answers", { # resolution has a tolerance expect_equal(resolution(c(1, 1 + 1000 * .Machine$double.eps, 2)), 1) }) + +test_that("expose/ignore_data() can round-trip a data.frame", { + + # Plain data.frame + df <- data_frame0(a = 1:3, b = 4:6, c = LETTERS[1:3], d = LETTERS[4:6]) + expect_equal(list(df), .ignore_data(df)) + expect_equal(list(df), .expose_data(df)) + + # data.frame with ignored columns + df <- data_frame0(a = 1:3, b = I(4:6), c = LETTERS[1:3], d = I(LETTERS[4:6])) + test <- .ignore_data(df)[[1]] + expect_equal(names(test), c("a", "c", ".ignored")) + expect_equal(names(test$.ignored), c("b", "d")) + + test <- .expose_data(test)[[1]] + expect_equal(test, df[, c("a", "c", "b", "d")]) + +}) diff --git a/vignettes/extending-ggplot2.Rmd b/vignettes/extending-ggplot2.Rmd index 66a610babe..0b856abe72 100644 --- a/vignettes/extending-ggplot2.Rmd +++ b/vignettes/extending-ggplot2.Rmd @@ -834,7 +834,7 @@ facet_trans <- function(trans, horizontal = TRUE, shrink = TRUE) { ggproto(NULL, FacetTrans, shrink = shrink, params = list( - trans = scales::as.trans(trans), + trans = scales::as.transform(trans), horizontal = horizontal ) )