From 1d788aad32e9527b1dc68e0198ff29d7e2158ea6 Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Tue, 2 Jul 2019 10:50:59 -0400 Subject: [PATCH 01/30] add default position guide = waiver() for all position scale constructors, exclude position guides from the general guide building code --- R/guides-.r | 10 ++++++++-- R/scale-continuous.r | 8 ++++---- R/scale-date.r | 16 ++++++++++++---- man/scale_continuous.Rd | 9 +++++++-- man/scale_date.Rd | 19 +++++++++++-------- 5 files changed, 42 insertions(+), 20 deletions(-) diff --git a/R/guides-.r b/R/guides-.r index 0ad41eb131..481eb42be1 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 diff --git a/R/scale-continuous.r b/R/scale-continuous.r index f7285d4acd..f3cc0bdce9 100644 --- a/R/scale-continuous.r +++ b/R/scale-continuous.r @@ -77,14 +77,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) @@ -96,14 +96,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/man/scale_continuous.Rd b/man/scale_continuous.Rd index ca74e2ad5e..234a16d355 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(...) @@ -102,6 +104,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 a48f8b01d4..f019b86054 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 @@ -104,6 +104,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.} From 422fcd306cf7bf77776e0394f9a5cc41d76724f7 Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Tue, 2 Jul 2019 10:58:06 -0400 Subject: [PATCH 02/30] add guide option to sec axis --- R/axis-secondary.R | 14 ++++++++++---- man/sec_axis.Rd | 7 +++++-- 2 files changed, 15 insertions(+), 6 deletions(-) diff --git a/R/axis-secondary.R b/R/axis-secondary.R index e7de5f44a6..c32a56deab 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) { @@ -150,6 +155,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/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 From 1d4daf017aa22f51d56b2387fb1a89116268612c Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Tue, 2 Jul 2019 11:25:23 -0400 Subject: [PATCH 03/30] add a guide_axis constructor --- NAMESPACE | 5 +++++ R/guides-none.r | 20 ++++++++++++++++++++ man/guide_axis.Rd | 42 ++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 67 insertions(+) create mode 100644 R/guides-none.r create mode 100644 man/guide_axis.Rd diff --git a/NAMESPACE b/NAMESPACE index fe651a8765..332f14042a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -66,12 +66,16 @@ S3method(grobWidth,absoluteGrob) S3method(grobWidth,zeroGrob) S3method(grobX,absoluteGrob) S3method(grobY,absoluteGrob) +S3method(guide_gengrob,axis) S3method(guide_gengrob,colorbar) S3method(guide_gengrob,legend) +S3method(guide_geom,axis) S3method(guide_geom,colorbar) S3method(guide_geom,legend) +S3method(guide_merge,axis) S3method(guide_merge,colorbar) S3method(guide_merge,legend) +S3method(guide_train,axis) S3method(guide_train,colorbar) S3method(guide_train,legend) S3method(heightDetails,titleGrob) @@ -355,6 +359,7 @@ export(ggproto) export(ggproto_parent) export(ggsave) export(ggtitle) +export(guide_axis) export(guide_colorbar) export(guide_colourbar) export(guide_gengrob) diff --git a/R/guides-none.r b/R/guides-none.r new file mode 100644 index 0000000000..a8b42ec1af --- /dev/null +++ b/R/guides-none.r @@ -0,0 +1,20 @@ + +guide_none <- function() { + structure(list(available_aes = "any"), class = c("guide", "guide_none")) +} + +guide_train.guide_none <- function(guide, scale, aesthetic = NULL) { + guide +} + +guide_merge.guide_none <- function(guide, new_guide) { + guide +} + +guide_geom.guide_none <- function(guide, layers, default_mapping) { + guide +} + +guide_gengrob.guide_none <- function(guide, theme, ...) { + zeroGrob() +} diff --git a/man/guide_axis.Rd b/man/guide_axis.Rd new file mode 100644 index 0000000000..df32ec86b0 --- /dev/null +++ b/man/guide_axis.Rd @@ -0,0 +1,42 @@ +% 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(label = TRUE, label.theme = NULL, line.theme = NULL, + tick.theme = NULL, tick.length = NULL, order = 0, + position = waiver(), ...) +} +\arguments{ +\item{label}{logical. If \code{TRUE} then the labels are drawn. If +\code{FALSE} then the labels are invisible.} + +\item{label.theme}{A theme object for rendering the label text. Usually the +object of \code{\link[=element_text]{element_text()}} is expected. By default, the theme is +specified by \code{legend.text} in \code{\link[=theme]{theme()}}.} + +\item{line.theme}{An \code{\link[=element_line]{element_line()}} to use as a template for the line +along the axis. Usually set with \link[=theme]{theme(axis.line = ...)}.} + +\item{tick.theme}{An \code{\link[=element_line]{element_line()}} to use as a template for the ticks +along the axis. Usually set with \link[=theme]{theme(axis.ticks = ...)}.} + +\item{tick.length}{A \code{\link[grid:unit]{grid::unit()}}. Usually set with +\link[=theme]{theme(axis.ticks.length = ...)}.} + +\item{order}{positive integer less than 99 that specifies the order of +this guide among multiple guides. This controls the order in which +multiple guides are displayed, not the contents of the guide itself. +If 0 (default), the order is determined by a secret algorithm.} + +\item{position}{Where this guide should be drawn: one of top, bottom, +left, or right.} + +\item{...}{ignored.} +} +\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()}. +} From 4a7e54ee685f9bf360f893d0f863ec4a9c46aa0b Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Tue, 2 Jul 2019 11:26:01 -0400 Subject: [PATCH 04/30] add guide none and finish adding guide axis --- DESCRIPTION | 1 + R/guides-axis.r | 120 ++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 121 insertions(+) diff --git a/DESCRIPTION b/DESCRIPTION index 7969bc5f43..cebe609c4b 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/R/guides-axis.r b/R/guides-axis.r index d7bc5449ed..aa335d58c6 100644 --- a/R/guides-axis.r +++ b/R/guides-axis.r @@ -1,4 +1,124 @@ +#' 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 line.theme An [element_line()] to use as a template for the line +#' along the axis. Usually set with [theme(axis.line = ...)][theme()]. +#' @param tick.theme An [element_line()] to use as a template for the ticks +#' along the axis. Usually set with [theme(axis.ticks = ...)][theme()]. +#' @param tick.length A [grid::unit()]. Usually set with +#' [theme(axis.ticks.length = ...)][theme()]. +#' @param position Where this guide should be drawn: one of top, bottom, +#' left, or right. +#' +#' @export +#' +guide_axis <- function(# label (axis.text*) + label = TRUE, + label.theme = NULL, + + # axis line (axis.line*) + line.theme = NULL, + + # axis ticks (axis.ticks*) + tick.theme = NULL, + tick.length = NULL, + + # general + order = 0, + position = waiver(), + ... +) { + structure( + list( + # label + label = label, + label.theme = label.theme, + + # axis line (axis.line*) + line.theme = line.theme, + + # axis ticks (axis.ticks*) + tick.theme = tick.theme, + tick.length = tick.length, + + # 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 +} + +# discards the new guide +#' @export +guide_merge.axis <- function(guide, new_guide) { + 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) { + stop("Not implemented", call. = FALSE) +} + + #' Grob for axes #' #' @param break_position position of ticks From 0496e55e89ca40079518a29c776d36f3059b295a Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Tue, 2 Jul 2019 11:35:48 -0400 Subject: [PATCH 05/30] add methods to get guides, layers, and mapping into the coords --- R/coord-.r | 8 ++++++++ R/layout.R | 19 +++++++++++++++++++ R/plot-build.r | 1 + 3 files changed, 28 insertions(+) diff --git a/R/coord-.r b/R/coord-.r index e2ea1a025d..6ecd92c45c 100644 --- a/R/coord-.r +++ b/R/coord-.r @@ -91,6 +91,14 @@ Coord <- ggproto("Coord", list() }, + setup_panel_guides = function(self, panel_params, guides, params) { + panel_params + }, + + train_panel_guides = function(self, panel_params, layers, default_mapping, params) { + panel_params + }, + transform = function(data, range) NULL, distance = function(x, y, panel_params) NULL, diff --git a/R/layout.R b/R/layout.R index 966f301fda..84a2f4db7a 100644 --- a/R/layout.R +++ b/R/layout.R @@ -209,6 +209,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 0bcb856338..85e6d4f828 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 From 0c0c01a62e239ced6fc3a6819e004f4c99211e7f Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Tue, 2 Jul 2019 13:30:10 -0400 Subject: [PATCH 06/30] guide_axis() objects mostly work with coord_cartesian() --- NAMESPACE | 5 +++ R/coord-.r | 4 +- R/coord-cartesian-.r | 95 +++++++++++++++++++++++++++++++++++++------ R/guides-.r | 7 +++- R/guides-axis.r | 32 ++++++++++++++- R/guides-none.r | 10 +++++ R/scale-discrete-.r | 8 ++-- R/scale-view.r | 20 ++++++++- man/guide_none.Rd | 11 +++++ man/scale_discrete.Rd | 9 +++- 10 files changed, 177 insertions(+), 24 deletions(-) create mode 100644 man/guide_none.Rd diff --git a/NAMESPACE b/NAMESPACE index 332f14042a..b733d55831 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -68,15 +68,19 @@ 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(heightDetails,titleGrob) S3method(heightDetails,zeroGrob) @@ -366,6 +370,7 @@ export(guide_gengrob) export(guide_geom) export(guide_legend) export(guide_merge) +export(guide_none) export(guide_train) export(guides) export(is.Coord) diff --git a/R/coord-.r b/R/coord-.r index 6ecd92c45c..88d316afe0 100644 --- a/R/coord-.r +++ b/R/coord-.r @@ -91,11 +91,11 @@ Coord <- ggproto("Coord", list() }, - setup_panel_guides = function(self, panel_params, guides, params) { + setup_panel_guides = function(self, panel_params, guides, params = list()) { panel_params }, - train_panel_guides = function(self, panel_params, layers, default_mapping, params) { + train_panel_guides = function(self, panel_params, layers, default_mapping, params = list()) { panel_params }, diff --git a/R/coord-cartesian-.r b/R/coord-cartesian-.r index 8222604039..05b0064f11 100644 --- a/R/coord-cartesian-.r +++ b/R/coord-cartesian-.r @@ -103,6 +103,53 @@ 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) { + guide <- panel_params$guides[[aesthetic]] + guide <- guide_train(guide, panel_params[[aesthetic]], aesthetic) + guide <- guide_transform(guide, self, panel_params) + guide <- guide_geom(guide, layers, default_mapping) + guide + }) + + panel_params + }, + render_bg = function(panel_params, theme) { guide_grid( theme, @@ -114,24 +161,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 = guides_grob_col(panel_params$guides, position = "top", theme = theme), + bottom = guides_grob_col(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 = guides_grob_row(panel_params$guides, position = "left", theme = theme), + right = guides_grob_row(panel_params$guides, position = "right", theme = theme) ) } ) @@ -153,6 +192,38 @@ view_scales_from_scale <- function(scale, coord_limits = NULL, expand = TRUE) { view_scales } +guides_grob_col <- function(guides, position, theme) { + guides <- guides_filter(guides, position) + if (length(guides) == 0) { + return(zeroGrob()) + } + + # FIXME: this needs to combine all the grobs, not sure how to do this just yet + grobs <- lapply(guides, guide_gengrob, theme) + grobs[[1]] +} + +guides_grob_row <- function(guides, position, theme) { + guides <- guides_filter(guides, position) + if (length(guides) == 0) { + return(zeroGrob()) + } + + # FIXME: this needs to combine all the grobs, not sure how to do this just yet + grobs <- lapply(guides, guide_gengrob, theme) + grobs[[1]] +} + +guides_filter <- function(guides, position) { + has_position <- vapply( + guides, + function(guide) identical(guide$position, position), + logical(1) + ) + + guides[has_position] +} + draw_view_scale_axis <- function(view_scale, axis_position, theme) { if(is.null(view_scale) || view_scale$is_empty()) { return(zeroGrob()) diff --git a/R/guides-.r b/R/guides-.r index 481eb42be1..a525d417bd 100644 --- a/R/guides-.r +++ b/R/guides-.r @@ -154,6 +154,11 @@ 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 @@ -176,7 +181,7 @@ 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 diff --git a/R/guides-axis.r b/R/guides-axis.r index aa335d58c6..85d521900d 100644 --- a/R/guides-axis.r +++ b/R/guides-axis.r @@ -83,7 +83,7 @@ guide_train.axis <- function(guide, scale, aesthetic = NULL) { } else { ticks <- new_data_frame(setNames(list(scale$map(breaks)), aesthetic)) ticks$.value <- breaks - ticks$.label <- scale$get_labels(breaks) + ticks$.label <- scale$get_labels() if (is.list(ticks$.label)) { if (any(sapply(ticks$.label, is.language))) { @@ -101,6 +101,27 @@ guide_train.axis <- function(guide, scale, aesthetic = NULL) { guide } +# haven't made this an S3 yet... +guide_transform <- 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)) { + 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) + guide$key[[other_aesthetic]] <- NULL + } else { + guide$key <- coord$transform(guide$key, panel_params) + } + + guide +} + # discards the new guide #' @export guide_merge.axis <- function(guide, new_guide) { @@ -115,7 +136,14 @@ guide_geom.axis <- function(guide, layers, default_mapping) { #' @export guide_gengrob.axis <- function(guide, theme) { - stop("Not implemented", call. = FALSE) + 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 + ) } diff --git a/R/guides-none.r b/R/guides-none.r index a8b42ec1af..c375036677 100644 --- a/R/guides-none.r +++ b/R/guides-none.r @@ -1,20 +1,30 @@ +#' Empty guide +#' +#' This guide draws nothing. +#' +#' @export +#' guide_none <- function() { structure(list(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) { guide } +#' @export guide_geom.guide_none <- function(guide, layers, default_mapping) { guide } +#' @export guide_gengrob.guide_none <- function(guide, theme, ...) { zeroGrob() } diff --git a/R/scale-discrete-.r b/R/scale-discrete-.r index 9dc3dc2537..94ceda9f49 100644 --- a/R/scale-discrete-.r +++ b/R/scale-discrete-.r @@ -43,18 +43,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..01e5b599be 100644 --- a/R/scale-view.r +++ b/R/scale-view.r @@ -26,6 +26,8 @@ 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(), @@ -47,10 +49,24 @@ view_scale_secondary <- function(scale, limits = scale$get_limits(), 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), @@ -87,6 +103,8 @@ 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, diff --git a/man/guide_none.Rd b/man/guide_none.Rd new file mode 100644 index 0000000000..30db3ab184 --- /dev/null +++ b/man/guide_none.Rd @@ -0,0 +1,11 @@ +% 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() +} +\description{ +This guide draws nothing. +} diff --git a/man/scale_discrete.Rd b/man/scale_discrete.Rd index 73697e91d2..01b7495041 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.} } From 821547729aa0ff0174d30e28d15d89d8e71ec7b6 Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Tue, 2 Jul 2019 23:58:55 -0400 Subject: [PATCH 07/30] fix breaks that are outside the scale limits --- R/scale-view.r | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/R/scale-view.r b/R/scale-view.r index 01e5b599be..95d18fa8c3 100644 --- a/R/scale-view.r +++ b/R/scale-view.r @@ -127,7 +127,11 @@ ViewScale <- ggproto("ViewScale", NULL, 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) From d6c35c7b014de6d937dfd0d2d97a2f6ab9e44a31 Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Wed, 3 Jul 2019 14:09:23 -0400 Subject: [PATCH 08/30] fix second axes --- R/coord-cartesian-.r | 2 +- R/scale-view.r | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/coord-cartesian-.r b/R/coord-cartesian-.r index 05b0064f11..bee65e3040 100644 --- a/R/coord-cartesian-.r +++ b/R/coord-cartesian-.r @@ -141,7 +141,7 @@ CoordCartesian <- ggproto("CoordCartesian", Coord, panel_params$guides <- lapply(aesthetics, function(aesthetic) { guide <- panel_params$guides[[aesthetic]] - guide <- guide_train(guide, panel_params[[aesthetic]], aesthetic) + guide <- guide_train(guide, panel_params[[aesthetic]]) guide <- guide_transform(guide, self, panel_params) guide <- guide_geom(guide, layers, default_mapping) guide diff --git a/R/scale-view.r b/R/scale-view.r index 95d18fa8c3..034d0f2148 100644 --- a/R/scale-view.r +++ b/R/scale-view.r @@ -61,7 +61,7 @@ view_scale_secondary <- function(scale, limits = scale$get_limits(), ggproto(NULL, ViewScale, scale = scale, - guide = scale$secondary_axis$guide, + guide = scale$secondary.axis$guide, position = position, break_info = break_info, # as far as scales are concerned, this is a regular scale with From 1f092f2b86c8f4e8035cd0d46b3d9d20cd3e141e Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Wed, 3 Jul 2019 15:25:47 -0400 Subject: [PATCH 09/30] fix new axis guides with coord_flip() --- R/coord-cartesian-.r | 1 + R/coord-flip.r | 27 +++++++++++++++++++++------ R/guides-axis.r | 1 - 3 files changed, 22 insertions(+), 7 deletions(-) diff --git a/R/coord-cartesian-.r b/R/coord-cartesian-.r index bee65e3040..1fa33ff453 100644 --- a/R/coord-cartesian-.r +++ b/R/coord-cartesian-.r @@ -140,6 +140,7 @@ CoordCartesian <- ggproto("CoordCartesian", Coord, 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) diff --git a/R/coord-flip.r b/R/coord-flip.r index 71d11f26ec..34736c5162 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_axes_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_axes_labels(panel_params) }, labels = function(panel_params) { - flip_labels(CoordCartesian$labels(panel_params)) + flip_axes_labels(CoordCartesian$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_axes_labels <- function(x) { old_names <- names(x) new_names <- old_names diff --git a/R/guides-axis.r b/R/guides-axis.r index 85d521900d..61cc849f66 100644 --- a/R/guides-axis.r +++ b/R/guides-axis.r @@ -114,7 +114,6 @@ guide_transform <- function(guide, coord, panel_params) { 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) - guide$key[[other_aesthetic]] <- NULL } else { guide$key <- coord$transform(guide$key, panel_params) } From 12812809f50998c9992303f4932ea7f4ddf0ccde Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Wed, 3 Jul 2019 15:42:47 -0400 Subject: [PATCH 10/30] this PR uses a different method to calculate the positions of ticks (coord$transform() vs. arbitrarily rescaling using the limits) --- .../sec-axis/sec-axis-custom-transform.svg | 36 +++++++++---------- .../sec-axis-independent-transformations.svg | 16 ++++----- .../sec-axis/sec-axis-monotonicity-test.svg | 16 ++++----- .../sec-axis/sec-axis-sec-power-transform.svg | 20 +++++------ .../sec-axis/sec-axis-skewed-transform.svg | 20 +++++------ .../figs/sec-axis/sec-axis-with-division.svg | 12 +++---- tests/figs/themes/axes-styling.svg | 32 ++++++++--------- tests/figs/themes/ticks-length.svg | 32 ++++++++--------- 8 files changed, 92 insertions(+), 92 deletions(-) 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 From c0bc33493ff88708f808bf2433a01b8bf5ea7782 Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Wed, 3 Jul 2019 16:33:24 -0400 Subject: [PATCH 11/30] pass on customizations to the draw method, add tests --- R/guides-axis.r | 55 ++-- man/guide_axis.Rd | 34 +- .../figs/guides/guide-axis-customization.svg | 292 ++++++++++++++++++ tests/testthat/test-guides.R | 12 + 4 files changed, 336 insertions(+), 57 deletions(-) create mode 100644 tests/figs/guides/guide-axis-customization.svg diff --git a/R/guides-axis.r b/R/guides-axis.r index 61cc849f66..11a2dde281 100644 --- a/R/guides-axis.r +++ b/R/guides-axis.r @@ -5,46 +5,29 @@ #' created with [scale_(x|y)_continuous()][scale_x_continuous()] and #' [scale_(x|y)_discrete()][scale_x_discrete()]. #' -#' @inheritParams guide_legend -#' @param line.theme An [element_line()] to use as a template for the line -#' along the axis. Usually set with [theme(axis.line = ...)][theme()]. -#' @param tick.theme An [element_line()] to use as a template for the ticks -#' along the axis. Usually set with [theme(axis.ticks = ...)][theme()]. -#' @param tick.length A [grid::unit()]. Usually set with -#' [theme(axis.ticks.length = ...)][theme()]. +#' @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 #' -guide_axis <- function(# label (axis.text*) - label = TRUE, - label.theme = NULL, - - # axis line (axis.line*) - line.theme = NULL, - - # axis ticks (axis.ticks*) - tick.theme = NULL, - tick.length = NULL, - - # general - order = 0, - position = waiver(), - ... -) { +guide_axis <- function(check.overlap = FALSE, angle = NULL, n_dodge = 1, + order = 0, position = waiver()) { structure( list( - # label - label = label, - label.theme = label.theme, - - # axis line (axis.line*) - line.theme = line.theme, - - # axis ticks (axis.ticks*) - tick.theme = tick.theme, - tick.length = tick.length, + # customizations + check.overlap = check.overlap, + angle = angle, + n_dodge = n_dodge, # general order = order, @@ -52,7 +35,6 @@ guide_axis <- function(# label (axis.text*) # parameter available_aes = c("x", "y"), - ..., name = "axis" ), @@ -141,7 +123,10 @@ guide_gengrob.axis <- function(guide, theme) { break_positions = guide$key[[aesthetic]], break_labels = guide$key$.label, axis_position = guide$position, - theme = theme + theme = theme, + check.overlap = guide$check.overlap, + angle = guide$angle, + n_dodge = guide$n_dodge ) } diff --git a/man/guide_axis.Rd b/man/guide_axis.Rd index df32ec86b0..ed8d322db9 100644 --- a/man/guide_axis.Rd +++ b/man/guide_axis.Rd @@ -4,36 +4,26 @@ \alias{guide_axis} \title{Axis guide} \usage{ -guide_axis(label = TRUE, label.theme = NULL, line.theme = NULL, - tick.theme = NULL, tick.length = NULL, order = 0, - position = waiver(), ...) +guide_axis(check.overlap = FALSE, angle = NULL, n_dodge = 1, + order = 0, position = waiver()) } \arguments{ -\item{label}{logical. If \code{TRUE} then the labels are drawn. If -\code{FALSE} then the labels are invisible.} +\item{check.overlap}{silently remove overlapping labels, +(recursively) prioritizing the first, last, and middle labels.} -\item{label.theme}{A theme object for rendering the label text. Usually the -object of \code{\link[=element_text]{element_text()}} is expected. By default, the theme is -specified by \code{legend.text} in \code{\link[=theme]{theme()}}.} +\item{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{line.theme}{An \code{\link[=element_line]{element_line()}} to use as a template for the line -along the axis. Usually set with \link[=theme]{theme(axis.line = ...)}.} +\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{tick.theme}{An \code{\link[=element_line]{element_line()}} to use as a template for the ticks -along the axis. Usually set with \link[=theme]{theme(axis.ticks = ...)}.} - -\item{tick.length}{A \code{\link[grid:unit]{grid::unit()}}. Usually set with -\link[=theme]{theme(axis.ticks.length = ...)}.} - -\item{order}{positive integer less than 99 that specifies the order of -this guide among multiple guides. This controls the order in which -multiple guides are displayed, not the contents of the guide itself. -If 0 (default), the order is determined by a secret algorithm.} +\item{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.} - -\item{...}{ignored.} } \description{ Axis guides are the visual representation of position scales like those 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/testthat/test-guides.R b/tests/testthat/test-guides.R index 2bd7d0b508..03c5167165 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -151,6 +151,18 @@ 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 are positioned correctly", { df <- data_frame(x = 1, y = 1, z = factor("a")) From 624498373750054a813c496c4a4d1be545d69cbe Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Wed, 3 Jul 2019 22:15:30 -0400 Subject: [PATCH 12/30] fix specification of guides in guides(), warn if guide might be in an inappropriate position --- R/guides-axis.r | 34 +- R/scale-view.r | 8 +- .../guides/guides-specified-in-guides.svg | 305 ++++++++++++++++++ tests/testthat/test-guides.R | 32 ++ 4 files changed, 375 insertions(+), 4 deletions(-) create mode 100644 tests/figs/guides/guides-specified-in-guides.svg diff --git a/R/guides-axis.r b/R/guides-axis.r index 11a2dde281..25c7728997 100644 --- a/R/guides-axis.r +++ b/R/guides-axis.r @@ -91,13 +91,16 @@ guide_transform <- function(guide, coord, panel_params) { aesthetics <- names(guide$key)[!grepl("^\\.", names(guide$key))] - if (!all(c("x", "y") %in% aesthetics)) { + 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) - } else { - guide$key <- coord$transform(guide$key, panel_params) + + warn_for_guide_position(guide) } guide @@ -388,3 +391,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/scale-view.r b/R/scale-view.r index 034d0f2148..cc4219f6d0 100644 --- a/R/scale-view.r +++ b/R/scale-view.r @@ -42,8 +42,14 @@ 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) 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/testthat/test-guides.R b/tests/testthat/test-guides.R index 03c5167165..b3289cc2e8 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -60,6 +60,14 @@ 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") +}) + # Visual tests ------------------------------------------------------------ test_that("axis guides are drawn correctly", { @@ -163,6 +171,30 @@ test_that("axis guides can be customized", { 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("more than one panel guide can be specified for a given position", { + ggplot(mpg, aes(class, hwy)) + + geom_point() + + guides( + y = guide_axis(order = 1), + y.sec = guide_axis(order = 2) + ) + + expect_true(FALSE) # doesn't work yet +}) + test_that("guides are positioned correctly", { df <- data_frame(x = 1, y = 1, z = factor("a")) From 50ef6f58b8f012f83953f0051d6cd9247caed526 Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Wed, 3 Jul 2019 22:35:23 -0400 Subject: [PATCH 13/30] make guide_transform() generic --- NAMESPACE | 3 +++ R/guides-.r | 4 ++++ R/guides-axis.r | 4 ++-- R/guides-none.r | 5 +++++ man/guide-exts.Rd | 3 +++ 5 files changed, 17 insertions(+), 2 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index b733d55831..98507b412a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -82,6 +82,8 @@ S3method(guide_train,axis) S3method(guide_train,colorbar) S3method(guide_train,guide_none) S3method(guide_train,legend) +S3method(guide_transform,axis) +S3method(guide_transform,guide_none) S3method(heightDetails,titleGrob) S3method(heightDetails,zeroGrob) S3method(interleave,default) @@ -372,6 +374,7 @@ 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/R/guides-.r b/R/guides-.r index a525d417bd..481f08ae0f 100644 --- a/R/guides-.r +++ b/R/guides-.r @@ -333,6 +333,10 @@ 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 #' @rdname guide-exts guide_gengrob <- function(guide, theme) UseMethod("guide_gengrob") diff --git a/R/guides-axis.r b/R/guides-axis.r index 25c7728997..a4c30bc707 100644 --- a/R/guides-axis.r +++ b/R/guides-axis.r @@ -83,8 +83,8 @@ guide_train.axis <- function(guide, scale, aesthetic = NULL) { guide } -# haven't made this an S3 yet... -guide_transform <- function(guide, coord, panel_params) { +#' @export +guide_transform.axis <- function(guide, coord, panel_params) { if (is.null(guide$position) || nrow(guide$key) == 0) { return(guide) } diff --git a/R/guides-none.r b/R/guides-none.r index c375036677..6a7052269b 100644 --- a/R/guides-none.r +++ b/R/guides-none.r @@ -24,6 +24,11 @@ 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/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{ From 2b2f4fb9ad8ada3c2f614185441db1d790b8db2e Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Wed, 3 Jul 2019 22:43:02 -0400 Subject: [PATCH 14/30] add ability for (in theory) multiple axes to be drawn at one panel location --- R/coord-cartesian-.r | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/R/coord-cartesian-.r b/R/coord-cartesian-.r index 1fa33ff453..f8562a35e2 100644 --- a/R/coord-cartesian-.r +++ b/R/coord-cartesian-.r @@ -195,24 +195,30 @@ view_scales_from_scale <- function(scale, coord_limits = NULL, expand = TRUE) { guides_grob_col <- function(guides, position, theme) { guides <- guides_filter(guides, position) - if (length(guides) == 0) { + grobs <- lapply(guides, guide_gengrob, theme) + + if (length(grobs) == 0) { return(zeroGrob()) + } else if (length(grobs) == 1) { + grobs[[1]] + } else { + heights <- do.call(unit.c, lapply(grobs, grobHeight)) + gtable_col("axis", grobs = grobs, width = unit(1, "npc"), heights = heights) } - - # FIXME: this needs to combine all the grobs, not sure how to do this just yet - grobs <- lapply(guides, guide_gengrob, theme) - grobs[[1]] } guides_grob_row <- function(guides, position, theme) { guides <- guides_filter(guides, position) - if (length(guides) == 0) { + grobs <- lapply(guides, guide_gengrob, theme) + + if (length(grobs) == 0) { return(zeroGrob()) + } else if (length(grobs) == 1) { + grobs[[1]] + } else { + widths <- do.call(unit.c, lapply(grobs, grobWidth)) + gtable_row("axis", grobs = grobs, height = unit(1, "npc"), widths = widths) } - - # FIXME: this needs to combine all the grobs, not sure how to do this just yet - grobs <- lapply(guides, guide_gengrob, theme) - grobs[[1]] } guides_filter <- function(guides, position) { @@ -222,13 +228,7 @@ guides_filter <- function(guides, position) { logical(1) ) - guides[has_position] -} - -draw_view_scale_axis <- function(view_scale, axis_position, theme) { - if(is.null(view_scale) || view_scale$is_empty()) { - return(zeroGrob()) - } - - 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)) + guides[order(guides_order)] } From 4a45706292e95958838b141e51314955f4c81ac4 Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Fri, 5 Jul 2019 10:32:53 -0400 Subject: [PATCH 15/30] issue a warning when more than one guide exists for one panel location --- R/coord-cartesian-.r | 33 +++++++++++---------------------- tests/testthat/test-guides.R | 22 +++++++++++----------- 2 files changed, 22 insertions(+), 33 deletions(-) diff --git a/R/coord-cartesian-.r b/R/coord-cartesian-.r index f8562a35e2..f8695ef209 100644 --- a/R/coord-cartesian-.r +++ b/R/coord-cartesian-.r @@ -163,15 +163,15 @@ CoordCartesian <- ggproto("CoordCartesian", Coord, render_axis_h = function(panel_params, theme) { list( - top = guides_grob_col(panel_params$guides, position = "top", theme = theme), - bottom = guides_grob_col(panel_params$guides, position = "bottom", theme = theme) + top = guides_grob(panel_params$guides, position = "top", theme = theme), + bottom = guides_grob(panel_params$guides, position = "bottom", theme = theme) ) }, render_axis_v = function(panel_params, theme) { list( - left = guides_grob_row(panel_params$guides, position = "left", theme = theme), - right = guides_grob_row(panel_params$guides, position = "right", theme = theme) + left = guides_grob(panel_params$guides, position = "left", theme = theme), + right = guides_grob(panel_params$guides, position = "right", theme = theme) ) } ) @@ -193,8 +193,8 @@ view_scales_from_scale <- function(scale, coord_limits = NULL, expand = TRUE) { view_scales } -guides_grob_col <- function(guides, position, theme) { - guides <- guides_filter(guides, position) +guides_grob <- function(guides, position, theme) { + guides <- guides_filter_by_position(guides, position) grobs <- lapply(guides, guide_gengrob, theme) if (length(grobs) == 0) { @@ -202,26 +202,15 @@ guides_grob_col <- function(guides, position, theme) { } else if (length(grobs) == 1) { grobs[[1]] } else { - heights <- do.call(unit.c, lapply(grobs, grobHeight)) - gtable_col("axis", grobs = grobs, width = unit(1, "npc"), heights = heights) - } -} - -guides_grob_row <- function(guides, position, theme) { - guides <- guides_filter(guides, position) - grobs <- lapply(guides, guide_gengrob, theme) - - if (length(grobs) == 0) { - return(zeroGrob()) - } else if (length(grobs) == 1) { + warning( + "More than one panel guide found at `position = \"", position, "\". ", + "Only showing the first guide." + ) grobs[[1]] - } else { - widths <- do.call(unit.c, lapply(grobs, grobWidth)) - gtable_row("axis", grobs = grobs, height = unit(1, "npc"), widths = widths) } } -guides_filter <- function(guides, position) { +guides_filter_by_position <- function(guides, position) { has_position <- vapply( guides, function(guide) identical(guide$position, position), diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index b3289cc2e8..ced0f01dfb 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -68,6 +68,17 @@ test_that("a warning is generated when guides are drawn at a location that doesn expect_warning(ggplot_gtable(built), "Position guide is perpendicular") }) +test_that("a warning is generated when more than one panel 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), "More than one panel guide") +}) + # Visual tests ------------------------------------------------------------ test_that("axis guides are drawn correctly", { @@ -184,17 +195,6 @@ test_that("guides can be specified in guides()", { expect_doppelganger("guides specified in guides()", plot) }) -test_that("more than one panel guide can be specified for a given position", { - ggplot(mpg, aes(class, hwy)) + - geom_point() + - guides( - y = guide_axis(order = 1), - y.sec = guide_axis(order = 2) - ) - - expect_true(FALSE) # doesn't work yet -}) - test_that("guides are positioned correctly", { df <- data_frame(x = 1, y = 1, z = factor("a")) From f91a546d2c5f0bde22dd7512c631cee825601052 Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Fri, 5 Jul 2019 10:37:28 -0400 Subject: [PATCH 16/30] ensure that user-facing messages refer to "position guides" --- R/coord-cartesian-.r | 2 +- tests/testthat/test-guides.R | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/coord-cartesian-.r b/R/coord-cartesian-.r index f8695ef209..9efcbf19a6 100644 --- a/R/coord-cartesian-.r +++ b/R/coord-cartesian-.r @@ -203,7 +203,7 @@ guides_grob <- function(guides, position, theme) { grobs[[1]] } else { warning( - "More than one panel guide found at `position = \"", position, "\". ", + "More than one position guide found at `position = \"", position, "\". ", "Only showing the first guide." ) grobs[[1]] diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index ced0f01dfb..b48094f2eb 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -68,7 +68,7 @@ test_that("a warning is generated when guides are drawn at a location that doesn expect_warning(ggplot_gtable(built), "Position guide is perpendicular") }) -test_that("a warning is generated when more than one panel guide is drawn at a location", { +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( @@ -76,7 +76,7 @@ test_that("a warning is generated when more than one panel guide is drawn at a l y.sec = guide_axis(position = "left") ) built <- expect_silent(ggplot_build(plot)) - expect_warning(ggplot_gtable(built), "More than one panel guide") + expect_warning(ggplot_gtable(built), "More than one position guide") }) # Visual tests ------------------------------------------------------------ From 7c435ae0c2f53cd64897c42ff9b4a6e4a63269b4 Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Fri, 5 Jul 2019 11:03:15 -0400 Subject: [PATCH 17/30] rename guides_grob to make it more specific --- R/coord-cartesian-.r | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/coord-cartesian-.r b/R/coord-cartesian-.r index 9efcbf19a6..53006b4d45 100644 --- a/R/coord-cartesian-.r +++ b/R/coord-cartesian-.r @@ -163,15 +163,15 @@ CoordCartesian <- ggproto("CoordCartesian", Coord, render_axis_h = function(panel_params, theme) { list( - top = guides_grob(panel_params$guides, position = "top", theme = theme), - bottom = guides_grob(panel_params$guides, position = "bottom", theme = 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) { list( - left = guides_grob(panel_params$guides, position = "left", theme = theme), - right = guides_grob(panel_params$guides, position = "right", theme = theme) + left = panel_guides_grob(panel_params$guides, position = "left", theme = theme), + right = panel_guides_grob(panel_params$guides, position = "right", theme = theme) ) } ) @@ -193,7 +193,7 @@ view_scales_from_scale <- function(scale, coord_limits = NULL, expand = TRUE) { view_scales } -guides_grob <- function(guides, position, theme) { +panel_guides_grob <- function(guides, position, theme) { guides <- guides_filter_by_position(guides, position) grobs <- lapply(guides, guide_gengrob, theme) From e9358edffc862d7006a983f9c60d55b0d26a9b0b Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Fri, 5 Jul 2019 12:32:38 -0400 Subject: [PATCH 18/30] add ability for guides to have titles --- R/coord-.r | 15 ++++++++- R/coord-cartesian-.r | 29 ++++++++++++++++++ R/coord-flip.r | 4 +-- R/coord-polar.r | 6 ++-- R/guides-axis.r | 19 +++++++++++- R/guides-none.r | 13 ++++++-- R/layout.R | 11 ++++--- man/guide_axis.Rd | 20 ++++++++++-- man/guide_none.Rd | 6 +++- tests/figs/guides/position-guide-titles.svg | 34 +++++++++++++++++++++ tests/testthat/test-guides.R | 14 +++++++++ 11 files changed, 155 insertions(+), 16 deletions(-) create mode 100644 tests/figs/guides/position-guide-titles.svg diff --git a/R/coord-.r b/R/coord-.r index 88d316afe0..30607dd590 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"), @@ -145,3 +145,16 @@ render_axis <- function(panel_params, axis, scale, position, theme) { zeroGrob() } } + +panel_label_default <- function(scale, aesthetic, labels) { + primary <- scale$name %|W|% labels[[aesthetic]] + primary <- scale$make_title(primary) + secondary <- if (is.null(scale$secondary.axis)) { + waiver() + } else { + scale$sec_name() + } %|W|% labels[[paste0("sec.", aesthetic)]] + if (is.derived(secondary)) secondary <- primary + secondary <- scale$make_sec_title(secondary) + list(primary = primary, secondary = secondary)[scale$axis_order()] +} diff --git a/R/coord-cartesian-.r b/R/coord-cartesian-.r index 53006b4d45..41ab35099e 100644 --- a/R/coord-cartesian-.r +++ b/R/coord-cartesian-.r @@ -151,6 +151,25 @@ CoordCartesian <- ggproto("CoordCartesian", Coord, 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, @@ -193,6 +212,16 @@ view_scales_from_scale <- function(scale, coord_limits = NULL, expand = TRUE) { view_scales } +panel_guide_label <- function(guides, position, default_label) { + guides <- guides_filter_by_position(guides, position) + + if (length(guides) == 0) { + default_label + } else { + guides[[1]]$title %||% waiver() %|W|% default_label + } +} + panel_guides_grob <- function(guides, position, theme) { guides <- guides_filter_by_position(guides, position) grobs <- lapply(guides, guide_gengrob, theme) diff --git a/R/coord-flip.r b/R/coord-flip.r index 34736c5162..afa5d7d7bc 100644 --- a/R/coord-flip.r +++ b/R/coord-flip.r @@ -61,8 +61,8 @@ CoordFlip <- ggproto("CoordFlip", CoordCartesian, flip_axes_labels(panel_params) }, - labels = function(panel_params) { - flip_axes_labels(CoordCartesian$labels(panel_params)) + labels = function(labels, panel_params) { + flip_axes_labels(CoordCartesian$labels(labels, panel_params)) }, setup_layout = function(layout, params) { 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/guides-axis.r b/R/guides-axis.r index a4c30bc707..9f4439f884 100644 --- a/R/guides-axis.r +++ b/R/guides-axis.r @@ -20,10 +20,27 @@ #' #' @export #' -guide_axis <- function(check.overlap = FALSE, angle = NULL, n_dodge = 1, +#' @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(n_dodge = 2)) +#' +#' # 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, diff --git a/R/guides-none.r b/R/guides-none.r index 6a7052269b..eaab644709 100644 --- a/R/guides-none.r +++ b/R/guides-none.r @@ -3,10 +3,19 @@ #' #' This guide draws nothing. #' +#' @inheritParams guide_axis +#' #' @export #' -guide_none <- function() { - structure(list(available_aes = "any"), class = c("guide", "guide_none")) +guide_none <- function(title = waiver(), position = waiver()) { + structure( + list( + title = title, + position = position, + available_aes = "any" + ), + class = c("guide", "guide_none") + ) } #' @export diff --git a/R/layout.R b/R/layout.R index 84a2f4db7a..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, diff --git a/man/guide_axis.Rd b/man/guide_axis.Rd index ed8d322db9..e1e158f175 100644 --- a/man/guide_axis.Rd +++ b/man/guide_axis.Rd @@ -4,8 +4,8 @@ \alias{guide_axis} \title{Axis guide} \usage{ -guide_axis(check.overlap = FALSE, angle = NULL, n_dodge = 1, - order = 0, position = waiver()) +guide_axis(title = waiver(), check.overlap = FALSE, angle = NULL, + n_dodge = 1, order = 0, position = waiver()) } \arguments{ \item{check.overlap}{silently remove overlapping labels, @@ -30,3 +30,19 @@ 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(n_dodge = 2)) + +# 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 index 30db3ab184..9ea9a49665 100644 --- a/man/guide_none.Rd +++ b/man/guide_none.Rd @@ -4,7 +4,11 @@ \alias{guide_none} \title{Empty guide} \usage{ -guide_none() +guide_none(title = waiver(), position = waiver()) +} +\arguments{ +\item{position}{Where this guide should be drawn: one of top, bottom, +left, or right.} } \description{ This guide draws nothing. 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/testthat/test-guides.R b/tests/testthat/test-guides.R index b48094f2eb..463eb79c56 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -195,6 +195,20 @@ test_that("guides can be specified in guides()", { 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")) From 8942c56827e47ab5968936fb2ccfa18858b14782 Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Fri, 5 Jul 2019 12:39:33 -0400 Subject: [PATCH 19/30] fix title parameter documentation for position guides --- R/guides-axis.r | 1 + man/guide_axis.Rd | 5 +++++ man/guide_none.Rd | 5 +++++ 3 files changed, 11 insertions(+) diff --git a/R/guides-axis.r b/R/guides-axis.r index 9f4439f884..1c93b5b1fa 100644 --- a/R/guides-axis.r +++ b/R/guides-axis.r @@ -5,6 +5,7 @@ #' 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()], diff --git a/man/guide_axis.Rd b/man/guide_axis.Rd index e1e158f175..71738ba828 100644 --- a/man/guide_axis.Rd +++ b/man/guide_axis.Rd @@ -8,6 +8,11 @@ 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.} diff --git a/man/guide_none.Rd b/man/guide_none.Rd index 9ea9a49665..514784d7c9 100644 --- a/man/guide_none.Rd +++ b/man/guide_none.Rd @@ -7,6 +7,11 @@ 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.} } From e06034761ff9103413c290660859852463443e15 Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Fri, 5 Jul 2019 12:43:05 -0400 Subject: [PATCH 20/30] remove unused method --- R/coord-.r | 13 ------------- 1 file changed, 13 deletions(-) diff --git a/R/coord-.r b/R/coord-.r index 30607dd590..26f45c9c17 100644 --- a/R/coord-.r +++ b/R/coord-.r @@ -145,16 +145,3 @@ render_axis <- function(panel_params, axis, scale, position, theme) { zeroGrob() } } - -panel_label_default <- function(scale, aesthetic, labels) { - primary <- scale$name %|W|% labels[[aesthetic]] - primary <- scale$make_title(primary) - secondary <- if (is.null(scale$secondary.axis)) { - waiver() - } else { - scale$sec_name() - } %|W|% labels[[paste0("sec.", aesthetic)]] - if (is.derived(secondary)) secondary <- primary - secondary <- scale$make_sec_title(secondary) - list(primary = primary, secondary = secondary)[scale$axis_order()] -} From b05111a34ac7b298fbfe1257488690197222ab76 Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Wed, 17 Jul 2019 12:11:55 -0400 Subject: [PATCH 21/30] implement hadley's review suggestions --- R/coord-cartesian-.r | 16 +++++++++------- R/guides-axis.r | 2 +- man/guide_axis.Rd | 2 +- 3 files changed, 11 insertions(+), 9 deletions(-) diff --git a/R/coord-cartesian-.r b/R/coord-cartesian-.r index 41ab35099e..af5dc3381d 100644 --- a/R/coord-cartesian-.r +++ b/R/coord-cartesian-.r @@ -156,17 +156,19 @@ CoordCartesian <- ggproto("CoordCartesian", Coord, positions_y <- c("left", "right") list( - x = lapply(c(1, 2), function(i) panel_guide_label( + 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]]) - ) + }), + y = lapply(c(1, 2), function(i) { + panel_guide_label( + panel_params$guides, + position = positions_y[[i]], + default_label = labels$y[[i]]) + }) ) }, diff --git a/R/guides-axis.r b/R/guides-axis.r index 1c93b5b1fa..96e100712b 100644 --- a/R/guides-axis.r +++ b/R/guides-axis.r @@ -30,7 +30,7 @@ #' # 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(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_axis.Rd b/man/guide_axis.Rd index 71738ba828..84976873cc 100644 --- a/man/guide_axis.Rd +++ b/man/guide_axis.Rd @@ -44,7 +44,7 @@ p <- ggplot(mpg, aes(cty * 100, hwy * 100)) + # 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(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()) From 5e5d7480850b880d3a822001ce290bed3327b985 Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Wed, 17 Jul 2019 13:14:09 -0400 Subject: [PATCH 22/30] clarify position guide resolving code --- R/coord-cartesian-.r | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/coord-cartesian-.r b/R/coord-cartesian-.r index af5dc3381d..2186d80117 100644 --- a/R/coord-cartesian-.r +++ b/R/coord-cartesian-.r @@ -217,10 +217,10 @@ view_scales_from_scale <- function(scale, coord_limits = NULL, expand = TRUE) { panel_guide_label <- function(guides, position, default_label) { guides <- guides_filter_by_position(guides, position) - if (length(guides) == 0) { + if (length(guides) == 0 || is.null(guides[[1]]$title)) { default_label } else { - guides[[1]]$title %||% waiver() %|W|% default_label + guides[[1]]$title %|W|% default_label } } From 2d040c782c3ebc2c83e590148478dcc83f5d35f1 Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Wed, 28 Aug 2019 13:33:55 -0300 Subject: [PATCH 23/30] fix guide_none() with non-position scales --- R/guides-.r | 2 +- tests/testthat/test-guides.R | 20 ++++++++++++++++++++ 2 files changed, 21 insertions(+), 1 deletion(-) diff --git a/R/guides-.r b/R/guides-.r index 481f08ae0f..71347ca83a 100644 --- a/R/guides-.r +++ b/R/guides-.r @@ -186,7 +186,7 @@ guides_train <- function(scales, theme, guides, labels) { # 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 diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index 463eb79c56..c0a33113c4 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -79,6 +79,26 @@ test_that("a warning is generated when more than one position guide is drawn at expect_warning(ggplot_gtable(built), "More than one position 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()) +}) + # Visual tests ------------------------------------------------------------ test_that("axis guides are drawn correctly", { From b52fa5951d06cdd975a5147255b715fc71d0c8e2 Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Wed, 28 Aug 2019 14:09:50 -0300 Subject: [PATCH 24/30] rename n_dodge to n.dodge --- R/guides-axis.r | 18 +++++++++--------- man/guide_axis.Rd | 8 ++++---- tests/testthat/test-guides.R | 16 ++++++++-------- 3 files changed, 21 insertions(+), 21 deletions(-) diff --git a/R/guides-axis.r b/R/guides-axis.r index 96e100712b..ac240c9875 100644 --- a/R/guides-axis.r +++ b/R/guides-axis.r @@ -11,7 +11,7 @@ #' @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. #' @param order Used to determine the order of the guides (left-to-right, @@ -29,14 +29,14 @@ #' #' # axis guides can be customized in the scale_* functions or #' # using guides() -#' p + scale_x_continuous(guide = guide_axis(n_dodge = 2)) +#' 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()) +#' 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, +guide_axis <- function(title = waiver(), check.overlap = FALSE, angle = NULL, n.dodge = 1, order = 0, position = waiver()) { structure( list( @@ -45,7 +45,7 @@ guide_axis <- function(title = waiver(), check.overlap = FALSE, angle = NULL, n_ # customizations check.overlap = check.overlap, angle = angle, - n_dodge = n_dodge, + n.dodge = n.dodge, # general order = order, @@ -147,7 +147,7 @@ guide_gengrob.axis <- function(guide, theme) { theme = theme, check.overlap = guide$check.overlap, angle = guide$angle, - n_dodge = guide$n_dodge + n.dodge = guide$n.dodge ) } @@ -163,14 +163,14 @@ guide_gengrob.axis <- function(guide, theme) { #' @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" @@ -249,7 +249,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) { diff --git a/man/guide_axis.Rd b/man/guide_axis.Rd index 84976873cc..dbd206aaa5 100644 --- a/man/guide_axis.Rd +++ b/man/guide_axis.Rd @@ -5,7 +5,7 @@ \title{Axis guide} \usage{ guide_axis(title = waiver(), check.overlap = FALSE, angle = NULL, - n_dodge = 1, order = 0, position = waiver()) + n.dodge = 1, order = 0, position = waiver()) } \arguments{ \item{title}{A character string or expression indicating a title of guide. @@ -20,7 +20,7 @@ specified in \code{\link[=labs]{labs()}} is used for the title.} 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 +\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.} @@ -43,11 +43,11 @@ p <- ggplot(mpg, aes(cty * 100, hwy * 100)) + # axis guides can be customized in the scale_* functions or # using guides() -p + scale_x_continuous(guide = guide_axis(n_dodge = 2)) +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()) +p + guides(x = guide_axis(n.dodge = 2), y.sec = guide_axis()) } diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index c0a33113c4..9c44a84851 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -166,7 +166,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) ) }) @@ -194,10 +194,10 @@ 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) + 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)) + scale_x_discrete(guide = guide_axis(n.dodge = 2)) expect_doppelganger("guide_axis() customization", plot) }) @@ -206,10 +206,10 @@ 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) + 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) From 2ef4fe1e4807a05fdd7e4b356dba18e9253ef975 Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Wed, 28 Aug 2019 14:25:32 -0300 Subject: [PATCH 25/30] remove "none" guides before calculating grobs --- R/coord-cartesian-.r | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/coord-cartesian-.r b/R/coord-cartesian-.r index 2186d80117..308a3e21cf 100644 --- a/R/coord-cartesian-.r +++ b/R/coord-cartesian-.r @@ -226,7 +226,9 @@ panel_guide_label <- function(guides, position, default_label) { panel_guides_grob <- function(guides, position, theme) { guides <- guides_filter_by_position(guides, position) - grobs <- lapply(guides, guide_gengrob, theme) + is_none <- vapply(guides, inherits, "guide_none", FUN.VALUE = logical(1)) + + grobs <- lapply(guides[!is_none], guide_gengrob, theme) if (length(grobs) == 0) { return(zeroGrob()) From f11609af8cacc79569a1cb5e1e64ea9b7898aaa6 Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Wed, 28 Aug 2019 15:19:49 -0300 Subject: [PATCH 26/30] fix multiple guide logic and warning --- R/coord-cartesian-.r | 31 ++++++------------------------- R/coord-sf.R | 2 ++ R/guides-axis.r | 10 +++++++++- R/guides-none.r | 2 +- tests/testthat/test-guides.R | 2 +- 5 files changed, 19 insertions(+), 28 deletions(-) diff --git a/R/coord-cartesian-.r b/R/coord-cartesian-.r index 308a3e21cf..d36a49674a 100644 --- a/R/coord-cartesian-.r +++ b/R/coord-cartesian-.r @@ -215,35 +215,16 @@ view_scales_from_scale <- function(scale, coord_limits = NULL, expand = TRUE) { } panel_guide_label <- function(guides, position, default_label) { - guides <- guides_filter_by_position(guides, position) - - if (length(guides) == 0 || is.null(guides[[1]]$title)) { - default_label - } else { - guides[[1]]$title %|W|% default_label - } + guide <- guide_for_position(guides, position) %||% guide_none(title = NULL) + guide$title %|W|% default_label } panel_guides_grob <- function(guides, position, theme) { - guides <- guides_filter_by_position(guides, position) - is_none <- vapply(guides, inherits, "guide_none", FUN.VALUE = logical(1)) - - grobs <- lapply(guides[!is_none], guide_gengrob, theme) - - if (length(grobs) == 0) { - return(zeroGrob()) - } else if (length(grobs) == 1) { - grobs[[1]] - } else { - warning( - "More than one position guide found at `position = \"", position, "\". ", - "Only showing the first guide." - ) - grobs[[1]] - } + guide <- guide_for_position(guides, position) %||% guide_none() + guide_gengrob(guide, theme) } -guides_filter_by_position <- function(guides, position) { +guide_for_position <- function(guides, position) { has_position <- vapply( guides, function(guide) identical(guide$position, position), @@ -252,5 +233,5 @@ guides_filter_by_position <- function(guides, position) { guides <- guides[has_position] guides_order <- vapply(guides, function(guide) as.numeric(guide$order)[1], numeric(1)) - guides[order(guides_order)] + Reduce(guide_merge, guides[order(guides_order)]) } 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-axis.r b/R/guides-axis.r index ac240c9875..2ad8e3ff94 100644 --- a/R/guides-axis.r +++ b/R/guides-axis.r @@ -124,9 +124,17 @@ guide_transform.axis <- function(guide, coord, panel_params) { guide } -# discards the new 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 } diff --git a/R/guides-none.r b/R/guides-none.r index eaab644709..e27b6e9892 100644 --- a/R/guides-none.r +++ b/R/guides-none.r @@ -25,7 +25,7 @@ guide_train.guide_none <- function(guide, scale, aesthetic = NULL) { #' @export guide_merge.guide_none <- function(guide, new_guide) { - guide + new_guide } #' @export diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index 9c44a84851..f711e60786 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -76,7 +76,7 @@ test_that("a warning is generated when more than one position guide is drawn at y.sec = guide_axis(position = "left") ) built <- expect_silent(ggplot_build(plot)) - expect_warning(ggplot_gtable(built), "More than one position guide") + expect_warning(ggplot_gtable(built), "Discarding guide") }) test_that("guide_none() can be used in non-position scales", { From b738de5d5bafc053e007cee52e890a6388691890 Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Wed, 28 Aug 2019 15:44:42 -0300 Subject: [PATCH 27/30] ensure guide_legend fails properly when used with position scales --- NAMESPACE | 1 + R/guides-.r | 11 +++++++++++ R/guides-axis.r | 2 +- R/scale-view.r | 8 +++----- tests/testthat/test-guides.R | 9 +++++++++ 5 files changed, 25 insertions(+), 6 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 98507b412a..ed854d8702 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -83,6 +83,7 @@ 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) diff --git a/R/guides-.r b/R/guides-.r index 71347ca83a..7cad5f52fc 100644 --- a/R/guides-.r +++ b/R/guides-.r @@ -337,6 +337,17 @@ guide_geom <- function(guide, layers, default_mapping) UseMethod("guide_geom") #' @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 2ad8e3ff94..ef0c7b6f65 100644 --- a/R/guides-axis.r +++ b/R/guides-axis.r @@ -83,7 +83,7 @@ guide_train.axis <- function(guide, scale, aesthetic = NULL) { } else { ticks <- new_data_frame(setNames(list(scale$map(breaks)), aesthetic)) ticks$.value <- breaks - ticks$.label <- scale$get_labels() + ticks$.label <- scale$get_labels(breaks) if (is.list(ticks$.label)) { if (any(sapply(ticks$.label, is.language))) { diff --git a/R/scale-view.r b/R/scale-view.r index cc4219f6d0..2986e275cd 100644 --- a/R/scale-view.r +++ b/R/scale-view.r @@ -34,7 +34,6 @@ view_scale_primary <- function(scale, limits = scale$get_limits(), limits = limits, continuous_range = continuous_range, breaks = breaks, - labels = scale$get_labels(breaks), minor_breaks = minor_breaks ) } @@ -82,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)) ) } @@ -96,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, @@ -117,7 +116,6 @@ ViewScale <- ggproto("ViewScale", NULL, limits = NULL, continuous_range = NULL, breaks = NULL, - labels = NULL, minor_breaks = NULL, is_empty = function(self) { @@ -128,7 +126,7 @@ 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) }, diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index f711e60786..4bbe155e39 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -99,6 +99,15 @@ test_that("guide_none() can be used in non-position scales", { 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", { From 0cc850ecc8f772f4df872d8ba009e129efb2bd5f Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Wed, 28 Aug 2019 15:51:12 -0300 Subject: [PATCH 28/30] fix axis plural --- R/coord-flip.r | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/coord-flip.r b/R/coord-flip.r index afa5d7d7bc..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_axes_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_axes_labels(panel_params) + flip_axis_labels(panel_params) }, labels = function(labels, panel_params) { - flip_axes_labels(CoordCartesian$labels(labels, panel_params)) + flip_axis_labels(CoordCartesian$labels(labels, panel_params)) }, setup_layout = function(layout, params) { @@ -94,7 +94,7 @@ scale_flip_axis <- function(scale) { # maintaining the position of the x* and y* names is # important for re-using the same guide_transform() # as CoordCartesian -flip_axes_labels <- function(x) { +flip_axis_labels <- function(x) { old_names <- names(x) new_names <- old_names From 92e16ae592b947d4af862852e55ef2335b4049cf Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Sun, 22 Sep 2019 09:18:50 -0300 Subject: [PATCH 29/30] add comment reminding to use find_global() when guides are officially extensible --- R/guides-.r | 1 + 1 file changed, 1 insertion(+) diff --git a/R/guides-.r b/R/guides-.r index 7cad5f52fc..40284afa00 100644 --- a/R/guides-.r +++ b/R/guides-.r @@ -162,6 +162,7 @@ resolve_guide <- function(aesthetic, scale, guides, default = "none", null = "no # 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")) From f930075ea5aa10a190999c1073755382e76e3362 Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Sun, 29 Sep 2019 17:52:41 -0300 Subject: [PATCH 30/30] add NEWS bullet --- NEWS.md | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/NEWS.md b/NEWS.md index 7d61546d9a..058230f25c 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). + * `expand_scale()` was deprecated in favour of `expansion()` for setting the `expand` argument of `x` and `y` scales (@paleolimbot).