diff --git a/DESCRIPTION b/DESCRIPTION index 95cb820686..c20a3cd7a5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -158,6 +158,7 @@ Collate: 'guides-.r' 'guides-axis.r' 'guides-grid.r' + 'guides-none.r' 'hexbin.R' 'labeller.r' 'labels.r' diff --git a/NAMESPACE b/NAMESPACE index 3670510528..28b49f80ad 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -67,14 +67,25 @@ S3method(grobWidth,absoluteGrob) S3method(grobWidth,zeroGrob) S3method(grobX,absoluteGrob) S3method(grobY,absoluteGrob) +S3method(guide_gengrob,axis) S3method(guide_gengrob,colorbar) +S3method(guide_gengrob,guide_none) S3method(guide_gengrob,legend) +S3method(guide_geom,axis) S3method(guide_geom,colorbar) +S3method(guide_geom,guide_none) S3method(guide_geom,legend) +S3method(guide_merge,axis) S3method(guide_merge,colorbar) +S3method(guide_merge,guide_none) S3method(guide_merge,legend) +S3method(guide_train,axis) S3method(guide_train,colorbar) +S3method(guide_train,guide_none) S3method(guide_train,legend) +S3method(guide_transform,axis) +S3method(guide_transform,default) +S3method(guide_transform,guide_none) S3method(heightDetails,titleGrob) S3method(heightDetails,zeroGrob) S3method(interleave,default) @@ -358,13 +369,16 @@ export(ggproto) export(ggproto_parent) export(ggsave) export(ggtitle) +export(guide_axis) export(guide_colorbar) export(guide_colourbar) export(guide_gengrob) export(guide_geom) export(guide_legend) export(guide_merge) +export(guide_none) export(guide_train) +export(guide_transform) export(guides) export(is.Coord) export(is.facet) diff --git a/NEWS.md b/NEWS.md index 5e96c37dcf..5dd0bea39b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,12 @@ # ggplot2 (development version) +* Position guides can now be customized using the new `guide_axis()`, + which can be passed to position `scale_*()` functions or via + `guides()`. The new axis guide (`guide_axis()`) comes with + arguments `check.overlap` (automatic removal of overlapping + labels), `angle` (easy rotation of axis labels), and + `n.dodge` (dodge labels into multiple rows/columns) (@paleolimbot, #3322). + * `Geom` now gains a `setup_params()` method in line with the other ggproto classes (@thomasp85, #3509) diff --git a/R/axis-secondary.R b/R/axis-secondary.R index 0d7f6df1a3..27b0554bd0 100644 --- a/R/axis-secondary.R +++ b/R/axis-secondary.R @@ -20,6 +20,9 @@ #' - A character vector giving labels (must be same length as `breaks`) #' - A function that takes the breaks as input and returns labels as output #' +#' @param guide A position guide that will be used to render +#' the axis on the plot. Usually this is [guide_axis()]. +#' #' @details #' `sec_axis` is used to create the specifications for a secondary axis. #' Except for the `trans` argument any of the arguments can be set to @@ -79,7 +82,8 @@ #' labels = scales::time_format("%b %d %I %p"))) #' #' @export -sec_axis <- function(trans = NULL, name = waiver(), breaks = waiver(), labels = waiver()) { +sec_axis <- function(trans = NULL, name = waiver(), breaks = waiver(), labels = waiver(), + guide = waiver()) { # sec_axis() historically accpeted two-sided formula, so be permissive. if (length(trans) > 2) trans <- trans[c(1,3)] @@ -88,14 +92,15 @@ sec_axis <- function(trans = NULL, name = waiver(), breaks = waiver(), labels = trans = trans, name = name, breaks = breaks, - labels = labels + labels = labels, + guide = guide ) } #' @rdname sec_axis #' #' @export -dup_axis <- function(trans = ~., name = derive(), breaks = derive(), labels = derive()) { - sec_axis(trans, name, breaks, labels) +dup_axis <- function(trans = ~., name = derive(), breaks = derive(), labels = derive(), guide = derive()) { + sec_axis(trans, name, breaks, labels, guide) } is.sec_axis <- function(x) { @@ -148,6 +153,7 @@ AxisSecondary <- ggproto("AxisSecondary", NULL, if (is.derived(self$breaks)) self$breaks <- scale$breaks if (is.waive(self$breaks)) self$breaks <- scale$trans$breaks if (is.derived(self$labels)) self$labels <- scale$labels + if (is.derived(self$guide)) self$guide <- scale$guide }, transform_range = function(self, range) { diff --git a/R/coord-.r b/R/coord-.r index e2ea1a025d..26f45c9c17 100644 --- a/R/coord-.r +++ b/R/coord-.r @@ -59,7 +59,7 @@ Coord <- ggproto("Coord", aspect = function(ranges) NULL, - labels = function(panel_params) panel_params, + labels = function(labels, panel_params) labels, render_fg = function(panel_params, theme) element_render(theme, "panel.border"), @@ -91,6 +91,14 @@ Coord <- ggproto("Coord", list() }, + setup_panel_guides = function(self, panel_params, guides, params = list()) { + panel_params + }, + + train_panel_guides = function(self, panel_params, layers, default_mapping, params = list()) { + panel_params + }, + transform = function(data, range) NULL, distance = function(x, y, panel_params) NULL, diff --git a/R/coord-cartesian-.r b/R/coord-cartesian-.r index 8222604039..d36a49674a 100644 --- a/R/coord-cartesian-.r +++ b/R/coord-cartesian-.r @@ -103,6 +103,75 @@ CoordCartesian <- ggproto("CoordCartesian", Coord, ) }, + setup_panel_guides = function(self, panel_params, guides, params = list()) { + aesthetics <- c("x", "y", "x.sec", "y.sec") + names(aesthetics) <- aesthetics + + # resolve the specified guide from the scale and/or guides + guides <- lapply(aesthetics, function(aesthetic) { + resolve_guide( + aesthetic, + panel_params[[aesthetic]], + guides, + default = guide_axis(), + null = guide_none() + ) + }) + + # resolve the guide definition as a "guide" S3 + guides <- lapply(guides, validate_guide) + + # if there is an "position" specification in the scale, pass this on to the guide + # ideally, this should be specified in the guide + guides <- lapply(aesthetics, function(aesthetic) { + guide <- guides[[aesthetic]] + scale <- panel_params[[aesthetic]] + # position could be NULL here for an empty scale + guide$position <- guide$position %|W|% scale$position + guide + }) + + panel_params$guides <- guides + panel_params + }, + + train_panel_guides = function(self, panel_params, layers, default_mapping, params = list()) { + aesthetics <- c("x", "y", "x.sec", "y.sec") + names(aesthetics) <- aesthetics + + panel_params$guides <- lapply(aesthetics, function(aesthetic) { + axis <- substr(aesthetic, 1, 1) + guide <- panel_params$guides[[aesthetic]] + guide <- guide_train(guide, panel_params[[aesthetic]]) + guide <- guide_transform(guide, self, panel_params) + guide <- guide_geom(guide, layers, default_mapping) + guide + }) + + panel_params + }, + + labels = function(self, labels, panel_params) { + positions_x <- c("top", "bottom") + positions_y <- c("left", "right") + + list( + x = lapply(c(1, 2), function(i) { + panel_guide_label( + panel_params$guides, + position = positions_x[[i]], + default_label = labels$x[[i]] + ) + }), + y = lapply(c(1, 2), function(i) { + panel_guide_label( + panel_params$guides, + position = positions_y[[i]], + default_label = labels$y[[i]]) + }) + ) + }, + render_bg = function(panel_params, theme) { guide_grid( theme, @@ -114,24 +183,16 @@ CoordCartesian <- ggproto("CoordCartesian", Coord, }, render_axis_h = function(panel_params, theme) { - arrange <- panel_params$x.arrange %||% c("secondary", "primary") - arrange_scale_keys <- c("primary" = "x", "secondary" = "x.sec")[arrange] - arrange_scales <- panel_params[arrange_scale_keys] - list( - top = draw_view_scale_axis(arrange_scales[[1]], "top", theme), - bottom = draw_view_scale_axis(arrange_scales[[2]], "bottom", theme) + top = panel_guides_grob(panel_params$guides, position = "top", theme = theme), + bottom = panel_guides_grob(panel_params$guides, position = "bottom", theme = theme) ) }, render_axis_v = function(panel_params, theme) { - arrange <- panel_params$y.arrange %||% c("primary", "secondary") - arrange_scale_keys <- c("primary" = "y", "secondary" = "y.sec")[arrange] - arrange_scales <- panel_params[arrange_scale_keys] - list( - left = draw_view_scale_axis(arrange_scales[[1]], "left", theme), - right = draw_view_scale_axis(arrange_scales[[2]], "right", theme) + left = panel_guides_grob(panel_params$guides, position = "left", theme = theme), + right = panel_guides_grob(panel_params$guides, position = "right", theme = theme) ) } ) @@ -153,10 +214,24 @@ view_scales_from_scale <- function(scale, coord_limits = NULL, expand = TRUE) { view_scales } -draw_view_scale_axis <- function(view_scale, axis_position, theme) { - if(is.null(view_scale) || view_scale$is_empty()) { - return(zeroGrob()) - } +panel_guide_label <- function(guides, position, default_label) { + guide <- guide_for_position(guides, position) %||% guide_none(title = NULL) + guide$title %|W|% default_label +} + +panel_guides_grob <- function(guides, position, theme) { + guide <- guide_for_position(guides, position) %||% guide_none() + guide_gengrob(guide, theme) +} + +guide_for_position <- function(guides, position) { + has_position <- vapply( + guides, + function(guide) identical(guide$position, position), + logical(1) + ) - draw_axis(view_scale$break_positions(), view_scale$get_labels(), axis_position, theme) + guides <- guides[has_position] + guides_order <- vapply(guides, function(guide) as.numeric(guide$order)[1], numeric(1)) + Reduce(guide_merge, guides[order(guides_order)]) } diff --git a/R/coord-flip.r b/R/coord-flip.r index 71d11f26ec..45e87c57f5 100644 --- a/R/coord-flip.r +++ b/R/coord-flip.r @@ -40,7 +40,7 @@ coord_flip <- function(xlim = NULL, ylim = NULL, expand = TRUE, clip = "on") { CoordFlip <- ggproto("CoordFlip", CoordCartesian, transform = function(data, panel_params) { - data <- flip_labels(data) + data <- flip_axis_labels(data) CoordCartesian$transform(data, panel_params) }, @@ -58,11 +58,11 @@ CoordFlip <- ggproto("CoordFlip", CoordCartesian, setup_panel_params = function(self, scale_x, scale_y, params = list()) { parent <- ggproto_parent(CoordCartesian, self) panel_params <- parent$setup_panel_params(scale_x, scale_y, params) - flip_labels(panel_params) + flip_axis_labels(panel_params) }, - labels = function(panel_params) { - flip_labels(CoordCartesian$labels(panel_params)) + labels = function(labels, panel_params) { + flip_axis_labels(CoordCartesian$labels(labels, panel_params)) }, setup_layout = function(layout, params) { @@ -72,14 +72,29 @@ CoordFlip <- ggproto("CoordFlip", CoordCartesian, }, modify_scales = function(scales_x, scales_y) { - lapply(scales_x, scale_flip_position) - lapply(scales_y, scale_flip_position) + lapply(scales_x, scale_flip_axis) + lapply(scales_y, scale_flip_axis) } ) +# In-place modification of a scale position to swap axes +scale_flip_axis <- function(scale) { + scale$position <- switch(scale$position, + top = "right", + bottom = "left", + left = "bottom", + right = "top", + scale$position + ) + + invisible(scale) +} -flip_labels <- function(x) { +# maintaining the position of the x* and y* names is +# important for re-using the same guide_transform() +# as CoordCartesian +flip_axis_labels <- function(x) { old_names <- names(x) new_names <- old_names diff --git a/R/coord-polar.r b/R/coord-polar.r index fd5d44fa3f..591447d015 100644 --- a/R/coord-polar.r +++ b/R/coord-polar.r @@ -305,11 +305,11 @@ CoordPolar <- ggproto("CoordPolar", Coord, ) }, - labels = function(self, panel_params) { + labels = function(self, labels, panel_params) { if (self$theta == "y") { - list(x = panel_params$y, y = panel_params$x) + list(x = labels$y, y = labels$x) } else { - panel_params + labels } }, diff --git a/R/coord-sf.R b/R/coord-sf.R index b73227c7e7..ed41ce4c94 100644 --- a/R/coord-sf.R +++ b/R/coord-sf.R @@ -195,6 +195,8 @@ CoordSf <- ggproto("CoordSf", CoordCartesian, diff(panel_params$y_range) / diff(panel_params$x_range) / ratio }, + labels = function(labels, panel_params) labels, + render_bg = function(self, panel_params, theme) { el <- calc_element("panel.grid.major", theme) diff --git a/R/guides-.r b/R/guides-.r index 0ad41eb131..40284afa00 100644 --- a/R/guides-.r +++ b/R/guides-.r @@ -73,7 +73,7 @@ update_guides <- function(p, guides) { } -# building guides - called in ggplotGrob (plot-render.r) +# building non-position guides - called in ggplotGrob (plot-build.r) # # the procedure is as follows: # @@ -116,7 +116,13 @@ build_guides <- function(scales, layers, default_mapping, position, theme, guide } # scales -> data for guides - gdefs <- guides_train(scales = scales, theme = theme, guides = guides, labels = labels) + gdefs <- guides_train( + scales = scales$non_position_scales(), + theme = theme, + guides = guides, + labels = labels + ) + if (length(gdefs) == 0) return(zeroGrob()) # merge overlay guides @@ -148,9 +154,15 @@ legend_position <- function(position) { } } +# resolve the guide from the scale and guides +resolve_guide <- function(aesthetic, scale, guides, default = "none", null = "none") { + guides[[aesthetic]] %||% scale$guide %|W|% default %||% null +} + # validate guide object validate_guide <- function(guide) { # if guide is specified by character, then find the corresponding guide + # when guides are officially extensible, this should use find_global() if (is.character(guide)) match.fun(paste("guide_", guide, sep = ""))() else if (inherits(guide, "guide")) @@ -170,12 +182,12 @@ guides_train <- function(scales, theme, guides, labels) { # which is prior to scale_ZZZ(guide=XXX) # guide is determined in order of: # + guides(XXX) > + scale_ZZZ(guide=XXX) > default(i.e., legend) - guide <- guides[[output]] %||% scale$guide + guide <- resolve_guide(output, scale, guides) # this should be changed to testing guide == "none" # scale$legend is backward compatibility # if guides(XXX=FALSE), then scale_ZZZ(guides=XXX) is discarded. - if (identical(guide, "none") || isFALSE(guide)) next + if (identical(guide, "none") || isFALSE(guide) || inherits(guide, "guide_none")) next # check the validity of guide. # if guide is character, then find the guide object @@ -322,6 +334,21 @@ guide_merge <- function(guide, new_guide) UseMethod("guide_merge") #' @rdname guide-exts guide_geom <- function(guide, layers, default_mapping) UseMethod("guide_geom") +#' @export +#' @rdname guide-exts +guide_transform <- function(guide, coord, panel_params) UseMethod("guide_transform") + +#' @export +guide_transform.default <- function(guide, coord, panel_params) { + stop( + "Guide with class ", + paste(class(guide), collapse = " / "), + " does not implement guide_transform(). ", + "Did you mean to use guide_axis()?", + call. = FALSE + ) +} + #' @export #' @rdname guide-exts guide_gengrob <- function(guide, theme) UseMethod("guide_gengrob") diff --git a/R/guides-axis.r b/R/guides-axis.r index d7bc5449ed..ef0c7b6f65 100644 --- a/R/guides-axis.r +++ b/R/guides-axis.r @@ -1,4 +1,165 @@ +#' Axis guide +#' +#' Axis guides are the visual representation of position scales like those +#' created with [scale_(x|y)_continuous()][scale_x_continuous()] and +#' [scale_(x|y)_discrete()][scale_x_discrete()]. +#' +#' @inheritParams guide_legend +#' @param check.overlap silently remove overlapping labels, +#' (recursively) prioritizing the first, last, and middle labels. +#' @param angle Compared to setting the angle in [theme()] / [element_text()], +#' this also uses some heuristics to automatically pick the `hjust` and `vjust` that +#' you probably want. +#' @param n.dodge The number of rows (for vertical axes) or columns (for +#' horizontal axes) that should be used to render the labels. This is +#' useful for displaying labels that would otherwise overlap. +#' @param order Used to determine the order of the guides (left-to-right, +#' top-to-bottom), if more than one guide must be drawn at the same location. +#' @param position Where this guide should be drawn: one of top, bottom, +#' left, or right. +#' +#' @export +#' +#' @examples +#' # plot with overlapping text +#' p <- ggplot(mpg, aes(cty * 100, hwy * 100)) + +#' geom_point() + +#' facet_wrap(vars(class)) +#' +#' # axis guides can be customized in the scale_* functions or +#' # using guides() +#' p + scale_x_continuous(guide = guide_axis(n.dodge = 2)) +#' p + guides(x = guide_axis(angle = 90)) +#' +#' # can also be used to add a duplicate guide +#' p + guides(x = guide_axis(n.dodge = 2), y.sec = guide_axis()) +#' +#' +guide_axis <- function(title = waiver(), check.overlap = FALSE, angle = NULL, n.dodge = 1, + order = 0, position = waiver()) { + structure( + list( + title = title, + + # customizations + check.overlap = check.overlap, + angle = angle, + n.dodge = n.dodge, + + # general + order = order, + position = position, + + # parameter + available_aes = c("x", "y"), + + name = "axis" + ), + class = c("guide", "axis") + ) +} + +#' @export +guide_train.axis <- function(guide, scale, aesthetic = NULL) { + + aesthetic <- aesthetic %||% scale$aesthetics[1] + breaks <- scale$get_breaks() + + empty_ticks <- new_data_frame( + list(aesthetic = numeric(0), .value = numeric(0), .label = character(0)) + ) + names(empty_ticks) <- c(aesthetic, ".value", ".label") + + if (length(intersect(scale$aesthetics, guide$available_aes)) == 0) { + warning( + "axis guide needs appropriate scales: ", + paste(guide$available_aes, collapse = ", "), + call. = FALSE + ) + guide$key <- empty_ticks + } else if (length(breaks) == 0) { + guide$key <- empty_ticks + } else { + ticks <- new_data_frame(setNames(list(scale$map(breaks)), aesthetic)) + ticks$.value <- breaks + ticks$.label <- scale$get_labels(breaks) + + if (is.list(ticks$.label)) { + if (any(sapply(ticks$.label, is.language))) { + ticks$.label <- do.call(expression, ticks$.label) + } else { + ticks$.label <- unlist(ticks$.label) + } + } + + guide$key <- ticks + } + + guide$name <- paste0(guide$name, "_", aesthetic) + guide$hash <- digest::digest(list(guide$title, guide$key$.value, guide$key$.label, guide$name)) + guide +} + +#' @export +guide_transform.axis <- function(guide, coord, panel_params) { + if (is.null(guide$position) || nrow(guide$key) == 0) { + return(guide) + } + + aesthetics <- names(guide$key)[!grepl("^\\.", names(guide$key))] + + if (all(c("x", "y") %in% aesthetics)) { + guide$key <- coord$transform(guide$key, panel_params) + } else { + other_aesthetic <- setdiff(c("x", "y"), aesthetics) + override_value <- if (guide$position %in% c("bottom", "left")) -Inf else Inf + guide$key[[other_aesthetic]] <- override_value + + guide$key <- coord$transform(guide$key, panel_params) + + warn_for_guide_position(guide) + } + + guide +} + +# discards the new guide with a warning +#' @export +guide_merge.axis <- function(guide, new_guide) { + if (!inherits(guide, "guide_none")) { + warning( + "guide_axis(): Discarding guide on merge. ", + "Do you have more than one guide with the same position?", + call. = FALSE + ) + } + + guide +} + +# axis guides don't care which geometry uses these aesthetics +#' @export +guide_geom.axis <- function(guide, layers, default_mapping) { + guide +} + +#' @export +guide_gengrob.axis <- function(guide, theme) { + aesthetic <- names(guide$key)[!grepl("^\\.", names(guide$key))][1] + + draw_axis( + break_positions = guide$key[[aesthetic]], + break_labels = guide$key$.label, + axis_position = guide$position, + theme = theme, + check.overlap = guide$check.overlap, + angle = guide$angle, + n.dodge = guide$n.dodge + ) +} + + #' Grob for axes #' #' @param break_position position of ticks @@ -10,14 +171,14 @@ #' @param angle Compared to setting the angle in [theme()] / [element_text()], #' this also uses some heuristics to automatically pick the `hjust` and `vjust` that #' you probably want. -#' @param n_dodge The number of rows (for vertical axes) or columns (for +#' @param n.dodge The number of rows (for vertical axes) or columns (for #' horizontal axes) that should be used to render the labels. This is #' useful for displaying labels that would otherwise overlap. #' #' @noRd #' draw_axis <- function(break_positions, break_labels, axis_position, theme, - check.overlap = FALSE, angle = NULL, n_dodge = 1) { + check.overlap = FALSE, angle = NULL, n.dodge = 1) { axis_position <- match.arg(axis_position, c("top", "bottom", "right", "left")) aesthetic <- if (axis_position %in% c("top", "bottom")) "x" else "y" @@ -96,7 +257,7 @@ draw_axis <- function(break_positions, break_labels, axis_position, theme, } # calculate multiple rows/columns of labels (which is usually 1) - dodge_pos <- rep(seq_len(n_dodge), length.out = n_breaks) + dodge_pos <- rep(seq_len(n.dodge), length.out = n_breaks) dodge_indices <- split(seq_len(n_breaks), dodge_pos) label_grobs <- lapply(dodge_indices, function(indices) { @@ -256,3 +417,28 @@ axis_label_element_overrides <- function(axis_position, angle = NULL) { stop("Unrecognized position: '", axis_position, "'", call. = FALSE) } } + +warn_for_guide_position <- function(guide) { + if (empty(guide$key) || nrow(guide$key) == 1) { + return() + } + + # this is trying to catch when a user specifies a position perpendicular + # to the direction of the axis (e.g., a "y" axis on "top") + + if (guide$position %in% c("top", "bottom")) { + position_aes <- "x" + } else if(guide$position %in% c("left", "right")) { + position_aes <- "y" + } else { + return() + } + + if (length(unique(guide$key[[position_aes]])) == 1) { + warning( + "Position guide is perpendicular to the intended axis. ", + "Did you mean to specify a different guide `position`?", + call. = FALSE + ) + } +} diff --git a/R/guides-none.r b/R/guides-none.r new file mode 100644 index 0000000000..e27b6e9892 --- /dev/null +++ b/R/guides-none.r @@ -0,0 +1,44 @@ + +#' Empty guide +#' +#' This guide draws nothing. +#' +#' @inheritParams guide_axis +#' +#' @export +#' +guide_none <- function(title = waiver(), position = waiver()) { + structure( + list( + title = title, + position = position, + available_aes = "any" + ), + class = c("guide", "guide_none") + ) +} + +#' @export +guide_train.guide_none <- function(guide, scale, aesthetic = NULL) { + guide +} + +#' @export +guide_merge.guide_none <- function(guide, new_guide) { + new_guide +} + +#' @export +guide_geom.guide_none <- function(guide, layers, default_mapping) { + guide +} + +#' @export +guide_transform.guide_none <- function(guide, coord, panel_params) { + guide +} + +#' @export +guide_gengrob.guide_none <- function(guide, theme, ...) { + zeroGrob() +} diff --git a/R/layout.R b/R/layout.R index 966f301fda..b1f9bb2a89 100644 --- a/R/layout.R +++ b/R/layout.R @@ -104,10 +104,13 @@ Layout <- ggproto("Layout", NULL, ) # Draw individual labels, then add to gtable - labels <- self$coord$labels(list( - x = self$xlabel(labels), - y = self$ylabel(labels) - )) + labels <- self$coord$labels( + list( + x = self$xlabel(labels), + y = self$ylabel(labels) + ), + self$panel_params[[1]] + ) labels <- self$render_labels(labels, theme) self$facet$draw_labels( plot_table, @@ -209,6 +212,25 @@ Layout <- ggproto("Layout", NULL, invisible() }, + setup_panel_guides = function(self, guides, layers, default_mapping) { + self$panel_params <- lapply( + self$panel_params, + self$coord$setup_panel_guides, + guides, + self$coord_params + ) + + self$panel_params <- lapply( + self$panel_params, + self$coord$train_panel_guides, + layers, + default_mapping, + self$coord_params + ) + + invisible() + }, + xlabel = function(self, labels) { primary <- self$panel_scales_x[[1]]$name %|W|% labels$x primary <- self$panel_scales_x[[1]]$make_title(primary) diff --git a/R/plot-build.r b/R/plot-build.r index e24a3d8882..714d200307 100644 --- a/R/plot-build.r +++ b/R/plot-build.r @@ -166,6 +166,7 @@ ggplot_gtable.ggplot_built <- function(data) { theme <- plot_theme(plot) geom_grobs <- Map(function(l, d) l$draw_geom(d, layout), plot$layers, data) + layout$setup_panel_guides(plot$guides, plot$layers, plot$mapping) plot_table <- layout$render(geom_grobs, data, theme, plot$labels) # Legends diff --git a/R/scale-continuous.r b/R/scale-continuous.r index 662f39b913..8f1cfb1217 100644 --- a/R/scale-continuous.r +++ b/R/scale-continuous.r @@ -76,14 +76,14 @@ NULL scale_x_continuous <- function(name = waiver(), breaks = waiver(), minor_breaks = waiver(), labels = waiver(), limits = NULL, expand = waiver(), oob = censor, - na.value = NA_real_, trans = "identity", + na.value = NA_real_, trans = "identity", guide = waiver(), position = "bottom", sec.axis = waiver()) { sc <- continuous_scale( c("x", "xmin", "xmax", "xend", "xintercept", "xmin_final", "xmax_final", "xlower", "xmiddle", "xupper", "x0"), "position_c", identity, name = name, breaks = breaks, minor_breaks = minor_breaks, labels = labels, limits = limits, expand = expand, oob = oob, na.value = na.value, trans = trans, - guide = "none", position = position, super = ScaleContinuousPosition + guide = guide, position = position, super = ScaleContinuousPosition ) set_sec_axis(sec.axis, sc) @@ -95,14 +95,14 @@ scale_x_continuous <- function(name = waiver(), breaks = waiver(), scale_y_continuous <- function(name = waiver(), breaks = waiver(), minor_breaks = waiver(), labels = waiver(), limits = NULL, expand = waiver(), oob = censor, - na.value = NA_real_, trans = "identity", + na.value = NA_real_, trans = "identity", guide = waiver(), position = "left", sec.axis = waiver()) { sc <- continuous_scale( c("y", "ymin", "ymax", "yend", "yintercept", "ymin_final", "ymax_final", "lower", "middle", "upper", "y0"), "position_c", identity, name = name, breaks = breaks, minor_breaks = minor_breaks, labels = labels, limits = limits, expand = expand, oob = oob, na.value = na.value, trans = trans, - guide = "none", position = position, super = ScaleContinuousPosition + guide = guide, position = position, super = ScaleContinuousPosition ) set_sec_axis(sec.axis, sc) diff --git a/R/scale-date.r b/R/scale-date.r index 030d2f412d..14f002d702 100644 --- a/R/scale-date.r +++ b/R/scale-date.r @@ -66,6 +66,7 @@ scale_x_date <- function(name = waiver(), date_minor_breaks = waiver(), limits = NULL, expand = waiver(), + guide = waiver(), position = "bottom", sec.axis = waiver()) { @@ -80,7 +81,7 @@ scale_x_date <- function(name = waiver(), date_labels = date_labels, minor_breaks = minor_breaks, date_minor_breaks = date_minor_breaks, - guide = "none", + guide = guide, limits = limits, expand = expand, position = position @@ -100,6 +101,7 @@ scale_y_date <- function(name = waiver(), date_minor_breaks = waiver(), limits = NULL, expand = waiver(), + guide = waiver(), position = "left", sec.axis = waiver()) { @@ -114,7 +116,7 @@ scale_y_date <- function(name = waiver(), date_labels = date_labels, minor_breaks = minor_breaks, date_minor_breaks = date_minor_breaks, - guide = "none", + guide = guide, limits = limits, expand = expand, position = position @@ -135,6 +137,7 @@ scale_x_datetime <- function(name = waiver(), timezone = NULL, limits = NULL, expand = waiver(), + guide = waiver(), position = "bottom", sec.axis = waiver()) { @@ -150,7 +153,7 @@ scale_x_datetime <- function(name = waiver(), minor_breaks = minor_breaks, date_minor_breaks = date_minor_breaks, timezone = timezone, - guide = "none", + guide = guide, limits = limits, expand = expand, position = position @@ -172,6 +175,7 @@ scale_y_datetime <- function(name = waiver(), timezone = NULL, limits = NULL, expand = waiver(), + guide = waiver(), position = "left", sec.axis = waiver()) { @@ -187,7 +191,7 @@ scale_y_datetime <- function(name = waiver(), minor_breaks = minor_breaks, date_minor_breaks = date_minor_breaks, timezone = timezone, - guide = "none", + guide = guide, limits = limits, expand = expand, position = position @@ -208,6 +212,7 @@ scale_x_time <- function(name = waiver(), expand = waiver(), oob = censor, na.value = NA_real_, + guide = waiver(), position = "bottom", sec.axis = waiver()) { @@ -220,6 +225,7 @@ scale_x_time <- function(name = waiver(), expand = expand, oob = oob, na.value = na.value, + guide = guide, position = position, trans = scales::hms_trans(), sec.axis = sec.axis @@ -237,6 +243,7 @@ scale_y_time <- function(name = waiver(), expand = waiver(), oob = censor, na.value = NA_real_, + guide = waiver(), position = "left", sec.axis = waiver()) { @@ -249,6 +256,7 @@ scale_y_time <- function(name = waiver(), expand = expand, oob = oob, na.value = na.value, + guide = guide, position = position, trans = scales::hms_trans(), sec.axis = sec.axis diff --git a/R/scale-discrete-.r b/R/scale-discrete-.r index 49e7e0eee7..1390bef2af 100644 --- a/R/scale-discrete-.r +++ b/R/scale-discrete-.r @@ -47,18 +47,18 @@ #' geom_point() + #' scale_x_discrete(labels = abbreviate) #' } -scale_x_discrete <- function(..., expand = waiver(), position = "bottom") { +scale_x_discrete <- function(..., expand = waiver(), guide = waiver(), position = "bottom") { sc <- discrete_scale(c("x", "xmin", "xmax", "xend"), "position_d", identity, ..., - expand = expand, guide = "none", position = position, super = ScaleDiscretePosition) + expand = expand, guide = guide, position = position, super = ScaleDiscretePosition) sc$range_c <- continuous_range() sc } #' @rdname scale_discrete #' @export -scale_y_discrete <- function(..., expand = waiver(), position = "left") { +scale_y_discrete <- function(..., expand = waiver(), guide = waiver(), position = "left") { sc <- discrete_scale(c("y", "ymin", "ymax", "yend"), "position_d", identity, ..., - expand = expand, guide = "none", position = position, super = ScaleDiscretePosition) + expand = expand, guide = guide, position = position, super = ScaleDiscretePosition) sc$range_c <- continuous_range() sc diff --git a/R/scale-view.r b/R/scale-view.r index 13afdba516..2986e275cd 100644 --- a/R/scale-view.r +++ b/R/scale-view.r @@ -26,13 +26,14 @@ view_scale_primary <- function(scale, limits = scale$get_limits(), ggproto(NULL, ViewScale, scale = scale, + guide = scale$guide, + position = scale$position, aesthetics = scale$aesthetics, name = scale$name, scale_is_discrete = scale$is_discrete(), limits = limits, continuous_range = continuous_range, breaks = breaks, - labels = scale$get_labels(breaks), minor_breaks = minor_breaks ) } @@ -40,17 +41,37 @@ view_scale_primary <- function(scale, limits = scale$get_limits(), # this function is a hack that is difficult to avoid given the complex implementation of second axes view_scale_secondary <- function(scale, limits = scale$get_limits(), continuous_range = scale$dimension(limits = limits)) { + if (is.null(scale$secondary.axis) || is.waive(scale$secondary.axis) || scale$secondary.axis$empty()) { - view_scale_empty() + # if there is no second axis, return the primary scale with no guide + # this guide can be overridden using guides() + primary_scale <- view_scale_primary(scale, limits, continuous_range) + scale_flip_position(primary_scale) + primary_scale$guide <- guide_none() + primary_scale } else { scale$secondary.axis$init(scale) break_info <- scale$secondary.axis$break_info(continuous_range, scale) names(break_info) <- gsub("sec\\.", "", names(break_info)) + # flip position from the original scale by default + # this can (should) be overridden in the guide + position <- switch(scale$position, + top = "bottom", + bottom = "top", + left = "right", + right = "left", + scale$position + ) + ggproto(NULL, ViewScale, scale = scale, + guide = scale$secondary.axis$guide, + position = position, break_info = break_info, - aesthetics = paste0(scale$aesthetics, ".sec"), + # as far as scales are concerned, this is a regular scale with + # different breaks and labels in a different data space + aesthetics = scale$aesthetics, name = scale$sec_name(), make_title = function(self, title) self$scale$make_sec_title(title), @@ -60,7 +81,7 @@ view_scale_secondary <- function(scale, limits = scale$get_limits(), get_breaks_minor = function(self) self$break_info$minor_source, break_positions = function(self) self$break_info$major, break_positions_minor = function(self) self$break_info$minor, - get_labels = function(self) self$break_info$labels, + get_labels = function(self, breaks = self$get_breaks()) self$break_info$labels, rescale = function(x) rescale(x, from = break_info$range, to = c(0, 1)) ) } @@ -74,7 +95,7 @@ view_scale_empty <- function() { get_limits = function() c(0, 1), get_breaks = function() NULL, get_breaks_minor = function() NULL, - get_labels = function() NULL, + get_labels = function(breaks = NULL) breaks, rescale = function(x) stop("Not implemented", call. = FALSE), map = function(x) stop("Not implemented", call. = FALSE), make_title = function(title) title, @@ -87,13 +108,14 @@ ViewScale <- ggproto("ViewScale", NULL, # map, rescale, and make_title need a reference # to the original scale scale = ggproto(NULL, Scale), + guide = guide_none(), + position = NULL, aesthetics = NULL, name = waiver(), scale_is_discrete = FALSE, limits = NULL, continuous_range = NULL, breaks = NULL, - labels = NULL, minor_breaks = NULL, is_empty = function(self) { @@ -104,12 +126,16 @@ ViewScale <- ggproto("ViewScale", NULL, get_limits = function(self) self$limits, get_breaks = function(self) self$breaks, get_breaks_minor = function(self) self$minor_breaks, - get_labels = function(self) self$labels, + get_labels = function(self, breaks = self$get_breaks()) self$scale$get_labels(breaks), rescale = function(self, x) { self$scale$rescale(x, self$limits, self$continuous_range) }, map = function(self, x) { - self$scale$map(x, self$limits) + if (self$is_discrete()) { + self$scale$map(x, self$limits) + } else { + self$scale$map(x, self$continuous_range) + } }, make_title = function(self, title) { self$scale$make_title(title) diff --git a/man/guide-exts.Rd b/man/guide-exts.Rd index 8d4fb270f4..17c1591cb6 100644 --- a/man/guide-exts.Rd +++ b/man/guide-exts.Rd @@ -5,6 +5,7 @@ \alias{guide_train} \alias{guide_merge} \alias{guide_geom} +\alias{guide_transform} \alias{guide_gengrob} \title{S3 generics for guides.} \usage{ @@ -14,6 +15,8 @@ guide_merge(guide, new_guide) guide_geom(guide, layers, default_mapping) +guide_transform(guide, coord, panel_params) + guide_gengrob(guide, theme) } \arguments{ diff --git a/man/guide_axis.Rd b/man/guide_axis.Rd new file mode 100644 index 0000000000..dbd206aaa5 --- /dev/null +++ b/man/guide_axis.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/guides-axis.r +\name{guide_axis} +\alias{guide_axis} +\title{Axis guide} +\usage{ +guide_axis(title = waiver(), check.overlap = FALSE, angle = NULL, + n.dodge = 1, order = 0, position = waiver()) +} +\arguments{ +\item{title}{A character string or expression indicating a title of guide. +If \code{NULL}, the title is not shown. By default +(\code{\link[=waiver]{waiver()}}), the name of the scale object or the name +specified in \code{\link[=labs]{labs()}} is used for the title.} + +\item{check.overlap}{silently remove overlapping labels, +(recursively) prioritizing the first, last, and middle labels.} + +\item{angle}{Compared to setting the angle in \code{\link[=theme]{theme()}} / \code{\link[=element_text]{element_text()}}, +this also uses some heuristics to automatically pick the \code{hjust} and \code{vjust} that +you probably want.} + +\item{n.dodge}{The number of rows (for vertical axes) or columns (for +horizontal axes) that should be used to render the labels. This is +useful for displaying labels that would otherwise overlap.} + +\item{order}{Used to determine the order of the guides (left-to-right, +top-to-bottom), if more than one guide must be drawn at the same location.} + +\item{position}{Where this guide should be drawn: one of top, bottom, +left, or right.} +} +\description{ +Axis guides are the visual representation of position scales like those +created with \link[=scale_x_continuous]{scale_(x|y)_continuous()} and +\link[=scale_x_discrete]{scale_(x|y)_discrete()}. +} +\examples{ +# plot with overlapping text +p <- ggplot(mpg, aes(cty * 100, hwy * 100)) + + geom_point() + + facet_wrap(vars(class)) + +# axis guides can be customized in the scale_* functions or +# using guides() +p + scale_x_continuous(guide = guide_axis(n.dodge = 2)) +p + guides(x = guide_axis(angle = 90)) + +# can also be used to add a duplicate guide +p + guides(x = guide_axis(n.dodge = 2), y.sec = guide_axis()) + + +} diff --git a/man/guide_none.Rd b/man/guide_none.Rd new file mode 100644 index 0000000000..514784d7c9 --- /dev/null +++ b/man/guide_none.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/guides-none.r +\name{guide_none} +\alias{guide_none} +\title{Empty guide} +\usage{ +guide_none(title = waiver(), position = waiver()) +} +\arguments{ +\item{title}{A character string or expression indicating a title of guide. +If \code{NULL}, the title is not shown. By default +(\code{\link[=waiver]{waiver()}}), the name of the scale object or the name +specified in \code{\link[=labs]{labs()}} is used for the title.} + +\item{position}{Where this guide should be drawn: one of top, bottom, +left, or right.} +} +\description{ +This guide draws nothing. +} diff --git a/man/scale_continuous.Rd b/man/scale_continuous.Rd index d904a781fe..925196344c 100644 --- a/man/scale_continuous.Rd +++ b/man/scale_continuous.Rd @@ -14,12 +14,14 @@ scale_x_continuous(name = waiver(), breaks = waiver(), minor_breaks = waiver(), labels = waiver(), limits = NULL, expand = waiver(), oob = censor, na.value = NA_real_, - trans = "identity", position = "bottom", sec.axis = waiver()) + trans = "identity", guide = waiver(), position = "bottom", + sec.axis = waiver()) scale_y_continuous(name = waiver(), breaks = waiver(), minor_breaks = waiver(), labels = waiver(), limits = NULL, expand = waiver(), oob = censor, na.value = NA_real_, - trans = "identity", position = "left", sec.axis = waiver()) + trans = "identity", guide = waiver(), position = "left", + sec.axis = waiver()) scale_x_log10(...) @@ -111,6 +113,9 @@ are defined in the scales package, and are called \code{_trans} (e.g., \code{\link[scales:boxcox_trans]{scales::boxcox_trans()}}). You can create your own transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} +\item{guide}{A function used to create a guide or its name. See +\code{\link[=guides]{guides()}} for more information.} + \item{position}{For position scales, The position of the axis. \code{left} or \code{right} for y axes, \code{top} or \code{bottom} for x axes.} diff --git a/man/scale_date.Rd b/man/scale_date.Rd index 3b9e123d5a..444a4cacd2 100644 --- a/man/scale_date.Rd +++ b/man/scale_date.Rd @@ -12,36 +12,36 @@ scale_x_date(name = waiver(), breaks = waiver(), date_breaks = waiver(), labels = waiver(), date_labels = waiver(), minor_breaks = waiver(), date_minor_breaks = waiver(), - limits = NULL, expand = waiver(), position = "bottom", - sec.axis = waiver()) + limits = NULL, expand = waiver(), guide = waiver(), + position = "bottom", sec.axis = waiver()) scale_y_date(name = waiver(), breaks = waiver(), date_breaks = waiver(), labels = waiver(), date_labels = waiver(), minor_breaks = waiver(), date_minor_breaks = waiver(), - limits = NULL, expand = waiver(), position = "left", - sec.axis = waiver()) + limits = NULL, expand = waiver(), guide = waiver(), + position = "left", sec.axis = waiver()) scale_x_datetime(name = waiver(), breaks = waiver(), date_breaks = waiver(), labels = waiver(), date_labels = waiver(), minor_breaks = waiver(), date_minor_breaks = waiver(), timezone = NULL, limits = NULL, expand = waiver(), - position = "bottom", sec.axis = waiver()) + guide = waiver(), position = "bottom", sec.axis = waiver()) scale_y_datetime(name = waiver(), breaks = waiver(), date_breaks = waiver(), labels = waiver(), date_labels = waiver(), minor_breaks = waiver(), date_minor_breaks = waiver(), timezone = NULL, limits = NULL, expand = waiver(), - position = "left", sec.axis = waiver()) + guide = waiver(), position = "left", sec.axis = waiver()) scale_x_time(name = waiver(), breaks = waiver(), minor_breaks = waiver(), labels = waiver(), limits = NULL, expand = waiver(), oob = censor, na.value = NA_real_, - position = "bottom", sec.axis = waiver()) + guide = waiver(), position = "bottom", sec.axis = waiver()) scale_y_time(name = waiver(), breaks = waiver(), minor_breaks = waiver(), labels = waiver(), limits = NULL, expand = waiver(), oob = censor, na.value = NA_real_, - position = "left", sec.axis = waiver()) + guide = waiver(), position = "left", sec.axis = waiver()) } \arguments{ \item{name}{The name of the scale. Used as the axis or legend title. If @@ -107,6 +107,9 @@ to generate the values for the \code{expand} argument. The defaults are to expand the scale by 5\% on each side for continuous variables, and by 0.6 units on each side for discrete variables.} +\item{guide}{A function used to create a guide or its name. See +\code{\link[=guides]{guides()}} for more information.} + \item{position}{For position scales, The position of the axis. \code{left} or \code{right} for y axes, \code{top} or \code{bottom} for x axes.} diff --git a/man/scale_discrete.Rd b/man/scale_discrete.Rd index b0f730cae2..cd73d626b1 100644 --- a/man/scale_discrete.Rd +++ b/man/scale_discrete.Rd @@ -5,9 +5,11 @@ \alias{scale_y_discrete} \title{Position scales for discrete data} \usage{ -scale_x_discrete(..., expand = waiver(), position = "bottom") +scale_x_discrete(..., expand = waiver(), guide = waiver(), + position = "bottom") -scale_y_discrete(..., expand = waiver(), position = "left") +scale_y_discrete(..., expand = waiver(), guide = waiver(), + position = "left") } \arguments{ \item{...}{Arguments passed on to \code{discrete_scale} @@ -70,6 +72,9 @@ to generate the values for the \code{expand} argument. The defaults are to expand the scale by 5\% on each side for continuous variables, and by 0.6 units on each side for discrete variables.} +\item{guide}{A function used to create a guide or its name. See +\code{\link[=guides]{guides()}} for more information.} + \item{position}{For position scales, The position of the axis. \code{left} or \code{right} for y axes, \code{top} or \code{bottom} for x axes.} } diff --git a/man/sec_axis.Rd b/man/sec_axis.Rd index f89a90c216..b57d45aaa7 100644 --- a/man/sec_axis.Rd +++ b/man/sec_axis.Rd @@ -7,10 +7,10 @@ \title{Specify a secondary axis} \usage{ sec_axis(trans = NULL, name = waiver(), breaks = waiver(), - labels = waiver()) + labels = waiver(), guide = waiver()) dup_axis(trans = ~., name = derive(), breaks = derive(), - labels = derive()) + labels = derive(), guide = derive()) derive() } @@ -34,6 +34,9 @@ derive() \item A character vector giving labels (must be same length as \code{breaks}) \item A function that takes the breaks as input and returns labels as output }} + +\item{guide}{A position guide that will be used to render +the axis on the plot. Usually this is \code{\link[=guide_axis]{guide_axis()}}.} } \description{ This function is used in conjunction with a position scale to create a diff --git a/tests/figs/guides/guide-axis-customization.svg b/tests/figs/guides/guide-axis-customization.svg new file mode 100644 index 0000000000..a242c3b6a2 --- /dev/null +++ b/tests/figs/guides/guide-axis-customization.svg @@ -0,0 +1,292 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +30 +20 +40 + + + + + + +20 +40 +30 + + + + + + + +2seater +midsize +pickup +suv +compact +minivan +subcompact +class +hwy +hwy +guide_axis() customization + diff --git a/tests/figs/guides/guides-specified-in-guides.svg b/tests/figs/guides/guides-specified-in-guides.svg new file mode 100644 index 0000000000..9d3274dabb --- /dev/null +++ b/tests/figs/guides/guides-specified-in-guides.svg @@ -0,0 +1,305 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +compact +minivan +subcompact +2seater +midsize +pickup +suv + + + + + + + +30 +20 +40 + + + + + + +20 +40 +30 + + + + + + + +2seater +midsize +pickup +suv +compact +minivan +subcompact +class +hwy +guides specified in guides() + diff --git a/tests/figs/guides/position-guide-titles.svg b/tests/figs/guides/position-guide-titles.svg new file mode 100644 index 0000000000..69f3b2e748 --- /dev/null +++ b/tests/figs/guides/position-guide-titles.svg @@ -0,0 +1,34 @@ + + + + + + + + + + + + + + + + + + + + +x (secondary) +x (primary) +y (primary) +y (secondary) +position guide titles + diff --git a/tests/figs/sec-axis/sec-axis-custom-transform.svg b/tests/figs/sec-axis/sec-axis-custom-transform.svg index 9635517c6a..0dbe8af171 100644 --- a/tests/figs/sec-axis/sec-axis-custom-transform.svg +++ b/tests/figs/sec-axis/sec-axis-custom-transform.svg @@ -70,24 +70,24 @@ - - - - - - - - - -0.001 -0.010 -0.100 -0.250 -0.300 -0.350 -0.400 -0.450 -0.500 + + + + + + + + + +0.001 +0.010 +0.100 +0.250 +0.300 +0.350 +0.400 +0.450 +0.500 diff --git a/tests/figs/sec-axis/sec-axis-independent-transformations.svg b/tests/figs/sec-axis/sec-axis-independent-transformations.svg index e9fa100779..3e3764dffe 100644 --- a/tests/figs/sec-axis/sec-axis-independent-transformations.svg +++ b/tests/figs/sec-axis/sec-axis-independent-transformations.svg @@ -46,15 +46,15 @@ -5 -10 -15 -20 +5 +10 +15 +20 25 - - - - + + + + 0.2 0.3 diff --git a/tests/figs/sec-axis/sec-axis-monotonicity-test.svg b/tests/figs/sec-axis/sec-axis-monotonicity-test.svg index 09da192d8a..cd76b3c44e 100644 --- a/tests/figs/sec-axis/sec-axis-monotonicity-test.svg +++ b/tests/figs/sec-axis/sec-axis-monotonicity-test.svg @@ -52,14 +52,14 @@ - - - - -1 -2 -3 -4 + + + + +1 +2 +3 +4 diff --git a/tests/figs/sec-axis/sec-axis-sec-power-transform.svg b/tests/figs/sec-axis/sec-axis-sec-power-transform.svg index 7451419cde..19517dabc6 100644 --- a/tests/figs/sec-axis/sec-axis-sec-power-transform.svg +++ b/tests/figs/sec-axis/sec-axis-sec-power-transform.svg @@ -53,17 +53,17 @@ -0.25 -0.00 -0.25 -0.50 -0.75 -1.00 +0.00 +0.25 +0.50 +0.75 +1.00 - - - - - + + + + + 4.950 4.975 5.000 diff --git a/tests/figs/sec-axis/sec-axis-skewed-transform.svg b/tests/figs/sec-axis/sec-axis-skewed-transform.svg index 4e5e2630ec..c5b429b83a 100644 --- a/tests/figs/sec-axis/sec-axis-skewed-transform.svg +++ b/tests/figs/sec-axis/sec-axis-skewed-transform.svg @@ -147,16 +147,16 @@ -1e-01 -1e+00 -1e+01 -1e+02 -1e+03 - - - - - +1e-01 +1e+00 +1e+01 +1e+02 +1e+03 + + + + + 0.00 0.25 0.50 diff --git a/tests/figs/sec-axis/sec-axis-with-division.svg b/tests/figs/sec-axis/sec-axis-with-division.svg index a7dc81bcff..364b556ead 100644 --- a/tests/figs/sec-axis/sec-axis-with-division.svg +++ b/tests/figs/sec-axis/sec-axis-with-division.svg @@ -284,12 +284,12 @@ - - - -10 -15 -20 + + + +10 +15 +20 diff --git a/tests/figs/themes/axes-styling.svg b/tests/figs/themes/axes-styling.svg index e16319a8e5..b0ae37c5cc 100644 --- a/tests/figs/themes/axes-styling.svg +++ b/tests/figs/themes/axes-styling.svg @@ -51,14 +51,14 @@ -2.5 -5.0 -7.5 -10.0 - - - - +2.5 +5.0 +7.5 +10.0 + + + + 2.5 5.0 @@ -69,14 +69,14 @@ - - - - -2.5 -5.0 -7.5 -10.0 + + + + +2.5 +5.0 +7.5 +10.0 diff --git a/tests/figs/themes/ticks-length.svg b/tests/figs/themes/ticks-length.svg index 58e713674f..99e8d21ff9 100644 --- a/tests/figs/themes/ticks-length.svg +++ b/tests/figs/themes/ticks-length.svg @@ -35,14 +35,14 @@ -2.5 -5.0 -7.5 -10.0 - - - - +2.5 +5.0 +7.5 +10.0 + + + + 2.5 5.0 7.5 @@ -51,14 +51,14 @@ - - - - -2.5 -5.0 -7.5 -10.0 + + + + +2.5 +5.0 +7.5 +10.0 diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index 6ef54fcaf5..0fa2b90a91 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -65,6 +65,54 @@ test_that("axis_label_element_overrides errors when angles are outside the range expect_error(axis_label_element_overrides("bottom", -91), "`angle` must") }) +test_that("a warning is generated when guides are drawn at a location that doesn't make sense", { + plot <- ggplot(mpg, aes(class, hwy)) + + geom_point() + + scale_y_continuous(guide = guide_axis(position = "top")) + built <- expect_silent(ggplot_build(plot)) + expect_warning(ggplot_gtable(built), "Position guide is perpendicular") +}) + +test_that("a warning is generated when more than one position guide is drawn at a location", { + plot <- ggplot(mpg, aes(class, hwy)) + + geom_point() + + guides( + y = guide_axis(position = "left"), + y.sec = guide_axis(position = "left") + ) + built <- expect_silent(ggplot_build(plot)) + expect_warning(ggplot_gtable(built), "Discarding guide") +}) + +test_that("guide_none() can be used in non-position scales", { + p <- ggplot(mpg, aes(cty, hwy, colour = class)) + + geom_point() + + scale_color_discrete(guide = guide_none()) + + built <- ggplot_build(p) + plot <- built$plot + guides <- build_guides( + plot$scales, + plot$layers, + plot$mapping, + "right", + theme_gray(), + plot$guides, + plot$labels + ) + + expect_identical(guides, zeroGrob()) +}) + +test_that("Using non-position guides for position scales results in an informative error", { + p <- ggplot(mpg, aes(cty, hwy)) + + geom_point() + + scale_x_continuous(guide = guide_legend()) + + built <- ggplot_build(p) + expect_error(ggplot_gtable(built), "does not implement guide_transform()") +}) + # Visual tests ------------------------------------------------------------ test_that("axis guides are drawn correctly", { @@ -132,7 +180,7 @@ test_that("axis guides are drawn correctly", { # dodged text expect_doppelganger( "axis guides, text dodged into rows/cols", - function() test_draw_axis(10, labels = function(b) comma(b * 1e9), n_dodge = 2) + function() test_draw_axis(10, labels = function(b) comma(b * 1e9), n.dodge = 2) ) }) @@ -156,6 +204,45 @@ test_that("axis guides are drawn correctly in plots", { ) }) +test_that("axis guides can be customized", { + plot <- ggplot(mpg, aes(class, hwy)) + + geom_point() + + scale_y_continuous( + sec.axis = dup_axis(guide = guide_axis(n.dodge = 2)), + guide = guide_axis(n.dodge = 2) + ) + + scale_x_discrete(guide = guide_axis(n.dodge = 2)) + + expect_doppelganger("guide_axis() customization", plot) +}) + +test_that("guides can be specified in guides()", { + plot <- ggplot(mpg, aes(class, hwy)) + + geom_point() + + guides( + x = guide_axis(n.dodge = 2), + y = guide_axis(n.dodge = 2), + x.sec = guide_axis(n.dodge = 2), + y.sec = guide_axis(n.dodge = 2) + ) + + expect_doppelganger("guides specified in guides()", plot) +}) + +test_that("guides have the final say in x and y", { + df <- data_frame(x = 1, y = 1) + plot <- ggplot(df, aes(x, y)) + + geom_point() + + guides( + x = guide_none(title = "x (primary)"), + y = guide_none(title = "y (primary)"), + x.sec = guide_none(title = "x (secondary)"), + y.sec = guide_none(title = "y (secondary)") + ) + + expect_doppelganger("position guide titles", plot) +}) + test_that("guides are positioned correctly", { df <- data_frame(x = 1, y = 1, z = factor("a"))