From 42e56a97bcd6115da81481fcf07283caa72e41bb Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 8 Jan 2020 11:41:41 +0100 Subject: [PATCH 1/4] Ensure that guide_bin and guide_colourbar can be used with discrete scales if the levels follow cut() naming semantics --- R/guide-bins.R | 18 +++++++++++++++--- R/guide-colorsteps.R | 31 ++++++++++++++++++++++++------- R/scale-.r | 1 - 3 files changed, 39 insertions(+), 11 deletions(-) diff --git a/R/guide-bins.R b/R/guide-bins.R index 5f243bb216..e0528e6ba0 100644 --- a/R/guide-bins.R +++ b/R/guide-bins.R @@ -123,13 +123,25 @@ guide_train.bins <- function(guide, scale, aesthetic = NULL) { if (length(breaks) == 0 || all(is.na(breaks))) { return() } - limits <- scale$get_limits() - all_breaks <- c(limits[1], breaks, limits[2]) - bin_at <- all_breaks[-1] - diff(all_breaks) / 2 # in the key data frame, use either the aesthetic provided as # argument to this function or, as a fall back, the first in the vector # of possible aesthetics handled by the scale aes_column_name <- aesthetic %||% scale$aesthetics[1] + + if (is.numeric(breaks)) { + limits <- scale$get_limits() + all_breaks <- c(limits[1], breaks, limits[2]) + bin_at <- all_breaks[-1] - diff(all_breaks) / 2 + } else { + bin_at <- breaks + breaks <- as.character(breaks) + breaks <- strsplit(gsub("\\(|\\)|\\[|\\]", "", breaks), ",\\s?") + breaks <- as.numeric(unlist(breaks)) + if (anyNA(breaks)) { + abort('Breaks not formatted correctly for a bin legend. Use `(, ]` format to indicate bins') + } + all_breaks <- breaks[c(1, seq_along(bin_at) * 2)] + } key <- new_data_frame(setNames(list(c(scale$map(bin_at), NA)), aes_column_name)) key$.label <- scale$get_labels(all_breaks) guide$show.limits <- guide$show.limits %||% scale$show_limits %||% FALSE diff --git a/R/guide-colorsteps.R b/R/guide-colorsteps.R index 0927966d79..4152c04e66 100644 --- a/R/guide-colorsteps.R +++ b/R/guide-colorsteps.R @@ -54,19 +54,35 @@ guide_colorsteps <- guide_coloursteps #' @export guide_train.colorsteps <- function(guide, scale, aesthetic = NULL) { - if (guide$even.steps) { - breaks <- scale$get_breaks() - if (length(breaks) == 0 || all(is.na(breaks))) + breaks <- scale$get_breaks() + browser() + if (guide$even.steps || !is.numeric(breaks)) { + if (length(breaks) == 0 || all(is.na(breaks))) { return() - limits <- scale$get_limits() - all_breaks <- c(limits[1], breaks, limits[2]) - bin_at <- all_breaks[-1] - diff(all_breaks) / 2 + } + if (is.numeric(breaks)) { + limits <- scale$get_limits() + all_breaks <- c(limits[1], breaks, limits[2]) + bin_at <- all_breaks[-1] - diff(all_breaks) / 2 + } else { + bin_at <- breaks + breaks_num <- as.character(breaks) + breaks_num <- strsplit(gsub("\\(|\\)|\\[|\\]", "", breaks_num), ",\\s?") + breaks_num <- as.numeric(unlist(breaks_num)) + if (anyNA(breaks_num)) { + abort('Breaks not formatted correctly for a bin legend. Use `(, ]` format to indicate bins') + } + all_breaks <- breaks_num[c(1, seq_along(breaks) * 2)] + limits <- all_breaks[c(1, length(all_breaks))] + breaks <- all_breaks[-c(1, length(all_breaks))] + } ticks <- new_data_frame(setNames(list(scale$map(breaks)), aesthetic %||% scale$aesthetics[1])) ticks$.value <- seq_along(breaks) - 0.5 ticks$.label <- scale$get_labels(breaks) guide$nbin <- length(breaks) + 1 guide$key <- ticks guide$bar <- new_data_frame(list(colour = scale$map(bin_at), value = seq_along(bin_at) - 1), n = length(bin_at)) + if (guide$reverse) { guide$key <- guide$key[nrow(guide$key):1, ] guide$bar <- guide$bar[nrow(guide$bar):1, ] @@ -74,10 +90,11 @@ guide_train.colorsteps <- function(guide, scale, aesthetic = NULL) { guide$hash <- with(guide, digest::digest(list(title, key$.label, bar, name))) } else { guide <- NextMethod() + limits <- scale$get_limits() } if (guide$show.limits %||% scale$show.limits %||% FALSE) { edges <- rescale(c(0, 1), to = guide$bar$value[c(1, nrow(guide$bar))], from = c(0.5, guide$nbin - 0.5) / guide$nbin) - limits <- scale$get_limits() + if (guide$reverse) edges <- rev(edges) guide$key <- guide$key[c(NA, seq_len(nrow(guide$key)), NA), , drop = FALSE] guide$key$.value[c(1, nrow(guide$key))] <- edges guide$key$.label[c(1, nrow(guide$key))] <- scale$get_labels(limits) diff --git a/R/scale-.r b/R/scale-.r index ac21da76bd..90776d39b8 100644 --- a/R/scale-.r +++ b/R/scale-.r @@ -848,7 +848,6 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale, } if (is.waive(self$labels)) { - breaks <- self$get_breaks() if (is.numeric(breaks)) { # Only format numbers, because on Windows, format messes up encoding format(breaks, justify = "none") From c470fd3da7bdbf8d14c2cf561d45e2035ca72e5c Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 8 Jan 2020 11:47:41 +0100 Subject: [PATCH 2/4] remove browser() --- R/guide-colorsteps.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/guide-colorsteps.R b/R/guide-colorsteps.R index 4152c04e66..58245c734f 100644 --- a/R/guide-colorsteps.R +++ b/R/guide-colorsteps.R @@ -55,7 +55,6 @@ guide_colorsteps <- guide_coloursteps #' @export guide_train.colorsteps <- function(guide, scale, aesthetic = NULL) { breaks <- scale$get_breaks() - browser() if (guide$even.steps || !is.numeric(breaks)) { if (length(breaks) == 0 || all(is.na(breaks))) { return() From 2ad83bc3c1d2b31b4de20f93db0e265325a4a7af Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 8 Jan 2020 21:00:19 +0100 Subject: [PATCH 3/4] Better docs and comments --- R/guide-bins.R | 15 +++++++++++++++ R/guide-colorsteps.R | 5 +++++ man/guide_bins.Rd | 14 ++++++++++++++ man/guide_coloursteps.Rd | 14 ++++++++++++++ 4 files changed, 48 insertions(+) diff --git a/R/guide-bins.R b/R/guide-bins.R index e0528e6ba0..04beade1e0 100644 --- a/R/guide-bins.R +++ b/R/guide-bins.R @@ -16,6 +16,18 @@ #' @param show.limits Logical. Should the limits of the scale be shown with #' labels and ticks. #' +#' @section Use with discrete scale: +#' This guide is intended to show binned data and work together with ggplot2's +#' binning scales. However, it is sometimes desirable to perform the binning in +#' a separate step, either as part of a stat (e.g. [stat_contour_filled()]) or +#' prior to the visualisation. If you want to use this guide for discrete data +#' the levels must follow the naming scheme implemented by [base::cut()]. This +#' means that a bin must be encoded as `"(, ]"` with `` +#' giving the lower bound of the bin and `` giving the upper bound +#' (`"[, )"` is also accepted). If you use [base::cut()] to +#' perform the binning everything should work as expected, if not, some recoding +#' may be needed. +#' #' @return A guide object #' @family guides #' @export @@ -133,6 +145,9 @@ guide_train.bins <- function(guide, scale, aesthetic = NULL) { all_breaks <- c(limits[1], breaks, limits[2]) bin_at <- all_breaks[-1] - diff(all_breaks) / 2 } else { + # If the breaks are not numeric it is used with a discrete scale. We check + # if the breaks follow the allowed format "(, ]", and if it + # does we convert it into bin specs bin_at <- breaks breaks <- as.character(breaks) breaks <- strsplit(gsub("\\(|\\)|\\[|\\]", "", breaks), ",\\s?") diff --git a/R/guide-colorsteps.R b/R/guide-colorsteps.R index 58245c734f..c5c37a8bb0 100644 --- a/R/guide-colorsteps.R +++ b/R/guide-colorsteps.R @@ -12,6 +12,8 @@ #' visible. #' @inheritDotParams guide_colourbar -nbin -raster -ticks -available_aes #' +#' @inheritSection guide_bins Use with discrete scale +#' #' @return A guide object #' @export #' @@ -64,6 +66,9 @@ guide_train.colorsteps <- function(guide, scale, aesthetic = NULL) { all_breaks <- c(limits[1], breaks, limits[2]) bin_at <- all_breaks[-1] - diff(all_breaks) / 2 } else { + # If the breaks are not numeric it is used with a discrete scale. We check + # if the breaks follow the allowed format "(, ]", and if it + # does we convert it into bin specs bin_at <- breaks breaks_num <- as.character(breaks) breaks_num <- strsplit(gsub("\\(|\\)|\\[|\\]", "", breaks_num), ",\\s?") diff --git a/man/guide_bins.Rd b/man/guide_bins.Rd index 87283e144d..35335d34fc 100644 --- a/man/guide_bins.Rd +++ b/man/guide_bins.Rd @@ -115,6 +115,20 @@ for all non-position aesthetics though colour and fill defaults to \code{\link[=guide_coloursteps]{guide_coloursteps()}}, and it will merge aesthetics together into the same guide if they are mapped in the same way. } +\section{Use with discrete scale}{ + +This guide is intended to show binned data and work together with ggplot2's +binning scales. However, it is sometimes desirable to perform the binning in +a separate step, either as part of a stat (e.g. \code{\link[=stat_contour_filled]{stat_contour_filled()}}) or +prior to the visualisation. If you want to use this guide for discrete data +the levels must follow the naming scheme implemented by \code{\link[base:cut]{base::cut()}}. This +means that a bin must be encoded as \code{"(, ]"} with \verb{} +giving the lower bound of the bin and \verb{} giving the upper bound +(\code{"[, )"} is also accepted). If you use \code{\link[base:cut]{base::cut()}} to +perform the binning everything should work as expected, if not, some recoding +may be needed. +} + \examples{ p <- ggplot(mtcars) + geom_point(aes(disp, mpg, size = hp)) + diff --git a/man/guide_coloursteps.Rd b/man/guide_coloursteps.Rd index c193aa08cf..2656d48d9d 100644 --- a/man/guide_coloursteps.Rd +++ b/man/guide_coloursteps.Rd @@ -86,6 +86,20 @@ This guide is version of \code{\link[=guide_colourbar]{guide_colourbar()}} for b scales. It shows areas between breaks as a single constant colour instead of the gradient known from the colourbar counterpart. } +\section{Use with discrete scale}{ + +This guide is intended to show binned data and work together with ggplot2's +binning scales. However, it is sometimes desirable to perform the binning in +a separate step, either as part of a stat (e.g. \code{\link[=stat_contour_filled]{stat_contour_filled()}}) or +prior to the visualisation. If you want to use this guide for discrete data +the levels must follow the naming scheme implemented by \code{\link[base:cut]{base::cut()}}. This +means that a bin must be encoded as \code{"(, ]"} with \verb{} +giving the lower bound of the bin and \verb{} giving the upper bound +(\code{"[, )"} is also accepted). If you use \code{\link[base:cut]{base::cut()}} to +perform the binning everything should work as expected, if not, some recoding +may be needed. +} + \examples{ df <- expand.grid(X1 = 1:10, X2 = 1:10) df$value <- df$X1 * df$X2 From 352b9f9b830d86a33b725b09d6df17c5ae8e99c0 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 8 Jan 2020 21:00:47 +0100 Subject: [PATCH 4/4] make contour_filled create an ordered factor (should result in a better scale choice) --- R/stat-contour.r | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/stat-contour.r b/R/stat-contour.r index 37c95cb582..449cc9dc36 100644 --- a/R/stat-contour.r +++ b/R/stat-contour.r @@ -108,7 +108,7 @@ StatContourFilled <- ggproto("StatContourFilled", Stat, names(isobands) <- pretty_isoband_levels(names(isobands)) path_df <- iso_to_path(isobands, data$group[1]) - path_df$level <- factor(path_df$level, levels = names(isobands)) + path_df$level <- ordered(path_df$level, levels = names(isobands)) path_df }