From bda092069cd93f0fd2df4f1c0753f2e6db15ee36 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Sun, 20 Jan 2019 18:51:08 -0600 Subject: [PATCH 01/30] First stab at ScaleBin --- R/scale-.r | 163 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 163 insertions(+) diff --git a/R/scale-.r b/R/scale-.r index fe594c4d05..2367cd1fd6 100644 --- a/R/scale-.r +++ b/R/scale-.r @@ -494,6 +494,123 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale, ) +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +ScaleBin <- ggproto("ScaleBin", Scale, + range = continuous_range(), + na.value = NA_real_, + oob = squish, + n_bins = NULL, + right = TRUE, + + is_discrete = function() TRUE, + + train = function(self, x) { + if (length(x) == 0) return() + self$range$train(x) + }, + + transform = function(x) { + x + }, + + map = function(self, x, limits = self$get_limits()) { + breaks <- self$get_breaks(limits) + + x_binned <- cut(x, c(limits[1], breaks, limits[2]), labels = FALSE, + include.lowest = TRUE, right = self$right) + + if (!is.null(self$palette.cache)) { + pal <- self$palette.cache + } else { + pal <- self$palette(length(self$breaks) + 1) + self$palette.cache <- pal + } + + pal[x_binned] + }, + + dimension = function(self, expand = c(0, 0, 0, 0)) { + expand_range4(length(self$get_limits()), expand) + }, + + get_breaks = function(self, limits = self$get_limits()) { + if (self$is_empty()) return(numeric()) + + if (is.null(self$breaks)) { + return(NULL) + } else if (identical(self$breaks, NA)) { + stop("Invalid breaks specification. Use NULL, not NA", call. = FALSE) + } else if (is.waive(self$breaks)) { + if (is.null(self$n_bins)) { + stop("Either breaks or n_bins must be specified", call. = FALSE) + } + width <- range(limits) / self$n_bins + breaks <- limits[1] + seq_len(n_bins - 1) * width + } else if (is.function(self$breaks)) { + breaks <- self$breaks(limits, n_bins) + } else { + breaks <- self$breaks + } + + breaks + }, + + get_breaks_minor = function(...) NULL, + + get_labels = function(self, breaks = self$get_breaks()) { + if (is.null(breaks)) return(NULL) + + breaks <- self$trans$inverse(breaks) + + if (is.null(self$labels)) { + return(NULL) + } else if (identical(self$labels, NA)) { + stop("Invalid labels specification. Use NULL, not NA", call. = FALSE) + } else if (is.waive(self$labels)) { + labels <- self$trans$format(breaks) + } else if (is.function(self$labels)) { + labels <- self$labels(breaks) + } else { + labels <- self$labels + } + if (length(labels) != length(breaks)) { + stop("Breaks and labels are different lengths") + } + labels + }, + + clone = function(self) { + new <- ggproto(NULL, self) + new$range <- continuous_range() + new + }, + + break_info = function(self, range = NULL) { + # range + if (is.null(range)) range <- self$dimension() + + # major breaks + major <- self$get_breaks(range) + + # labels + labels <- self$get_labels(major) + + # drop oob breaks/labels by testing major == NA + if (!is.null(labels)) labels <- labels[!is.na(major)] + if (!is.null(major)) major <- major[!is.na(major)] + + # rescale breaks [0, 1], which are used by coord/guide + major_n <- rescale(major, from = range) + + list(range = range, labels = labels, + major = major_n, minor = NULL, + major_source = major, minor_source = NULL) + } +) + #' Continuous scale constructor. #' #' @export @@ -659,6 +776,52 @@ discrete_scale <- function(aesthetics, scale_name, palette, name = waiver(), ) } +continuous_scale <- function(aesthetics, scale_name, palette, name = waiver(), + breaks = waiver(), labels = waiver(), limits = NULL, + oob = squish, expand = waiver(), na.value = NA_real_, + n_bins = NULL, right = TRUE, trans = "identity", + guide = "legend", position = "left", super = ScaleBin) { + + aesthetics <- standardise_aes_names(aesthetics) + + check_breaks_labels(breaks, labels) + + position <- match.arg(position, c("left", "right", "top", "bottom")) + + if (is.null(breaks) && !is_position_aes(aesthetics) && guide != "none") { + guide <- "none" + } + + trans <- as.trans(trans) + if (!is.null(limits)) { + limits <- trans$transform(limits) + } + + ggproto(NULL, super, + call = match.call(), + + aesthetics = aesthetics, + scale_name = scale_name, + palette = palette, + + range = continuous_range(), + limits = limits, + trans = trans, + na.value = na.value, + expand = expand, + oob = oob, + n_bins = n_bins, + right = right, + + name = name, + breaks = breaks, + minor_breaks = minor_breaks, + + labels = labels, + guide = guide, + position = position + ) +} # In place modification of a scale to change the primary axis scale_flip_position <- function(scale) { scale$position <- switch(scale$position, From e047a1daf3ad3219557a96a9532babbb45ba540d Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Sun, 20 Jan 2019 18:53:29 -0600 Subject: [PATCH 02/30] Rename to ScaleBinned --- R/scale-.r | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/R/scale-.r b/R/scale-.r index 2367cd1fd6..c866eeb5c7 100644 --- a/R/scale-.r +++ b/R/scale-.r @@ -498,7 +498,7 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale, #' @format NULL #' @usage NULL #' @export -ScaleBin <- ggproto("ScaleBin", Scale, +ScaleBinned <- ggproto("ScaleBinned", Scale, range = continuous_range(), na.value = NA_real_, oob = squish, @@ -776,11 +776,11 @@ discrete_scale <- function(aesthetics, scale_name, palette, name = waiver(), ) } -continuous_scale <- function(aesthetics, scale_name, palette, name = waiver(), - breaks = waiver(), labels = waiver(), limits = NULL, - oob = squish, expand = waiver(), na.value = NA_real_, - n_bins = NULL, right = TRUE, trans = "identity", - guide = "legend", position = "left", super = ScaleBin) { +binned_scale <- function(aesthetics, scale_name, palette, name = waiver(), + breaks = waiver(), labels = waiver(), limits = NULL, + oob = squish, expand = waiver(), na.value = NA_real_, + n_bins = NULL, right = TRUE, trans = "identity", + guide = "legend", position = "left", super = ScaleBinned) { aesthetics <- standardise_aes_names(aesthetics) From bd3c98964a9f191b608bd4f17812a89376dbff86 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Tue, 22 Jan 2019 20:38:26 +0100 Subject: [PATCH 03/30] Add positional scales --- DESCRIPTION | 1 + NAMESPACE | 4 ++ R/scale-.r | 55 +++++++++++++++++-------- R/scale-binned.R | 83 ++++++++++++++++++++++++++++++++++++++ man/binned_scale.Rd | 89 +++++++++++++++++++++++++++++++++++++++++ man/ggplot2-ggproto.Rd | 18 +++++---- man/scale_binned.Rd | 38 ++++++++++++++++++ man/scale_continuous.Rd | 3 +- man/scale_date.Rd | 3 +- man/scale_discrete.Rd | 3 +- 10 files changed, 270 insertions(+), 27 deletions(-) create mode 100644 R/scale-binned.R create mode 100644 man/binned_scale.Rd create mode 100644 man/scale_binned.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 036f1f5b28..f9f724320b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -182,6 +182,7 @@ Collate: 'save.r' 'scale-.r' 'scale-alpha.r' + 'scale-binned.R' 'scale-brewer.r' 'scale-colour.r' 'scale-continuous.r' diff --git a/NAMESPACE b/NAMESPACE index 21b0aa84ed..d39f4cad0d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -189,6 +189,8 @@ export(PositionJitterdodge) export(PositionNudge) export(PositionStack) export(Scale) +export(ScaleBinned) +export(ScaleBinnedPosition) export(ScaleContinuous) export(ScaleContinuousDate) export(ScaleContinuousDatetime) @@ -489,6 +491,7 @@ export(scale_size_identity) export(scale_size_manual) export(scale_size_ordinal) export(scale_type) +export(scale_x_binned) export(scale_x_continuous) export(scale_x_date) export(scale_x_datetime) @@ -497,6 +500,7 @@ export(scale_x_log10) export(scale_x_reverse) export(scale_x_sqrt) export(scale_x_time) +export(scale_y_binned) export(scale_y_continuous) export(scale_y_date) export(scale_y_datetime) diff --git a/R/scale-.r b/R/scale-.r index c866eeb5c7..e16bb99897 100644 --- a/R/scale-.r +++ b/R/scale-.r @@ -207,7 +207,13 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, transform = function(self, x) { new_x <- self$trans$transform(x) if (any(is.finite(x) != is.finite(new_x))) { - type <- if (self$scale_name == "position_c") "continuous" else "discrete" + type <- if (self$scale_name == "position_c") { + "continuous" + } else if (self$scale_name == "position_d") { + "discrete" + } else { + "binned" + } axis <- if ("x" %in% self$aesthetics) "x" else "y" warning("Transformation introduced infinite values in ", type, " ", axis, "-axis", call. = FALSE) } @@ -504,10 +510,15 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, oob = squish, n_bins = NULL, right = TRUE, + after_stat = FALSE, is_discrete = function() TRUE, train = function(self, x) { + if (!is.numeric(x)) { + stop("Binned scales only support continuous data", call. = FALSE) + } + if (length(x) == 0) return() self$range$train(x) }, @@ -517,23 +528,27 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, }, map = function(self, x, limits = self$get_limits()) { - breaks <- self$get_breaks(limits) + if (after_stat) { + x + } else { + breaks <- self$get_breaks(limits) - x_binned <- cut(x, c(limits[1], breaks, limits[2]), labels = FALSE, - include.lowest = TRUE, right = self$right) + x_binned <- cut(x, c(limits[1], breaks, limits[2]), labels = FALSE, + include.lowest = TRUE, right = self$right) - if (!is.null(self$palette.cache)) { - pal <- self$palette.cache - } else { - pal <- self$palette(length(self$breaks) + 1) - self$palette.cache <- pal - } + if (!is.null(self$palette.cache)) { + pal <- self$palette.cache + } else { + pal <- self$palette(length(self$breaks) + 1) + self$palette.cache <- pal + } - pal[x_binned] + pal[x_binned] + } }, dimension = function(self, expand = c(0, 0, 0, 0)) { - expand_range4(length(self$get_limits()), expand) + expand_range4(self$get_limits(), expand) }, get_breaks = function(self, limits = self$get_limits()) { @@ -547,14 +562,16 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, if (is.null(self$n_bins)) { stop("Either breaks or n_bins must be specified", call. = FALSE) } - width <- range(limits) / self$n_bins - breaks <- limits[1] + seq_len(n_bins - 1) * width + width <- diff(limits) / self$n_bins + breaks <- limits[1] + seq_len(self$n_bins - 1) * width } else if (is.function(self$breaks)) { - breaks <- self$breaks(limits, n_bins) + breaks <- self$breaks(limits, self$n_bins) } else { breaks <- self$breaks } + self$breaks <- breaks + breaks }, @@ -776,6 +793,13 @@ discrete_scale <- function(aesthetics, scale_name, palette, name = waiver(), ) } +#' Binning scale constructor +#' +#' @inheritParams continuous_scale +#' @param n_bins The number of bins to create if breaks are not given directly +#' @param right Should values on the border between bins be part of the right +#' (upper) bin? +#' @keywords internal binned_scale <- function(aesthetics, scale_name, palette, name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, oob = squish, expand = waiver(), na.value = NA_real_, @@ -815,7 +839,6 @@ binned_scale <- function(aesthetics, scale_name, palette, name = waiver(), name = name, breaks = breaks, - minor_breaks = minor_breaks, labels = labels, guide = guide, diff --git a/R/scale-binned.R b/R/scale-binned.R new file mode 100644 index 0000000000..c4d5cf11ae --- /dev/null +++ b/R/scale-binned.R @@ -0,0 +1,83 @@ +#' Positional scales for binning continuous data (x & y) +#' +#' `scale_x_binned()` and `scale_y_binned()` are scales that discretize +#' continuous position data. You can use these scales to transform continuous +#' inputs before using it with a geom that requires discrete positions. An +#' example is using `scale_x_binned()` with [geom_bar()] to create a histogram. +#' +#' #' @inheritParams binned_scale +#' +#' @family position scales +#' @name scale_binned +#' @aliases NULL +#' +#' @examples +#' # Create a histogram by binning the x-axis +#' ggplot(mtcars) + +#' geom_bar(aes(mpg)) + +#' scale_x_binned() +NULL + +#' @rdname scale_binned +#' +#' @export +scale_x_binned <- function(name = waiver(), n_bins = 10, breaks = waiver(), + labels = waiver(), limits = NULL, expand = waiver(), + oob = squish, na.value = NA_real_, right = TRUE, + trans = "identity", position = "bottom") { + binned_scale( + aesthetics = c("x", "xmin", "xmax", "xend", "xintercept", "xmin_final", "xmax_final", "xlower", "xmiddle", "xupper"), + scale_name = "position_b", palette = identity, name = name, breaks = breaks, + labels = labels, limits = limits, expand = expand, oob = oob, na.value = na.value, + n_bins = n_bins, right = right, trans = trans, guide = "none", + position = position, super = ScaleBinnedPosition + ) +} + +#' @rdname scale_binned +#' +#' @export +scale_y_binned <- function(name = waiver(), n_bins = 10, breaks = waiver(), + labels = waiver(), limits = NULL, expand = waiver(), + oob = squish, na.value = NA_real_, right = TRUE, + trans = "identity", position = "left") { + binned_scale( + aesthetics = c("y", "ymin", "ymax", "yend", "yintercept", "ymin_final", "ymax_final", "lower", "middle", "upper"), + scale_name = "position_b", palette = identity, name = name, breaks = breaks, + labels = labels, limits = limits, expand = expand, oob = oob, na.value = na.value, + n_bins = n_bins, right = right, trans = trans, guide = "none", + position = position, super = ScaleBinnedPosition + ) +} + +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +ScaleBinnedPosition <- ggproto("ScaleBinnedPosition", ScaleBinned, + after_stat = FALSE, + map = function(self, x, limits = self$get_limits()) { + if (self$after_stat) { + x + } else { + self$after_stat <- TRUE + + x <- as.numeric(self$oob(x, limits)) + x <- ifelse(!is.na(x), x, self$na.value) + + breaks <- self$get_breaks(limits) + + all_breaks <- c(limits[1], breaks, limits[2]) + + x_binned <- cut(x, all_breaks, labels = FALSE, + include.lowest = TRUE, right = self$right) + + midpoints <- all_breaks[-1] - diff(all_breaks) / 2 + + midpoints[x_binned] + } + }, + reset = function(self) { + NULL + } +) diff --git a/man/binned_scale.Rd b/man/binned_scale.Rd new file mode 100644 index 0000000000..7b90120b0b --- /dev/null +++ b/man/binned_scale.Rd @@ -0,0 +1,89 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/scale-.r +\name{binned_scale} +\alias{binned_scale} +\title{Binning scale constructor} +\usage{ +binned_scale(aesthetics, scale_name, palette, name = waiver(), + breaks = waiver(), labels = waiver(), limits = NULL, + oob = squish, expand = waiver(), na.value = NA_real_, + n_bins = NULL, right = TRUE, trans = "identity", + guide = "legend", position = "left", super = ScaleBinned) +} +\arguments{ +\item{aesthetics}{The names of the aesthetics that this scale works with} + +\item{scale_name}{The name of the scale} + +\item{palette}{A palette function that when called with a numeric vector with +values between 0 and 1 returns the corresponding values in the range the +scale maps to.} + +\item{name}{The name of the scale. Used as the axis or legend title. If +\code{waiver()}, the default, the name of the scale is taken from the first +mapping used for that aesthetic. If \code{NULL}, the legend title will be +omitted.} + +\item{breaks}{One of: +\itemize{ +\item \code{NULL} for no breaks +\item \code{waiver()} for the default breaks computed by the +transformation object +\item A numeric vector of positions +\item A function that takes the limits as input and returns breaks +as output +}} + +\item{labels}{One of: +\itemize{ +\item \code{NULL} for no labels +\item \code{waiver()} for the default labels computed by the +transformation object +\item A character vector giving labels (must be same length as \code{breaks}) +\item A function that takes the breaks as input and returns labels +as output +}} + +\item{limits}{A numeric vector of length two providing limits of the scale. +Use \code{NA} to refer to the existing minimum or maximum.} + +\item{oob}{Function that handles limits outside of the scale limits +(out of bounds). The default replaces out of bounds values with \code{NA}.} + +\item{expand}{Vector of range expansion constants used to add some +padding around the data, to ensure that they are placed some distance +away from the axes. Use the convenience function \code{\link[=expand_scale]{expand_scale()}} +to generate the values for the \code{expand} argument. The defaults are to +expand the scale by 5\% on each side for continuous variables, and by +0.6 units on each side for discrete variables.} + +\item{na.value}{Missing values will be replaced with this value.} + +\item{n_bins}{The number of bins to create if breaks are not given directly} + +\item{right}{Should values on the border between bins be part of the right +(upper) bin?} + +\item{trans}{Either the name of a transformation object, or the +object itself. Built-in transformations include "asn", "atanh", +"boxcox", "exp", "identity", "log", "log10", "log1p", "log2", +"logit", "probability", "probit", "reciprocal", "reverse" and "sqrt". + +A transformation object bundles together a transform, its inverse, +and methods for generating breaks and labels. Transformation objects +are defined in the scales package, and are called \code{name_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 info.} + +\item{position}{The position of the axis. "left" or "right" for vertical +scales, "top" or "bottom" for horizontal scales} + +\item{super}{The super class to use for the constructed scale} +} +\description{ +Binning scale constructor +} +\keyword{internal} diff --git a/man/ggplot2-ggproto.Rd b/man/ggplot2-ggproto.Rd index bad0d955d7..7b5962268c 100644 --- a/man/ggplot2-ggproto.Rd +++ b/man/ggplot2-ggproto.Rd @@ -15,14 +15,14 @@ % R/geom-vline.r, R/layout.R, R/position-.r, R/position-dodge.r, % R/position-dodge2.r, R/position-identity.r, R/position-jitter.r, % R/position-jitterdodge.R, R/position-nudge.R, R/position-stack.r, -% R/scale-.r, R/scale-continuous.r, R/scale-date.r, R/scale-discrete-.r, -% R/scale-identity.r, R/stat-bin.r, R/stat-bin2d.r, R/stat-bindot.r, -% R/stat-binhex.r, R/stat-boxplot.r, R/stat-contour.r, R/stat-count.r, -% R/stat-density-2d.r, R/stat-density.r, R/stat-ecdf.r, R/stat-ellipse.R, -% R/stat-function.r, R/stat-identity.r, R/stat-qq-line.R, R/stat-qq.r, -% R/stat-quantile.r, R/stat-smooth.r, R/stat-sum.r, R/stat-summary-2d.r, -% R/stat-summary-bin.R, R/stat-summary-hex.r, R/stat-summary.r, -% R/stat-unique.r, R/stat-ydensity.r +% R/scale-.r, R/scale-binned.R, R/scale-continuous.r, R/scale-date.r, +% R/scale-discrete-.r, R/scale-identity.r, R/stat-bin.r, R/stat-bin2d.r, +% R/stat-bindot.r, R/stat-binhex.r, R/stat-boxplot.r, R/stat-contour.r, +% R/stat-count.r, R/stat-density-2d.r, R/stat-density.r, R/stat-ecdf.r, +% R/stat-ellipse.R, R/stat-function.r, R/stat-identity.r, R/stat-qq-line.R, +% R/stat-qq.r, R/stat-quantile.r, R/stat-smooth.r, R/stat-sum.r, +% R/stat-summary-2d.r, R/stat-summary-bin.R, R/stat-summary-hex.r, +% R/stat-summary.r, R/stat-unique.r, R/stat-ydensity.r \docType{data} \name{ggplot2-ggproto} \alias{ggplot2-ggproto} @@ -95,6 +95,8 @@ \alias{Scale} \alias{ScaleContinuous} \alias{ScaleDiscrete} +\alias{ScaleBinned} +\alias{ScaleBinnedPosition} \alias{ScaleContinuousPosition} \alias{ScaleContinuousDatetime} \alias{ScaleContinuousDate} diff --git a/man/scale_binned.Rd b/man/scale_binned.Rd new file mode 100644 index 0000000000..4ab310b02d --- /dev/null +++ b/man/scale_binned.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/scale-binned.R +\name{scale_binned} +\alias{scale_x_binned} +\alias{scale_y_binned} +\title{Positional scales for binning continuous data (x & y)} +\usage{ +scale_x_binned(name = waiver(), n_bins = 10, breaks = waiver(), + labels = waiver(), limits = NULL, expand = waiver(), + oob = squish, na.value = NA_real_, right = TRUE, + trans = "identity", position = "bottom") + +scale_y_binned(name = waiver(), n_bins = 10, breaks = waiver(), + labels = waiver(), limits = NULL, expand = waiver(), + oob = squish, na.value = NA_real_, right = TRUE, + trans = "identity", position = "left") +} +\description{ +\code{scale_x_binned()} and \code{scale_y_binned()} are scales that discretize +continuous position data. You can use these scales to transform continuous +inputs before using it with a geom that requires discrete positions. An +example is using \code{scale_x_binned()} with \code{\link[=geom_bar]{geom_bar()}} to create a histogram. +} +\details{ +#' @inheritParams binned_scale +} +\examples{ +# Create a histogram by binning the x-axis +ggplot(mtcars) + + geom_bar(aes(mpg)) + + scale_x_binned() +} +\seealso{ +Other position scales: \code{\link{scale_x_continuous}}, + \code{\link{scale_x_date}}, + \code{\link{scale_x_discrete}} +} +\concept{position scales} diff --git a/man/scale_continuous.Rd b/man/scale_continuous.Rd index 25c1bdbd1f..d33e4fc04b 100644 --- a/man/scale_continuous.Rd +++ b/man/scale_continuous.Rd @@ -168,7 +168,8 @@ p1 + scale_y_continuous(trans = scales::reciprocal_trans()) \seealso{ \code{\link[=sec_axis]{sec_axis()}} for how to specify secondary axes -Other position scales: \code{\link{scale_x_date}}, +Other position scales: \code{\link{scale_x_binned}}, + \code{\link{scale_x_date}}, \code{\link{scale_x_discrete}} } \concept{position scales} diff --git a/man/scale_date.Rd b/man/scale_date.Rd index aa1c57d0c4..e833abaf2a 100644 --- a/man/scale_date.Rd +++ b/man/scale_date.Rd @@ -141,7 +141,8 @@ base + scale_x_date(limits = c(Sys.Date() - 7, NA)) \seealso{ \code{\link[=sec_axis]{sec_axis()}} for how to specify secondary axes -Other position scales: \code{\link{scale_x_continuous}}, +Other position scales: \code{\link{scale_x_binned}}, + \code{\link{scale_x_continuous}}, \code{\link{scale_x_discrete}} } \concept{position scales} diff --git a/man/scale_discrete.Rd b/man/scale_discrete.Rd index 457785b76f..9369d0b958 100644 --- a/man/scale_discrete.Rd +++ b/man/scale_discrete.Rd @@ -106,7 +106,8 @@ ggplot(mpg, aes(reorder(manufacturer, displ), cty)) + } } \seealso{ -Other position scales: \code{\link{scale_x_continuous}}, +Other position scales: \code{\link{scale_x_binned}}, + \code{\link{scale_x_continuous}}, \code{\link{scale_x_date}} } \concept{position scales} From 7f0a9f48b8849602e380c4ec80c44abb9d496499 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Thu, 24 Jan 2019 13:16:29 +0100 Subject: [PATCH 04/30] Make binned position work with uneven bin sizes --- R/scale-binned.R | 34 +++++++++++++++++++++++++--------- 1 file changed, 25 insertions(+), 9 deletions(-) diff --git a/R/scale-binned.R b/R/scale-binned.R index c4d5cf11ae..a8e8e2037d 100644 --- a/R/scale-binned.R +++ b/R/scale-binned.R @@ -56,25 +56,41 @@ scale_y_binned <- function(name = waiver(), n_bins = 10, breaks = waiver(), #' @export ScaleBinnedPosition <- ggproto("ScaleBinnedPosition", ScaleBinned, after_stat = FALSE, + + train = function(self, x) { + if (!is.numeric(x)) { + stop("Binned scales only support continuous data", call. = FALSE) + } + + if (length(x) == 0 || self$after_stat) return() + self$range$train(x) + }, + map = function(self, x, limits = self$get_limits()) { + breaks <- self$get_breaks(limits) + all_breaks <- unique(sort(c(limits[1], breaks, limits[2]))) + if (self$after_stat) { - x + # Backtransform to original scale + x_binned <- cut(x, seq_len(length(all_breaks) + 1) - 0.5, labels = FALSE, + include.lowest = TRUE, right = self$right) + # lowest <- tapply(x, x_binned, min) + # lowest <- lowest[match(seq_len(length(all_breaks) - 1), as.integer(names(lowest)))] + # highest <- tapply(x, x_binned, max) + # highest <- highest[match(seq_len(length(all_breaks) - 1), as.integer(names(highest)))] + # + # (x - x_binned + .5) * (highest - lowest)[x_binned] * diff(all_breaks)[x_binned] + all_breaks[x_binned] + + (x - x_binned + .5) * diff(all_breaks)[x_binned] + all_breaks[x_binned] } else { self$after_stat <- TRUE x <- as.numeric(self$oob(x, limits)) x <- ifelse(!is.na(x), x, self$na.value) - - breaks <- self$get_breaks(limits) - - all_breaks <- c(limits[1], breaks, limits[2]) - x_binned <- cut(x, all_breaks, labels = FALSE, include.lowest = TRUE, right = self$right) - midpoints <- all_breaks[-1] - diff(all_breaks) / 2 - - midpoints[x_binned] + x_binned # Return integer form so stat treat it like a discrete scale } }, reset = function(self) { From d06acbe478af74372dd2cc2f8c9fc0772fa471f5 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Thu, 24 Jan 2019 14:57:12 +0100 Subject: [PATCH 05/30] fix expansion of range --- R/scale-binned.R | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/R/scale-binned.R b/R/scale-binned.R index a8e8e2037d..6b17a2b82b 100644 --- a/R/scale-binned.R +++ b/R/scale-binned.R @@ -57,6 +57,8 @@ scale_y_binned <- function(name = waiver(), n_bins = 10, breaks = waiver(), ScaleBinnedPosition <- ggproto("ScaleBinnedPosition", ScaleBinned, after_stat = FALSE, + is_discrete = function() FALSE, + train = function(self, x) { if (!is.numeric(x)) { stop("Binned scales only support continuous data", call. = FALSE) @@ -83,8 +85,6 @@ ScaleBinnedPosition <- ggproto("ScaleBinnedPosition", ScaleBinned, (x - x_binned + .5) * diff(all_breaks)[x_binned] + all_breaks[x_binned] } else { - self$after_stat <- TRUE - x <- as.numeric(self$oob(x, limits)) x <- ifelse(!is.na(x), x, self$na.value) x_binned <- cut(x, all_breaks, labels = FALSE, @@ -94,6 +94,10 @@ ScaleBinnedPosition <- ggproto("ScaleBinnedPosition", ScaleBinned, } }, reset = function(self) { - NULL + self$after_stat <- TRUE + self$range$reset() + limits <- self$get_limits() + breaks <- self$get_breaks(limits) + self$range$train(c(limits, breaks)) } ) From 11aa5e887a89257bd516532145cf21b4f1840611 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Fri, 25 Jan 2019 09:13:32 +0100 Subject: [PATCH 06/30] Use the same breaks algorithm as continuous scale --- R/scale-.r | 32 +++++++++++++++++++++++--------- R/scale-binned.R | 25 +++++++++---------------- man/binned_scale.Rd | 11 ++++++++--- man/scale_binned.Rd | 8 ++++---- 4 files changed, 44 insertions(+), 32 deletions(-) diff --git a/R/scale-.r b/R/scale-.r index e16bb99897..076e19db87 100644 --- a/R/scale-.r +++ b/R/scale-.r @@ -508,9 +508,10 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, range = continuous_range(), na.value = NA_real_, oob = squish, - n_bins = NULL, + n_breaks = NULL, right = TRUE, after_stat = FALSE, + show_limits = FALSE, is_discrete = function() TRUE, @@ -554,22 +555,26 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, get_breaks = function(self, limits = self$get_limits()) { if (self$is_empty()) return(numeric()) + limits <- self$trans$inverse(limits) + if (is.null(self$breaks)) { return(NULL) } else if (identical(self$breaks, NA)) { stop("Invalid breaks specification. Use NULL, not NA", call. = FALSE) } else if (is.waive(self$breaks)) { - if (is.null(self$n_bins)) { - stop("Either breaks or n_bins must be specified", call. = FALSE) + if (!is.null(self$n_breaks)) { + assign("n", self$n_breaks, environment(self$trans$breaks)) } - width <- diff(limits) / self$n_bins - breaks <- limits[1] + seq_len(self$n_bins - 1) * width + breaks <- self$trans$breaks(limits) } else if (is.function(self$breaks)) { breaks <- self$breaks(limits, self$n_bins) } else { breaks <- self$breaks } + # Breaks must be within limits + breaks <- breaks[breaks >= limits[1] & breaks <= limits[2]] + self$breaks <- breaks breaks @@ -611,6 +616,10 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, # major breaks major <- self$get_breaks(range) + if (self$show_limits) { + limits <- self$get_limits() + major <- sort(unique(c(limits, major))) + } # labels labels <- self$get_labels(major) @@ -796,15 +805,19 @@ discrete_scale <- function(aesthetics, scale_name, palette, name = waiver(), #' Binning scale constructor #' #' @inheritParams continuous_scale -#' @param n_bins The number of bins to create if breaks are not given directly +#' @param n_breaks The number of break points to create if breaks are not given +#' directly. It will attempt to find nice breakpoint and may thus not give the +#' exact number of breaks as requested. #' @param right Should values on the border between bins be part of the right #' (upper) bin? +#' @param show_limits should the limits of the scale appear as ticks #' @keywords internal binned_scale <- function(aesthetics, scale_name, palette, name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, oob = squish, expand = waiver(), na.value = NA_real_, - n_bins = NULL, right = TRUE, trans = "identity", - guide = "legend", position = "left", super = ScaleBinned) { + n_breaks = NULL, right = TRUE, trans = "identity", + show_limits = FALSE, guide = "legend", position = "left", + super = ScaleBinned) { aesthetics <- standardise_aes_names(aesthetics) @@ -834,8 +847,9 @@ binned_scale <- function(aesthetics, scale_name, palette, name = waiver(), na.value = na.value, expand = expand, oob = oob, - n_bins = n_bins, + n_breaks = n_breaks, right = right, + show_limits = show_limits, name = name, breaks = breaks, diff --git a/R/scale-binned.R b/R/scale-binned.R index 6b17a2b82b..68df3116e6 100644 --- a/R/scale-binned.R +++ b/R/scale-binned.R @@ -21,32 +21,32 @@ NULL #' @rdname scale_binned #' #' @export -scale_x_binned <- function(name = waiver(), n_bins = 10, breaks = waiver(), +scale_x_binned <- function(name = waiver(), n_breaks = 10, breaks = waiver(), labels = waiver(), limits = NULL, expand = waiver(), oob = squish, na.value = NA_real_, right = TRUE, - trans = "identity", position = "bottom") { + show_limits = FALSE, trans = "identity", position = "bottom") { binned_scale( aesthetics = c("x", "xmin", "xmax", "xend", "xintercept", "xmin_final", "xmax_final", "xlower", "xmiddle", "xupper"), scale_name = "position_b", palette = identity, name = name, breaks = breaks, labels = labels, limits = limits, expand = expand, oob = oob, na.value = na.value, - n_bins = n_bins, right = right, trans = trans, guide = "none", - position = position, super = ScaleBinnedPosition + n_breaks = n_breaks, right = right, trans = trans, show_limits = show_limits, + guide = "none", position = position, super = ScaleBinnedPosition ) } #' @rdname scale_binned #' #' @export -scale_y_binned <- function(name = waiver(), n_bins = 10, breaks = waiver(), +scale_y_binned <- function(name = waiver(), n_breaks = 10, breaks = waiver(), labels = waiver(), limits = NULL, expand = waiver(), oob = squish, na.value = NA_real_, right = TRUE, - trans = "identity", position = "left") { + show_limits = FALSE, trans = "identity", position = "left") { binned_scale( aesthetics = c("y", "ymin", "ymax", "yend", "yintercept", "ymin_final", "ymax_final", "lower", "middle", "upper"), scale_name = "position_b", palette = identity, name = name, breaks = breaks, labels = labels, limits = limits, expand = expand, oob = oob, na.value = na.value, - n_bins = n_bins, right = right, trans = trans, guide = "none", - position = position, super = ScaleBinnedPosition + n_breaks = n_breaks, right = right, trans = trans, show_limits = show_limits, + guide = "none", position = position, super = ScaleBinnedPosition ) } @@ -76,13 +76,6 @@ ScaleBinnedPosition <- ggproto("ScaleBinnedPosition", ScaleBinned, # Backtransform to original scale x_binned <- cut(x, seq_len(length(all_breaks) + 1) - 0.5, labels = FALSE, include.lowest = TRUE, right = self$right) - # lowest <- tapply(x, x_binned, min) - # lowest <- lowest[match(seq_len(length(all_breaks) - 1), as.integer(names(lowest)))] - # highest <- tapply(x, x_binned, max) - # highest <- highest[match(seq_len(length(all_breaks) - 1), as.integer(names(highest)))] - # - # (x - x_binned + .5) * (highest - lowest)[x_binned] * diff(all_breaks)[x_binned] + all_breaks[x_binned] - (x - x_binned + .5) * diff(all_breaks)[x_binned] + all_breaks[x_binned] } else { x <- as.numeric(self$oob(x, limits)) @@ -95,9 +88,9 @@ ScaleBinnedPosition <- ggproto("ScaleBinnedPosition", ScaleBinned, }, reset = function(self) { self$after_stat <- TRUE - self$range$reset() limits <- self$get_limits() breaks <- self$get_breaks(limits) + self$range$reset() self$range$train(c(limits, breaks)) } ) diff --git a/man/binned_scale.Rd b/man/binned_scale.Rd index 7b90120b0b..7438405e50 100644 --- a/man/binned_scale.Rd +++ b/man/binned_scale.Rd @@ -7,8 +7,9 @@ binned_scale(aesthetics, scale_name, palette, name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, oob = squish, expand = waiver(), na.value = NA_real_, - n_bins = NULL, right = TRUE, trans = "identity", - guide = "legend", position = "left", super = ScaleBinned) + n_breaks = NULL, right = TRUE, trans = "identity", + show_limits = FALSE, guide = "legend", position = "left", + super = ScaleBinned) } \arguments{ \item{aesthetics}{The names of the aesthetics that this scale works with} @@ -59,7 +60,9 @@ expand the scale by 5\% on each side for continuous variables, and by \item{na.value}{Missing values will be replaced with this value.} -\item{n_bins}{The number of bins to create if breaks are not given directly} +\item{n_breaks}{The number of break points to create if breaks are not given +directly. It will attempt to find nice breakpoint and may thus not give the +exact number of breaks as requested.} \item{right}{Should values on the border between bins be part of the right (upper) bin?} @@ -75,6 +78,8 @@ are defined in the scales package, and are called \code{name_trans}, e.g. \code{\link[scales:boxcox_trans]{scales::boxcox_trans()}}. You can create your own transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} +\item{show_limits}{should the limits of the scale appear as ticks} + \item{guide}{A function used to create a guide or its name. See \code{\link[=guides]{guides()}} for more info.} diff --git a/man/scale_binned.Rd b/man/scale_binned.Rd index 4ab310b02d..9219ed63b3 100644 --- a/man/scale_binned.Rd +++ b/man/scale_binned.Rd @@ -5,15 +5,15 @@ \alias{scale_y_binned} \title{Positional scales for binning continuous data (x & y)} \usage{ -scale_x_binned(name = waiver(), n_bins = 10, breaks = waiver(), +scale_x_binned(name = waiver(), n_breaks = 10, breaks = waiver(), labels = waiver(), limits = NULL, expand = waiver(), oob = squish, na.value = NA_real_, right = TRUE, - trans = "identity", position = "bottom") + show_limits = FALSE, trans = "identity", position = "bottom") -scale_y_binned(name = waiver(), n_bins = 10, breaks = waiver(), +scale_y_binned(name = waiver(), n_breaks = 10, breaks = waiver(), labels = waiver(), limits = NULL, expand = waiver(), oob = squish, na.value = NA_real_, right = TRUE, - trans = "identity", position = "left") + show_limits = FALSE, trans = "identity", position = "left") } \description{ \code{scale_x_binned()} and \code{scale_y_binned()} are scales that discretize From 7f1b7f37871b4bfba3d3e1c2143622347bb42c4b Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Fri, 25 Jan 2019 10:31:55 +0100 Subject: [PATCH 07/30] Make sure to reset the breaks parent environment --- R/scale-.r | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/scale-.r b/R/scale-.r index 076e19db87..9579db89fd 100644 --- a/R/scale-.r +++ b/R/scale-.r @@ -563,7 +563,9 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, stop("Invalid breaks specification. Use NULL, not NA", call. = FALSE) } else if (is.waive(self$breaks)) { if (!is.null(self$n_breaks)) { + old_n <- get("n", environment(self$trans$breaks)) assign("n", self$n_breaks, environment(self$trans$breaks)) + on.exit(assign("n", old_n, environment(self$trans$breaks))) } breaks <- self$trans$breaks(limits) } else if (is.function(self$breaks)) { From e53c122f17cc35e20aab74ed60669c1720e12ceb Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 30 Jan 2019 09:48:57 +0100 Subject: [PATCH 08/30] prepare non-positional binned scales --- R/scale-.r | 42 +++++++++++++++++++++++++++++++----------- R/scale-binned.R | 23 +++++++++++++++++++++-- 2 files changed, 52 insertions(+), 13 deletions(-) diff --git a/R/scale-.r b/R/scale-.r index 9579db89fd..3ed9f91052 100644 --- a/R/scale-.r +++ b/R/scale-.r @@ -513,7 +513,7 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, after_stat = FALSE, show_limits = FALSE, - is_discrete = function() TRUE, + is_discrete = function() FALSE, train = function(self, x) { if (!is.numeric(x)) { @@ -529,7 +529,7 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, }, map = function(self, x, limits = self$get_limits()) { - if (after_stat) { + if (self$after_stat) { x } else { breaks <- self$get_breaks(limits) @@ -568,6 +568,26 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, on.exit(assign("n", old_n, environment(self$trans$breaks))) } breaks <- self$trans$breaks(limits) + # Ensure terminal bins are same width if limits not set + if (is.null(self$limits)) { + nbreaks <- length(breaks) + if (nbreaks >= 2) { + new_limits <- c(2 * breaks[1] - breaks[2], 2 * breaks[nbreaks] - breaks[nbreaks - 1]) + if (breaks[nbreaks] > limits[2]) { + new_limits[2] <- breaks[nbreaks] + breaks <- breaks[-nbreaks] + } + if (breaks[1] < limits[1]) { + new_limits[1] <- breaks[1] + breaks <- breaks[-1] + } + limits <- new_limits + self$limits <- limits + } else { + bin_size <- max(breaks[1] - limits[1], limits[2] - breaks[1]) + limits <- c(breaks[1] - bin_size, breaks[1] + bin_size) + } + } } else if (is.function(self$breaks)) { breaks <- self$breaks(limits, self$n_bins) } else { @@ -618,6 +638,13 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, # major breaks major <- self$get_breaks(range) + + if (!is.null(self$palette.cache)) { + pal <- self$palette.cache + } else { + pal <- self$palette(length(major) + 1) + } + if (self$show_limits) { limits <- self$get_limits() major <- sort(unique(c(limits, major))) @@ -626,15 +653,8 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, # labels labels <- self$get_labels(major) - # drop oob breaks/labels by testing major == NA - if (!is.null(labels)) labels <- labels[!is.na(major)] - if (!is.null(major)) major <- major[!is.na(major)] - - # rescale breaks [0, 1], which are used by coord/guide - major_n <- rescale(major, from = range) - list(range = range, labels = labels, - major = major_n, minor = NULL, + major = pal, minor = NULL, major_source = major, minor_source = NULL) } ) @@ -817,7 +837,7 @@ discrete_scale <- function(aesthetics, scale_name, palette, name = waiver(), binned_scale <- function(aesthetics, scale_name, palette, name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, oob = squish, expand = waiver(), na.value = NA_real_, - n_breaks = NULL, right = TRUE, trans = "identity", + n_breaks = 7, right = TRUE, trans = "identity", show_limits = FALSE, guide = "legend", position = "left", super = ScaleBinned) { diff --git a/R/scale-binned.R b/R/scale-binned.R index 68df3116e6..e24222c4b0 100644 --- a/R/scale-binned.R +++ b/R/scale-binned.R @@ -57,8 +57,6 @@ scale_y_binned <- function(name = waiver(), n_breaks = 10, breaks = waiver(), ScaleBinnedPosition <- ggproto("ScaleBinnedPosition", ScaleBinned, after_stat = FALSE, - is_discrete = function() FALSE, - train = function(self, x) { if (!is.numeric(x)) { stop("Binned scales only support continuous data", call. = FALSE) @@ -92,5 +90,26 @@ ScaleBinnedPosition <- ggproto("ScaleBinnedPosition", ScaleBinned, breaks <- self$get_breaks(limits) self$range$reset() self$range$train(c(limits, breaks)) + }, + break_info = function(self, range = NULL) { + # range + if (is.null(range)) range <- self$dimension() + + # major breaks + major <- self$get_breaks(range) + if (self$show_limits) { + limits <- self$get_limits() + major <- sort(unique(c(limits, major))) + } + + # labels + labels <- self$get_labels(major) + + # rescale breaks [0, 1], which are used by coord/guide + major_n <- rescale(major, from = range) + + list(range = range, labels = labels, + major = major_n, minor = NULL, + major_source = major, minor_source = NULL) } ) From 316fdebd10634b87042fa27dea57621be0c7b893 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 30 Jan 2019 09:49:42 +0100 Subject: [PATCH 09/30] make coloursteps guide as shorthand for sensible colourbar settings --- R/guide-colorbar.r | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/R/guide-colorbar.r b/R/guide-colorbar.r index e5a17976ca..f22026e5af 100644 --- a/R/guide-colorbar.r +++ b/R/guide-colorbar.r @@ -548,6 +548,15 @@ guide_gengrob.colorbar <- function(guide, theme) { #' @rdname guide_colourbar guide_colorbar <- guide_colourbar +#' @export +#' @rdname guide_colourbar +guide_coloursteps <- function(raster = FALSE, ticks = FALSE, nbin = 100, ...) { + guide_colourbar(raster = raster, ticks = ticks, nbin = nbin, ...) +} +#' @export +#' @rdname guide_colourbar +guide_colorsteps <- guide_coloursteps + #' Calculate the default hjust and vjust settings depending on legend #' direction and position. #' From 6c5309b0bfbeb360b788c368624d0915c7f40201 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 30 Jan 2019 09:51:18 +0100 Subject: [PATCH 10/30] Make colour version of binned scales --- NAMESPACE | 10 ++++++++++ R/scale-brewer.r | 21 +++++++++++++++++++++ R/scale-gradient.r | 21 +++++++++++++++++++++ R/zxx.r | 20 ++++++++++++++++++++ man/binned_scale.Rd | 2 +- man/guide_colourbar.Rd | 6 ++++++ man/scale_brewer.Rd | 9 +++++++++ man/scale_gradient.Rd | 13 +++++++++++++ 8 files changed, 101 insertions(+), 1 deletion(-) diff --git a/NAMESPACE b/NAMESPACE index d39f4cad0d..b5fc1c3f07 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -357,7 +357,9 @@ export(ggproto_parent) export(ggsave) export(ggtitle) export(guide_colorbar) +export(guide_colorsteps) export(guide_colourbar) +export(guide_coloursteps) export(guide_gengrob) export(guide_geom) export(guide_legend) @@ -421,6 +423,8 @@ export(scale_alpha_discrete) export(scale_alpha_identity) export(scale_alpha_manual) export(scale_alpha_ordinal) +export(scale_color_binned) +export(scale_color_blender) export(scale_color_brewer) export(scale_color_continuous) export(scale_color_discrete) @@ -432,8 +436,11 @@ export(scale_color_grey) export(scale_color_hue) export(scale_color_identity) export(scale_color_manual) +export(scale_color_steps) export(scale_color_viridis_c) export(scale_color_viridis_d) +export(scale_colour_binned) +export(scale_colour_blender) export(scale_colour_brewer) export(scale_colour_continuous) export(scale_colour_date) @@ -448,11 +455,13 @@ export(scale_colour_hue) export(scale_colour_identity) export(scale_colour_manual) export(scale_colour_ordinal) +export(scale_colour_steps) export(scale_colour_viridis_c) export(scale_colour_viridis_d) export(scale_continuous_identity) export(scale_discrete_identity) export(scale_discrete_manual) +export(scale_fill_blender) export(scale_fill_brewer) export(scale_fill_continuous) export(scale_fill_date) @@ -467,6 +476,7 @@ export(scale_fill_hue) export(scale_fill_identity) export(scale_fill_manual) export(scale_fill_ordinal) +export(scale_fill_steps) export(scale_fill_viridis_c) export(scale_fill_viridis_d) export(scale_linetype) diff --git a/R/scale-brewer.r b/R/scale-brewer.r index b9c5a36eb6..969b60c8ed 100644 --- a/R/scale-brewer.r +++ b/R/scale-brewer.r @@ -100,6 +100,27 @@ scale_fill_distiller <- function(..., type = "seq", palette = 1, direction = -1, gradient_n_pal(brewer_pal(type, palette, direction)(7), values, space), na.value = na.value, guide = guide, ...) } +#' @export +#' @rdname scale_brewer +scale_colour_blender <- function(..., type = "seq", palette = 1, direction = -1, na.value = "grey50", guide = "coloursteps", aesthetics = "colour") { + # warn about using a qualitative brewer palette to generate the gradient + type <- match.arg(type, c("seq", "div", "qual")) + if (type == "qual") { + warning("Using a discrete colour palette in a binned scale.\n Consider using type = \"seq\" or type = \"div\" instead", call. = FALSE) + } + binned_scale(aesthetics, "blender", brewer_pal(type, palette, direction), na.value = na.value, guide = guide, ...) +} + +#' @export +#' @rdname scale_brewer +scale_fill_blender <- function(..., type = "seq", palette = 1, direction = -1, na.value = "grey50", guide = "coloursteps", aesthetics = "fill") { + type <- match.arg(type, c("seq", "div", "qual")) + if (type == "qual") { + warning("Using a discrete colour palette in a binned scale.\n Consider using type = \"seq\" or type = \"div\" instead", call. = FALSE) + } + binned_scale(aesthetics, "distiller", brewer_pal(type, palette, direction), na.value = na.value, guide = guide, ...) +} + # icon.brewer <- function() { # rectGrob(c(0.1, 0.3, 0.5, 0.7, 0.9), width = 0.21, # gp = gpar(fill = RColorBrewer::brewer.pal(5, "PuOr"), col = NA) diff --git a/R/scale-gradient.r b/R/scale-gradient.r index 2877e39417..5b19118f36 100644 --- a/R/scale-gradient.r +++ b/R/scale-gradient.r @@ -117,3 +117,24 @@ scale_fill_gradientn <- function(..., colours, values = NULL, space = "Lab", na. continuous_scale(aesthetics, "gradientn", gradient_n_pal(colours, values, space), na.value = na.value, guide = guide, ...) } +#' @rdname scale_gradient +#' @export +scale_colour_steps <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab", + na.value = "grey50", guide = "coloursteps", aesthetics = "colour") { + binned_scale(aesthetics, "steps", seq_stepped_pal(low, high, space), + na.value = na.value, guide = guide, ...) +} +#' @rdname scale_gradient +#' @export +scale_fill_steps <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab", + na.value = "grey50", guide = "coloursteps", aesthetics = "fill") { + binned_scale(aesthetics, "steps", seq_stepped_pal(low, high, space), + na.value = na.value, guide = guide, ...) +} + +seq_stepped_pal <- function(low, high, space) { + pal <- seq_gradient_pal(low, high, space) + function(n) { + pal(seq(0, 1, length.out = n)) + } +} diff --git a/R/zxx.r b/R/zxx.r index 32ab91f1bc..d73f391ac1 100644 --- a/R/zxx.r +++ b/R/zxx.r @@ -10,6 +10,11 @@ scale_colour_discrete <- scale_colour_hue #' @usage NULL scale_colour_ordinal <- scale_colour_viridis_d +#' @export +#' @rdname scale_gradient +#' @usage NULL +scale_colour_binned <- scale_colour_steps + #' @export #' @rdname scale_gradient #' @usage NULL @@ -109,11 +114,21 @@ scale_color_brewer <- scale_colour_brewer #' @usage NULL scale_color_distiller <- scale_colour_distiller +#' @export +#' @rdname scale_brewer +#' @usage NULL +scale_color_blender <- scale_colour_blender + #' @export #' @rdname scale_gradient #' @usage NULL scale_color_continuous <- scale_colour_continuous +#' @export +#' @rdname scale_gradient +#' @usage NULL +scale_color_binned <- scale_colour_binned + #' @export #' @rdname scale_hue #' @usage NULL @@ -124,6 +139,11 @@ scale_color_discrete <- scale_colour_hue #' @usage NULL scale_color_gradient <- scale_colour_gradient +#' @export +#' @rdname scale_gradient +#' @usage NULL +scale_color_steps <- scale_colour_steps + #' @export #' @rdname scale_gradient #' @usage NULL diff --git a/man/binned_scale.Rd b/man/binned_scale.Rd index 7438405e50..b0496fa83c 100644 --- a/man/binned_scale.Rd +++ b/man/binned_scale.Rd @@ -7,7 +7,7 @@ binned_scale(aesthetics, scale_name, palette, name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, oob = squish, expand = waiver(), na.value = NA_real_, - n_breaks = NULL, right = TRUE, trans = "identity", + n_breaks = 7, right = TRUE, trans = "identity", show_limits = FALSE, guide = "legend", position = "left", super = ScaleBinned) } diff --git a/man/guide_colourbar.Rd b/man/guide_colourbar.Rd index 63330959ff..29b3a66841 100644 --- a/man/guide_colourbar.Rd +++ b/man/guide_colourbar.Rd @@ -3,6 +3,8 @@ \name{guide_colourbar} \alias{guide_colourbar} \alias{guide_colorbar} +\alias{guide_coloursteps} +\alias{guide_colorsteps} \title{Continuous colour bar guide} \usage{ guide_colourbar(title = waiver(), title.position = NULL, @@ -26,6 +28,10 @@ guide_colorbar(title = waiver(), title.position = NULL, draw.llim = TRUE, direction = NULL, default.unit = "line", reverse = FALSE, order = 0, available_aes = c("colour", "color", "fill"), ...) + +guide_coloursteps(raster = FALSE, ticks = FALSE, nbin = 100, ...) + +guide_colorsteps(raster = FALSE, ticks = FALSE, nbin = 100, ...) } \arguments{ \item{title}{A character string or expression indicating a title of guide. diff --git a/man/scale_brewer.Rd b/man/scale_brewer.Rd index e65b97f618..c0fee0cae6 100644 --- a/man/scale_brewer.Rd +++ b/man/scale_brewer.Rd @@ -5,8 +5,11 @@ \alias{scale_fill_brewer} \alias{scale_colour_distiller} \alias{scale_fill_distiller} +\alias{scale_colour_blender} +\alias{scale_fill_blender} \alias{scale_color_brewer} \alias{scale_color_distiller} +\alias{scale_color_blender} \title{Sequential, diverging and qualitative colour scales from colorbrewer.org} \usage{ scale_colour_brewer(..., type = "seq", palette = 1, direction = 1, @@ -22,6 +25,12 @@ scale_colour_distiller(..., type = "seq", palette = 1, scale_fill_distiller(..., type = "seq", palette = 1, direction = -1, values = NULL, space = "Lab", na.value = "grey50", guide = "colourbar", aesthetics = "fill") + +scale_colour_blender(..., type = "seq", palette = 1, direction = -1, + na.value = "grey50", guide = "coloursteps", aesthetics = "colour") + +scale_fill_blender(..., type = "seq", palette = 1, direction = -1, + na.value = "grey50", guide = "coloursteps", aesthetics = "fill") } \arguments{ \item{...}{Other arguments passed on to \code{\link[=discrete_scale]{discrete_scale()}} or, for diff --git a/man/scale_gradient.Rd b/man/scale_gradient.Rd index 31cca12add..e67891f7b3 100644 --- a/man/scale_gradient.Rd +++ b/man/scale_gradient.Rd @@ -7,12 +7,17 @@ \alias{scale_fill_gradient2} \alias{scale_colour_gradientn} \alias{scale_fill_gradientn} +\alias{scale_colour_steps} +\alias{scale_fill_steps} +\alias{scale_colour_binned} \alias{scale_colour_datetime} \alias{scale_colour_date} \alias{scale_fill_datetime} \alias{scale_fill_date} \alias{scale_color_continuous} +\alias{scale_color_binned} \alias{scale_color_gradient} +\alias{scale_color_steps} \alias{scale_color_gradient2} \alias{scale_color_gradientn} \title{Gradient colour scales} @@ -40,6 +45,14 @@ scale_colour_gradientn(..., colours, values = NULL, space = "Lab", scale_fill_gradientn(..., colours, values = NULL, space = "Lab", na.value = "grey50", guide = "colourbar", aesthetics = "fill", colors) + +scale_colour_steps(..., low = "#132B43", high = "#56B1F7", + space = "Lab", na.value = "grey50", guide = "coloursteps", + aesthetics = "colour") + +scale_fill_steps(..., low = "#132B43", high = "#56B1F7", + space = "Lab", na.value = "grey50", guide = "coloursteps", + aesthetics = "fill") } \arguments{ \item{...}{Arguments passed on to \code{continuous_scale} From a2630c45290cd5e24ddedb9ecfe408c93c3a34e4 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Thu, 31 Jan 2019 11:15:56 +0100 Subject: [PATCH 11/30] Make sure binned scale works with transforms --- R/scale-.r | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) diff --git a/R/scale-.r b/R/scale-.r index 3ed9f91052..c64b4c6626 100644 --- a/R/scale-.r +++ b/R/scale-.r @@ -524,8 +524,20 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, self$range$train(x) }, - transform = function(x) { - x + transform = function(self, x) { + new_x <- self$trans$transform(x) + if (any(is.finite(x) != is.finite(new_x))) { + type <- if (self$scale_name == "position_c") { + "continuous" + } else if (self$scale_name == "position_d") { + "discrete" + } else { + "binned" + } + axis <- if ("x" %in% self$aesthetics) "x" else "y" + warning("Transformation introduced infinite values in ", type, " ", axis, "-axis", call. = FALSE) + } + new_x }, map = function(self, x, limits = self$get_limits()) { @@ -582,11 +594,11 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, breaks <- breaks[-1] } limits <- new_limits - self$limits <- limits } else { bin_size <- max(breaks[1] - limits[1], limits[2] - breaks[1]) limits <- c(breaks[1] - bin_size, breaks[1] + bin_size) } + self$limits <- self$trans$transform(limits) } } else if (is.function(self$breaks)) { breaks <- self$breaks(limits, self$n_bins) @@ -596,10 +608,9 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, # Breaks must be within limits breaks <- breaks[breaks >= limits[1] & breaks <= limits[2]] - self$breaks <- breaks - breaks + self$trans$transform(breaks) }, get_breaks_minor = function(...) NULL, From aa0b8edb85c576a45b10c1182e326586ff523fc9 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Thu, 31 Jan 2019 11:18:54 +0100 Subject: [PATCH 12/30] Improvements to guide_colorsteps --- NAMESPACE | 1 + R/guide-colorbar.r | 41 +++++++++++++++++++++++++++++++++++++++-- man/guide_colourbar.Rd | 6 ++++-- 3 files changed, 44 insertions(+), 4 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index b5fc1c3f07..b9d689c259 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -72,6 +72,7 @@ S3method(guide_geom,legend) S3method(guide_merge,colorbar) S3method(guide_merge,legend) S3method(guide_train,colorbar) +S3method(guide_train,colorsteps) S3method(guide_train,legend) S3method(heightDetails,titleGrob) S3method(heightDetails,zeroGrob) diff --git a/R/guide-colorbar.r b/R/guide-colorbar.r index f22026e5af..21d1a22534 100644 --- a/R/guide-colorbar.r +++ b/R/guide-colorbar.r @@ -550,13 +550,50 @@ guide_colorbar <- guide_colourbar #' @export #' @rdname guide_colourbar -guide_coloursteps <- function(raster = FALSE, ticks = FALSE, nbin = 100, ...) { - guide_colourbar(raster = raster, ticks = ticks, nbin = nbin, ...) +guide_coloursteps <- function(even_steps = TRUE, show_limits = NULL, ticks = FALSE, nbin = 100, ...) { + guide <- guide_colourbar(raster = FALSE, ticks = ticks, nbin = nbin, ...) + guide$even_steps <- even_steps + guide$show_limits <- show_limits + class(guide) <- c('colorsteps', class(guide)) + guide } #' @export #' @rdname guide_colourbar guide_colorsteps <- guide_coloursteps +#' @export +guide_train.colorsteps <- function(guide, scale, aesthetic = NULL) { + if (guide$even_steps) { + breaks <- scale$get_breaks() + if (length(breaks) == 0 || all(is.na(breaks))) + return() + limits <- scale$get_limits() + all_breaks <- c(limits[1], breaks, limits[2]) + bin_at <- all_breaks[-1] - diff(all_breaks) / 2 + ticks <- new_data_frame(setNames(list(scale$map(breaks)), aesthetic %||% scale$aesthetics[1])) + ticks$.value <- seq_along(breaks) - 0.5 + ticks$.label <- scale$get_labels(breaks) + guide$nbin <- length(breaks) + 1 + guide$key <- ticks + guide$bar <- new_data_frame(list(colour = scale$map(bin_at), value = seq_along(bin_at) - 1), n = length(bin_at)) + if (guide$reverse) { + guide$key <- guide$key[nrow(guide$key):1, ] + guide$bar <- guide$bar[nrow(guide$bar):1, ] + } + guide$hash <- with(guide, digest::digest(list(title, key$.label, bar, name))) + } else { + guide <- NextMethod() + } + if (guide$show_limits %||% scale$show_limits %||% FALSE) { + edges <- rescale(c(0, 1), to = guide$bar$value[c(1, nrow(guide$bar))], from = c(0.5, guide$nbin - 0.5) / guide$nbin) + limits <- scale$get_limits() + guide$key <- guide$key[c(NA, seq_len(nrow(guide$key)), NA), , drop = FALSE] + guide$key$.value[c(1, nrow(guide$key))] <- edges + guide$key$.label[c(1, nrow(guide$key))] <- scale$get_labels(limits) + } + guide +} + #' Calculate the default hjust and vjust settings depending on legend #' direction and position. #' diff --git a/man/guide_colourbar.Rd b/man/guide_colourbar.Rd index 29b3a66841..77f81a024d 100644 --- a/man/guide_colourbar.Rd +++ b/man/guide_colourbar.Rd @@ -29,9 +29,11 @@ guide_colorbar(title = waiver(), title.position = NULL, reverse = FALSE, order = 0, available_aes = c("colour", "color", "fill"), ...) -guide_coloursteps(raster = FALSE, ticks = FALSE, nbin = 100, ...) +guide_coloursteps(even_steps = TRUE, show_limits = NULL, + ticks = FALSE, nbin = 100, ...) -guide_colorsteps(raster = FALSE, ticks = FALSE, nbin = 100, ...) +guide_colorsteps(even_steps = TRUE, show_limits = NULL, + ticks = FALSE, nbin = 100, ...) } \arguments{ \item{title}{A character string or expression indicating a title of guide. From ba7c27f2bdf94d6f5c067f3df72d5587cf3bd654 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Thu, 31 Jan 2019 11:27:13 +0100 Subject: [PATCH 13/30] Fix docs --- R/guide-colorbar.r | 5 ++++ R/scale-binned.R | 2 +- man/guide_colourbar.Rd | 6 ++++ man/scale_binned.Rd | 67 ++++++++++++++++++++++++++++++++++++++++-- 4 files changed, 76 insertions(+), 4 deletions(-) diff --git a/R/guide-colorbar.r b/R/guide-colorbar.r index 21d1a22534..27fb8ee6f4 100644 --- a/R/guide-colorbar.r +++ b/R/guide-colorbar.r @@ -550,6 +550,11 @@ guide_colorbar <- guide_colourbar #' @export #' @rdname guide_colourbar +#' +#' @param even_steps Should the bin sizes reflect their size or be even across all +#' bins? Defaults to `TRUE` +#' @param show_limits Should labels for the outer limits of the bins be printed? +#' Default is `NULL` which makes the guide use the setting from the scale guide_coloursteps <- function(even_steps = TRUE, show_limits = NULL, ticks = FALSE, nbin = 100, ...) { guide <- guide_colourbar(raster = FALSE, ticks = ticks, nbin = nbin, ...) guide$even_steps <- even_steps diff --git a/R/scale-binned.R b/R/scale-binned.R index e24222c4b0..2882e7839d 100644 --- a/R/scale-binned.R +++ b/R/scale-binned.R @@ -5,7 +5,7 @@ #' inputs before using it with a geom that requires discrete positions. An #' example is using `scale_x_binned()` with [geom_bar()] to create a histogram. #' -#' #' @inheritParams binned_scale +#' @inheritParams binned_scale #' #' @family position scales #' @name scale_binned diff --git a/man/guide_colourbar.Rd b/man/guide_colourbar.Rd index 77f81a024d..a739fc91ef 100644 --- a/man/guide_colourbar.Rd +++ b/man/guide_colourbar.Rd @@ -128,6 +128,12 @@ If 0 (default), the order is determined by a secret algorithm.} for which a colourbar can be drawn.} \item{...}{ignored.} + +\item{even_steps}{Should the bin sizes reflect their size or be even across all +bins? Defaults to \code{TRUE}} + +\item{show_limits}{Should labels for the outer limits of the bins be printed? +Default is \code{NULL} which makes the guide use the setting from the scale} } \value{ A guide object diff --git a/man/scale_binned.Rd b/man/scale_binned.Rd index 9219ed63b3..2ad205a915 100644 --- a/man/scale_binned.Rd +++ b/man/scale_binned.Rd @@ -15,15 +15,76 @@ scale_y_binned(name = waiver(), n_breaks = 10, breaks = waiver(), oob = squish, na.value = NA_real_, right = TRUE, show_limits = FALSE, trans = "identity", position = "left") } +\arguments{ +\item{name}{The name of the scale. Used as the axis or legend title. If +\code{waiver()}, the default, the name of the scale is taken from the first +mapping used for that aesthetic. If \code{NULL}, the legend title will be +omitted.} + +\item{n_breaks}{The number of break points to create if breaks are not given +directly. It will attempt to find nice breakpoint and may thus not give the +exact number of breaks as requested.} + +\item{breaks}{One of: +\itemize{ +\item \code{NULL} for no breaks +\item \code{waiver()} for the default breaks computed by the +transformation object +\item A numeric vector of positions +\item A function that takes the limits as input and returns breaks +as output +}} + +\item{labels}{One of: +\itemize{ +\item \code{NULL} for no labels +\item \code{waiver()} for the default labels computed by the +transformation object +\item A character vector giving labels (must be same length as \code{breaks}) +\item A function that takes the breaks as input and returns labels +as output +}} + +\item{limits}{A numeric vector of length two providing limits of the scale. +Use \code{NA} to refer to the existing minimum or maximum.} + +\item{expand}{Vector of range expansion constants used to add some +padding around the data, to ensure that they are placed some distance +away from the axes. Use the convenience function \code{\link[=expand_scale]{expand_scale()}} +to generate the values for the \code{expand} argument. The defaults are to +expand the scale by 5\% on each side for continuous variables, and by +0.6 units on each side for discrete variables.} + +\item{oob}{Function that handles limits outside of the scale limits +(out of bounds). The default replaces out of bounds values with \code{NA}.} + +\item{na.value}{Missing values will be replaced with this value.} + +\item{right}{Should values on the border between bins be part of the right +(upper) bin?} + +\item{show_limits}{should the limits of the scale appear as ticks} + +\item{trans}{Either the name of a transformation object, or the +object itself. Built-in transformations include "asn", "atanh", +"boxcox", "exp", "identity", "log", "log10", "log1p", "log2", +"logit", "probability", "probit", "reciprocal", "reverse" and "sqrt". + +A transformation object bundles together a transform, its inverse, +and methods for generating breaks and labels. Transformation objects +are defined in the scales package, and are called \code{name_trans}, e.g. +\code{\link[scales:boxcox_trans]{scales::boxcox_trans()}}. You can create your own +transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} + +\item{position}{The position of the axis. "left" or "right" for vertical +scales, "top" or "bottom" for horizontal scales} +} \description{ \code{scale_x_binned()} and \code{scale_y_binned()} are scales that discretize continuous position data. You can use these scales to transform continuous inputs before using it with a geom that requires discrete positions. An example is using \code{scale_x_binned()} with \code{\link[=geom_bar]{geom_bar()}} to create a histogram. } -\details{ -#' @inheritParams binned_scale -} \examples{ # Create a histogram by binning the x-axis ggplot(mtcars) + From 575c61022f037d8acf4e7946c4d6929f5ecf1c5a Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Thu, 31 Jan 2019 11:45:50 +0100 Subject: [PATCH 14/30] begin playing with guide_bin --- DESCRIPTION | 1 + NAMESPACE | 4 + R/guide-bins.R | 523 +++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 528 insertions(+) create mode 100644 R/guide-bins.R diff --git a/DESCRIPTION b/DESCRIPTION index f9f724320b..1868fa9599 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -151,6 +151,7 @@ Collate: 'grob-dotstack.r' 'grob-null.r' 'grouping.r' + 'guide-bins.R' 'guide-colorbar.r' 'guide-legend.r' 'guides-.r' diff --git a/NAMESPACE b/NAMESPACE index b9d689c259..1c7e2750ca 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -65,12 +65,16 @@ S3method(grobWidth,absoluteGrob) S3method(grobWidth,zeroGrob) S3method(grobX,absoluteGrob) S3method(grobY,absoluteGrob) +S3method(guide_gengrob,bins) S3method(guide_gengrob,colorbar) S3method(guide_gengrob,legend) +S3method(guide_geom,bins) S3method(guide_geom,colorbar) S3method(guide_geom,legend) +S3method(guide_merge,bins) S3method(guide_merge,colorbar) S3method(guide_merge,legend) +S3method(guide_train,bins) S3method(guide_train,colorbar) S3method(guide_train,colorsteps) S3method(guide_train,legend) diff --git a/R/guide-bins.R b/R/guide-bins.R new file mode 100644 index 0000000000..51c5d79fd6 --- /dev/null +++ b/R/guide-bins.R @@ -0,0 +1,523 @@ +guide_bins <- function( + # title + title = waiver(), + title.position = NULL, + title.theme = NULL, + title.hjust = NULL, + title.vjust = NULL, + + # label + label = TRUE, + label.position = NULL, + label.theme = NULL, + label.hjust = NULL, + label.vjust = NULL, + + # bar + barwidth = NULL, + barheight = NULL, + + # frame + frame.colour = NULL, + frame.linewidth = 0.5, + frame.linetype = 1, + + # divider + divider.colour = NULL, + divider.linewidth = 0.5, + divider.linetype = 1, + + # general + direction = NULL, + default.unit = "line", + override.aes = list(), + reverse = FALSE, + order = 0, + ...) { + + if (!is.null(barwidth) && !is.unit(barwidth)) { + barwidth <- unit(barwidth, default.unit) + } + if (!is.null(barheight) && !is.unit(barheight)) { + barheight <- unit(barheight, default.unit) + } + + structure(list( + # title + title = title, + title.position = title.position, + title.theme = title.theme, + title.hjust = title.hjust, + title.vjust = title.vjust, + + # label + label = label, + label.position = label.position, + label.theme = label.theme, + label.hjust = label.hjust, + label.vjust = label.vjust, + + # bar + barwidth = barwidth, + barheight = barheight, + + # frame + frame.colour = frame.colour, + frame.linewidth = frame.linewidth, + frame.linetype = frame.linetype, + + # divider + divider.colour = divider.colour, + divider.linewidth = divider.linewidth, + divider.linetype = divider.linetype, + + # general + direction = direction, + default.unit = default.unit, + reverse = reverse, + order = order, + + # parameter + available_aes = c("any"), + ..., + name = "bins"), + class = c("guide", "bins") + ) +} + +#' @export +guide_train.bins <- function(guide, scale, aesthetic = NULL) { + breaks <- scale$break_info() + if (length(breaks$major_source) == 0 || all(is.na(breaks$major_source))) { + return() + } + + # in the key data frame, use either the aesthetic provided as + # argument to this function or, as a fall back, the first in the vector + # of possible aesthetics handled by the scale + aes_column_name <- aesthetic %||% scale$aesthetics[1] + key <- new_data_frame(setNames(list(breaks$major), aes_column_name)) + + label <- breaks$labels + position <- breaks$major_source + if (length(position) != nrow(key) + 1) { + label <- c(NA, label, NA) + position <- c(breaks$range[1], position, breaks$range[2]) + } + labels <- new_data_frame(list(label = label, position = position)) + + if (guide$reverse) { + key <- key[nrow(key):1, ] + labels <- labels[nrow(labels):1, ] + } + + guide$key <- key + guide$labels <- labels + guide$hash <- with( + guide, + digest::digest(list(title, labels$label, direction, name)) + ) + guide +} + +#' @export +guide_merge.bins <- function(guide, new_guide) { + guide$key <- merge(guide$key, new_guide$key, sort = FALSE) + guide$override.aes <- c(guide$override.aes, new_guide$override.aes) + if (any(duplicated(names(guide$override.aes)))) { + warning("Duplicated override.aes is ignored.") + } + guide$override.aes <- guide$override.aes[!duplicated(names(guide$override.aes))] + guide +} + +#' @export +guide_geom.bins <- function(guide, layers, default_mapping) { + # arrange common data for vertical and horizontal guide + guide$geoms <- lapply(layers, function(layer) { + matched <- matched_aes(layer, guide, default_mapping) + + if (length(matched) > 0) { + # This layer contributes to the legend + + # check if this layer should be included, different behaviour depending on + # if show.legend is a logical or a named logical vector + if (!is.null(names(layer$show.legend))) { + layer$show.legend <- rename_aes(layer$show.legend) + include <- is.na(layer$show.legend[matched]) || + layer$show.legend[matched] + } else { + include <- is.na(layer$show.legend) || layer$show.legend + } + + if (include) { + # Default is to include it + + # Filter out set aesthetics that can't be applied to the legend + n <- vapply(layer$aes_params, length, integer(1)) + params <- layer$aes_params[n == 1] + + data <- layer$geom$use_defaults(guide$key[matched], params) + } else { + return(NULL) + } + } else { + # This layer does not contribute to the legend + if (is.na(layer$show.legend) || !layer$show.legend) { + # Default is to exclude it + return(NULL) + } else { + data <- layer$geom$use_defaults(NULL, layer$aes_params)[rep(1, nrow(guide$key)), ] + } + } + + # override.aes in guide_legend manually changes the geom + data <- modify_list(data, guide$override.aes) + + list( + draw_key = layer$geom$draw_key, + data = data, + params = c(layer$geom_params, layer$stat_params) + ) + }) + + # remove null geom + guide$geoms <- compact(guide$geoms) + + # Finally, remove this guide if no layer is drawn + if (length(guide$geoms) == 0) guide <- NULL + guide +} + +#' @export +guide_gengrob.bins <- function(guide, theme) { + # settings of location and size + if (guide$direction == "horizontal") { + label.position <- guide$label.position %||% "bottom" + if (!label.position %in% c("top", "bottom")) stop("label position \"", label.position, "\" is invalid") + + barwidth <- width_cm(guide$barwidth %||% (theme$legend.key.width * 5)) + barheight <- height_cm(guide$barheight %||% theme$legend.key.height) + } else { # guide$direction == "vertical" + label.position <- guide$label.position %||% "right" + if (!label.position %in% c("left", "right")) stop("label position \"", label.position, "\" is invalid") + + barwidth <- width_cm(guide$barwidth %||% theme$legend.key.width) + barheight <- height_cm(guide$barheight %||% (theme$legend.key.height * 5)) + } + + barlength <- switch(guide$direction, "horizontal" = barwidth, "vertical" = barheight) + nbreak <- nrow(guide$key) + + # Keys + key_width <- width_cm( + guide$keywidth %||% theme$legend.key.width %||% theme$legend.key.size + ) + key_height <- height_cm( + guide$keyheight %||% theme$legend.key.height %||% theme$legend.key.size + ) + + key_size_mat <- do.call("cbind", lapply(guide$geoms, function(g) g$data$size / 10)) + if (nrow(key_size_mat) == 0 || ncol(key_size_mat) == 0) { + key_size_mat <- matrix(0, ncol = 1, nrow = nbreak) + } + key_sizes <- apply(key_size_mat, 1, max) + + if (!is.null(guide$nrow) && !is.null(guide$ncol) && + guide$nrow * guide$ncol < nbreak) { + stop( + "`nrow` * `ncol` needs to be larger than the number of breaks", + call. = FALSE + ) + } + + # If neither nrow/ncol specified, guess with "reasonable" values + if (is.null(guide$nrow) && is.null(guide$ncol)) { + if (guide$direction == "horizontal") { + guide$nrow <- ceiling(nbreak / 5) + } else { + guide$ncol <- ceiling(nbreak / 20) + } + } + legend.nrow <- guide$nrow %||% ceiling(nbreak / guide$ncol) + legend.ncol <- guide$ncol %||% ceiling(nbreak / guide$nrow) + + key_sizes <- matrix( + c(key_sizes, rep(0, legend.nrow * legend.ncol - nbreak)), + legend.nrow, + legend.ncol, + byrow = guide$byrow + ) + + key_widths <- pmax(key_width, apply(key_sizes, 2, max)) + key_heights <- pmax(key_height, apply(key_sizes, 1, max)) + + bg <- element_render(theme, "legend.key") + # grob for key + key_size <- c(key_width, key_height) * 10 + draw_key <- function(i) { + lapply(guide$geoms, function(g) { + g$draw_key(g$data[i, ], g$params, key_size) + }) + } + grob.keys <- unlist(lapply(seq_len(nbreak), draw_key), recursive = FALSE) + + # make the bar grob (`grob.bar`) + if (guide$direction == "horizontal") { + bw <- barwidth / nrow(guide$bar) + bx <- (seq(nrow(guide$bar)) - 1) * bw + grob.bar <-rectGrob(x = bx, y = 0, vjust = 0, hjust = 0, width = bw, height = barheight, default.units = "cm", + gp = gpar(col = NA, fill = guide$bar$colour)) + } else { # guide$direction == "vertical" + bh <- barheight / nrow(guide$bar) + by <- (seq(nrow(guide$bar)) - 1) * bh + grob.bar <-rectGrob(x = 0, y = by, vjust = 0, hjust = 0, width = barwidth, height = bh, default.units = "cm", + gp = gpar(col = NA, fill = guide$bar$colour)) + } + + # make frame around color bar if requested (colour is not NULL) + if (!is.null(guide$frame.colour)) { + grob.bar <- grobTree( + grob.bar, + rectGrob( + width = barwidth, + height = barheight, + default.units = "cm", + gp = gpar( + col = guide$frame.colour, + lwd = guide$frame.linewidth, + lty = guide$frame.linetype, + fill = NA) + ) + ) + } + + # tick and label position + tick_pos <- rescale(guide$key$.value, c(0.5, guide$nbin - 0.5), guide$bar$value[c(1, nrow(guide$bar))]) * barlength / guide$nbin + label_pos <- unit(tick_pos, "cm") + if (!guide$draw.ulim) tick_pos <- tick_pos[-1] + if (!guide$draw.llim) tick_pos <- tick_pos[-length(tick_pos)] + + # title + + # obtain the theme for the legend title. We need this both for the title grob + # and to obtain the title fontsize. + title.theme <- guide$title.theme %||% calc_element("legend.title", theme) + + title.hjust <- guide$title.hjust %||% theme$legend.title.align %||% title.theme$hjust %||% 0 + title.vjust <- guide$title.vjust %||% title.theme$vjust %||% 0.5 + + grob.title <- ggname("guide.title", + element_grob( + title.theme, + label = guide$title, + hjust = title.hjust, + vjust = title.vjust, + margin_x = TRUE, + margin_y = TRUE + ) + ) + + title_width <- width_cm(grob.title) + title_height <- height_cm(grob.title) + title_fontsize <- title.theme$size %||% calc_element("legend.title", theme)$size %||% 0 + + # gap between keys etc + # the default horizontal and vertical gap need to be the same to avoid strange + # effects for certain guide layouts + hgap <- width_cm(theme$legend.spacing.x %||% (0.5 * unit(title_fontsize, "pt"))) + vgap <- height_cm(theme$legend.spacing.y %||% (0.5 * unit(title_fontsize, "pt"))) + + # Labels + + # get the defaults for label justification. The defaults are complicated and depend + # on the direction of the legend and on label placement + just_defaults <- label_just_defaults.colorbar(guide$direction, label.position) + # don't set expressions left-justified + if (just_defaults$hjust == 0 && any(is.expression(guide$key$.label))) just_defaults$hjust <- 1 + + # get the label theme + label.theme <- guide$label.theme %||% calc_element("legend.text", theme) + + # We break inheritance for hjust and vjust, because that's more intuitive here; it still allows manual + # setting of hjust and vjust if desired. The alternative is to ignore hjust and vjust altogether, which + # seems worse + if (is.null(guide$label.theme$hjust) && is.null(theme$legend.text$hjust)) label.theme$hjust <- NULL + if (is.null(guide$label.theme$vjust) && is.null(theme$legend.text$vjust)) label.theme$vjust <- NULL + + # label.theme in param of guide_legend() > theme$legend.text.align > default + hjust <- guide$label.hjust %||% theme$legend.text.align %||% label.theme$hjust %||% + just_defaults$hjust + vjust <- guide$label.vjust %||% label.theme$vjust %||% + just_defaults$vjust + + # make the label grob (`grob.label`) + if (!guide$label) + grob.label <- zeroGrob() + else { + if (guide$direction == "horizontal") { + x <- label_pos + y <- rep(vjust, length(label_pos)) + margin_x <- FALSE + margin_y <- TRUE + } else { # guide$direction == "vertical" + x <- rep(hjust, length(label_pos)) + y <- label_pos + margin_x <- TRUE + margin_y <- FALSE + } + label <- guide$key$.label + + # If any of the labels are quoted language objects, convert them + # to expressions. Labels from formatter functions can return these + if (any(vapply(label, is.call, logical(1)))) { + label <- lapply(label, function(l) { + if (is.call(l)) substitute(expression(x), list(x = l)) + else l + }) + label <- do.call(c, label) + } + grob.label <- element_grob( + element = label.theme, + label = label, + x = x, + y = y, + hjust = hjust, + vjust = vjust, + margin_x = margin_x, + margin_y = margin_y + ) + grob.label <- ggname("guide.label", grob.label) + } + + label_width <- width_cm(grob.label) + label_height <- height_cm(grob.label) + + # make the ticks grob (`grob.ticks`) + if (!guide$ticks) + grob.ticks <-zeroGrob() + else { + if (guide$direction == "horizontal") { + x0 <- rep(tick_pos, 2) + y0 <- c(rep(0, nbreak), rep(barheight * (4/5), nbreak)) + x1 <- rep(tick_pos, 2) + y1 <- c(rep(barheight * (1/5), nbreak), rep(barheight, nbreak)) + } else { # guide$direction == "vertical" + x0 <- c(rep(0, nbreak), rep(barwidth * (4/5), nbreak)) + y0 <- rep(tick_pos, 2) + x1 <- c(rep(barwidth * (1/5), nbreak), rep(barwidth, nbreak)) + y1 <- rep(tick_pos, 2) + } + grob.ticks <- segmentsGrob( + x0 = x0, y0 = y0, x1 = x1, y1 = y1, + default.units = "cm", + gp = gpar( + col = guide$ticks.colour, + lwd = guide$ticks.linewidth, + lineend = "butt" + ) + ) + } + + # layout of bar and label + if (guide$direction == "horizontal") { + if (label.position == "top") { + bl_widths <- barwidth + bl_heights <- c(label_height, vgap, barheight) + vps <- list(bar.row = 3, bar.col = 1, + label.row = 1, label.col = 1) + } else { # label.position == "bottom" or other + bl_widths <- barwidth + bl_heights <- c(barheight, vgap, label_height) + vps <- list(bar.row = 1, bar.col = 1, + label.row = 3, label.col = 1) + } + } else { # guide$direction == "vertical" + if (label.position == "left") { + bl_widths <- c(label_width, hgap, barwidth) + bl_heights <- barheight + vps <- list(bar.row = 1, bar.col = 3, + label.row = 1, label.col = 1) + } else { # label.position == "right" or other + bl_widths <- c(barwidth, hgap, label_width) + bl_heights <- barheight + vps <- list(bar.row = 1, bar.col = 1, + label.row = 1, label.col = 3) + } + } + + # layout of title and bar+label + switch(guide$title.position, + "top" = { + widths <- c(bl_widths, max(0, title_width - sum(bl_widths))) + heights <- c(title_height, vgap, bl_heights) + vps <- with(vps, + list(bar.row = bar.row + 2, bar.col = bar.col, + label.row = label.row + 2, label.col = label.col, + title.row = 1, title.col = 1:length(widths))) + }, + "bottom" = { + widths <- c(bl_widths, max(0, title_width - sum(bl_widths))) + heights <- c(bl_heights, vgap, title_height) + vps <- with(vps, + list(bar.row = bar.row, bar.col = bar.col, + label.row = label.row, label.col = label.col, + title.row = length(heights), title.col = 1:length(widths))) + }, + "left" = { + widths <- c(title_width, hgap, bl_widths) + heights <- c(bl_heights, max(0, title_height - sum(bl_heights))) + vps <- with(vps, + list(bar.row = bar.row, bar.col = bar.col + 2, + label.row = label.row, label.col = label.col + 2, + title.row = 1:length(heights), title.col = 1)) + }, + "right" = { + widths <- c(bl_widths, hgap, title_width) + heights <- c(bl_heights, max(0, title_height - sum(bl_heights))) + vps <- with(vps, + list(bar.row = bar.row, bar.col = bar.col, + label.row = label.row, label.col = label.col, + title.row = 1:length(heights), title.col = length(widths))) + }) + + # background + grob.background <- element_render(theme, "legend.background") + + # padding + padding <- convertUnit(theme$legend.margin %||% margin(), "cm", valueOnly = TRUE) + widths <- c(padding[4], widths, padding[2]) + heights <- c(padding[1], heights, padding[3]) + + gt <- gtable(widths = unit(widths, "cm"), heights = unit(heights, "cm")) + gt <- gtable_add_grob(gt, grob.background, name = "background", clip = "off", + t = 1, r = -1, b = -1, l = 1) + gt <- gtable_add_grob(gt, grob.bar, name = "bar", clip = "off", + t = 1 + min(vps$bar.row), r = 1 + max(vps$bar.col), + b = 1 + max(vps$bar.row), l = 1 + min(vps$bar.col)) + gt <- gtable_add_grob( + gt, + grob.label, + name = "label", + clip = "off", + t = 1 + min(vps$label.row), r = 1 + max(vps$label.col), + b = 1 + max(vps$label.row), l = 1 + min(vps$label.col)) + gt <- gtable_add_grob( + gt, + justify_grobs( + grob.title, + hjust = title.hjust, + vjust = title.vjust, + int_angle = title.theme$angle, + debug = title.theme$debug + ), + name = "title", + clip = "off", + t = 1 + min(vps$title.row), r = 1 + max(vps$title.col), + b = 1 + max(vps$title.row), l = 1 + min(vps$title.col)) + gt <- gtable_add_grob(gt, grob.ticks, name = "ticks", clip = "off", + t = 1 + min(vps$bar.row), r = 1 + max(vps$bar.col), + b = 1 + max(vps$bar.row), l = 1 + min(vps$bar.col)) + + gt +} From deed97302a38e779de365475fa1608890f9db5a2 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Mon, 23 Sep 2019 08:26:47 +0200 Subject: [PATCH 15/30] further work on bin guide --- R/guide-bins.R | 607 +++++++++++++++++++++++++++---------------------- 1 file changed, 335 insertions(+), 272 deletions(-) diff --git a/R/guide-bins.R b/R/guide-bins.R index 51c5d79fd6..34cd4e6d88 100644 --- a/R/guide-bins.R +++ b/R/guide-bins.R @@ -87,35 +87,26 @@ guide_bins <- function( #' @export guide_train.bins <- function(guide, scale, aesthetic = NULL) { - breaks <- scale$break_info() - if (length(breaks$major_source) == 0 || all(is.na(breaks$major_source))) { + breaks <- scale$get_breaks() + if (length(breaks) == 0 || all(is.na(breaks))) { return() } - + limits <- scale$get_limits() + all_breaks <- c(limits[1], breaks, limits[2]) + bin_at <- all_breaks[-1] - diff(all_breaks) / 2 # in the key data frame, use either the aesthetic provided as # argument to this function or, as a fall back, the first in the vector # of possible aesthetics handled by the scale aes_column_name <- aesthetic %||% scale$aesthetics[1] - key <- new_data_frame(setNames(list(breaks$major), aes_column_name)) - - label <- breaks$labels - position <- breaks$major_source - if (length(position) != nrow(key) + 1) { - label <- c(NA, label, NA) - position <- c(breaks$range[1], position, breaks$range[2]) - } - labels <- new_data_frame(list(label = label, position = position)) + key <- new_data_frame(setNames(list(c(scale$map(bin_at), NA)), aes_column_name)) + key$.label <- scale$get_labels(all_breaks) - if (guide$reverse) { - key <- key[nrow(key):1, ] - labels <- labels[nrow(labels):1, ] - } + if (guide$reverse) key <- key[nrow(key):1, ] guide$key <- key - guide$labels <- labels guide$hash <- with( guide, - digest::digest(list(title, labels$label, direction, name)) + digest::digest(list(title, key$.label, direction, name)) ) guide } @@ -191,114 +182,14 @@ guide_geom.bins <- function(guide, layers, default_mapping) { #' @export guide_gengrob.bins <- function(guide, theme) { - # settings of location and size - if (guide$direction == "horizontal") { - label.position <- guide$label.position %||% "bottom" - if (!label.position %in% c("top", "bottom")) stop("label position \"", label.position, "\" is invalid") - - barwidth <- width_cm(guide$barwidth %||% (theme$legend.key.width * 5)) - barheight <- height_cm(guide$barheight %||% theme$legend.key.height) - } else { # guide$direction == "vertical" - label.position <- guide$label.position %||% "right" - if (!label.position %in% c("left", "right")) stop("label position \"", label.position, "\" is invalid") - - barwidth <- width_cm(guide$barwidth %||% theme$legend.key.width) - barheight <- height_cm(guide$barheight %||% (theme$legend.key.height * 5)) - } - - barlength <- switch(guide$direction, "horizontal" = barwidth, "vertical" = barheight) - nbreak <- nrow(guide$key) - - # Keys - key_width <- width_cm( - guide$keywidth %||% theme$legend.key.width %||% theme$legend.key.size - ) - key_height <- height_cm( - guide$keyheight %||% theme$legend.key.height %||% theme$legend.key.size - ) - key_size_mat <- do.call("cbind", lapply(guide$geoms, function(g) g$data$size / 10)) - if (nrow(key_size_mat) == 0 || ncol(key_size_mat) == 0) { - key_size_mat <- matrix(0, ncol = 1, nrow = nbreak) - } - key_sizes <- apply(key_size_mat, 1, max) + # default setting + label.position <- guide$label.position %||% "right" + if (!label.position %in% c("top", "bottom", "left", "right")) + stop("label position \"", label.position, "\" is invalid") - if (!is.null(guide$nrow) && !is.null(guide$ncol) && - guide$nrow * guide$ncol < nbreak) { - stop( - "`nrow` * `ncol` needs to be larger than the number of breaks", - call. = FALSE - ) - } - - # If neither nrow/ncol specified, guess with "reasonable" values - if (is.null(guide$nrow) && is.null(guide$ncol)) { - if (guide$direction == "horizontal") { - guide$nrow <- ceiling(nbreak / 5) - } else { - guide$ncol <- ceiling(nbreak / 20) - } - } - legend.nrow <- guide$nrow %||% ceiling(nbreak / guide$ncol) - legend.ncol <- guide$ncol %||% ceiling(nbreak / guide$nrow) - - key_sizes <- matrix( - c(key_sizes, rep(0, legend.nrow * legend.ncol - nbreak)), - legend.nrow, - legend.ncol, - byrow = guide$byrow - ) - - key_widths <- pmax(key_width, apply(key_sizes, 2, max)) - key_heights <- pmax(key_height, apply(key_sizes, 1, max)) - - bg <- element_render(theme, "legend.key") - # grob for key - key_size <- c(key_width, key_height) * 10 - draw_key <- function(i) { - lapply(guide$geoms, function(g) { - g$draw_key(g$data[i, ], g$params, key_size) - }) - } - grob.keys <- unlist(lapply(seq_len(nbreak), draw_key), recursive = FALSE) - - # make the bar grob (`grob.bar`) - if (guide$direction == "horizontal") { - bw <- barwidth / nrow(guide$bar) - bx <- (seq(nrow(guide$bar)) - 1) * bw - grob.bar <-rectGrob(x = bx, y = 0, vjust = 0, hjust = 0, width = bw, height = barheight, default.units = "cm", - gp = gpar(col = NA, fill = guide$bar$colour)) - } else { # guide$direction == "vertical" - bh <- barheight / nrow(guide$bar) - by <- (seq(nrow(guide$bar)) - 1) * bh - grob.bar <-rectGrob(x = 0, y = by, vjust = 0, hjust = 0, width = barwidth, height = bh, default.units = "cm", - gp = gpar(col = NA, fill = guide$bar$colour)) - } - - # make frame around color bar if requested (colour is not NULL) - if (!is.null(guide$frame.colour)) { - grob.bar <- grobTree( - grob.bar, - rectGrob( - width = barwidth, - height = barheight, - default.units = "cm", - gp = gpar( - col = guide$frame.colour, - lwd = guide$frame.linewidth, - lty = guide$frame.linetype, - fill = NA) - ) - ) - } - - # tick and label position - tick_pos <- rescale(guide$key$.value, c(0.5, guide$nbin - 0.5), guide$bar$value[c(1, nrow(guide$bar))]) * barlength / guide$nbin - label_pos <- unit(tick_pos, "cm") - if (!guide$draw.ulim) tick_pos <- tick_pos[-1] - if (!guide$draw.llim) tick_pos <- tick_pos[-length(tick_pos)] - - # title + nbreak <- nrow(guide$key) - 1 + guide$byrow <- FALSE # obtain the theme for the legend title. We need this both for the title grob # and to obtain the title fontsize. @@ -320,7 +211,8 @@ guide_gengrob.bins <- function(guide, theme) { title_width <- width_cm(grob.title) title_height <- height_cm(grob.title) - title_fontsize <- title.theme$size %||% calc_element("legend.title", theme)$size %||% 0 + title_fontsize <- title.theme$size %||% calc_element("legend.title", theme)$size %||% + calc_element("text", theme)$size %||% 11 # gap between keys etc # the default horizontal and vertical gap need to be the same to avoid strange @@ -330,178 +222,324 @@ guide_gengrob.bins <- function(guide, theme) { # Labels - # get the defaults for label justification. The defaults are complicated and depend - # on the direction of the legend and on label placement - just_defaults <- label_just_defaults.colorbar(guide$direction, label.position) - # don't set expressions left-justified - if (just_defaults$hjust == 0 && any(is.expression(guide$key$.label))) just_defaults$hjust <- 1 - - # get the label theme + # first get the label theme, we need it below even when there are no labels label.theme <- guide$label.theme %||% calc_element("legend.text", theme) - # We break inheritance for hjust and vjust, because that's more intuitive here; it still allows manual - # setting of hjust and vjust if desired. The alternative is to ignore hjust and vjust altogether, which - # seems worse - if (is.null(guide$label.theme$hjust) && is.null(theme$legend.text$hjust)) label.theme$hjust <- NULL - if (is.null(guide$label.theme$vjust) && is.null(theme$legend.text$vjust)) label.theme$vjust <- NULL - - # label.theme in param of guide_legend() > theme$legend.text.align > default - hjust <- guide$label.hjust %||% theme$legend.text.align %||% label.theme$hjust %||% - just_defaults$hjust - vjust <- guide$label.vjust %||% label.theme$vjust %||% - just_defaults$vjust - - # make the label grob (`grob.label`) - if (!guide$label) - grob.label <- zeroGrob() - else { - if (guide$direction == "horizontal") { - x <- label_pos - y <- rep(vjust, length(label_pos)) - margin_x <- FALSE - margin_y <- TRUE - } else { # guide$direction == "vertical" - x <- rep(hjust, length(label_pos)) - y <- label_pos - margin_x <- TRUE - margin_y <- FALSE - } - label <- guide$key$.label - - # If any of the labels are quoted language objects, convert them - # to expressions. Labels from formatter functions can return these - if (any(vapply(label, is.call, logical(1)))) { - label <- lapply(label, function(l) { - if (is.call(l)) substitute(expression(x), list(x = l)) - else l - }) - label <- do.call(c, label) - } - grob.label <- element_grob( - element = label.theme, - label = label, - x = x, - y = y, - hjust = hjust, - vjust = vjust, - margin_x = margin_x, - margin_y = margin_y - ) - grob.label <- ggname("guide.label", grob.label) + if (!guide$label || is.null(guide$key$.label)) { + grob.labels <- rep(list(zeroGrob()), nrow(guide$key)) + } else { + # get the defaults for label justification. The defaults are complicated and depend + # on the direction of the legend and on label placement + just_defaults <- label_just_defaults.legend(guide$direction, label.position) + # don't set expressions left-justified + if (just_defaults$hjust == 0 && any(is.expression(guide$key$.label))) just_defaults$hjust <- 1 + + # We break inheritance for hjust and vjust, because that's more intuitive here; it still allows manual + # setting of hjust and vjust if desired. The alternative is to ignore hjust and vjust altogether, which + # seems worse + if (is.null(guide$label.theme$hjust) && is.null(theme$legend.text$hjust)) label.theme$hjust <- NULL + if (is.null(guide$label.theme$vjust) && is.null(theme$legend.text$vjust)) label.theme$vjust <- NULL + + # label.theme in param of guide_legend() > theme$legend.text.align > default + hjust <- guide$label.hjust %||% theme$legend.text.align %||% label.theme$hjust %||% + just_defaults$hjust + vjust <- guide$label.vjust %||% label.theme$vjust %||% + just_defaults$vjust + + grob.labels <- lapply(guide$key$.label, function(label, ...) { + g <- element_grob( + element = label.theme, + label = label, + hjust = hjust, + vjust = vjust, + margin_x = TRUE, + margin_y = TRUE + ) + ggname("guide.label", g) + }) } + break.labels <- grob.labels[-c(1, length(grob.labels))] + range.labels <- grob.labels[c(1, length(grob.labels))] - label_width <- width_cm(grob.label) - label_height <- height_cm(grob.label) - - # make the ticks grob (`grob.ticks`) - if (!guide$ticks) - grob.ticks <-zeroGrob() - else { - if (guide$direction == "horizontal") { - x0 <- rep(tick_pos, 2) - y0 <- c(rep(0, nbreak), rep(barheight * (4/5), nbreak)) - x1 <- rep(tick_pos, 2) - y1 <- c(rep(barheight * (1/5), nbreak), rep(barheight, nbreak)) - } else { # guide$direction == "vertical" - x0 <- c(rep(0, nbreak), rep(barwidth * (4/5), nbreak)) - y0 <- rep(tick_pos, 2) - x1 <- c(rep(barwidth * (1/5), nbreak), rep(barwidth, nbreak)) - y1 <- rep(tick_pos, 2) - } - grob.ticks <- segmentsGrob( - x0 = x0, y0 = y0, x1 = x1, y1 = y1, - default.units = "cm", - gp = gpar( - col = guide$ticks.colour, - lwd = guide$ticks.linewidth, - lineend = "butt" - ) - ) + label_widths <- width_cm(break.labels) + label_heights <- height_cm(break.labels) + + # Keys + key_width <- width_cm( + guide$keywidth %||% theme$legend.key.width %||% theme$legend.key.size + ) + key_height <- height_cm( + guide$keyheight %||% theme$legend.key.height %||% theme$legend.key.size + ) + + key_size_mat <- do.call("cbind", lapply(guide$geoms, function(g) g$data$size / 10)) + if (nrow(key_size_mat) == 0 || ncol(key_size_mat) == 0) { + key_size_mat <- matrix(0, ncol = 1, nrow = nbreak) } + key_sizes <- apply(key_size_mat, 1, max) + key_sizes <- key_sizes[-length(key_sizes)] - # layout of bar and label if (guide$direction == "horizontal") { - if (label.position == "top") { - bl_widths <- barwidth - bl_heights <- c(label_height, vgap, barheight) - vps <- list(bar.row = 3, bar.col = 1, - label.row = 1, label.col = 1) - } else { # label.position == "bottom" or other - bl_widths <- barwidth - bl_heights <- c(barheight, vgap, label_height) - vps <- list(bar.row = 1, bar.col = 1, - label.row = 3, label.col = 1) - } - } else { # guide$direction == "vertical" - if (label.position == "left") { - bl_widths <- c(label_width, hgap, barwidth) - bl_heights <- barheight - vps <- list(bar.row = 1, bar.col = 3, - label.row = 1, label.col = 1) - } else { # label.position == "right" or other - bl_widths <- c(barwidth, hgap, label_width) - bl_heights <- barheight - vps <- list(bar.row = 1, bar.col = 1, - label.row = 1, label.col = 3) - } + legend.nrow <- 1 + legend.ncol <- nbreak + } else { + legend.nrow <- nbreak + legend.ncol <- 1 + } + + key_sizes <- matrix(key_sizes, legend.nrow, legend.ncol) + + key_widths <- pmax(key_width, apply(key_sizes, 2, max)) + key_heights <- pmax(key_height, apply(key_sizes, 1, max)) + + label_widths <- apply( + matrix( + c(label_widths), + legend.nrow, + legend.ncol + ), + 2, + max + ) + label_heights <- apply( + matrix( + c(label_heights), + legend.nrow, + legend.ncol + ), + 1, + max + ) + + if (guide$byrow) { + vps <- new_data_frame(list( + R = ceiling(seq(nbreak) / legend.ncol), + C = (seq(nbreak) - 1) %% legend.ncol + 1 + )) + } else { + vps <- mat_2_df(arrayInd(seq(nbreak), dim(key_sizes)), c("R", "C")) } - # layout of title and bar+label + # layout of key-label depends on the direction of the guide + if (guide$byrow == TRUE) { + switch( + label.position, + "top" = { + kl_widths <- pmax(label_widths, key_widths) + kl_heights <- utils::head( + interleave(label_heights, vgap, key_heights, vgap), + -1 + ) + vps <- transform( + vps, + key.row = R * 4 - 1, + key.col = C, + label.row = R * 4 - 3, + label.col = C + ) + }, + "bottom" = { + kl_widths <- pmax(label_widths, key_widths) + kl_heights <- utils::head( + interleave(key_heights, vgap, label_heights, vgap), + -1 + ) + vps <- transform( + vps, + key.row = R * 4 - 3, + key.col = C, + label.row = R * 4 - 1, + label.col = C + ) + }, + "left" = { + kl_widths <- utils::head( + interleave(label_widths, hgap, key_widths, hgap), + -1 + ) + kl_heights <- utils::head( + interleave(pmax(label_heights, key_heights), vgap), + -1 + ) + vps <- transform( + vps, + key.row = R * 2 - 1, + key.col = C * 4 - 1, + label.row = R * 2 - 1, + label.col = C * 4 - 3 + ) + }, + "right" = { + kl_widths <- utils::head( + interleave(key_widths, hgap, label_widths, hgap), + -1 + ) + kl_heights <- utils::head( + interleave(pmax(label_heights, key_heights), vgap), + -1 + ) + vps <- transform( + vps, + key.row = R * 2 - 1, + key.col = C * 4 - 3, + label.row = R * 2 - 1, + label.col = C * 4 - 1 + ) + }) + } else { + switch( + label.position, + "top" = { + kl_widths <- utils::head( + interleave(pmax(label_widths, key_widths), hgap), + -1 + ) + kl_heights <- utils::head( + interleave(label_heights, vgap, key_heights, vgap), + -1 + ) + vps <- transform( + vps, + key.row = R * 4 - 1, + key.col = C * 2 - 1, + label.row = R * 4 - 3, + label.col = C * 2 - 1 + ) + }, + "bottom" = { + kl_widths <- utils::head( + interleave(pmax(label_widths, key_widths), hgap), + -1 + ) + kl_heights <- utils::head( + interleave(key_heights, vgap, label_heights, vgap), + -1 + ) + vps <- transform( + vps, + key.row = R * 4 - 3, + key.col = C * 2 - 1, + label.row = R * 4 - 1, + label.col = C * 2 - 1 + ) + }, + "left" = { + kl_widths <- utils::head( + interleave(label_widths, hgap, key_widths, hgap), + -1 + ) + kl_heights <- pmax(key_heights, label_heights) + vps <- transform( + vps, + key.row = R, + key.col = C * 4 - 1, + label.row = R, + label.col = C * 4 - 3 + ) + }, + "right" = { + kl_widths <- utils::head( + interleave(key_widths, hgap, label_widths, hgap), + -1 + ) + kl_heights <- pmax(key_heights, label_heights) + vps <- transform( + vps, + key.row = R, + key.col = C * 4 - 3, + label.row = R, + label.col = C * 4 - 1 + ) + }) + } + + # layout the title over key-label switch(guide$title.position, "top" = { - widths <- c(bl_widths, max(0, title_width - sum(bl_widths))) - heights <- c(title_height, vgap, bl_heights) - vps <- with(vps, - list(bar.row = bar.row + 2, bar.col = bar.col, - label.row = label.row + 2, label.col = label.col, - title.row = 1, title.col = 1:length(widths))) + widths <- c(kl_widths, max(0, title_width - sum(kl_widths))) + heights <- c(title_height, vgap, kl_heights) + vps <- transform( + vps, + key.row = key.row + 2, + key.col = key.col, + label.row = label.row + 2, + label.col = label.col + ) + vps.title.row = 1; vps.title.col = 1:length(widths) }, "bottom" = { - widths <- c(bl_widths, max(0, title_width - sum(bl_widths))) - heights <- c(bl_heights, vgap, title_height) - vps <- with(vps, - list(bar.row = bar.row, bar.col = bar.col, - label.row = label.row, label.col = label.col, - title.row = length(heights), title.col = 1:length(widths))) + widths <- c(kl_widths, max(0, title_width - sum(kl_widths))) + heights <- c(kl_heights, vgap, title_height) + vps <- transform( + vps, + key.row = key.row, + key.col = key.col, + label.row = label.row, + label.col = label.col + ) + vps.title.row = length(heights); vps.title.col = 1:length(widths) }, "left" = { - widths <- c(title_width, hgap, bl_widths) - heights <- c(bl_heights, max(0, title_height - sum(bl_heights))) - vps <- with(vps, - list(bar.row = bar.row, bar.col = bar.col + 2, - label.row = label.row, label.col = label.col + 2, - title.row = 1:length(heights), title.col = 1)) + widths <- c(title_width, hgap, kl_widths) + heights <- c(kl_heights, max(0, title_height - sum(kl_heights))) + vps <- transform( + vps, + key.row = key.row, + key.col = key.col + 2, + label.row = label.row, + label.col = label.col + 2 + ) + vps.title.row = 1:length(heights); vps.title.col = 1 }, "right" = { - widths <- c(bl_widths, hgap, title_width) - heights <- c(bl_heights, max(0, title_height - sum(bl_heights))) - vps <- with(vps, - list(bar.row = bar.row, bar.col = bar.col, - label.row = label.row, label.col = label.col, - title.row = 1:length(heights), title.col = length(widths))) + widths <- c(kl_widths, hgap, title_width) + heights <- c(kl_heights, max(0, title_height - sum(kl_heights))) + vps <- transform( + vps, + key.row = key.row, + key.col = key.col, + label.row = label.row, + label.col = label.col + ) + vps.title.row = 1:length(heights); vps.title.col = length(widths) }) + # grob for key + key_size <- c(key_width, key_height) * 10 + + draw_key <- function(i) { + bg <- element_render(theme, "legend.key") + keys <- lapply(guide$geoms, function(g) { + g$draw_key(g$data[i, ], g$params, key_size) + }) + c(list(bg), keys) + } + grob.keys <- unlist(lapply(seq_len(nbreak), draw_key), recursive = FALSE) + # background grob.background <- element_render(theme, "legend.background") + ngeom <- length(guide$geoms) + 1 + kcols <- rep(vps$key.col, each = ngeom) + krows <- rep(vps$key.row, each = ngeom) + # padding padding <- convertUnit(theme$legend.margin %||% margin(), "cm", valueOnly = TRUE) widths <- c(padding[4], widths, padding[2]) heights <- c(padding[1], heights, padding[3]) + # Create the gtable for the legend gt <- gtable(widths = unit(widths, "cm"), heights = unit(heights, "cm")) - gt <- gtable_add_grob(gt, grob.background, name = "background", clip = "off", - t = 1, r = -1, b = -1, l = 1) - gt <- gtable_add_grob(gt, grob.bar, name = "bar", clip = "off", - t = 1 + min(vps$bar.row), r = 1 + max(vps$bar.col), - b = 1 + max(vps$bar.row), l = 1 + min(vps$bar.col)) gt <- gtable_add_grob( gt, - grob.label, - name = "label", + grob.background, + name = "background", clip = "off", - t = 1 + min(vps$label.row), r = 1 + max(vps$label.col), - b = 1 + max(vps$label.row), l = 1 + min(vps$label.col)) + t = 1, + r = -1, + b = -1, + l = 1 + ) gt <- gtable_add_grob( gt, justify_grobs( @@ -513,11 +551,36 @@ guide_gengrob.bins <- function(guide, theme) { ), name = "title", clip = "off", - t = 1 + min(vps$title.row), r = 1 + max(vps$title.col), - b = 1 + max(vps$title.row), l = 1 + min(vps$title.col)) - gt <- gtable_add_grob(gt, grob.ticks, name = "ticks", clip = "off", - t = 1 + min(vps$bar.row), r = 1 + max(vps$bar.col), - b = 1 + max(vps$bar.row), l = 1 + min(vps$bar.col)) - + t = 1 + min(vps.title.row), + r = 1 + max(vps.title.col), + b = 1 + max(vps.title.row), + l = 1 + min(vps.title.col) + ) + gt <- gtable_add_grob( + gt, + grob.keys, + name = paste("key", krows, kcols, c("bg", seq(ngeom - 1)), sep = "-"), + clip = "off", + t = 1 + krows, + r = 1 + kcols, + b = 1 + krows, + l = 1 + kcols + ) + gt <- gtable_add_grob( + gt, + justify_grobs( + grob.labels, + hjust = hjust, + vjust = vjust, + int_angle = label.theme$angle, + debug = label.theme$debug + ), + name = paste("label", vps$label.row, vps$label.col, sep = "-"), + clip = "off", + t = vps$label.row, + r = 1 + vps$label.col, + b = 1 + vps$label.row, + l = 1 + vps$label.col + ) gt } From b7cda3c3bc71459315970e88737df2c9f59189fd Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Tue, 24 Sep 2019 11:21:18 +0200 Subject: [PATCH 16/30] Fix argument names to be dot.case --- R/guide-colorbar.r | 14 +++++++------- R/scale-.r | 22 +++++++++++----------- R/scale-binned.R | 14 +++++++------- man/binned_scale.Rd | 8 ++++---- man/guide_colourbar.Rd | 8 ++++---- man/scale_binned.Rd | 12 ++++++------ 6 files changed, 39 insertions(+), 39 deletions(-) diff --git a/R/guide-colorbar.r b/R/guide-colorbar.r index d8c0272301..f815767f8f 100644 --- a/R/guide-colorbar.r +++ b/R/guide-colorbar.r @@ -570,14 +570,14 @@ guide_colorbar <- guide_colourbar #' @export #' @rdname guide_colourbar #' -#' @param even_steps Should the bin sizes reflect their size or be even across all +#' @param even.steps Should the bin sizes reflect their size or be even across all #' bins? Defaults to `TRUE` -#' @param show_limits Should labels for the outer limits of the bins be printed? +#' @param show.limits Should labels for the outer limits of the bins be printed? #' Default is `NULL` which makes the guide use the setting from the scale -guide_coloursteps <- function(even_steps = TRUE, show_limits = NULL, ticks = FALSE, nbin = 100, ...) { +guide_coloursteps <- function(even.steps = TRUE, show.limits = NULL, ticks = FALSE, nbin = 100, ...) { guide <- guide_colourbar(raster = FALSE, ticks = ticks, nbin = nbin, ...) - guide$even_steps <- even_steps - guide$show_limits <- show_limits + guide$even.steps <- even.steps + guide$show.limits <- show.limits class(guide) <- c('colorsteps', class(guide)) guide } @@ -587,7 +587,7 @@ guide_colorsteps <- guide_coloursteps #' @export guide_train.colorsteps <- function(guide, scale, aesthetic = NULL) { - if (guide$even_steps) { + if (guide$even.steps) { breaks <- scale$get_breaks() if (length(breaks) == 0 || all(is.na(breaks))) return() @@ -608,7 +608,7 @@ guide_train.colorsteps <- function(guide, scale, aesthetic = NULL) { } else { guide <- NextMethod() } - if (guide$show_limits %||% scale$show_limits %||% FALSE) { + if (guide$show.limits %||% scale$show.limits %||% FALSE) { edges <- rescale(c(0, 1), to = guide$bar$value[c(1, nrow(guide$bar))], from = c(0.5, guide$nbin - 0.5) / guide$nbin) limits <- scale$get_limits() guide$key <- guide$key[c(NA, seq_len(nrow(guide$key)), NA), , drop = FALSE] diff --git a/R/scale-.r b/R/scale-.r index d470e57aed..bc5dcb7d0e 100644 --- a/R/scale-.r +++ b/R/scale-.r @@ -824,10 +824,10 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, range = continuous_range(), na.value = NA_real_, oob = squish, - n_breaks = NULL, + n.breaks = NULL, right = TRUE, after_stat = FALSE, - show_limits = FALSE, + show.limits = FALSE, is_discrete = function() FALSE, @@ -890,9 +890,9 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, } else if (identical(self$breaks, NA)) { stop("Invalid breaks specification. Use NULL, not NA", call. = FALSE) } else if (is.waive(self$breaks)) { - if (!is.null(self$n_breaks)) { + if (!is.null(self$n.breaks)) { old_n <- get("n", environment(self$trans$breaks)) - assign("n", self$n_breaks, environment(self$trans$breaks)) + assign("n", self$n.breaks, environment(self$trans$breaks)) on.exit(assign("n", old_n, environment(self$trans$breaks))) } breaks <- self$trans$breaks(limits) @@ -972,7 +972,7 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, pal <- self$palette(length(major) + 1) } - if (self$show_limits) { + if (self$show.limits) { limits <- self$get_limits() major <- sort(unique(c(limits, major))) } @@ -1154,18 +1154,18 @@ discrete_scale <- function(aesthetics, scale_name, palette, name = waiver(), #' Binning scale constructor #' #' @inheritParams continuous_scale -#' @param n_breaks The number of break points to create if breaks are not given +#' @param n.breaks The number of break points to create if breaks are not given #' directly. It will attempt to find nice breakpoint and may thus not give the #' exact number of breaks as requested. #' @param right Should values on the border between bins be part of the right #' (upper) bin? -#' @param show_limits should the limits of the scale appear as ticks +#' @param show.limits should the limits of the scale appear as ticks #' @keywords internal binned_scale <- function(aesthetics, scale_name, palette, name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, oob = squish, expand = waiver(), na.value = NA_real_, - n_breaks = 7, right = TRUE, trans = "identity", - show_limits = FALSE, guide = "legend", position = "left", + n.breaks = 7, right = TRUE, trans = "identity", + show.limits = FALSE, guide = "legend", position = "left", super = ScaleBinned) { aesthetics <- standardise_aes_names(aesthetics) @@ -1196,9 +1196,9 @@ binned_scale <- function(aesthetics, scale_name, palette, name = waiver(), na.value = na.value, expand = expand, oob = oob, - n_breaks = n_breaks, + n.breaks = n.breaks, right = right, - show_limits = show_limits, + show.limits = show.limits, name = name, breaks = breaks, diff --git a/R/scale-binned.R b/R/scale-binned.R index 2882e7839d..ed948eaa81 100644 --- a/R/scale-binned.R +++ b/R/scale-binned.R @@ -21,15 +21,15 @@ NULL #' @rdname scale_binned #' #' @export -scale_x_binned <- function(name = waiver(), n_breaks = 10, breaks = waiver(), +scale_x_binned <- function(name = waiver(), n.breaks = 10, breaks = waiver(), labels = waiver(), limits = NULL, expand = waiver(), oob = squish, na.value = NA_real_, right = TRUE, - show_limits = FALSE, trans = "identity", position = "bottom") { + show.limits = FALSE, trans = "identity", position = "bottom") { binned_scale( aesthetics = c("x", "xmin", "xmax", "xend", "xintercept", "xmin_final", "xmax_final", "xlower", "xmiddle", "xupper"), scale_name = "position_b", palette = identity, name = name, breaks = breaks, labels = labels, limits = limits, expand = expand, oob = oob, na.value = na.value, - n_breaks = n_breaks, right = right, trans = trans, show_limits = show_limits, + n.breaks = n.breaks, right = right, trans = trans, show.limits = show.limits, guide = "none", position = position, super = ScaleBinnedPosition ) } @@ -37,15 +37,15 @@ scale_x_binned <- function(name = waiver(), n_breaks = 10, breaks = waiver(), #' @rdname scale_binned #' #' @export -scale_y_binned <- function(name = waiver(), n_breaks = 10, breaks = waiver(), +scale_y_binned <- function(name = waiver(), n.breaks = 10, breaks = waiver(), labels = waiver(), limits = NULL, expand = waiver(), oob = squish, na.value = NA_real_, right = TRUE, - show_limits = FALSE, trans = "identity", position = "left") { + show.limits = FALSE, trans = "identity", position = "left") { binned_scale( aesthetics = c("y", "ymin", "ymax", "yend", "yintercept", "ymin_final", "ymax_final", "lower", "middle", "upper"), scale_name = "position_b", palette = identity, name = name, breaks = breaks, labels = labels, limits = limits, expand = expand, oob = oob, na.value = na.value, - n_breaks = n_breaks, right = right, trans = trans, show_limits = show_limits, + n.breaks = n.breaks, right = right, trans = trans, show.limits = show.limits, guide = "none", position = position, super = ScaleBinnedPosition ) } @@ -97,7 +97,7 @@ ScaleBinnedPosition <- ggproto("ScaleBinnedPosition", ScaleBinned, # major breaks major <- self$get_breaks(range) - if (self$show_limits) { + if (self$show.limits) { limits <- self$get_limits() major <- sort(unique(c(limits, major))) } diff --git a/man/binned_scale.Rd b/man/binned_scale.Rd index a683d55dc6..6c4364e2fc 100644 --- a/man/binned_scale.Rd +++ b/man/binned_scale.Rd @@ -7,8 +7,8 @@ binned_scale(aesthetics, scale_name, palette, name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, oob = squish, expand = waiver(), na.value = NA_real_, - n_breaks = 7, right = TRUE, trans = "identity", - show_limits = FALSE, guide = "legend", position = "left", + n.breaks = 7, right = TRUE, trans = "identity", + show.limits = FALSE, guide = "legend", position = "left", super = ScaleBinned) } \arguments{ @@ -77,7 +77,7 @@ expand the scale by 5\% on each side for continuous variables, and by \item{na.value}{Missing values will be replaced with this value.} -\item{n_breaks}{The number of break points to create if breaks are not given +\item{n.breaks}{The number of break points to create if breaks are not given directly. It will attempt to find nice breakpoint and may thus not give the exact number of breaks as requested.} @@ -96,7 +96,7 @@ are defined in the scales package, and are called \code{_trans} (e.g., \code{\link[scales:boxcox_trans]{scales::boxcox_trans()}}). You can create your own transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} -\item{show_limits}{should the limits of the scale appear as ticks} +\item{show.limits}{should the limits of the scale appear as ticks} \item{guide}{A function used to create a guide or its name. See \code{\link[=guides]{guides()}} for more information.} diff --git a/man/guide_colourbar.Rd b/man/guide_colourbar.Rd index a739fc91ef..6fc3e0a239 100644 --- a/man/guide_colourbar.Rd +++ b/man/guide_colourbar.Rd @@ -29,10 +29,10 @@ guide_colorbar(title = waiver(), title.position = NULL, reverse = FALSE, order = 0, available_aes = c("colour", "color", "fill"), ...) -guide_coloursteps(even_steps = TRUE, show_limits = NULL, +guide_coloursteps(even.steps = TRUE, show.limits = NULL, ticks = FALSE, nbin = 100, ...) -guide_colorsteps(even_steps = TRUE, show_limits = NULL, +guide_colorsteps(even.steps = TRUE, show.limits = NULL, ticks = FALSE, nbin = 100, ...) } \arguments{ @@ -129,10 +129,10 @@ for which a colourbar can be drawn.} \item{...}{ignored.} -\item{even_steps}{Should the bin sizes reflect their size or be even across all +\item{even.steps}{Should the bin sizes reflect their size or be even across all bins? Defaults to \code{TRUE}} -\item{show_limits}{Should labels for the outer limits of the bins be printed? +\item{show.limits}{Should labels for the outer limits of the bins be printed? Default is \code{NULL} which makes the guide use the setting from the scale} } \value{ diff --git a/man/scale_binned.Rd b/man/scale_binned.Rd index 6cae40d280..69e1eb79b1 100644 --- a/man/scale_binned.Rd +++ b/man/scale_binned.Rd @@ -5,15 +5,15 @@ \alias{scale_y_binned} \title{Positional scales for binning continuous data (x & y)} \usage{ -scale_x_binned(name = waiver(), n_breaks = 10, breaks = waiver(), +scale_x_binned(name = waiver(), n.breaks = 10, breaks = waiver(), labels = waiver(), limits = NULL, expand = waiver(), oob = squish, na.value = NA_real_, right = TRUE, - show_limits = FALSE, trans = "identity", position = "bottom") + show.limits = FALSE, trans = "identity", position = "bottom") -scale_y_binned(name = waiver(), n_breaks = 10, breaks = waiver(), +scale_y_binned(name = waiver(), n.breaks = 10, breaks = waiver(), labels = waiver(), limits = NULL, expand = waiver(), oob = squish, na.value = NA_real_, right = TRUE, - show_limits = FALSE, trans = "identity", position = "left") + show.limits = FALSE, trans = "identity", position = "left") } \arguments{ \item{name}{The name of the scale. Used as the axis or legend title. If @@ -21,7 +21,7 @@ scale_y_binned(name = waiver(), n_breaks = 10, breaks = waiver(), mapping used for that aesthetic. If \code{NULL}, the legend title will be omitted.} -\item{n_breaks}{The number of break points to create if breaks are not given +\item{n.breaks}{The number of break points to create if breaks are not given directly. It will attempt to find nice breakpoint and may thus not give the exact number of breaks as requested.} @@ -79,7 +79,7 @@ bounds values with \code{NA}. \item{right}{Should values on the border between bins be part of the right (upper) bin?} -\item{show_limits}{should the limits of the scale appear as ticks} +\item{show.limits}{should the limits of the scale appear as ticks} \item{trans}{For continuous scales, the name of a transformation object or the object itself. Built-in transformations include "asn", "atanh", From cb1dab66a5c90561bba42665cf7af2c06d05a8e5 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Tue, 24 Sep 2019 11:22:07 +0200 Subject: [PATCH 17/30] Working version of guide_bins --- R/guide-bins.R | 407 +++++++++++++++++-------------------------------- 1 file changed, 144 insertions(+), 263 deletions(-) diff --git a/R/guide-bins.R b/R/guide-bins.R index 34cd4e6d88..7b6e4aeeb8 100644 --- a/R/guide-bins.R +++ b/R/guide-bins.R @@ -13,19 +13,14 @@ guide_bins <- function( label.hjust = NULL, label.vjust = NULL, - # bar - barwidth = NULL, - barheight = NULL, + # key + keywidth = NULL, + keyheight = NULL, - # frame - frame.colour = NULL, - frame.linewidth = 0.5, - frame.linetype = 1, - - # divider - divider.colour = NULL, - divider.linewidth = 0.5, - divider.linetype = 1, + # ticks + ticks = TRUE, + ticks.colour = "black", + ticks.linewidth = 0.5, # general direction = NULL, @@ -33,15 +28,9 @@ guide_bins <- function( override.aes = list(), reverse = FALSE, order = 0, + show.limits = NULL, ...) { - if (!is.null(barwidth) && !is.unit(barwidth)) { - barwidth <- unit(barwidth, default.unit) - } - if (!is.null(barheight) && !is.unit(barheight)) { - barheight <- unit(barheight, default.unit) - } - structure(list( # title title = title, @@ -57,25 +46,21 @@ guide_bins <- function( label.hjust = label.hjust, label.vjust = label.vjust, - # bar - barwidth = barwidth, - barheight = barheight, + # key + keywidth = keywidth, + keyheight = keyheight, - # frame - frame.colour = frame.colour, - frame.linewidth = frame.linewidth, - frame.linetype = frame.linetype, - - # divider - divider.colour = divider.colour, - divider.linewidth = divider.linewidth, - divider.linetype = divider.linetype, + # ticks + ticks = ticks, + ticks.colour = ticks.colour, + ticks.linewidth = ticks.linewidth, # general direction = direction, default.unit = default.unit, reverse = reverse, order = order, + show.limits = show.limits, # parameter available_aes = c("any"), @@ -100,6 +85,10 @@ guide_train.bins <- function(guide, scale, aesthetic = NULL) { aes_column_name <- aesthetic %||% scale$aesthetics[1] key <- new_data_frame(setNames(list(c(scale$map(bin_at), NA)), aes_column_name)) key$.label <- scale$get_labels(all_breaks) + guide$show.limits <- guide$show.limits %||% scale$show_limits %||% FALSE + if (!guide$show.limits) { + key$.label[c(1, nrow(key))] <- NA + } if (guide$reverse) key <- key[nrow(key):1, ] @@ -188,8 +177,7 @@ guide_gengrob.bins <- function(guide, theme) { if (!label.position %in% c("top", "bottom", "left", "right")) stop("label position \"", label.position, "\" is invalid") - nbreak <- nrow(guide$key) - 1 - guide$byrow <- FALSE + n_keys <- nrow(guide$key) - 1 # obtain the theme for the legend title. We need this both for the title grob # and to obtain the title fontsize. @@ -257,12 +245,13 @@ guide_gengrob.bins <- function(guide, theme) { ) ggname("guide.label", g) }) + if (!guide$show.limits) { + grob.labels[c(1, length(grob.labels))] <- list(zeroGrob()) + } } - break.labels <- grob.labels[-c(1, length(grob.labels))] - range.labels <- grob.labels[c(1, length(grob.labels))] - label_widths <- width_cm(break.labels) - label_heights <- height_cm(break.labels) + label_widths <- width_cm(grob.labels) + label_heights <- height_cm(grob.labels) # Keys key_width <- width_cm( @@ -272,237 +261,90 @@ guide_gengrob.bins <- function(guide, theme) { guide$keyheight %||% theme$legend.key.height %||% theme$legend.key.size ) - key_size_mat <- do.call("cbind", lapply(guide$geoms, function(g) g$data$size / 10)) + key_size_mat <- do.call("cbind", + lapply(guide$geoms, function(g) g$data$size / 10) + )[seq_len(n_keys), , drop = FALSE] + if (nrow(key_size_mat) == 0 || ncol(key_size_mat) == 0) { - key_size_mat <- matrix(0, ncol = 1, nrow = nbreak) + key_size_mat <- matrix(0, ncol = 1, nrow = n_keys) } key_sizes <- apply(key_size_mat, 1, max) - key_sizes <- key_sizes[-length(key_sizes)] if (guide$direction == "horizontal") { - legend.nrow <- 1 - legend.ncol <- nbreak + key.nrow <- 1 + key.ncol <- n_keys + label.nrow <- 1 + label.ncol <- n_keys + 1 } else { - legend.nrow <- nbreak - legend.ncol <- 1 + key.nrow <- n_keys + key.ncol <- 1 + label.nrow <- n_keys + 1 + label.ncol <- 1 } - key_sizes <- matrix(key_sizes, legend.nrow, legend.ncol) + key_sizes <- matrix(key_sizes, key.nrow, key.ncol) + label_sizes <- matrix(label_widths, label.nrow, label.ncol) - key_widths <- pmax(key_width, apply(key_sizes, 2, max)) - key_heights <- pmax(key_height, apply(key_sizes, 1, max)) + key_widths <- max(key_width, apply(key_sizes, 2, max)) + key_heights <- max(key_height, apply(key_sizes, 1, max)) - label_widths <- apply( - matrix( - c(label_widths), - legend.nrow, - legend.ncol - ), - 2, - max + label_widths <- max(apply(label_sizes, 2, max)) + label_heights <- max(apply(label_sizes, 1, max)) + + key_loc <- data_frame( + R = seq(2, by = 2, length.out = n_keys), + C = 1 ) - label_heights <- apply( - matrix( - c(label_heights), - legend.nrow, - legend.ncol - ), - 1, - max + label_loc <- data_frame( + R = seq(1, by = 2, length.out = n_keys + 1), + C = 3 ) + tick_loc <- label_loc + tick_loc$C <- 1 - if (guide$byrow) { - vps <- new_data_frame(list( - R = ceiling(seq(nbreak) / legend.ncol), - C = (seq(nbreak) - 1) %% legend.ncol + 1 - )) - } else { - vps <- mat_2_df(arrayInd(seq(nbreak), dim(key_sizes)), c("R", "C")) - } - - # layout of key-label depends on the direction of the guide - if (guide$byrow == TRUE) { - switch( - label.position, - "top" = { - kl_widths <- pmax(label_widths, key_widths) - kl_heights <- utils::head( - interleave(label_heights, vgap, key_heights, vgap), - -1 - ) - vps <- transform( - vps, - key.row = R * 4 - 1, - key.col = C, - label.row = R * 4 - 3, - label.col = C - ) - }, - "bottom" = { - kl_widths <- pmax(label_widths, key_widths) - kl_heights <- utils::head( - interleave(key_heights, vgap, label_heights, vgap), - -1 - ) - vps <- transform( - vps, - key.row = R * 4 - 3, - key.col = C, - label.row = R * 4 - 1, - label.col = C - ) - }, - "left" = { - kl_widths <- utils::head( - interleave(label_widths, hgap, key_widths, hgap), - -1 - ) - kl_heights <- utils::head( - interleave(pmax(label_heights, key_heights), vgap), - -1 - ) - vps <- transform( - vps, - key.row = R * 2 - 1, - key.col = C * 4 - 1, - label.row = R * 2 - 1, - label.col = C * 4 - 3 - ) - }, - "right" = { - kl_widths <- utils::head( - interleave(key_widths, hgap, label_widths, hgap), - -1 - ) - kl_heights <- utils::head( - interleave(pmax(label_heights, key_heights), vgap), - -1 - ) - vps <- transform( - vps, - key.row = R * 2 - 1, - key.col = C * 4 - 3, - label.row = R * 2 - 1, - label.col = C * 4 - 1 - ) - }) - } else { - switch( - label.position, - "top" = { - kl_widths <- utils::head( - interleave(pmax(label_widths, key_widths), hgap), - -1 - ) - kl_heights <- utils::head( - interleave(label_heights, vgap, key_heights, vgap), - -1 - ) - vps <- transform( - vps, - key.row = R * 4 - 1, - key.col = C * 2 - 1, - label.row = R * 4 - 3, - label.col = C * 2 - 1 - ) - }, - "bottom" = { - kl_widths <- utils::head( - interleave(pmax(label_widths, key_widths), hgap), - -1 - ) - kl_heights <- utils::head( - interleave(key_heights, vgap, label_heights, vgap), - -1 - ) - vps <- transform( - vps, - key.row = R * 4 - 3, - key.col = C * 2 - 1, - label.row = R * 4 - 1, - label.col = C * 2 - 1 - ) - }, - "left" = { - kl_widths <- utils::head( - interleave(label_widths, hgap, key_widths, hgap), - -1 - ) - kl_heights <- pmax(key_heights, label_heights) - vps <- transform( - vps, - key.row = R, - key.col = C * 4 - 1, - label.row = R, - label.col = C * 4 - 3 - ) - }, - "right" = { - kl_widths <- utils::head( - interleave(key_widths, hgap, label_widths, hgap), - -1 - ) - kl_heights <- pmax(key_heights, label_heights) - vps <- transform( - vps, - key.row = R, - key.col = C * 4 - 3, - label.row = R, - label.col = C * 4 - 1 - ) - }) + widths <- c(key_widths, hgap, label_widths) + heights <- c(interleave(rep(0, n_keys), key_heights), 0) + if (guide$direction == "horizontal") { + names(key_loc) <- c("C", "R") + names(label_loc) <- c("C", "R") + names(tick_loc) <- c("C", "R") + heights <- c(key_heights, vgap, label_heights) + widths <- c(interleave(rep(0, n_keys), key_widths), 0) } # layout the title over key-label switch(guide$title.position, - "top" = { - widths <- c(kl_widths, max(0, title_width - sum(kl_widths))) - heights <- c(title_height, vgap, kl_heights) - vps <- transform( - vps, - key.row = key.row + 2, - key.col = key.col, - label.row = label.row + 2, - label.col = label.col - ) - vps.title.row = 1; vps.title.col = 1:length(widths) - }, - "bottom" = { - widths <- c(kl_widths, max(0, title_width - sum(kl_widths))) - heights <- c(kl_heights, vgap, title_height) - vps <- transform( - vps, - key.row = key.row, - key.col = key.col, - label.row = label.row, - label.col = label.col - ) - vps.title.row = length(heights); vps.title.col = 1:length(widths) - }, - "left" = { - widths <- c(title_width, hgap, kl_widths) - heights <- c(kl_heights, max(0, title_height - sum(kl_heights))) - vps <- transform( - vps, - key.row = key.row, - key.col = key.col + 2, - label.row = label.row, - label.col = label.col + 2 - ) - vps.title.row = 1:length(heights); vps.title.col = 1 - }, - "right" = { - widths <- c(kl_widths, hgap, title_width) - heights <- c(kl_heights, max(0, title_height - sum(kl_heights))) - vps <- transform( - vps, - key.row = key.row, - key.col = key.col, - label.row = label.row, - label.col = label.col - ) - vps.title.row = 1:length(heights); vps.title.col = length(widths) - }) + "top" = { + widths <- c(widths, max(0, title_width - sum(widths))) + heights <- c(title_height, vgap, heights) + key_loc$R <- key_loc$R + 2 + label_loc$R <- label_loc$R + 2 + tick_loc$R <- tick_loc$R + 2 + title_row = 1 + title_col = seq_along(widths) + }, + "bottom" = { + widths <- c(widths, max(0, title_width - sum(widths))) + heights <- c(heights, vgap, title_height) + title_row = length(heights) + title_col = seq_along(widths) + }, + "left" = { + widths <- c(title_width, hgap, widths) + heights <- c(heights, max(0, title_height - sum(heights))) + key_loc$C <- key_loc$C + 2 + label_loc$C <- label_loc$C + 2 + tick_loc$C <- tick_loc$C + 2 + title_row = seq_along(heights) + title_col = 1 + }, + "right" = { + widths <- c(widths, hgap, title_width) + heights <- c(heights, max(0, title_height - sum(heights))) + title_row = seq_along(heights) + title_col = length(widths) + } + ) # grob for key key_size <- c(key_width, key_height) * 10 @@ -514,20 +356,49 @@ guide_gengrob.bins <- function(guide, theme) { }) c(list(bg), keys) } - grob.keys <- unlist(lapply(seq_len(nbreak), draw_key), recursive = FALSE) + grob.keys <- unlist(lapply(seq_len(n_keys), draw_key), recursive = FALSE) # background grob.background <- element_render(theme, "legend.background") ngeom <- length(guide$geoms) + 1 - kcols <- rep(vps$key.col, each = ngeom) - krows <- rep(vps$key.row, each = ngeom) + kcols <- rep(key_loc$C, each = ngeom) + krows <- rep(key_loc$R, each = ngeom) # padding padding <- convertUnit(theme$legend.margin %||% margin(), "cm", valueOnly = TRUE) widths <- c(padding[4], widths, padding[2]) heights <- c(padding[1], heights, padding[3]) + # make the ticks grob (`grob.ticks`) + if (!guide$ticks) + grob.ticks <- zeroGrob() + else { + if (guide$direction == "horizontal") { + x0 <- rep(0.5, 2) + y0 <- c(0, 4/5) + x1 <- rep(0.5, 2) + y1 <- c(1/5, 1) + } else { # guide$direction == "vertical" + y0 <- rep(0.5, 2) + x0 <- c(0, 4/5) + y1 <- rep(0.5, 2) + x1 <- c(1/5, 1) + } + grob.ticks <- segmentsGrob( + x0 = x0, y0 = y0, x1 = x1, y1 = y1, + default.units = "npc", + gp = gpar( + col = guide$ticks.colour, + lwd = guide$ticks.linewidth, + lineend = "butt" + ) + ) + } + grob.ticks <- rep_len(list(grob.ticks), length(grob.labels)) + if (!guide$show.limits) { + grob.ticks[c(1, length(grob.ticks))] <- list(zeroGrob()) + } # Create the gtable for the legend gt <- gtable(widths = unit(widths, "cm"), heights = unit(heights, "cm")) gt <- gtable_add_grob( @@ -551,10 +422,10 @@ guide_gengrob.bins <- function(guide, theme) { ), name = "title", clip = "off", - t = 1 + min(vps.title.row), - r = 1 + max(vps.title.col), - b = 1 + max(vps.title.row), - l = 1 + min(vps.title.col) + t = 1 + min(title_row), + r = 1 + max(title_col), + b = 1 + max(title_row), + l = 1 + min(title_col) ) gt <- gtable_add_grob( gt, @@ -566,6 +437,16 @@ guide_gengrob.bins <- function(guide, theme) { b = 1 + krows, l = 1 + kcols ) + gt <- gtable_add_grob( + gt, + grob.ticks, + name = paste("label", tick_loc$R, tick_loc$C, sep = "-"), + clip = "off", + t = 1 + tick_loc$R, + r = 1 + tick_loc$C, + b = 1 + tick_loc$R, + l = 1 + tick_loc$C + ) gt <- gtable_add_grob( gt, justify_grobs( @@ -575,12 +456,12 @@ guide_gengrob.bins <- function(guide, theme) { int_angle = label.theme$angle, debug = label.theme$debug ), - name = paste("label", vps$label.row, vps$label.col, sep = "-"), + name = paste("label", label_loc$R, label_loc$C, sep = "-"), clip = "off", - t = vps$label.row, - r = 1 + vps$label.col, - b = 1 + vps$label.row, - l = 1 + vps$label.col + t = 1 + label_loc$R, + r = 1 + label_loc$C, + b = 1 + label_loc$R, + l = 1 + label_loc$C ) gt } From a7d791f8106bbba146eb5017cf50fb37dd5d68d9 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Tue, 24 Sep 2019 21:25:50 +0200 Subject: [PATCH 18/30] Fix weird duplication of scale constructors --- R/scale-.r | 281 +++++++++++------------------------------------------ 1 file changed, 58 insertions(+), 223 deletions(-) diff --git a/R/scale-.r b/R/scale-.r index bc5dcb7d0e..c87a588267 100644 --- a/R/scale-.r +++ b/R/scale-.r @@ -186,6 +186,64 @@ discrete_scale <- function(aesthetics, scale_name, palette, name = waiver(), ) } +#' Binning scale constructor +#' +#' @inheritParams continuous_scale +#' @param n.breaks The number of break points to create if breaks are not given +#' directly. It will attempt to find nice breakpoint and may thus not give the +#' exact number of breaks as requested. +#' @param right Should values on the border between bins be part of the right +#' (upper) bin? +#' @param show.limits should the limits of the scale appear as ticks +#' @keywords internal +binned_scale <- function(aesthetics, scale_name, palette, name = waiver(), + breaks = waiver(), labels = waiver(), limits = NULL, + oob = squish, expand = waiver(), na.value = NA_real_, + n.breaks = 7, right = TRUE, trans = "identity", + show.limits = FALSE, guide = "bins", position = "left", + super = ScaleBinned) { + + aesthetics <- standardise_aes_names(aesthetics) + + check_breaks_labels(breaks, labels) + + position <- match.arg(position, c("left", "right", "top", "bottom")) + + if (is.null(breaks) && !is_position_aes(aesthetics) && guide != "none") { + guide <- "none" + } + + trans <- as.trans(trans) + if (!is.null(limits)) { + limits <- trans$transform(limits) + } + + ggproto(NULL, super, + call = match.call(), + + aesthetics = aesthetics, + scale_name = scale_name, + palette = palette, + + range = continuous_range(), + limits = limits, + trans = trans, + na.value = na.value, + expand = expand, + oob = oob, + n.breaks = n.breaks, + right = right, + show.limits = show.limits, + + name = name, + breaks = breaks, + + labels = labels, + guide = guide, + position = position + ) +} + #' @section Scales: #' #' All `scale_*` functions like [scale_x_continuous()] return a `Scale*` @@ -986,229 +1044,6 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, } ) -#' Continuous scale constructor. -#' -#' @export -#' @param aesthetics The names of the aesthetics that this scale works with -#' @param scale_name The name of the scale -#' @param palette A palette function that when called with a numeric vector with -#' values between 0 and 1 returns the corresponding values in the range the -#' scale maps to. -#' @param name The name of the scale. Used as the axis or legend title. If -#' `waiver()`, the default, the name of the scale is taken from the first -#' mapping used for that aesthetic. If `NULL`, the legend title will be -#' omitted. -#' @param breaks One of: -#' - `NULL` for no breaks -#' - `waiver()` for the default breaks computed by the -#' transformation object -#' - A numeric vector of positions -#' - A function that takes the limits as input and returns breaks -#' as output -#' @param minor_breaks One of: -#' - `NULL` for no minor breaks -#' - `waiver()` for the default breaks (one minor break between -#' each major break) -#' - A numeric vector of positions -#' - A function that given the limits returns a vector of minor breaks. -#' @param labels One of: -#' - `NULL` for no labels -#' - `waiver()` for the default labels computed by the -#' transformation object -#' - 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 limits A numeric vector of length two providing limits of the scale. -#' Use `NA` to refer to the existing minimum or maximum. -#' @param rescaler Used by diverging and n colour gradients -#' (i.e. [scale_colour_gradient2()], [scale_colour_gradientn()]). -#' A function used to scale the input values to the range \[0, 1]. -#' @param oob Function that handles limits outside of the scale limits -#' (out of bounds). The default replaces out of bounds values with `NA`. -#' @inheritParams scale_x_discrete -#' @param na.value Missing values will be replaced with this value. -#' @param trans Either the name of a transformation object, or the -#' object itself. Built-in transformations include "asn", "atanh", -#' "boxcox", "exp", "identity", "log", "log10", "log1p", "log2", -#' "logit", "probability", "probit", "reciprocal", "reverse" and "sqrt". -#' -#' A transformation object bundles together a transform, its inverse, -#' and methods for generating breaks and labels. Transformation objects -#' are defined in the scales package, and are called `name_trans`, e.g. -#' [scales::boxcox_trans()]. You can create your own -#' transformation with [scales::trans_new()]. -#' @param guide A function used to create a guide or its name. See -#' [guides()] for more info. -#' @param position The position of the axis. "left" or "right" for vertical -#' scales, "top" or "bottom" for horizontal scales -#' @param super The super class to use for the constructed scale -#' @keywords internal -continuous_scale <- function(aesthetics, scale_name, palette, name = waiver(), - breaks = waiver(), minor_breaks = waiver(), labels = waiver(), limits = NULL, - rescaler = rescale, oob = censor, expand = waiver(), na.value = NA_real_, - trans = "identity", guide = "legend", position = "left", super = ScaleContinuous) { - - aesthetics <- standardise_aes_names(aesthetics) - - check_breaks_labels(breaks, labels) - - position <- match.arg(position, c("left", "right", "top", "bottom")) - - if (is.null(breaks) && !is_position_aes(aesthetics) && guide != "none") { - guide <- "none" - } - - trans <- as.trans(trans) - if (!is.null(limits)) { - limits <- trans$transform(limits) - } - - ggproto(NULL, super, - call = match.call(), - - aesthetics = aesthetics, - scale_name = scale_name, - palette = palette, - - range = continuous_range(), - limits = limits, - trans = trans, - na.value = na.value, - expand = expand, - rescaler = rescaler, # Used by diverging and n colour gradients - oob = oob, - - name = name, - breaks = breaks, - minor_breaks = minor_breaks, - - labels = labels, - guide = guide, - position = position - ) -} - -#' Discrete scale constructor. -#' -#' @export -#' @inheritParams continuous_scale -#' @param palette A palette function that when called with a single integer -#' argument (the number of levels in the scale) returns the values that -#' they should take. -#' @param breaks One of: -#' - `NULL` for no breaks -#' - `waiver()` for the default breaks computed by the -#' transformation object -#' - A character vector of breaks -#' - A function that takes the limits as input and returns breaks -#' as output -#' @param limits A character vector that defines possible values of the scale -#' and their order. -#' @param drop Should unused factor levels be omitted from the scale? -#' The default, `TRUE`, uses the levels that appear in the data; -#' `FALSE` uses all the levels in the factor. -#' @param na.translate Unlike continuous scales, discrete scales can easily show -#' missing values, and do so by default. If you want to remove missing values -#' from a discrete scale, specify `na.translate = FALSE`. -#' @param na.value If `na.translate = TRUE`, what value aesthetic -#' value should missing be displayed as? Does not apply to position scales -#' where `NA` is always placed at the far right. -#' @keywords internal -discrete_scale <- function(aesthetics, scale_name, palette, name = waiver(), - breaks = waiver(), labels = waiver(), limits = NULL, expand = waiver(), - na.translate = TRUE, na.value = NA, drop = TRUE, - guide = "legend", position = "left", super = ScaleDiscrete) { - - aesthetics <- standardise_aes_names(aesthetics) - - check_breaks_labels(breaks, labels) - - position <- match.arg(position, c("left", "right", "top", "bottom")) - - if (is.null(breaks) && !is_position_aes(aesthetics) && guide != "none") { - guide <- "none" - } - - ggproto(NULL, super, - call = match.call(), - - aesthetics = aesthetics, - scale_name = scale_name, - palette = palette, - - range = discrete_range(), - limits = limits, - na.value = na.value, - na.translate = na.translate, - expand = expand, - - name = name, - breaks = breaks, - labels = labels, - drop = drop, - guide = guide, - position = position - ) -} - -#' Binning scale constructor -#' -#' @inheritParams continuous_scale -#' @param n.breaks The number of break points to create if breaks are not given -#' directly. It will attempt to find nice breakpoint and may thus not give the -#' exact number of breaks as requested. -#' @param right Should values on the border between bins be part of the right -#' (upper) bin? -#' @param show.limits should the limits of the scale appear as ticks -#' @keywords internal -binned_scale <- function(aesthetics, scale_name, palette, name = waiver(), - breaks = waiver(), labels = waiver(), limits = NULL, - oob = squish, expand = waiver(), na.value = NA_real_, - n.breaks = 7, right = TRUE, trans = "identity", - show.limits = FALSE, guide = "legend", position = "left", - super = ScaleBinned) { - - aesthetics <- standardise_aes_names(aesthetics) - - check_breaks_labels(breaks, labels) - - position <- match.arg(position, c("left", "right", "top", "bottom")) - - if (is.null(breaks) && !is_position_aes(aesthetics) && guide != "none") { - guide <- "none" - } - - trans <- as.trans(trans) - if (!is.null(limits)) { - limits <- trans$transform(limits) - } - - ggproto(NULL, super, - call = match.call(), - - aesthetics = aesthetics, - scale_name = scale_name, - palette = palette, - - range = continuous_range(), - limits = limits, - trans = trans, - na.value = na.value, - expand = expand, - oob = oob, - n.breaks = n.breaks, - right = right, - show.limits = show.limits, - - name = name, - breaks = breaks, - - labels = labels, - guide = guide, - position = position - ) -} - # In place modification of a scale to change the primary axis scale_flip_position <- function(scale) { scale$position <- switch(scale$position, From 61ced3f48cfb8b20753ba6b2624fce65f673a7bf Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Tue, 24 Sep 2019 21:33:36 +0200 Subject: [PATCH 19/30] remove atrociousness --- R/scale-.r | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/R/scale-.r b/R/scale-.r index c87a588267..4a322af9de 100644 --- a/R/scale-.r +++ b/R/scale-.r @@ -948,12 +948,14 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, } else if (identical(self$breaks, NA)) { stop("Invalid breaks specification. Use NULL, not NA", call. = FALSE) } else if (is.waive(self$breaks)) { - if (!is.null(self$n.breaks)) { - old_n <- get("n", environment(self$trans$breaks)) - assign("n", self$n.breaks, environment(self$trans$breaks)) - on.exit(assign("n", old_n, environment(self$trans$breaks))) + if (!is.null(self$n.breaks) && "n" %in% names(formals(self$trans$breaks))) { + breaks <- self$trans$breaks(limits, n = self$n.breaks) + } else { + if (!is.null(self$n.breaks)) { + warning("Ignoring n.breaks. Use a trans object that supports setting number of breaks", call. = FALSE) + } + breaks <- self$trans$breaks(limits) } - breaks <- self$trans$breaks(limits) # Ensure terminal bins are same width if limits not set if (is.null(self$limits)) { nbreaks <- length(breaks) From 795fa12fc854a640f8e0baf6d30fcd6ea834b9c1 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 25 Sep 2019 13:33:50 +0200 Subject: [PATCH 20/30] Fixes based on feedback from @hadley --- R/scale-.r | 54 ++++++++++++++++++++++++------------------------ R/scale-binned.R | 33 +++++++++++++++++++---------- 2 files changed, 49 insertions(+), 38 deletions(-) diff --git a/R/scale-.r b/R/scale-.r index 4a322af9de..d9e03d48ac 100644 --- a/R/scale-.r +++ b/R/scale-.r @@ -530,17 +530,8 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, transform = function(self, x) { new_x <- self$trans$transform(x) - if (any(is.finite(x) != is.finite(new_x))) { - type <- if (self$scale_name == "position_c") { - "continuous" - } else if (self$scale_name == "position_d") { - "discrete" - } else { - "binned" - } - axis <- if ("x" %in% self$aesthetics) "x" else "y" - warning("Transformation introduced infinite values in ", type, " ", axis, "-axis", call. = FALSE) - } + axis <- if ("x" %in% self$aesthetics) "x" else "y" + check_transformation(x, new_x, self$scale_name, axis) new_x }, @@ -884,7 +875,7 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, oob = squish, n.breaks = NULL, right = TRUE, - after_stat = FALSE, + after.stat = FALSE, show.limits = FALSE, is_discrete = function() FALSE, @@ -894,34 +885,30 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, stop("Binned scales only support continuous data", call. = FALSE) } - if (length(x) == 0) return() + if (length(x) == 0) { + return() + } self$range$train(x) }, transform = function(self, x) { new_x <- self$trans$transform(x) - if (any(is.finite(x) != is.finite(new_x))) { - type <- if (self$scale_name == "position_c") { - "continuous" - } else if (self$scale_name == "position_d") { - "discrete" - } else { - "binned" - } - axis <- if ("x" %in% self$aesthetics) "x" else "y" - warning("Transformation introduced infinite values in ", type, " ", axis, "-axis", call. = FALSE) - } + axis <- if ("x" %in% self$aesthetics) "x" else "y" + check_transformation(x, new_x, self$scale_name, axis) new_x }, map = function(self, x, limits = self$get_limits()) { - if (self$after_stat) { + if (self$after.stat) { x } else { breaks <- self$get_breaks(limits) - x_binned <- cut(x, c(limits[1], breaks, limits[2]), labels = FALSE, - include.lowest = TRUE, right = self$right) + x_binned <- cut(x, c(limits[1], breaks, limits[2]), + labels = FALSE, + include.lowest = TRUE, + right = self$right + ) if (!is.null(self$palette.cache)) { pal <- self$palette.cache @@ -1057,3 +1044,16 @@ scale_flip_position <- function(scale) { ) invisible() } + +check_transformation <- function(x, transformed, name, axis) { + if (any(is.finite(x) != is.finite(transformed))) { + type <- if (name == "position_b") { + "binned" + } else if (name == "position_c") { + "continuous" + } else { + "discrete" + } + warning("Transformation introduced infinite values in ", type, " ", axis, "-axis", call. = FALSE) + } +} diff --git a/R/scale-binned.R b/R/scale-binned.R index ed948eaa81..f0dbc7de5f 100644 --- a/R/scale-binned.R +++ b/R/scale-binned.R @@ -55,14 +55,14 @@ scale_y_binned <- function(name = waiver(), n.breaks = 10, breaks = waiver(), #' @usage NULL #' @export ScaleBinnedPosition <- ggproto("ScaleBinnedPosition", ScaleBinned, - after_stat = FALSE, + after.stat = FALSE, train = function(self, x) { if (!is.numeric(x)) { stop("Binned scales only support continuous data", call. = FALSE) } - if (length(x) == 0 || self$after_stat) return() + if (length(x) == 0 || self$after.stat) return() self$range$train(x) }, @@ -70,22 +70,28 @@ ScaleBinnedPosition <- ggproto("ScaleBinnedPosition", ScaleBinned, breaks <- self$get_breaks(limits) all_breaks <- unique(sort(c(limits[1], breaks, limits[2]))) - if (self$after_stat) { + if (self$after.stat) { # Backtransform to original scale - x_binned <- cut(x, seq_len(length(all_breaks) + 1) - 0.5, labels = FALSE, - include.lowest = TRUE, right = self$right) + x_binned <- cut(x, seq_len(length(all_breaks) + 1) - 0.5, + labels = FALSE, + include.lowest = TRUE, + right = self$right + ) (x - x_binned + .5) * diff(all_breaks)[x_binned] + all_breaks[x_binned] } else { x <- as.numeric(self$oob(x, limits)) x <- ifelse(!is.na(x), x, self$na.value) - x_binned <- cut(x, all_breaks, labels = FALSE, - include.lowest = TRUE, right = self$right) + x_binned <- cut(x, all_breaks, + labels = FALSE, + include.lowest = TRUE, + right = self$right + ) x_binned # Return integer form so stat treat it like a discrete scale } }, reset = function(self) { - self$after_stat <- TRUE + self$after.stat <- TRUE limits <- self$get_limits() breaks <- self$get_breaks(limits) self$range$reset() @@ -108,8 +114,13 @@ ScaleBinnedPosition <- ggproto("ScaleBinnedPosition", ScaleBinned, # rescale breaks [0, 1], which are used by coord/guide major_n <- rescale(major, from = range) - list(range = range, labels = labels, - major = major_n, minor = NULL, - major_source = major, minor_source = NULL) + list( + range = range, + labels = labels, + major = major_n, + minor = NULL, + major_source = major, + minor_source = NULL + ) } ) From 79e223eccf480b089032cd9aa7429b50eea35ac7 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 25 Sep 2019 13:34:19 +0200 Subject: [PATCH 21/30] finalize guide_bins --- R/guide-bins.R | 127 +++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 101 insertions(+), 26 deletions(-) diff --git a/R/guide-bins.R b/R/guide-bins.R index 7b6e4aeeb8..78c2892c7a 100644 --- a/R/guide-bins.R +++ b/R/guide-bins.R @@ -18,9 +18,10 @@ guide_bins <- function( keyheight = NULL, # ticks - ticks = TRUE, - ticks.colour = "black", - ticks.linewidth = 0.5, + axis = TRUE, + axis.colour = "black", + axis.linewidth = 0.5, + axis.arrow = NULL, # general direction = NULL, @@ -51,9 +52,10 @@ guide_bins <- function( keyheight = keyheight, # ticks - ticks = ticks, - ticks.colour = ticks.colour, - ticks.linewidth = ticks.linewidth, + axis = axis, + axis.colour = axis.colour, + axis.linewidth = axis.linewidth, + axis.arrow = axis.arrow, # general direction = direction, @@ -173,9 +175,19 @@ guide_geom.bins <- function(guide, layers, default_mapping) { guide_gengrob.bins <- function(guide, theme) { # default setting - label.position <- guide$label.position %||% "right" - if (!label.position %in% c("top", "bottom", "left", "right")) - stop("label position \"", label.position, "\" is invalid") + if (guide$direction == "horizontal") { + label.position <- guide$label.position %||% "bottom" + if (!label.position %in% c("top", "bottom")) { + warning("Ignoring invalid label.position", call. = FALSE) + label.position <- "bottom" + } + } else { + label.position <- guide$label.position %||% "right" + if (!label.position %in% c("left", "right")) { + warning("Ignoring invalid label.position", call. = FALSE) + label.position <- "right" + } + } n_keys <- nrow(guide$key) - 1 @@ -218,7 +230,7 @@ guide_gengrob.bins <- function(guide, theme) { } else { # get the defaults for label justification. The defaults are complicated and depend # on the direction of the legend and on label placement - just_defaults <- label_just_defaults.legend(guide$direction, label.position) + just_defaults <- label_just_defaults.bins(guide$direction, label.position) # don't set expressions left-justified if (just_defaults$hjust == 0 && any(is.expression(guide$key$.label))) just_defaults$hjust <- 1 @@ -293,22 +305,24 @@ guide_gengrob.bins <- function(guide, theme) { key_loc <- data_frame( R = seq(2, by = 2, length.out = n_keys), - C = 1 + C = if (label.position %in% c("right", "bottom")) 1 else 3 ) label_loc <- data_frame( R = seq(1, by = 2, length.out = n_keys + 1), - C = 3 + C = if (label.position %in% c("right", "bottom")) 3 else 1 ) tick_loc <- label_loc - tick_loc$C <- 1 + tick_loc$C <- if (label.position %in% c("right", "bottom")) 1 else 3 widths <- c(key_widths, hgap, label_widths) + if (label.position != "right") widths <- rev(widths) heights <- c(interleave(rep(0, n_keys), key_heights), 0) if (guide$direction == "horizontal") { names(key_loc) <- c("C", "R") names(label_loc) <- c("C", "R") names(tick_loc) <- c("C", "R") heights <- c(key_heights, vgap, label_heights) + if (label.position != "bottom") heights <- rev(heights) widths <- c(interleave(rep(0, n_keys), key_widths), 0) } @@ -371,29 +385,54 @@ guide_gengrob.bins <- function(guide, theme) { heights <- c(padding[1], heights, padding[3]) # make the ticks grob (`grob.ticks`) - if (!guide$ticks) + if (!guide$axis) { grob.ticks <- zeroGrob() - else { + grob.axis <- zeroGrob() + } else { if (guide$direction == "horizontal") { - x0 <- rep(0.5, 2) - y0 <- c(0, 4/5) - x1 <- rep(0.5, 2) - y1 <- c(1/5, 1) + x0 <- 0.5 + y0 <- 0 + x1 <- 0.5 + y1 <- 1/5 + axis_x <- c(0, 1) + axis_y <- c(0, 0) + if (label.position == "top") { + y0 <- 4/5 + y1 <- 1 + axis_y <- c(1, 1) + } } else { # guide$direction == "vertical" - y0 <- rep(0.5, 2) - x0 <- c(0, 4/5) - y1 <- rep(0.5, 2) - x1 <- c(1/5, 1) + y0 <- 0.5 + x0 <- 4/5 + y1 <- 0.5 + x1 <- 1 + axis_x <- c(1, 1) + axis_y <- c(0, 1) + if (label.position == "left") { + x0 <- 0 + x1 <- 1/5 + axis_x <- c(0, 0) + } } grob.ticks <- segmentsGrob( x0 = x0, y0 = y0, x1 = x1, y1 = y1, default.units = "npc", gp = gpar( - col = guide$ticks.colour, - lwd = guide$ticks.linewidth, + col = guide$axis.colour, + lwd = guide$axis.linewidth, lineend = "butt" ) ) + grob.axis <- segmentsGrob( + x0 = axis_x[1], y0 = axis_y[1], x1 = axis_x[2], y1 = axis_y[2], + default.units = "npc", + arrow = guide$axis.arrow, + gp = gpar( + col = guide$axis.colour, + lwd = guide$axis.linewidth, + lineend = if (is.null(guide$axis.arrow)) "square" else "round" + ) + ) } grob.ticks <- rep_len(list(grob.ticks), length(grob.labels)) if (!guide$show.limits) { @@ -440,13 +479,23 @@ guide_gengrob.bins <- function(guide, theme) { gt <- gtable_add_grob( gt, grob.ticks, - name = paste("label", tick_loc$R, tick_loc$C, sep = "-"), + name = paste("tick", tick_loc$R, tick_loc$C, sep = "-"), clip = "off", t = 1 + tick_loc$R, r = 1 + tick_loc$C, b = 1 + tick_loc$R, l = 1 + tick_loc$C ) + gt <- gtable_add_grob( + gt, + grob.axis, + name = "axis", + clip = "off", + t = min(1 + tick_loc$R), + r = min(1 + tick_loc$C), + b = max(1 + tick_loc$R), + l = max(1 + tick_loc$C) + ) gt <- gtable_add_grob( gt, justify_grobs( @@ -465,3 +514,29 @@ guide_gengrob.bins <- function(guide, theme) { ) gt } + +#' Calculate the default hjust and vjust settings depending on legend +#' direction and position. +#' +#' @noRd +label_just_defaults.bins <- function(direction, position) { + if (direction == "horizontal") { + switch( + position, + "top" = list(hjust = 0.5, vjust = 0), + "bottom" = list(hjust = 0.5, vjust = 1), + "left" = list(hjust = 1, vjust = 0.5), + list(hjust = 0.5, vjust = 0.5) + ) + } + else { + switch( + position, + "top" = list(hjust = 0.5, vjust = 0), + "bottom" = list(hjust = 0.5, vjust = 1), + "left" = list(hjust = 1, vjust = 0.5), + list(hjust = 0, vjust = 0.5) + ) + + } +} From 12faceb0e6476c714279a78adbeff32b5572f1be Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 25 Sep 2019 21:41:24 +0200 Subject: [PATCH 22/30] Implement rescaler for binned scales --- R/scale-.r | 21 +++++++++++++++------ 1 file changed, 15 insertions(+), 6 deletions(-) diff --git a/R/scale-.r b/R/scale-.r index d9e03d48ac..d399afdbbb 100644 --- a/R/scale-.r +++ b/R/scale-.r @@ -198,10 +198,10 @@ discrete_scale <- function(aesthetics, scale_name, palette, name = waiver(), #' @keywords internal binned_scale <- function(aesthetics, scale_name, palette, name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, - oob = squish, expand = waiver(), na.value = NA_real_, - n.breaks = 7, right = TRUE, trans = "identity", - show.limits = FALSE, guide = "bins", position = "left", - super = ScaleBinned) { + rescaler = rescale, oob = squish, expand = waiver(), + na.value = NA_real_, n.breaks = NULL, right = TRUE, + trans = "identity", show.limits = FALSE, guide = "bins", + position = "left", super = ScaleBinned) { aesthetics <- standardise_aes_names(aesthetics) @@ -230,6 +230,7 @@ binned_scale <- function(aesthetics, scale_name, palette, name = waiver(), trans = trans, na.value = na.value, expand = expand, + rescaler = rescaler, oob = oob, n.breaks = n.breaks, right = right, @@ -872,6 +873,7 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale, ScaleBinned <- ggproto("ScaleBinned", Scale, range = continuous_range(), na.value = NA_real_, + rescaler = rescale, oob = squish, n.breaks = NULL, right = TRUE, @@ -904,7 +906,10 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, } else { breaks <- self$get_breaks(limits) - x_binned <- cut(x, c(limits[1], breaks, limits[2]), + x <- self$rescale(self$oob(x, range = limits), limits) + breaks <- self$rescale(c(limits[1], breaks, limits[2]), limits) + + x_binned <- cut(x, breaks, labels = FALSE, include.lowest = TRUE, right = self$right @@ -913,7 +918,7 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, if (!is.null(self$palette.cache)) { pal <- self$palette.cache } else { - pal <- self$palette(length(self$breaks) + 1) + pal <- self$palette(breaks[-1] - diff(breaks) / 2) self$palette.cache <- pal } @@ -921,6 +926,10 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, } }, + rescale = function(self, x, limits = self$get_limits(), range = limits) { + self$rescaler(x, from = range) + }, + dimension = function(self, expand = c(0, 0, 0, 0)) { expand_range4(self$get_limits(), expand) }, From 7316e6fa6e36c3fe178c5f55ab0fc672195fc2c9 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 25 Sep 2019 21:42:07 +0200 Subject: [PATCH 23/30] Fix merging of guide_bins --- R/guide-bins.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/guide-bins.R b/R/guide-bins.R index 78c2892c7a..41cb55cbb3 100644 --- a/R/guide-bins.R +++ b/R/guide-bins.R @@ -88,9 +88,6 @@ guide_train.bins <- function(guide, scale, aesthetic = NULL) { key <- new_data_frame(setNames(list(c(scale$map(bin_at), NA)), aes_column_name)) key$.label <- scale$get_labels(all_breaks) guide$show.limits <- guide$show.limits %||% scale$show_limits %||% FALSE - if (!guide$show.limits) { - key$.label[c(1, nrow(key))] <- NA - } if (guide$reverse) key <- key[nrow(key):1, ] @@ -173,6 +170,9 @@ guide_geom.bins <- function(guide, layers, default_mapping) { #' @export guide_gengrob.bins <- function(guide, theme) { + if (!guide$show.limits) { + guide$key$.label[c(1, nrow(guide$key))] <- NA + } # default setting if (guide$direction == "horizontal") { From 99b96e2e9051245410c5dd81f751e940f4b892ee Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 25 Sep 2019 21:42:37 +0200 Subject: [PATCH 24/30] Binned versions of all relevant scales --- DESCRIPTION | 1 + NAMESPACE | 9 ++ R/scale-alpha.r | 5 + R/scale-gradient.r | 21 ---- R/scale-linetype.r | 6 ++ R/scale-shape.r | 6 ++ R/scale-size.r | 11 +++ R/scale-steps.R | 119 +++++++++++++++++++++++ R/scale-viridis.r | 40 ++++++++ R/utilities.r | 6 ++ man/binned_scale.Rd | 14 ++- man/continuous_scale.Rd | 81 ---------------- man/discrete_scale.Rd | 37 ------- man/scale_alpha.Rd | 4 + man/scale_brewer.Rd | 1 + man/scale_discrete.Rd | 23 ----- man/scale_gradient.Rd | 65 +------------ man/scale_grey.Rd | 24 +---- man/scale_hue.Rd | 24 +---- man/scale_linetype.Rd | 23 +---- man/scale_manual.Rd | 23 ----- man/scale_shape.Rd | 26 +---- man/scale_size.Rd | 51 +--------- man/scale_steps.Rd | 207 ++++++++++++++++++++++++++++++++++++++++ man/scale_viridis.Rd | 13 ++- 25 files changed, 447 insertions(+), 393 deletions(-) create mode 100644 R/scale-steps.R create mode 100644 man/scale_steps.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 20fb170323..e9bd02223d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -201,6 +201,7 @@ Collate: 'scale-manual.r' 'scale-shape.r' 'scale-size.r' + 'scale-steps.R' 'scale-type.R' 'scale-view.r' 'scale-viridis.r' diff --git a/NAMESPACE b/NAMESPACE index c68e1773b6..65bcceadaf 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -469,6 +469,9 @@ export(scale_colour_identity) export(scale_colour_manual) export(scale_colour_ordinal) export(scale_colour_steps) +export(scale_colour_steps2) +export(scale_colour_stepsn) +export(scale_colour_viridis_b) export(scale_colour_viridis_c) export(scale_colour_viridis_d) export(scale_continuous_identity) @@ -490,15 +493,20 @@ export(scale_fill_identity) export(scale_fill_manual) export(scale_fill_ordinal) export(scale_fill_steps) +export(scale_fill_steps2) +export(scale_fill_stepsn) +export(scale_fill_viridis_b) export(scale_fill_viridis_c) export(scale_fill_viridis_d) export(scale_linetype) +export(scale_linetype_binned) export(scale_linetype_continuous) export(scale_linetype_discrete) export(scale_linetype_identity) export(scale_linetype_manual) export(scale_radius) export(scale_shape) +export(scale_shape_binned) export(scale_shape_continuous) export(scale_shape_discrete) export(scale_shape_identity) @@ -506,6 +514,7 @@ export(scale_shape_manual) export(scale_shape_ordinal) export(scale_size) export(scale_size_area) +export(scale_size_binned) export(scale_size_continuous) export(scale_size_date) export(scale_size_datetime) diff --git a/R/scale-alpha.r b/R/scale-alpha.r index 967ae92d9a..00a4fee8bf 100644 --- a/R/scale-alpha.r +++ b/R/scale-alpha.r @@ -26,6 +26,11 @@ scale_alpha <- function(..., range = c(0.1, 1)) { #' @export scale_alpha_continuous <- scale_alpha +#' @rdname scale_alpha +scale_alpha_binned <- function(..., range = c(0.1, 1)) { + binned_scale("alpha", "alpha_b", rescale_pal(range), ...) +} + #' @rdname scale_alpha #' @export scale_alpha_discrete <- function(...) { diff --git a/R/scale-gradient.r b/R/scale-gradient.r index de12bf732a..9e733712e9 100644 --- a/R/scale-gradient.r +++ b/R/scale-gradient.r @@ -134,24 +134,3 @@ scale_fill_gradientn <- function(..., colours, values = NULL, space = "Lab", na. continuous_scale(aesthetics, "gradientn", gradient_n_pal(colours, values, space), na.value = na.value, guide = guide, ...) } -#' @rdname scale_gradient -#' @export -scale_colour_steps <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab", - na.value = "grey50", guide = "coloursteps", aesthetics = "colour") { - binned_scale(aesthetics, "steps", seq_stepped_pal(low, high, space), - na.value = na.value, guide = guide, ...) -} -#' @rdname scale_gradient -#' @export -scale_fill_steps <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab", - na.value = "grey50", guide = "coloursteps", aesthetics = "fill") { - binned_scale(aesthetics, "steps", seq_stepped_pal(low, high, space), - na.value = na.value, guide = guide, ...) -} - -seq_stepped_pal <- function(low, high, space) { - pal <- seq_gradient_pal(low, high, space) - function(n) { - pal(seq(0, 1, length.out = n)) - } -} diff --git a/R/scale-linetype.r b/R/scale-linetype.r index 874c25d6ff..621399fd12 100644 --- a/R/scale-linetype.r +++ b/R/scale-linetype.r @@ -33,6 +33,12 @@ scale_linetype <- function(..., na.value = "blank") { na.value = na.value, ...) } +#' @rdname scale_linetype +#' @export +scale_linetype_binned <- function(...) { + binned_scale("linetype", "linetype_b", binned_pal(linetype_pal()), ...) +} + #' @rdname scale_linetype #' @export scale_linetype_continuous <- function(...) { diff --git a/R/scale-shape.r b/R/scale-shape.r index 2a7c8cabac..6663084d83 100644 --- a/R/scale-shape.r +++ b/R/scale-shape.r @@ -38,6 +38,12 @@ scale_shape <- function(..., solid = TRUE) { discrete_scale("shape", "shape_d", shape_pal(solid), ...) } +#' @rdname scale_shape +#' @export +scale_shape_binned <- function(..., solid = TRUE) { + binned_scale("shape", "shape_b", binned_pal(shape_pal(solid)), ...) +} + #' @rdname scale_shape #' @export #' @usage NULL diff --git a/R/scale-size.r b/R/scale-size.r index fafc562e88..d1bffad235 100644 --- a/R/scale-size.r +++ b/R/scale-size.r @@ -42,6 +42,17 @@ scale_size_continuous <- function(name = waiver(), breaks = waiver(), labels = w guide = guide) } +#' @rdname scale_size +#' @export +#' @usage NULL +scale_size_binned <- function(name = waiver(), breaks = waiver(), labels = waiver(), + limits = NULL, range = c(1, 6), n.breaks = NULL, + trans = "identity", guide = "bins") { + binned_scale("size", "area_b", area_pal(range), name = name, + breaks = breaks, labels = labels, limits = limits, trans = trans, + n.breaks = n.breaks, guide = guide) +} + #' @rdname scale_size #' @export scale_radius <- function(name = waiver(), breaks = waiver(), labels = waiver(), diff --git a/R/scale-steps.R b/R/scale-steps.R new file mode 100644 index 0000000000..87020fdd83 --- /dev/null +++ b/R/scale-steps.R @@ -0,0 +1,119 @@ +#' Binned gradient colour scales +#' +#' `scale_*_steps` creates a two colour binned gradient (low-high), +#' `scale_*_stepsn` creates a n-colour binned gradient. +#' +#' Default colours are generated with \pkg{munsell} and +#' `mnsl(c("2.5PB 2/4", "2.5PB 7/10"))`. Generally, for continuous +#' colour scales you want to keep hue constant, but vary chroma and +#' luminance. The \pkg{munsell} package makes this easy to do using the +#' Munsell colour system. +#' +#' @inheritParams scales::seq_gradient_pal +#' @inheritParams scale_colour_hue +#' @param low,high Colours for low and high ends of the gradient. +#' @param guide Type of legend. Use `"coloursteps"` for continuous +#' colour bar, or `"bins"` for discrete colour legend. +#' @inheritDotParams binned_scale -na.value -guide -aesthetics +#' @seealso [scales::seq_gradient_pal()] for details on underlying +#' palette +#' @family colour scales +#' @rdname scale_steps +#' @export +#' @examples +#' df <- data.frame( +#' x = runif(100), +#' y = runif(100), +#' z1 = rnorm(100), +#' z2 = abs(rnorm(100)) +#' ) +#' +#' df_na <- data.frame( +#' value = seq(1, 20), +#' x = runif(20), +#' y = runif(20), +#' z1 = c(rep(NA, 10), rnorm(10)) +#' ) +#' +#' # Default colour scale colours from light blue to dark blue +#' ggplot(df, aes(x, y)) + +#' geom_point(aes(colour = z2)) +#' +#' # For diverging colour scales use gradient2 +#' ggplot(df, aes(x, y)) + +#' geom_point(aes(colour = z1)) + +#' scale_colour_gradient2() +#' +#' # Use your own colour scale with gradientn +#' ggplot(df, aes(x, y)) + +#' geom_point(aes(colour = z1)) + +#' scale_colour_gradientn(colours = terrain.colors(10)) +#' +#' # Equivalent fill scales do the same job for the fill aesthetic +#' ggplot(faithfuld, aes(waiting, eruptions)) + +#' geom_raster(aes(fill = density)) + +#' scale_fill_gradientn(colours = terrain.colors(10)) +#' +#' # Adjust colour choices with low and high +#' ggplot(df, aes(x, y)) + +#' geom_point(aes(colour = z2)) + +#' scale_colour_gradient(low = "white", high = "black") +#' # Avoid red-green colour contrasts because ~10% of men have difficulty +#' # seeing them +#' +#'# Use `na.value = NA` to hide missing values but keep the original axis range +#' ggplot(df_na, aes(x = value, y)) + +#' geom_bar(aes(fill = z1), stat = "identity") + +#' scale_fill_gradient(low = "yellow", high = "red", na.value = NA) +#' +#' ggplot(df_na, aes(x, y)) + +#' geom_point(aes(colour = z1)) + +#' scale_colour_gradient(low = "yellow", high = "red", na.value = NA) +#' + +#' @rdname scale_steps +#' @export +scale_colour_steps <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab", + na.value = "grey50", guide = "coloursteps", aesthetics = "colour") { + binned_scale(aesthetics, "steps", seq_gradient_pal(low, high, space), + na.value = na.value, guide = guide, ...) +} +#' @rdname scale_steps +#' @export +scale_colour_steps2 <- function(..., low = muted("red"), mid = "white", high = muted("blue"), + midpoint = 0, space = "Lab", na.value = "grey50", guide = "coloursteps", + aesthetics = "colour") { + binned_scale(aesthetics, "steps2", div_gradient_pal(low, mid, high, space), + na.value = na.value, guide = guide, rescaler = mid_rescaler(mid = midpoint), ...) +} +#' @rdname scale_steps +#' @export +scale_colour_stepsn <- function(..., colours, values = NULL, space = "Lab", na.value = "grey50", + guide = "coloursteps", aesthetics = "colour", colors) { + colours <- if (missing(colours)) colors else colours + binned_scale(aesthetics, "stepsn", + gradient_n_pal(colours, values, space), na.value = na.value, guide = guide, ...) +} +#' @rdname scale_steps +#' @export +scale_fill_steps <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab", + na.value = "grey50", guide = "coloursteps", aesthetics = "fill") { + binned_scale(aesthetics, "steps", seq_gradient_pal(low, high, space), + na.value = na.value, guide = guide, ...) +} +#' @rdname scale_steps +#' @export +scale_fill_steps2 <- function(..., low = muted("red"), mid = "white", high = muted("blue"), + midpoint = 0, space = "Lab", na.value = "grey50", guide = "coloursteps", + aesthetics = "fill") { + binned_scale(aesthetics, "steps2", div_gradient_pal(low, mid, high, space), + na.value = na.value, guide = guide, rescaler = mid_rescaler(mid = midpoint), ...) +} +#' @rdname scale_steps +#' @export +scale_fill_stepsn <- function(..., colours, values = NULL, space = "Lab", na.value = "grey50", + guide = "coloursteps", aesthetics = "fill", colors) { + colours <- if (missing(colours)) colors else colours + binned_scale(aesthetics, "stepsn", + gradient_n_pal(colours, values, space), na.value = na.value, guide = guide, ...) +} diff --git a/R/scale-viridis.r b/R/scale-viridis.r index ef5da6b395..23f3ab8888 100644 --- a/R/scale-viridis.r +++ b/R/scale-viridis.r @@ -111,3 +111,43 @@ scale_fill_viridis_c <- function(..., alpha = 1, begin = 0, end = 1, ... ) } + +#' @export +#' @rdname scale_viridis +scale_colour_viridis_b <- function(..., alpha = 1, begin = 0, end = 1, + direction = 1, option = "D", values = NULL, + space = "Lab", na.value = "grey50", + guide = "coloursteps", aesthetics = "colour") { + binned_scale( + aesthetics, + "viridis_b", + gradient_n_pal( + viridis_pal(alpha, begin, end, direction, option)(6), + values, + space + ), + na.value = na.value, + guide = guide, + ... + ) +} + +#' @export +#' @rdname scale_viridis +scale_fill_viridis_b <- function(..., alpha = 1, begin = 0, end = 1, + direction = 1, option = "D", values = NULL, + space = "Lab", na.value = "grey50", + guide = "coloursteps", aesthetics = "fill") { + binned_scale( + aesthetics, + "viridis_b", + gradient_n_pal( + viridis_pal(alpha, begin, end, direction, option)(6), + values, + space + ), + na.value = na.value, + guide = guide, + ... + ) +} diff --git a/R/utilities.r b/R/utilities.r index 6336ace4b8..29edb19f16 100644 --- a/R/utilities.r +++ b/R/utilities.r @@ -176,6 +176,12 @@ rescale01 <- function(x) { (x - rng[1]) / (rng[2] - rng[1]) } +binned_pal <- function(palette) { + function(x) { + palette(length(x)) + } +} + #' Give a deprecation error, warning, or message, depending on version number. #' #' This function is deprecated. diff --git a/man/binned_scale.Rd b/man/binned_scale.Rd index 6c4364e2fc..aab545964d 100644 --- a/man/binned_scale.Rd +++ b/man/binned_scale.Rd @@ -6,10 +6,10 @@ \usage{ binned_scale(aesthetics, scale_name, palette, name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, - oob = squish, expand = waiver(), na.value = NA_real_, - n.breaks = 7, right = TRUE, trans = "identity", - show.limits = FALSE, guide = "legend", position = "left", - super = ScaleBinned) + rescaler = rescale, oob = squish, expand = waiver(), + na.value = NA_real_, n.breaks = NULL, right = TRUE, + trans = "identity", show.limits = FALSE, guide = "bins", + position = "left", super = ScaleBinned) } \arguments{ \item{aesthetics}{The names of the aesthetics that this scale works with.} @@ -58,6 +58,12 @@ If the purpose is to zoom, use the limit argument in the coordinate system (see \code{\link[=coord_cartesian]{coord_cartesian()}}). }} +\item{rescaler}{A function used to scale the input values to the +range [0, 1]. This is always \code{\link[scales:rescale]{scales::rescale()}}, except for +diverging and n colour gradients (i.e., \code{\link[=scale_colour_gradient2]{scale_colour_gradient2()}}, +\code{\link[=scale_colour_gradientn]{scale_colour_gradientn()}}). The \code{rescaler} is ignored by position +scales, which ways use \code{\link[scales:rescale]{scales::rescale()}}.} + \item{oob}{One of: \itemize{ \item Function that handles limits outside of the scale limits diff --git a/man/continuous_scale.Rd b/man/continuous_scale.Rd index 7df5efc75f..6c5ee2a3fb 100644 --- a/man/continuous_scale.Rd +++ b/man/continuous_scale.Rd @@ -4,12 +4,6 @@ \alias{continuous_scale} \title{Continuous scale constructor} \usage{ -continuous_scale(aesthetics, scale_name, palette, name = waiver(), - breaks = waiver(), minor_breaks = waiver(), labels = waiver(), - limits = NULL, rescaler = rescale, oob = censor, - expand = waiver(), na.value = NA_real_, trans = "identity", - guide = "legend", position = "left", super = ScaleContinuous) - continuous_scale(aesthetics, scale_name, palette, name = waiver(), breaks = waiver(), minor_breaks = waiver(), labels = waiver(), limits = NULL, rescaler = rescale, oob = censor, @@ -115,84 +109,9 @@ transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} \item{position}{For position scales, The position of the axis. \code{left} or \code{right} for y axes, \code{top} or \code{bottom} for x axes.} -\item{super}{The super class to use for the constructed scale} - -\item{aesthetics}{The names of the aesthetics that this scale works with} - -\item{scale_name}{The name of the scale} - -\item{palette}{A palette function that when called with a numeric vector with -values between 0 and 1 returns the corresponding values in the range the -scale maps to.} - -\item{name}{The name of the scale. Used as the axis or legend title. If -\code{waiver()}, the default, the name of the scale is taken from the first -mapping used for that aesthetic. If \code{NULL}, the legend title will be -omitted.} - -\item{breaks}{One of: -\itemize{ -\item \code{NULL} for no breaks -\item \code{waiver()} for the default breaks computed by the -transformation object -\item A numeric vector of positions -\item A function that takes the limits as input and returns breaks -as output -}} - -\item{minor_breaks}{One of: -\itemize{ -\item \code{NULL} for no minor breaks -\item \code{waiver()} for the default breaks (one minor break between -each major break) -\item A numeric vector of positions -\item A function that given the limits returns a vector of minor breaks. -}} - -\item{labels}{One of: -\itemize{ -\item \code{NULL} for no labels -\item \code{waiver()} for the default labels computed by the -transformation object -\item A character vector giving labels (must be same length as \code{breaks}) -\item A function that takes the breaks as input and returns labels -as output -}} - -\item{limits}{A numeric vector of length two providing limits of the scale. -Use \code{NA} to refer to the existing minimum or maximum.} - -\item{rescaler}{Used by diverging and n colour gradients -(i.e. \code{\link[=scale_colour_gradient2]{scale_colour_gradient2()}}, \code{\link[=scale_colour_gradientn]{scale_colour_gradientn()}}). -A function used to scale the input values to the range [0, 1].} - -\item{oob}{Function that handles limits outside of the scale limits -(out of bounds). The default replaces out of bounds values with \code{NA}.} - -\item{na.value}{Missing values will be replaced with this value.} - -\item{trans}{Either the name of a transformation object, or the -object itself. Built-in transformations include "asn", "atanh", -"boxcox", "exp", "identity", "log", "log10", "log1p", "log2", -"logit", "probability", "probit", "reciprocal", "reverse" and "sqrt". - -A transformation object bundles together a transform, its inverse, -and methods for generating breaks and labels. Transformation objects -are defined in the scales package, and are called \code{name_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 info.} - -\item{position}{The position of the axis. "left" or "right" for vertical -scales, "top" or "bottom" for horizontal scales} - \item{super}{The super class to use for the constructed scale} } \description{ Continuous scale constructor - -Continuous scale constructor. } \keyword{internal} diff --git a/man/discrete_scale.Rd b/man/discrete_scale.Rd index 38abba5602..0aabfe02b1 100644 --- a/man/discrete_scale.Rd +++ b/man/discrete_scale.Rd @@ -4,12 +4,6 @@ \alias{discrete_scale} \title{Discrete scale constructor} \usage{ -discrete_scale(aesthetics, scale_name, palette, name = waiver(), - breaks = waiver(), labels = waiver(), limits = NULL, - expand = waiver(), na.translate = TRUE, na.value = NA, - drop = TRUE, guide = "legend", position = "left", - super = ScaleDiscrete) - discrete_scale(aesthetics, scale_name, palette, name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, expand = waiver(), na.translate = TRUE, na.value = NA, @@ -79,39 +73,8 @@ The default, \code{TRUE}, uses the levels that appear in the data; \code{left} or \code{right} for y axes, \code{top} or \code{bottom} for x axes.} \item{super}{The super class to use for the constructed scale} - -\item{palette}{A palette function that when called with a single integer -argument (the number of levels in the scale) returns the values that -they should take.} - -\item{breaks}{One of: -\itemize{ -\item \code{NULL} for no breaks -\item \code{waiver()} for the default breaks computed by the -transformation object -\item A character vector of breaks -\item A function that takes the limits as input and returns breaks -as output -}} - -\item{limits}{A character vector that defines possible values of the scale -and their order.} - -\item{drop}{Should unused factor levels be omitted from the scale? -The default, \code{TRUE}, uses the levels that appear in the data; -\code{FALSE} uses all the levels in the factor.} - -\item{na.translate}{Unlike continuous scales, discrete scales can easily show -missing values, and do so by default. If you want to remove missing values -from a discrete scale, specify \code{na.translate = FALSE}.} - -\item{na.value}{If \code{na.translate = TRUE}, what value aesthetic -value should missing be displayed as? Does not apply to position scales -where \code{NA} is always placed at the far right.} } \description{ Discrete scale constructor - -Discrete scale constructor. } \keyword{internal} diff --git a/man/scale_alpha.Rd b/man/scale_alpha.Rd index fdd86fffc4..95f3ad255f 100644 --- a/man/scale_alpha.Rd +++ b/man/scale_alpha.Rd @@ -3,6 +3,7 @@ \name{scale_alpha} \alias{scale_alpha} \alias{scale_alpha_continuous} +\alias{scale_alpha_binned} \alias{scale_alpha_discrete} \alias{scale_alpha_ordinal} \alias{scale_alpha_datetime} @@ -13,6 +14,8 @@ scale_alpha(..., range = c(0.1, 1)) scale_alpha_continuous(..., range = c(0.1, 1)) +scale_alpha_binned(..., range = c(0.1, 1)) + scale_alpha_discrete(...) scale_alpha_ordinal(..., range = c(0.1, 1)) @@ -43,6 +46,7 @@ Other colour scales: \code{\link{scale_colour_brewer}}, \code{\link{scale_colour_gradient}}, \code{\link{scale_colour_grey}}, \code{\link{scale_colour_hue}}, + \code{\link{scale_colour_steps}}, \code{\link{scale_colour_viridis_d}} } \concept{colour scales} diff --git a/man/scale_brewer.Rd b/man/scale_brewer.Rd index 70b82f29b4..f74477e353 100644 --- a/man/scale_brewer.Rd +++ b/man/scale_brewer.Rd @@ -129,6 +129,7 @@ Other colour scales: \code{\link{scale_alpha}}, \code{\link{scale_colour_gradient}}, \code{\link{scale_colour_grey}}, \code{\link{scale_colour_hue}}, + \code{\link{scale_colour_steps}}, \code{\link{scale_colour_viridis_d}} } \concept{colour scales} diff --git a/man/scale_discrete.Rd b/man/scale_discrete.Rd index 0ee7a72e9c..1297441b9c 100644 --- a/man/scale_discrete.Rd +++ b/man/scale_discrete.Rd @@ -33,29 +33,6 @@ missing values, and do so by default. If you want to remove missing values from a discrete scale, specify \code{na.translate = FALSE}.} \item{na.value}{If \code{na.translate = TRUE}, what value aesthetic value should missing be displayed as? Does not apply to position scales -where \code{NA} is always placed at the far right.} - \item{palette}{A palette function that when called with a single integer -argument (the number of levels in the scale) returns the values that -they should take.} - \item{breaks}{One of: -\itemize{ -\item \code{NULL} for no breaks -\item \code{waiver()} for the default breaks computed by the -transformation object -\item A character vector of breaks -\item A function that takes the limits as input and returns breaks -as output -}} - \item{limits}{A character vector that defines possible values of the scale -and their order.} - \item{drop}{Should unused factor levels be omitted from the scale? -The default, \code{TRUE}, uses the levels that appear in the data; -\code{FALSE} uses all the levels in the factor.} - \item{na.translate}{Unlike continuous scales, discrete scales can easily show -missing values, and do so by default. If you want to remove missing values -from a discrete scale, specify \code{na.translate = FALSE}.} - \item{na.value}{If \code{na.translate = TRUE}, what value aesthetic -value should missing be displayed as? Does not apply to position scales where \code{NA} is always placed at the far right.} \item{aesthetics}{The names of the aesthetics that this scale works with.} \item{scale_name}{The name of the scale that should be used for error messages diff --git a/man/scale_gradient.Rd b/man/scale_gradient.Rd index fc277a4ad9..d5dea1d74f 100644 --- a/man/scale_gradient.Rd +++ b/man/scale_gradient.Rd @@ -7,8 +7,6 @@ \alias{scale_fill_gradient2} \alias{scale_colour_gradientn} \alias{scale_fill_gradientn} -\alias{scale_colour_steps} -\alias{scale_fill_steps} \alias{scale_colour_binned} \alias{scale_colour_datetime} \alias{scale_color_datetime} @@ -46,14 +44,6 @@ scale_colour_gradientn(..., colours, values = NULL, space = "Lab", scale_fill_gradientn(..., colours, values = NULL, space = "Lab", na.value = "grey50", guide = "colourbar", aesthetics = "fill", colors) - -scale_colour_steps(..., low = "#132B43", high = "#56B1F7", - space = "Lab", na.value = "grey50", guide = "coloursteps", - aesthetics = "colour") - -scale_fill_steps(..., low = "#132B43", high = "#56B1F7", - space = "Lab", na.value = "grey50", guide = "coloursteps", - aesthetics = "fill") } \arguments{ \item{...}{Arguments passed on to \code{continuous_scale} @@ -138,60 +128,6 @@ expand the scale by 5\% on each side for continuous variables, and by \item{position}{For position scales, The position of the axis. \code{left} or \code{right} for y axes, \code{top} or \code{bottom} for x axes.} \item{super}{The super class to use for the constructed scale} - \item{scale_name}{The name of the scale} - \item{palette}{A palette function that when called with a numeric vector with -values between 0 and 1 returns the corresponding values in the range the -scale maps to.} - \item{name}{The name of the scale. Used as the axis or legend title. If -\code{waiver()}, the default, the name of the scale is taken from the first -mapping used for that aesthetic. If \code{NULL}, the legend title will be -omitted.} - \item{breaks}{One of: -\itemize{ -\item \code{NULL} for no breaks -\item \code{waiver()} for the default breaks computed by the -transformation object -\item A numeric vector of positions -\item A function that takes the limits as input and returns breaks -as output -}} - \item{minor_breaks}{One of: -\itemize{ -\item \code{NULL} for no minor breaks -\item \code{waiver()} for the default breaks (one minor break between -each major break) -\item A numeric vector of positions -\item A function that given the limits returns a vector of minor breaks. -}} - \item{labels}{One of: -\itemize{ -\item \code{NULL} for no labels -\item \code{waiver()} for the default labels computed by the -transformation object -\item A character vector giving labels (must be same length as \code{breaks}) -\item A function that takes the breaks as input and returns labels -as output -}} - \item{limits}{A numeric vector of length two providing limits of the scale. -Use \code{NA} to refer to the existing minimum or maximum.} - \item{rescaler}{Used by diverging and n colour gradients -(i.e. \code{\link[=scale_colour_gradient2]{scale_colour_gradient2()}}, \code{\link[=scale_colour_gradientn]{scale_colour_gradientn()}}). -A function used to scale the input values to the range [0, 1].} - \item{oob}{Function that handles limits outside of the scale limits -(out of bounds). The default replaces out of bounds values with \code{NA}.} - \item{trans}{Either the name of a transformation object, or the -object itself. Built-in transformations include "asn", "atanh", -"boxcox", "exp", "identity", "log", "log10", "log1p", "log2", -"logit", "probability", "probit", "reciprocal", "reverse" and "sqrt". - -A transformation object bundles together a transform, its inverse, -and methods for generating breaks and labels. Transformation objects -are defined in the scales package, and are called \code{name_trans}, e.g. -\code{\link[scales:boxcox_trans]{scales::boxcox_trans()}}. You can create your own -transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} - \item{position}{The position of the axis. "left" or "right" for vertical -scales, "top" or "bottom" for horizontal scales} - \item{super}{The super class to use for the constructed scale} }} \item{low, high}{Colours for low and high ends of the gradient.} @@ -292,6 +228,7 @@ Other colour scales: \code{\link{scale_alpha}}, \code{\link{scale_colour_brewer}}, \code{\link{scale_colour_grey}}, \code{\link{scale_colour_hue}}, + \code{\link{scale_colour_steps}}, \code{\link{scale_colour_viridis_d}} } \concept{colour scales} diff --git a/man/scale_grey.Rd b/man/scale_grey.Rd index f048264d2e..3e55326b3e 100644 --- a/man/scale_grey.Rd +++ b/man/scale_grey.Rd @@ -36,29 +36,6 @@ missing values, and do so by default. If you want to remove missing values from a discrete scale, specify \code{na.translate = FALSE}.} \item{na.value}{If \code{na.translate = TRUE}, what value aesthetic value should missing be displayed as? Does not apply to position scales -where \code{NA} is always placed at the far right.} - \item{palette}{A palette function that when called with a single integer -argument (the number of levels in the scale) returns the values that -they should take.} - \item{breaks}{One of: -\itemize{ -\item \code{NULL} for no breaks -\item \code{waiver()} for the default breaks computed by the -transformation object -\item A character vector of breaks -\item A function that takes the limits as input and returns breaks -as output -}} - \item{limits}{A character vector that defines possible values of the scale -and their order.} - \item{drop}{Should unused factor levels be omitted from the scale? -The default, \code{TRUE}, uses the levels that appear in the data; -\code{FALSE} uses all the levels in the factor.} - \item{na.translate}{Unlike continuous scales, discrete scales can easily show -missing values, and do so by default. If you want to remove missing values -from a discrete scale, specify \code{na.translate = FALSE}.} - \item{na.value}{If \code{na.translate = TRUE}, what value aesthetic -value should missing be displayed as? Does not apply to position scales where \code{NA} is always placed at the far right.} \item{aesthetics}{The names of the aesthetics that this scale works with.} \item{scale_name}{The name of the scale that should be used for error messages @@ -126,6 +103,7 @@ Other colour scales: \code{\link{scale_alpha}}, \code{\link{scale_colour_brewer}}, \code{\link{scale_colour_gradient}}, \code{\link{scale_colour_hue}}, + \code{\link{scale_colour_steps}}, \code{\link{scale_colour_viridis_d}} } \concept{colour scales} diff --git a/man/scale_hue.Rd b/man/scale_hue.Rd index 34a5d0fe57..6a5f5dcde5 100644 --- a/man/scale_hue.Rd +++ b/man/scale_hue.Rd @@ -41,29 +41,6 @@ missing values, and do so by default. If you want to remove missing values from a discrete scale, specify \code{na.translate = FALSE}.} \item{na.value}{If \code{na.translate = TRUE}, what value aesthetic value should missing be displayed as? Does not apply to position scales -where \code{NA} is always placed at the far right.} - \item{palette}{A palette function that when called with a single integer -argument (the number of levels in the scale) returns the values that -they should take.} - \item{breaks}{One of: -\itemize{ -\item \code{NULL} for no breaks -\item \code{waiver()} for the default breaks computed by the -transformation object -\item A character vector of breaks -\item A function that takes the limits as input and returns breaks -as output -}} - \item{limits}{A character vector that defines possible values of the scale -and their order.} - \item{drop}{Should unused factor levels be omitted from the scale? -The default, \code{TRUE}, uses the levels that appear in the data; -\code{FALSE} uses all the levels in the factor.} - \item{na.translate}{Unlike continuous scales, discrete scales can easily show -missing values, and do so by default. If you want to remove missing values -from a discrete scale, specify \code{na.translate = FALSE}.} - \item{na.value}{If \code{na.translate = TRUE}, what value aesthetic -value should missing be displayed as? Does not apply to position scales where \code{NA} is always placed at the far right.} \item{scale_name}{The name of the scale that should be used for error messages associated with this scale.} @@ -159,6 +136,7 @@ Other colour scales: \code{\link{scale_alpha}}, \code{\link{scale_colour_brewer}}, \code{\link{scale_colour_gradient}}, \code{\link{scale_colour_grey}}, + \code{\link{scale_colour_steps}}, \code{\link{scale_colour_viridis_d}} } \concept{colour scales} diff --git a/man/scale_linetype.Rd b/man/scale_linetype.Rd index c99cd17f64..ef2657b68e 100644 --- a/man/scale_linetype.Rd +++ b/man/scale_linetype.Rd @@ -2,12 +2,15 @@ % Please edit documentation in R/scale-linetype.r \name{scale_linetype} \alias{scale_linetype} +\alias{scale_linetype_binned} \alias{scale_linetype_continuous} \alias{scale_linetype_discrete} \title{Scale for line patterns} \usage{ scale_linetype(..., na.value = "blank") +scale_linetype_binned(...) + scale_linetype_continuous(...) scale_linetype_discrete(..., na.value = "blank") @@ -33,26 +36,6 @@ The default, \code{TRUE}, uses the levels that appear in the data; \code{FALSE} uses all the levels in the factor.} \item{na.translate}{Unlike continuous scales, discrete scales can easily show missing values, and do so by default. If you want to remove missing values -from a discrete scale, specify \code{na.translate = FALSE}.} - \item{palette}{A palette function that when called with a single integer -argument (the number of levels in the scale) returns the values that -they should take.} - \item{breaks}{One of: -\itemize{ -\item \code{NULL} for no breaks -\item \code{waiver()} for the default breaks computed by the -transformation object -\item A character vector of breaks -\item A function that takes the limits as input and returns breaks -as output -}} - \item{limits}{A character vector that defines possible values of the scale -and their order.} - \item{drop}{Should unused factor levels be omitted from the scale? -The default, \code{TRUE}, uses the levels that appear in the data; -\code{FALSE} uses all the levels in the factor.} - \item{na.translate}{Unlike continuous scales, discrete scales can easily show -missing values, and do so by default. If you want to remove missing values from a discrete scale, specify \code{na.translate = FALSE}.} \item{aesthetics}{The names of the aesthetics that this scale works with.} \item{scale_name}{The name of the scale that should be used for error messages diff --git a/man/scale_manual.Rd b/man/scale_manual.Rd index a9c0141695..9f0df47334 100644 --- a/man/scale_manual.Rd +++ b/man/scale_manual.Rd @@ -49,29 +49,6 @@ missing values, and do so by default. If you want to remove missing values from a discrete scale, specify \code{na.translate = FALSE}.} \item{na.value}{If \code{na.translate = TRUE}, what value aesthetic value should missing be displayed as? Does not apply to position scales -where \code{NA} is always placed at the far right.} - \item{palette}{A palette function that when called with a single integer -argument (the number of levels in the scale) returns the values that -they should take.} - \item{breaks}{One of: -\itemize{ -\item \code{NULL} for no breaks -\item \code{waiver()} for the default breaks computed by the -transformation object -\item A character vector of breaks -\item A function that takes the limits as input and returns breaks -as output -}} - \item{limits}{A character vector that defines possible values of the scale -and their order.} - \item{drop}{Should unused factor levels be omitted from the scale? -The default, \code{TRUE}, uses the levels that appear in the data; -\code{FALSE} uses all the levels in the factor.} - \item{na.translate}{Unlike continuous scales, discrete scales can easily show -missing values, and do so by default. If you want to remove missing values -from a discrete scale, specify \code{na.translate = FALSE}.} - \item{na.value}{If \code{na.translate = TRUE}, what value aesthetic -value should missing be displayed as? Does not apply to position scales where \code{NA} is always placed at the far right.} \item{scale_name}{The name of the scale that should be used for error messages associated with this scale.} diff --git a/man/scale_shape.Rd b/man/scale_shape.Rd index e71d39c506..00d1cc8d55 100644 --- a/man/scale_shape.Rd +++ b/man/scale_shape.Rd @@ -2,12 +2,15 @@ % Please edit documentation in R/scale-shape.r \name{scale_shape} \alias{scale_shape} +\alias{scale_shape_binned} \alias{scale_shape_discrete} \alias{scale_shape_ordinal} \alias{scale_shape_continuous} \title{Scales for shapes, aka glyphs} \usage{ scale_shape(..., solid = TRUE) + +scale_shape_binned(..., solid = TRUE) } \arguments{ \item{...}{Arguments passed on to \code{discrete_scale} @@ -33,29 +36,6 @@ missing values, and do so by default. If you want to remove missing values from a discrete scale, specify \code{na.translate = FALSE}.} \item{na.value}{If \code{na.translate = TRUE}, what value aesthetic value should missing be displayed as? Does not apply to position scales -where \code{NA} is always placed at the far right.} - \item{palette}{A palette function that when called with a single integer -argument (the number of levels in the scale) returns the values that -they should take.} - \item{breaks}{One of: -\itemize{ -\item \code{NULL} for no breaks -\item \code{waiver()} for the default breaks computed by the -transformation object -\item A character vector of breaks -\item A function that takes the limits as input and returns breaks -as output -}} - \item{limits}{A character vector that defines possible values of the scale -and their order.} - \item{drop}{Should unused factor levels be omitted from the scale? -The default, \code{TRUE}, uses the levels that appear in the data; -\code{FALSE} uses all the levels in the factor.} - \item{na.translate}{Unlike continuous scales, discrete scales can easily show -missing values, and do so by default. If you want to remove missing values -from a discrete scale, specify \code{na.translate = FALSE}.} - \item{na.value}{If \code{na.translate = TRUE}, what value aesthetic -value should missing be displayed as? Does not apply to position scales where \code{NA} is always placed at the far right.} \item{aesthetics}{The names of the aesthetics that this scale works with.} \item{scale_name}{The name of the scale that should be used for error messages diff --git a/man/scale_size.Rd b/man/scale_size.Rd index 94e39c51fa..b63b35b936 100644 --- a/man/scale_size.Rd +++ b/man/scale_size.Rd @@ -3,6 +3,7 @@ \name{scale_size} \alias{scale_size} \alias{scale_size_continuous} +\alias{scale_size_binned} \alias{scale_radius} \alias{scale_size_discrete} \alias{scale_size_ordinal} @@ -152,56 +153,6 @@ expand the scale by 5\% on each side for continuous variables, and by \item{position}{For position scales, The position of the axis. \code{left} or \code{right} for y axes, \code{top} or \code{bottom} for x axes.} \item{super}{The super class to use for the constructed scale} - \item{name}{The name of the scale. Used as the axis or legend title. If -\code{waiver()}, the default, the name of the scale is taken from the first -mapping used for that aesthetic. If \code{NULL}, the legend title will be -omitted.} - \item{breaks}{One of: -\itemize{ -\item \code{NULL} for no breaks -\item \code{waiver()} for the default breaks computed by the -transformation object -\item A numeric vector of positions -\item A function that takes the limits as input and returns breaks -as output -}} - \item{minor_breaks}{One of: -\itemize{ -\item \code{NULL} for no minor breaks -\item \code{waiver()} for the default breaks (one minor break between -each major break) -\item A numeric vector of positions -\item A function that given the limits returns a vector of minor breaks. -}} - \item{labels}{One of: -\itemize{ -\item \code{NULL} for no labels -\item \code{waiver()} for the default labels computed by the -transformation object -\item A character vector giving labels (must be same length as \code{breaks}) -\item A function that takes the breaks as input and returns labels -as output -}} - \item{limits}{A numeric vector of length two providing limits of the scale. -Use \code{NA} to refer to the existing minimum or maximum.} - \item{oob}{Function that handles limits outside of the scale limits -(out of bounds). The default replaces out of bounds values with \code{NA}.} - \item{na.value}{Missing values will be replaced with this value.} - \item{trans}{Either the name of a transformation object, or the -object itself. Built-in transformations include "asn", "atanh", -"boxcox", "exp", "identity", "log", "log10", "log1p", "log2", -"logit", "probability", "probit", "reciprocal", "reverse" and "sqrt". - -A transformation object bundles together a transform, its inverse, -and methods for generating breaks and labels. Transformation objects -are defined in the scales package, and are called \code{name_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 info.} - \item{position}{The position of the axis. "left" or "right" for vertical -scales, "top" or "bottom" for horizontal scales} - \item{super}{The super class to use for the constructed scale} }} \item{max_size}{Size of largest points.} diff --git a/man/scale_steps.Rd b/man/scale_steps.Rd new file mode 100644 index 0000000000..4f62cfba93 --- /dev/null +++ b/man/scale_steps.Rd @@ -0,0 +1,207 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/scale-steps.R +\name{scale_colour_steps} +\alias{scale_colour_steps} +\alias{scale_colour_steps2} +\alias{scale_colour_stepsn} +\alias{scale_fill_steps} +\alias{scale_fill_steps2} +\alias{scale_fill_stepsn} +\title{Binned gradient colour scales} +\usage{ +scale_colour_steps(..., low = "#132B43", high = "#56B1F7", + space = "Lab", na.value = "grey50", guide = "coloursteps", + aesthetics = "colour") + +scale_colour_steps2(..., low = muted("red"), mid = "white", + high = muted("blue"), midpoint = 0, space = "Lab", + na.value = "grey50", guide = "coloursteps", aesthetics = "colour") + +scale_colour_stepsn(..., colours, values = NULL, space = "Lab", + na.value = "grey50", guide = "coloursteps", aesthetics = "colour", + colors) + +scale_fill_steps(..., low = "#132B43", high = "#56B1F7", + space = "Lab", na.value = "grey50", guide = "coloursteps", + aesthetics = "fill") + +scale_fill_steps2(..., low = muted("red"), mid = "white", + high = muted("blue"), midpoint = 0, space = "Lab", + na.value = "grey50", guide = "coloursteps", aesthetics = "fill") + +scale_fill_stepsn(..., colours, values = NULL, space = "Lab", + na.value = "grey50", guide = "coloursteps", aesthetics = "fill", + colors) +} +\arguments{ +\item{...}{Arguments passed on to \code{binned_scale} +\describe{ + \item{n.breaks}{The number of break points to create if breaks are not given +directly. It will attempt to find nice breakpoint and may thus not give the +exact number of breaks as requested.} + \item{right}{Should values on the border between bins be part of the right +(upper) bin?} + \item{show.limits}{should the limits of the scale appear as ticks} + \item{scale_name}{The name of the scale that should be used for error messages +associated with this scale.} + \item{palette}{A palette function that when called with a numeric vector with +values between 0 and 1 returns the corresponding output values +(e.g., \code{\link[scales:area_pal]{scales::area_pal()}}).} + \item{name}{The name of the scale. Used as the axis or legend title. If +\code{waiver()}, the default, the name of the scale is taken from the first +mapping used for that aesthetic. If \code{NULL}, the legend title will be +omitted.} + \item{breaks}{One of: +\itemize{ +\item \code{NULL} for no breaks +\item \code{waiver()} for the default breaks computed by the +\link[scales:trans_new]{transformation object} +\item A numeric vector of positions +\item A function that takes the limits as input and returns breaks +as output (e.g., a function returned by \code{\link[scales:extended_breaks]{scales::extended_breaks()}}) +}} + \item{labels}{One of: +\itemize{ +\item \code{NULL} for no labels +\item \code{waiver()} for the default labels computed by the +transformation object +\item A character vector giving labels (must be same length as \code{breaks}) +\item A function that takes the breaks as input and returns labels +as output +}} + \item{limits}{One of: +\itemize{ +\item \code{NULL} to use the default scale range +\item A numeric vector of length two providing limits of the scale. +Use \code{NA} to refer to the existing minimum or maximum +\item A function that accepts the existing (automatic) limits and returns +new limits +Note that setting limits on positional scales will \strong{remove} data outside of the limits. +If the purpose is to zoom, use the limit argument in the coordinate system +(see \code{\link[=coord_cartesian]{coord_cartesian()}}). +}} + \item{rescaler}{A function used to scale the input values to the +range [0, 1]. This is always \code{\link[scales:rescale]{scales::rescale()}}, except for +diverging and n colour gradients (i.e., \code{\link[=scale_colour_gradient2]{scale_colour_gradient2()}}, +\code{\link[=scale_colour_gradientn]{scale_colour_gradientn()}}). The \code{rescaler} is ignored by position +scales, which ways use \code{\link[scales:rescale]{scales::rescale()}}.} + \item{oob}{One of: +\itemize{ +\item Function that handles limits outside of the scale limits +(out of bounds). +\item The default (\code{\link[scales:censor]{scales::censor()}}) replaces out of +bounds values with \code{NA}. +\item \code{\link[scales:squish]{scales::squish()}} for squishing out of bounds values into range. +\item \code{\link[scales:squish_infinite]{scales::squish_infinite()}} for squishing infitite values into range. +}} + \item{expand}{For position scales, a vector of range expansion constants used to add some +padding around the data to ensure that they are placed some distance +away from the axes. Use the convenience function \code{\link[=expansion]{expansion()}} +to generate the values for the \code{expand} argument. The defaults are to +expand the scale by 5\% on each side for continuous variables, and by +0.6 units on each side for discrete variables.} + \item{trans}{For continuous scales, the name of a transformation object +or the object itself. Built-in transformations include "asn", "atanh", +"boxcox", "date", "exp", "hms", "identity", "log", "log10", "log1p", "log2", +"logit", "modulus", "probability", "probit", "pseudo_log", "reciprocal", +"reverse", "sqrt" and "time". + +A transformation object bundles together a transform, its inverse, +and methods for generating breaks and labels. Transformation objects +are defined in the scales package, and are called \code{_trans} (e.g., +\code{\link[scales:boxcox_trans]{scales::boxcox_trans()}}). You can create your own +transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} + \item{position}{For position scales, The position of the axis. +\code{left} or \code{right} for y axes, \code{top} or \code{bottom} for x axes.} + \item{super}{The super class to use for the constructed scale} +}} + +\item{low, high}{Colours for low and high ends of the gradient.} + +\item{space}{colour space in which to calculate gradient. Must be "Lab" - +other values are deprecated.} + +\item{na.value}{Colour to use for missing values} + +\item{guide}{Type of legend. Use \code{"coloursteps"} for continuous +colour bar, or \code{"bins"} for discrete colour legend.} + +\item{aesthetics}{Character string or vector of character strings listing the +name(s) of the aesthetic(s) that this scale works with. This can be useful, for +example, to apply colour settings to the \code{colour} and \code{fill} aesthetics at the +same time, via \code{aesthetics = c("colour", "fill")}.} +} +\description{ +\code{scale_*_steps} creates a two colour binned gradient (low-high), +\code{scale_*_stepsn} creates a n-colour binned gradient. +} +\details{ +Default colours are generated with \pkg{munsell} and +\code{mnsl(c("2.5PB 2/4", "2.5PB 7/10"))}. Generally, for continuous +colour scales you want to keep hue constant, but vary chroma and +luminance. The \pkg{munsell} package makes this easy to do using the +Munsell colour system. +} +\examples{ +df <- data.frame( + x = runif(100), + y = runif(100), + z1 = rnorm(100), + z2 = abs(rnorm(100)) +) + +df_na <- data.frame( + value = seq(1, 20), + x = runif(20), + y = runif(20), + z1 = c(rep(NA, 10), rnorm(10)) +) + +# Default colour scale colours from light blue to dark blue +ggplot(df, aes(x, y)) + + geom_point(aes(colour = z2)) + +# For diverging colour scales use gradient2 +ggplot(df, aes(x, y)) + + geom_point(aes(colour = z1)) + + scale_colour_gradient2() + +# Use your own colour scale with gradientn +ggplot(df, aes(x, y)) + + geom_point(aes(colour = z1)) + + scale_colour_gradientn(colours = terrain.colors(10)) + +# Equivalent fill scales do the same job for the fill aesthetic +ggplot(faithfuld, aes(waiting, eruptions)) + + geom_raster(aes(fill = density)) + + scale_fill_gradientn(colours = terrain.colors(10)) + +# Adjust colour choices with low and high +ggplot(df, aes(x, y)) + + geom_point(aes(colour = z2)) + + scale_colour_gradient(low = "white", high = "black") +# Avoid red-green colour contrasts because ~10\% of men have difficulty +# seeing them + +# Use `na.value = NA` to hide missing values but keep the original axis range +ggplot(df_na, aes(x = value, y)) + + geom_bar(aes(fill = z1), stat = "identity") + + scale_fill_gradient(low = "yellow", high = "red", na.value = NA) + + ggplot(df_na, aes(x, y)) + + geom_point(aes(colour = z1)) + + scale_colour_gradient(low = "yellow", high = "red", na.value = NA) + +} +\seealso{ +\code{\link[scales:seq_gradient_pal]{scales::seq_gradient_pal()}} for details on underlying +palette + +Other colour scales: \code{\link{scale_alpha}}, + \code{\link{scale_colour_brewer}}, + \code{\link{scale_colour_gradient}}, + \code{\link{scale_colour_grey}}, + \code{\link{scale_colour_hue}}, + \code{\link{scale_colour_viridis_d}} +} +\concept{colour scales} diff --git a/man/scale_viridis.Rd b/man/scale_viridis.Rd index 6faca738fb..9e7bbf5e24 100644 --- a/man/scale_viridis.Rd +++ b/man/scale_viridis.Rd @@ -5,6 +5,8 @@ \alias{scale_fill_viridis_d} \alias{scale_colour_viridis_c} \alias{scale_fill_viridis_c} +\alias{scale_colour_viridis_b} +\alias{scale_fill_viridis_b} \alias{scale_colour_ordinal} \alias{scale_color_ordinal} \alias{scale_fill_ordinal} @@ -25,6 +27,14 @@ scale_colour_viridis_c(..., alpha = 1, begin = 0, end = 1, scale_fill_viridis_c(..., alpha = 1, begin = 0, end = 1, direction = 1, option = "D", values = NULL, space = "Lab", na.value = "grey50", guide = "colourbar", aesthetics = "fill") + +scale_colour_viridis_b(..., alpha = 1, begin = 0, end = 1, + direction = 1, option = "D", values = NULL, space = "Lab", + na.value = "grey50", guide = "coloursteps", aesthetics = "colour") + +scale_fill_viridis_b(..., alpha = 1, begin = 0, end = 1, + direction = 1, option = "D", values = NULL, space = "Lab", + na.value = "grey50", guide = "coloursteps", aesthetics = "fill") } \arguments{ \item{...}{Other arguments passed on to \code{\link[=discrete_scale]{discrete_scale()}} or @@ -107,6 +117,7 @@ Other colour scales: \code{\link{scale_alpha}}, \code{\link{scale_colour_brewer}}, \code{\link{scale_colour_gradient}}, \code{\link{scale_colour_grey}}, - \code{\link{scale_colour_hue}} + \code{\link{scale_colour_hue}}, + \code{\link{scale_colour_steps}} } \concept{colour scales} From 267095fe15d5934b14050e99e1244ddee8513ee6 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 25 Sep 2019 22:12:27 +0200 Subject: [PATCH 25/30] fix blender scales to work with rescaler fix --- R/scale-brewer.r | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/scale-brewer.r b/R/scale-brewer.r index 511ee2ac73..739861901c 100644 --- a/R/scale-brewer.r +++ b/R/scale-brewer.r @@ -112,7 +112,7 @@ scale_colour_blender <- function(..., type = "seq", palette = 1, direction = -1, if (type == "qual") { warning("Using a discrete colour palette in a binned scale.\n Consider using type = \"seq\" or type = \"div\" instead", call. = FALSE) } - binned_scale(aesthetics, "blender", brewer_pal(type, palette, direction), na.value = na.value, guide = guide, ...) + binned_scale(aesthetics, "blender", binned_pal(brewer_pal(type, palette, direction)), na.value = na.value, guide = guide, ...) } #' @export @@ -122,7 +122,7 @@ scale_fill_blender <- function(..., type = "seq", palette = 1, direction = -1, n if (type == "qual") { warning("Using a discrete colour palette in a binned scale.\n Consider using type = \"seq\" or type = \"div\" instead", call. = FALSE) } - binned_scale(aesthetics, "distiller", brewer_pal(type, palette, direction), na.value = na.value, guide = guide, ...) + binned_scale(aesthetics, "distiller", binned_pal(brewer_pal(type, palette, direction)), na.value = na.value, guide = guide, ...) } # icon.brewer <- function() { From 5299fa9239ee52f0bf2f09ca15085735e0c4f771 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 25 Sep 2019 22:12:49 +0200 Subject: [PATCH 26/30] update position scales to work properly with the new ViewScale setup --- R/scale-binned.R | 26 ++++---------------------- 1 file changed, 4 insertions(+), 22 deletions(-) diff --git a/R/scale-binned.R b/R/scale-binned.R index f0dbc7de5f..7c112f2d6c 100644 --- a/R/scale-binned.R +++ b/R/scale-binned.R @@ -97,30 +97,12 @@ ScaleBinnedPosition <- ggproto("ScaleBinnedPosition", ScaleBinned, self$range$reset() self$range$train(c(limits, breaks)) }, - break_info = function(self, range = NULL) { - # range - if (is.null(range)) range <- self$dimension() - # major breaks - major <- self$get_breaks(range) + get_breaks = function(self, limits = self$get_limits()) { + breaks <- ggproto_parent(ScaleBinned, self)$get_breaks(limits) if (self$show.limits) { - limits <- self$get_limits() - major <- sort(unique(c(limits, major))) + breaks <- sort(unique(c(self$get_limits(), breaks))) } - - # labels - labels <- self$get_labels(major) - - # rescale breaks [0, 1], which are used by coord/guide - major_n <- rescale(major, from = range) - - list( - range = range, - labels = labels, - major = major_n, - minor = NULL, - major_source = major, - minor_source = NULL - ) + breaks } ) From fd394e4924a8174238c84e947b4baec5a76c6750 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Thu, 26 Sep 2019 13:37:09 +0200 Subject: [PATCH 27/30] Improve structure. Add binning scale documentation to all relevant entries and make docs for new entities --- DESCRIPTION | 1 + NAMESPACE | 5 ++ NEWS.md | 4 + R/guide-bins.R | 45 ++++++++++++ R/guide-colorbar.r | 73 ------------------ R/guide-colorsteps.R | 106 +++++++++++++++++++++++++++ R/scale-.r | 42 +++++++---- R/scale-alpha.r | 2 +- R/scale-binned.R | 26 ++++--- R/scale-brewer.r | 13 +++- R/scale-colour.r | 31 +++++++- R/scale-linetype.r | 5 +- R/scale-shape.r | 3 +- R/scale-size.r | 20 ++++- R/scale-steps.R | 58 ++++----------- R/scale-viridis.r | 9 ++- R/zxx.r | 28 ++++--- man/binned_scale.Rd | 15 ++-- man/guide_bins.Rd | 130 +++++++++++++++++++++++++++++++++ man/guide_colourbar.Rd | 19 +---- man/guide_coloursteps.Rd | 120 ++++++++++++++++++++++++++++++ man/guide_legend.Rd | 5 +- man/guides.Rd | 4 +- man/scale_alpha.Rd | 2 +- man/scale_binned.Rd | 27 ++++--- man/scale_brewer.Rd | 13 +++- man/scale_colour_continuous.Rd | 8 +- man/scale_gradient.Rd | 2 - man/scale_linetype.Rd | 5 +- man/scale_shape.Rd | 3 +- man/scale_size.Rd | 19 ++++- man/scale_steps.Rd | 94 +++++++++++------------- man/scale_viridis.Rd | 9 ++- 33 files changed, 679 insertions(+), 267 deletions(-) create mode 100644 R/guide-colorsteps.R create mode 100644 man/guide_bins.Rd create mode 100644 man/guide_coloursteps.Rd diff --git a/DESCRIPTION b/DESCRIPTION index e9bd02223d..78730a1632 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -155,6 +155,7 @@ Collate: 'grouping.r' 'guide-bins.R' 'guide-colorbar.r' + 'guide-colorsteps.R' 'guide-legend.r' 'guides-.r' 'guides-axis.r' diff --git a/NAMESPACE b/NAMESPACE index 65bcceadaf..e86ee8173b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -365,6 +365,7 @@ export(ggproto) export(ggproto_parent) export(ggsave) export(ggtitle) +export(guide_bins) export(guide_colorbar) export(guide_colorsteps) export(guide_colourbar) @@ -450,6 +451,8 @@ export(scale_color_identity) export(scale_color_manual) export(scale_color_ordinal) export(scale_color_steps) +export(scale_color_steps2) +export(scale_color_stepsn) export(scale_color_viridis_c) export(scale_color_viridis_d) export(scale_colour_binned) @@ -477,6 +480,7 @@ export(scale_colour_viridis_d) export(scale_continuous_identity) export(scale_discrete_identity) export(scale_discrete_manual) +export(scale_fill_binned) export(scale_fill_blender) export(scale_fill_brewer) export(scale_fill_continuous) @@ -515,6 +519,7 @@ export(scale_shape_ordinal) export(scale_size) export(scale_size_area) export(scale_size_binned) +export(scale_size_binned_area) export(scale_size_continuous) export(scale_size_date) export(scale_size_datetime) diff --git a/NEWS.md b/NEWS.md index 5e96c37dcf..9644ddaff0 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,9 @@ # ggplot2 (development version) +* A new scale type has been added, that allows binning of aesthetics at the + scale level. It has versions for both position and non-position aesthetics and + comes with two new guides (`guide_bins` and `guide_coloursteps`) (@thomasp85, #3096) + * `Geom` now gains a `setup_params()` method in line with the other ggproto classes (@thomasp85, #3509) diff --git a/R/guide-bins.R b/R/guide-bins.R index 41cb55cbb3..88a21e1c10 100644 --- a/R/guide-bins.R +++ b/R/guide-bins.R @@ -1,3 +1,48 @@ +#' A binned version of guide_legend +#' +#' This guide is a version of the [guide_legend()] guide for binned scales. It +#' differs in that it places ticks correctly between the keys, and sports a +#' small axis to better show the binning. Like [guide_legend()] it can be used +#' for all non-position aesthetics though colour and fill defaults to +#' [guide_coloursteps()], and it will merge aesthetics together into the same +#' guide if they are mapped in the same way. +#' +#' @inheritParams guide_legend +#' @param axis Logical. Should a small axis be drawn along the guide +#' @param axis.colour,axis.linewidth Graphic specifications for the look of the +#' axis. +#' @param axis.arrow A call to `arrow()` to specify arrows at the end of the +#' axis line, thus showing an open interval. +#' @param show.limits Logical. Should the limits of the scale be shown with +#' labels and ticks. +#' +#' @return A guide object +#' @family guides +#' @export +#' +#' @examples +#' p <- ggplot(mtcars) + +#' geom_point(aes(disp, mpg, size = hp)) + +#' scale_size_binned() +#' +#' # Standard look +#' p +#' +#' # Remove the axis or style it +#' p + guides(size = guide_bins(axis = FALSE)) +#' +#' p + guides(size = guide_bins(show.limits = TRUE)) +#' +#' p + guides(size = guide_bins( +#' axis.arrow = arrow(length = unit(1.5, 'mm'), ends = 'both') +#' )) +#' +#' # Guides are merged together if possible +#' ggplot(mtcars) + +#' geom_point(aes(disp, mpg, size = hp, colour = hp)) + +#' scale_size_binned() + +#' scale_colour_binned(guide = "bins") +#' guide_bins <- function( # title title = waiver(), diff --git a/R/guide-colorbar.r b/R/guide-colorbar.r index f815767f8f..26a959ad3f 100644 --- a/R/guide-colorbar.r +++ b/R/guide-colorbar.r @@ -566,76 +566,3 @@ guide_gengrob.colorbar <- function(guide, theme) { #' @export #' @rdname guide_colourbar guide_colorbar <- guide_colourbar - -#' @export -#' @rdname guide_colourbar -#' -#' @param even.steps Should the bin sizes reflect their size or be even across all -#' bins? Defaults to `TRUE` -#' @param show.limits Should labels for the outer limits of the bins be printed? -#' Default is `NULL` which makes the guide use the setting from the scale -guide_coloursteps <- function(even.steps = TRUE, show.limits = NULL, ticks = FALSE, nbin = 100, ...) { - guide <- guide_colourbar(raster = FALSE, ticks = ticks, nbin = nbin, ...) - guide$even.steps <- even.steps - guide$show.limits <- show.limits - class(guide) <- c('colorsteps', class(guide)) - guide -} -#' @export -#' @rdname guide_colourbar -guide_colorsteps <- guide_coloursteps - -#' @export -guide_train.colorsteps <- function(guide, scale, aesthetic = NULL) { - if (guide$even.steps) { - breaks <- scale$get_breaks() - if (length(breaks) == 0 || all(is.na(breaks))) - return() - limits <- scale$get_limits() - all_breaks <- c(limits[1], breaks, limits[2]) - bin_at <- all_breaks[-1] - diff(all_breaks) / 2 - ticks <- new_data_frame(setNames(list(scale$map(breaks)), aesthetic %||% scale$aesthetics[1])) - ticks$.value <- seq_along(breaks) - 0.5 - ticks$.label <- scale$get_labels(breaks) - guide$nbin <- length(breaks) + 1 - guide$key <- ticks - guide$bar <- new_data_frame(list(colour = scale$map(bin_at), value = seq_along(bin_at) - 1), n = length(bin_at)) - if (guide$reverse) { - guide$key <- guide$key[nrow(guide$key):1, ] - guide$bar <- guide$bar[nrow(guide$bar):1, ] - } - guide$hash <- with(guide, digest::digest(list(title, key$.label, bar, name))) - } else { - guide <- NextMethod() - } - if (guide$show.limits %||% scale$show.limits %||% FALSE) { - edges <- rescale(c(0, 1), to = guide$bar$value[c(1, nrow(guide$bar))], from = c(0.5, guide$nbin - 0.5) / guide$nbin) - limits <- scale$get_limits() - guide$key <- guide$key[c(NA, seq_len(nrow(guide$key)), NA), , drop = FALSE] - guide$key$.value[c(1, nrow(guide$key))] <- edges - guide$key$.label[c(1, nrow(guide$key))] <- scale$get_labels(limits) - } - guide -} - -#' Calculate the default hjust and vjust settings depending on legend -#' direction and position. -#' -#' @noRd -label_just_defaults.colorbar <- function(direction, position) { - if (direction == "horizontal") { - switch( - position, - "top" = list(hjust = 0.5, vjust = 0), - list(hjust = 0.5, vjust = 1) - ) - } - else { - switch( - position, - "left" = list(hjust = 1, vjust = 0.5), - list(hjust = 0, vjust = 0.5) - ) - } -} - diff --git a/R/guide-colorsteps.R b/R/guide-colorsteps.R new file mode 100644 index 0000000000..fcbabf448f --- /dev/null +++ b/R/guide-colorsteps.R @@ -0,0 +1,106 @@ +#' Discretized colourbar guide +#' +#' This guide is version of [guide_colourbar()] for binned colour and fill +#' scales. It shows areas between breaks as a single constant colour instead of +#' the gradient known from the colourbar counterpart. +#' +#' @param even.steps Should the rendered size of the bins be equal, or should +#' they be proportional to their length in the data space? Defaults to `TRUE` +#' @param show.limits Should labels for the outer limits of the bins be printed? +#' Default is `NULL` which makes the guide use the setting from the scale +#' @param ticks A logical specifying if tick marks on the colourbar should be +#' visible. +#' @inheritDotParams guide_colourbar -nbin -raster -ticks -available_aes +#' +#' @return A guide object +#' @export +#' +#' @family guides +#' @examples +#' df <- reshape2::melt(outer(1:10, 1:10), varnames = c("X1", "X2")) +#' +#' p <- ggplot(df, aes(X1, X2)) + geom_tile(aes(fill = value)) +#' +#' # Coloursteps guide is the default for binned colour scales +#' p + scale_fill_binned() +#' +#' # By default each bin in the guide is the same size irrespectively of how +#' # their sizes relate in data space +#' p + scale_fill_binned(breaks = c(10, 25, 50)) +#' +#' # This can be changed with the `even.steps` argument +#' p + scale_fill_binned( +#' breaks = c(10, 25, 50), +#' guide = guide_coloursteps(even.steps = FALSE) +#' ) +#' +#' # By default the limits is not shown, but this can be changed +#' p + scale_fill_binned(guide = guide_coloursteps(show.limits = TRUE)) +#' +#' # (can also be set in the scale) +#' p + scale_fill_binned(show.limits = TRUE) +#' +guide_coloursteps <- function(even.steps = TRUE, show.limits = NULL, ticks = FALSE, ...) { + guide <- guide_colourbar(raster = FALSE, ticks = ticks, nbin = 100, ...) + guide$even.steps <- even.steps + guide$show.limits <- show.limits + class(guide) <- c('colorsteps', class(guide)) + guide +} +#' @export +#' @rdname guide_coloursteps +guide_colorsteps <- guide_coloursteps + +#' @export +guide_train.colorsteps <- function(guide, scale, aesthetic = NULL) { + if (guide$even.steps) { + breaks <- scale$get_breaks() + if (length(breaks) == 0 || all(is.na(breaks))) + return() + limits <- scale$get_limits() + all_breaks <- c(limits[1], breaks, limits[2]) + bin_at <- all_breaks[-1] - diff(all_breaks) / 2 + ticks <- new_data_frame(setNames(list(scale$map(breaks)), aesthetic %||% scale$aesthetics[1])) + ticks$.value <- seq_along(breaks) - 0.5 + ticks$.label <- scale$get_labels(breaks) + guide$nbin <- length(breaks) + 1 + guide$key <- ticks + guide$bar <- new_data_frame(list(colour = scale$map(bin_at), value = seq_along(bin_at) - 1), n = length(bin_at)) + if (guide$reverse) { + guide$key <- guide$key[nrow(guide$key):1, ] + guide$bar <- guide$bar[nrow(guide$bar):1, ] + } + guide$hash <- with(guide, digest::digest(list(title, key$.label, bar, name))) + } else { + guide <- NextMethod() + } + if (guide$show.limits %||% scale$show.limits %||% FALSE) { + edges <- rescale(c(0, 1), to = guide$bar$value[c(1, nrow(guide$bar))], from = c(0.5, guide$nbin - 0.5) / guide$nbin) + limits <- scale$get_limits() + guide$key <- guide$key[c(NA, seq_len(nrow(guide$key)), NA), , drop = FALSE] + guide$key$.value[c(1, nrow(guide$key))] <- edges + guide$key$.label[c(1, nrow(guide$key))] <- scale$get_labels(limits) + } + guide +} + +#' Calculate the default hjust and vjust settings depending on legend +#' direction and position. +#' +#' @noRd +label_just_defaults.colorbar <- function(direction, position) { + if (direction == "horizontal") { + switch( + position, + "top" = list(hjust = 0.5, vjust = 0), + list(hjust = 0.5, vjust = 1) + ) + } + else { + switch( + position, + "left" = list(hjust = 1, vjust = 0.5), + list(hjust = 0, vjust = 0.5) + ) + } +} diff --git a/R/scale-.r b/R/scale-.r index d399afdbbb..76e32d006d 100644 --- a/R/scale-.r +++ b/R/scale-.r @@ -190,18 +190,22 @@ discrete_scale <- function(aesthetics, scale_name, palette, name = waiver(), #' #' @inheritParams continuous_scale #' @param n.breaks The number of break points to create if breaks are not given -#' directly. It will attempt to find nice breakpoint and may thus not give the -#' exact number of breaks as requested. +#' directly. +#' @param nice.breaks Logical. Should breaks be attempted placed at nice values +#' instead of exactly evenly spaced between the limits. If `TRUE` (default) +#' the scale will ask the transformation object to create breaks, and this +#' may result in a different number of breaks than requested. Ignored if +#' breaks are given explicetly. #' @param right Should values on the border between bins be part of the right -#' (upper) bin? +#' (upper) bin? #' @param show.limits should the limits of the scale appear as ticks #' @keywords internal binned_scale <- function(aesthetics, scale_name, palette, name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, rescaler = rescale, oob = squish, expand = waiver(), - na.value = NA_real_, n.breaks = NULL, right = TRUE, - trans = "identity", show.limits = FALSE, guide = "bins", - position = "left", super = ScaleBinned) { + na.value = NA_real_, n.breaks = NULL, nice.breaks = TRUE, + right = TRUE, trans = "identity", show.limits = FALSE, + guide = "bins", position = "left", super = ScaleBinned) { aesthetics <- standardise_aes_names(aesthetics) @@ -233,6 +237,7 @@ binned_scale <- function(aesthetics, scale_name, palette, name = waiver(), rescaler = rescaler, oob = oob, n.breaks = n.breaks, + nice.breaks = nice.breaks, right = right, show.limits = show.limits, @@ -876,6 +881,7 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, rescaler = rescale, oob = squish, n.breaks = NULL, + nice.breaks = TRUE, right = TRUE, after.stat = FALSE, show.limits = FALSE, @@ -905,9 +911,10 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, x } else { breaks <- self$get_breaks(limits) + breaks <- sort(unique(c(limits[1], breaks, limits[2]))) x <- self$rescale(self$oob(x, range = limits), limits) - breaks <- self$rescale(c(limits[1], breaks, limits[2]), limits) + breaks <- self$rescale(breaks, limits) x_binned <- cut(x, breaks, labels = FALSE, @@ -944,16 +951,25 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, } else if (identical(self$breaks, NA)) { stop("Invalid breaks specification. Use NULL, not NA", call. = FALSE) } else if (is.waive(self$breaks)) { - if (!is.null(self$n.breaks) && "n" %in% names(formals(self$trans$breaks))) { - breaks <- self$trans$breaks(limits, n = self$n.breaks) - } else { - if (!is.null(self$n.breaks)) { - warning("Ignoring n.breaks. Use a trans object that supports setting number of breaks", call. = FALSE) + if (self$nice.breaks) { + if (!is.null(self$n.breaks) && "n" %in% names(formals(self$trans$breaks))) { + breaks <- self$trans$breaks(limits, n = self$n.breaks) + } else { + if (!is.null(self$n.breaks)) { + warning("Ignoring n.breaks. Use a trans object that supports setting number of breaks", call. = FALSE) + } + breaks <- self$trans$breaks(limits) } - breaks <- self$trans$breaks(limits) + } else { + n.breaks <- self$n.breaks %||% 5 # same default as trans objects + breaks <- seq(limits[1], limits[2], length.out = n.breaks + 2) + breaks <- breaks[-c(1, length(breaks))] } + # Ensure terminal bins are same width if limits not set if (is.null(self$limits)) { + # Remove calculated breaks if they coincide with limits + breaks <- setdiff(breaks, limits) nbreaks <- length(breaks) if (nbreaks >= 2) { new_limits <- c(2 * breaks[1] - breaks[2], 2 * breaks[nbreaks] - breaks[nbreaks - 1]) diff --git a/R/scale-alpha.r b/R/scale-alpha.r index 00a4fee8bf..9c59f09d20 100644 --- a/R/scale-alpha.r +++ b/R/scale-alpha.r @@ -5,7 +5,7 @@ #' `scale_alpha` is an alias for `scale_alpha_continuous` since #' that is the most common use of alpha, and it saves a bit of typing. #' -#' @param ... Other arguments passed on to [continuous_scale()] +#' @param ... Other arguments passed on to [continuous_scale()], [binned_scale], #' or [discrete_scale()] as appropriate, to control name, limits, #' breaks, labels and so forth. #' @param range Output range of alpha values. Must lie between 0 and 1. diff --git a/R/scale-binned.R b/R/scale-binned.R index 7c112f2d6c..4a869bc726 100644 --- a/R/scale-binned.R +++ b/R/scale-binned.R @@ -21,32 +21,34 @@ NULL #' @rdname scale_binned #' #' @export -scale_x_binned <- function(name = waiver(), n.breaks = 10, breaks = waiver(), - labels = waiver(), limits = NULL, expand = waiver(), - oob = squish, na.value = NA_real_, right = TRUE, - show.limits = FALSE, trans = "identity", position = "bottom") { +scale_x_binned <- function(name = waiver(), n.breaks = 10, nice.breaks = TRUE, + breaks = waiver(), labels = waiver(), limits = NULL, + expand = waiver(), oob = squish, na.value = NA_real_, + right = TRUE, show.limits = FALSE, trans = "identity", + position = "bottom") { binned_scale( aesthetics = c("x", "xmin", "xmax", "xend", "xintercept", "xmin_final", "xmax_final", "xlower", "xmiddle", "xupper"), scale_name = "position_b", palette = identity, name = name, breaks = breaks, labels = labels, limits = limits, expand = expand, oob = oob, na.value = na.value, - n.breaks = n.breaks, right = right, trans = trans, show.limits = show.limits, - guide = "none", position = position, super = ScaleBinnedPosition + n.breaks = n.breaks, nice.breaks = nice.breaks, right = right, trans = trans, + show.limits = show.limits, guide = "none", position = position, super = ScaleBinnedPosition ) } #' @rdname scale_binned #' #' @export -scale_y_binned <- function(name = waiver(), n.breaks = 10, breaks = waiver(), - labels = waiver(), limits = NULL, expand = waiver(), - oob = squish, na.value = NA_real_, right = TRUE, - show.limits = FALSE, trans = "identity", position = "left") { +scale_y_binned <- function(name = waiver(), n.breaks = 10, nice.breaks = TRUE, + breaks = waiver(), labels = waiver(), limits = NULL, + expand = waiver(), oob = squish, na.value = NA_real_, + right = TRUE, show.limits = FALSE, trans = "identity", + position = "left") { binned_scale( aesthetics = c("y", "ymin", "ymax", "yend", "yintercept", "ymin_final", "ymax_final", "lower", "middle", "upper"), scale_name = "position_b", palette = identity, name = name, breaks = breaks, labels = labels, limits = limits, expand = expand, oob = oob, na.value = na.value, - n.breaks = n.breaks, right = right, trans = trans, show.limits = show.limits, - guide = "none", position = position, super = ScaleBinnedPosition + n.breaks = n.breaks, nice.breaks = nice.breaks, right = right, trans = trans, + show.limits = show.limits, guide = "none", position = position, super = ScaleBinnedPosition ) } diff --git a/R/scale-brewer.r b/R/scale-brewer.r index 739861901c..dade5151d0 100644 --- a/R/scale-brewer.r +++ b/R/scale-brewer.r @@ -8,7 +8,8 @@ #' #' @note #' The `distiller` scales extend brewer to continuous scales by smoothly -#' interpolating 7 colours from any palette to a continuous scale. +#' interpolating 7 colours from any palette to a continuous scale. The `blender` +#' scales provide binned versions of the brewer scales. #' #' @details #' The `brewer` scales were carefully designed and tested on discrete data. @@ -32,9 +33,9 @@ #' @param palette If a string, will use that named palette. If a number, will index into #' the list of palettes of appropriate `type`. The list of available palettes can found #' in the Palettes section. -#' @param ... Other arguments passed on to [discrete_scale()] or, for -#' `distiller` scales, [continuous_scale()] to control name, -#' limits, breaks, labels and so forth. +#' @param ... Other arguments passed on to [discrete_scale()], [continuous_scale()], +#' or [binned_scale()], for `brewer`, `distiller`, and `blender` variants +#' respectively, to control name, limits, breaks, labels and so forth. #' @family colour scales #' @rdname scale_brewer #' @export @@ -69,6 +70,10 @@ #' v #' v + scale_fill_distiller() #' v + scale_fill_distiller(palette = "Spectral") +#' +#' # or use blender variants to discretize continuous data +#' v + scale_fill_blender() +#' scale_colour_brewer <- function(..., type = "seq", palette = 1, direction = 1, aesthetics = "colour") { discrete_scale(aesthetics, "brewer", brewer_pal(type, palette, direction), ...) } diff --git a/R/scale-colour.r b/R/scale-colour.r index d50fb9e22c..e9637a9120 100644 --- a/R/scale-colour.r +++ b/R/scale-colour.r @@ -1,4 +1,4 @@ -#' Continuous colour scales +#' Continuous and binned colour scales #' #' Colour scales for continuous data default to the values of the #' `ggplot2.continuous.colour` and `ggplot2.continuous.fill` options. If these @@ -9,7 +9,8 @@ #' @param type One of "gradient" (the default) or "viridis" indicating the #' colour scale to use #' @seealso [scale_colour_gradient()], [scale_colour_viridis_c()], -#' [scale_fill_gradient()], and [scale_fill_viridis_c()] +#' [scale_colour_steps()], [scale_colour_viridis_b()], [scale_fill_gradient()], +#' [scale_fill_viridis_c()], [scale_fill_steps()], and [scale_fill_viridis_b()] #' @export #' @rdname scale_colour_continuous #' @section Color Blindness: @@ -58,3 +59,29 @@ scale_fill_continuous <- function(..., stop("Unknown scale type", call. = FALSE) ) } + +#' @export +#' @rdname scale_colour_continuous +#' @usage NULL +scale_colour_binned <- function(..., + type = getOption("ggplot2.continuous.colour", default = "gradient")) { + switch( + type, + gradient = scale_colour_steps(...), + viridis = scale_colour_viridis_b(...), + stop("Unknown scale type", call. = FALSE) + ) +} + +#' @export +#' @rdname scale_colour_continuous +#' @usage NULL +scale_fill_binned <- function(..., + type = getOption("ggplot2.continuous.colour", default = "gradient")) { + switch( + type, + gradient = scale_fill_steps(...), + viridis = scale_fill_viridis_b(...), + stop("Unknown scale type", call. = FALSE) + ) +} diff --git a/R/scale-linetype.r b/R/scale-linetype.r index 621399fd12..e7c7ac7d6e 100644 --- a/R/scale-linetype.r +++ b/R/scale-linetype.r @@ -2,7 +2,8 @@ #' #' Default line types based on a set supplied by Richard Pearson, #' University of Manchester. Continuous values can not be mapped to -#' line types. +#' line types unless `scale_linetype_binned()` is used. Still, as linetypes has +#' no inherent order, this use is not advised. #' #' @inheritParams scale_x_discrete #' @inheritDotParams discrete_scale -expand -position -na.value @@ -35,7 +36,7 @@ scale_linetype <- function(..., na.value = "blank") { #' @rdname scale_linetype #' @export -scale_linetype_binned <- function(...) { +scale_linetype_binned <- function(..., na.value = "blank") { binned_scale("linetype", "linetype_b", binned_pal(linetype_pal()), ...) } diff --git a/R/scale-shape.r b/R/scale-shape.r index 6663084d83..8c496f1d92 100644 --- a/R/scale-shape.r +++ b/R/scale-shape.r @@ -4,7 +4,8 @@ #' If you have more than six levels, you will get a warning message, and the #' seventh and subsequence levels will not appear on the plot. Use #' [scale_shape_manual()] to supply your own values. You can not map -#' a continuous variable to shape. +#' a continuous variable to shape unless `scale_shape_binned()` is used. Still, +#' as shape has no inherent order, this use is not advised.. #' #' @param solid Should the shapes be solid, `TRUE`, or hollow, #' `FALSE`? diff --git a/R/scale-size.r b/R/scale-size.r index d1bffad235..35e6e0608c 100644 --- a/R/scale-size.r +++ b/R/scale-size.r @@ -4,10 +4,13 @@ #' aesthetic is most commonly used for points and text, and humans perceive #' the area of points (not their radius), so this provides for optimal #' perception. `scale_size_area` ensures that a value of 0 is mapped -#' to a size of 0. +#' to a size of 0. `scale_size_binned` is a binned version of `scale_size` that +#' scales by area (but does not ensure 0 equals an area of zero). For a binned +#' equivalent of `scale_size_area` use `scale_size_binned_area`. #' #' @name scale_size #' @inheritParams continuous_scale +#' @inheritParams binned_scale #' @param range a numeric vector of length 2 that specifies the minimum and #' maximum size of the plotting symbol after transformation. #' @seealso [scale_size_area()] if you want 0 values to be mapped @@ -22,6 +25,9 @@ #' # If you want zero value to have zero size, use scale_size_area: #' p + scale_size_area() #' +#' # Binning can sometimes make it easier to match the scaled data to the legend +#' p + scale_size_binned() +#' #' # This is most useful when size is a count #' ggplot(mpg, aes(class, cyl)) + #' geom_count() + @@ -47,10 +53,10 @@ scale_size_continuous <- function(name = waiver(), breaks = waiver(), labels = w #' @usage NULL scale_size_binned <- function(name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, range = c(1, 6), n.breaks = NULL, - trans = "identity", guide = "bins") { + nice.breaks = TRUE, trans = "identity", guide = "bins") { binned_scale("size", "area_b", area_pal(range), name = name, breaks = breaks, labels = labels, limits = limits, trans = trans, - n.breaks = n.breaks, guide = guide) + n.breaks = n.breaks, nice.breaks = nice.breaks, guide = guide) } #' @rdname scale_size @@ -102,6 +108,14 @@ scale_size_area <- function(..., max_size = 6) { rescaler = rescale_max, ...) } +#' @export +#' @rdname scale_size +scale_size_binned_area <- function(..., max_size = 6) { + binned_scale("size", "area_b", + palette = abs_area(max_size), + rescaler = rescale_max, ...) +} + #' @rdname scale_size #' @export #' @usage NULL diff --git a/R/scale-steps.R b/R/scale-steps.R index 87020fdd83..d671569754 100644 --- a/R/scale-steps.R +++ b/R/scale-steps.R @@ -1,7 +1,10 @@ #' Binned gradient colour scales #' #' `scale_*_steps` creates a two colour binned gradient (low-high), -#' `scale_*_stepsn` creates a n-colour binned gradient. +#' `scale_*_steps2` creates a diverging binned colour gradient (low-mid-high), +#' and `scale_*_stepsn` creates a n-colour binned gradient. These scales are +#' binned variants of the [gradient scale][scale_colour_gradient] family and +#' works in the same way. #' #' Default colours are generated with \pkg{munsell} and #' `mnsl(c("2.5PB 2/4", "2.5PB 7/10"))`. Generally, for continuous @@ -9,12 +12,9 @@ #' luminance. The \pkg{munsell} package makes this easy to do using the #' Munsell colour system. #' -#' @inheritParams scales::seq_gradient_pal -#' @inheritParams scale_colour_hue -#' @param low,high Colours for low and high ends of the gradient. -#' @param guide Type of legend. Use `"coloursteps"` for continuous -#' colour bar, or `"bins"` for discrete colour legend. -#' @inheritDotParams binned_scale -na.value -guide -aesthetics +#' @inheritParams scale_colour_gradient +#' @inheritDotParams binned_scale -aesthetics -scale_name -palette -na.value -guide -rescaler +#' #' @seealso [scales::seq_gradient_pal()] for details on underlying #' palette #' @family colour scales @@ -24,51 +24,23 @@ #' df <- data.frame( #' x = runif(100), #' y = runif(100), -#' z1 = rnorm(100), -#' z2 = abs(rnorm(100)) -#' ) -#' -#' df_na <- data.frame( -#' value = seq(1, 20), -#' x = runif(20), -#' y = runif(20), -#' z1 = c(rep(NA, 10), rnorm(10)) +#' z1 = rnorm(100) #' ) #' -#' # Default colour scale colours from light blue to dark blue -#' ggplot(df, aes(x, y)) + -#' geom_point(aes(colour = z2)) -#' -#' # For diverging colour scales use gradient2 +#' # Use scale_colour_steps for a standard binned gradient #' ggplot(df, aes(x, y)) + #' geom_point(aes(colour = z1)) + -#' scale_colour_gradient2() +#' scale_colour_steps() #' -#' # Use your own colour scale with gradientn +#' # Get a divergent binned scale with the *2 variant #' ggplot(df, aes(x, y)) + #' geom_point(aes(colour = z1)) + -#' scale_colour_gradientn(colours = terrain.colors(10)) +#' scale_colour_steps2() #' -#' # Equivalent fill scales do the same job for the fill aesthetic -#' ggplot(faithfuld, aes(waiting, eruptions)) + -#' geom_raster(aes(fill = density)) + -#' scale_fill_gradientn(colours = terrain.colors(10)) -#' -#' # Adjust colour choices with low and high +#' # Define your own colour ramp to extract binned colours from #' ggplot(df, aes(x, y)) + -#' geom_point(aes(colour = z2)) + -#' scale_colour_gradient(low = "white", high = "black") -#' # Avoid red-green colour contrasts because ~10% of men have difficulty -#' # seeing them -#' -#'# Use `na.value = NA` to hide missing values but keep the original axis range -#' ggplot(df_na, aes(x = value, y)) + -#' geom_bar(aes(fill = z1), stat = "identity") + -#' scale_fill_gradient(low = "yellow", high = "red", na.value = NA) -#' -#' ggplot(df_na, aes(x, y)) + -#' geom_point(aes(colour = z1)) + -#' scale_colour_gradient(low = "yellow", high = "red", na.value = NA) +#' geom_point(aes(colour = z1)) + +#' scale_colour_stepsn(colours = terrain.colors(10)) #' #' @rdname scale_steps diff --git a/R/scale-viridis.r b/R/scale-viridis.r index 23f3ab8888..4b4dde093a 100644 --- a/R/scale-viridis.r +++ b/R/scale-viridis.r @@ -8,8 +8,9 @@ #' @inheritParams viridisLite::viridis #' @inheritParams scales::gradient_n_pal #' @inheritParams continuous_scale -#' @param ... Other arguments passed on to [discrete_scale()] or -#' [continuous_scale()] to control name, limits, breaks, labels and so forth. +#' @param ... Other arguments passed on to [discrete_scale()], +#' [continuous_scale()], or [binned_scale] to control name, limits, breaks, +#' labels and so forth. #' @param aesthetics Character string or vector of character strings listing the #' name(s) of the aesthetic(s) that this scale works with. This can be useful, for #' example, to apply colour settings to the `colour` and `fill` aesthetics at the @@ -50,6 +51,10 @@ #' geom_tile(aes(waiting, eruptions, fill = density))) #' v + scale_fill_viridis_c() #' v + scale_fill_viridis_c(option = "plasma") +#' +#' # Use viridis_b to bin continuous data before mapping +#' v + scale_fill_viridis_b() +#' scale_colour_viridis_d <- function(..., alpha = 1, begin = 0, end = 1, direction = 1, option = "D", aesthetics = "colour") { discrete_scale( diff --git a/R/zxx.r b/R/zxx.r index e8351f2813..c040952497 100644 --- a/R/zxx.r +++ b/R/zxx.r @@ -15,11 +15,6 @@ scale_colour_ordinal <- scale_colour_viridis_d #' @usage NULL scale_color_ordinal <- scale_colour_ordinal -#' @export -#' @rdname scale_gradient -#' @usage NULL -scale_colour_binned <- scale_colour_steps - #' @export #' @rdname scale_gradient #' @usage NULL @@ -140,6 +135,11 @@ scale_color_blender <- scale_colour_blender #' @usage NULL scale_color_continuous <- scale_colour_continuous +#' @export +#' @rdname scale_colour_continuous +#' @usage NULL +scale_color_binned <- scale_colour_binned + #' @export #' @rdname scale_gradient #' @usage NULL @@ -158,17 +158,27 @@ scale_color_gradient <- scale_colour_gradient #' @export #' @rdname scale_gradient #' @usage NULL -scale_color_steps <- scale_colour_steps +scale_color_gradient2 <- scale_colour_gradient2 #' @export #' @rdname scale_gradient #' @usage NULL -scale_color_gradient2 <- scale_colour_gradient2 +scale_color_gradientn <- scale_colour_gradientn #' @export -#' @rdname scale_gradient +#' @rdname scale_steps #' @usage NULL -scale_color_gradientn <- scale_colour_gradientn +scale_color_steps <- scale_colour_steps + +#' @export +#' @rdname scale_steps +#' @usage NULL +scale_color_steps2 <- scale_colour_steps2 + +#' @export +#' @rdname scale_steps +#' @usage NULL +scale_color_stepsn <- scale_colour_stepsn #' @export #' @rdname scale_grey diff --git a/man/binned_scale.Rd b/man/binned_scale.Rd index aab545964d..0da32bd185 100644 --- a/man/binned_scale.Rd +++ b/man/binned_scale.Rd @@ -7,9 +7,9 @@ binned_scale(aesthetics, scale_name, palette, name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, rescaler = rescale, oob = squish, expand = waiver(), - na.value = NA_real_, n.breaks = NULL, right = TRUE, - trans = "identity", show.limits = FALSE, guide = "bins", - position = "left", super = ScaleBinned) + na.value = NA_real_, n.breaks = NULL, nice.breaks = TRUE, + right = TRUE, trans = "identity", show.limits = FALSE, + guide = "bins", position = "left", super = ScaleBinned) } \arguments{ \item{aesthetics}{The names of the aesthetics that this scale works with.} @@ -84,8 +84,13 @@ expand the scale by 5\% on each side for continuous variables, and by \item{na.value}{Missing values will be replaced with this value.} \item{n.breaks}{The number of break points to create if breaks are not given -directly. It will attempt to find nice breakpoint and may thus not give the -exact number of breaks as requested.} +directly.} + +\item{nice.breaks}{Logical. Should breaks be attempted placed at nice values +instead of exactly evenly spaced between the limits. If \code{TRUE} (default) +the scale will ask the transformation object to create breaks, and this +may result in a different number of breaks than requested. Ignored if +breaks are given explicetly.} \item{right}{Should values on the border between bins be part of the right (upper) bin?} diff --git a/man/guide_bins.Rd b/man/guide_bins.Rd new file mode 100644 index 0000000000..13e0bce1fc --- /dev/null +++ b/man/guide_bins.Rd @@ -0,0 +1,130 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/guide-bins.R +\name{guide_bins} +\alias{guide_bins} +\title{A binned version of guide_legend} +\usage{ +guide_bins(title = waiver(), title.position = NULL, + title.theme = NULL, title.hjust = NULL, title.vjust = NULL, + label = TRUE, label.position = NULL, label.theme = NULL, + label.hjust = NULL, label.vjust = NULL, keywidth = NULL, + keyheight = NULL, axis = TRUE, axis.colour = "black", + axis.linewidth = 0.5, axis.arrow = NULL, direction = NULL, + default.unit = "line", override.aes = list(), reverse = FALSE, + order = 0, show.limits = NULL, ...) +} +\arguments{ +\item{title}{A character string or expression indicating a title of guide. +If \code{NULL}, the title is not shown. By default +(\code{\link[=waiver]{waiver()}}), the name of the scale object or the name +specified in \code{\link[=labs]{labs()}} is used for the title.} + +\item{title.position}{A character string indicating the position of a +title. One of "top" (default for a vertical guide), "bottom", "left" +(default for a horizontal guide), or "right."} + +\item{title.theme}{A theme object for rendering the title text. Usually the +object of \code{\link[=element_text]{element_text()}} is expected. By default, the theme is +specified by \code{legend.title} in \code{\link[=theme]{theme()}} or theme.} + +\item{title.hjust}{A number specifying horizontal justification of the +title text.} + +\item{title.vjust}{A number specifying vertical justification of the title +text.} + +\item{label}{logical. If \code{TRUE} then the labels are drawn. If +\code{FALSE} then the labels are invisible.} + +\item{label.position}{A character string indicating the position of a +label. One of "top", "bottom" (default for horizontal guide), "left", or +"right" (default for vertical guide).} + +\item{label.theme}{A theme object for rendering the label text. Usually the +object of \code{\link[=element_text]{element_text()}} is expected. By default, the theme is +specified by \code{legend.text} in \code{\link[=theme]{theme()}}.} + +\item{label.hjust}{A numeric specifying horizontal justification of the +label text.} + +\item{label.vjust}{A numeric specifying vertical justification of the label +text.} + +\item{keywidth}{A numeric or a \code{\link[grid:unit]{grid::unit()}} object specifying +the width of the legend key. Default value is \code{legend.key.width} or +\code{legend.key.size} in \code{\link[=theme]{theme()}}.} + +\item{keyheight}{A numeric or a \code{\link[grid:unit]{grid::unit()}} object specifying +the height of the legend key. Default value is \code{legend.key.height} or +\code{legend.key.size} in \code{\link[=theme]{theme()}}.} + +\item{axis}{Logical. Should a small axis be drawn along the guide} + +\item{axis.colour, axis.linewidth}{Graphic specifications for the look of the +axis.} + +\item{axis.arrow}{A call to \code{arrow()} to specify arrows at the end of the +axis line, thus showing an open interval.} + +\item{direction}{A character string indicating the direction of the guide. +One of "horizontal" or "vertical."} + +\item{default.unit}{A character string indicating \code{\link[grid:unit]{grid::unit()}} +for \code{keywidth} and \code{keyheight}.} + +\item{override.aes}{A list specifying aesthetic parameters of legend key. +See details and examples.} + +\item{reverse}{logical. If \code{TRUE} the order of legends is reversed.} + +\item{order}{positive integer less than 99 that specifies the order of +this guide among multiple guides. This controls the order in which +multiple guides are displayed, not the contents of the guide itself. +If 0 (default), the order is determined by a secret algorithm.} + +\item{show.limits}{Logical. Should the limits of the scale be shown with +labels and ticks.} + +\item{...}{ignored.} +} +\value{ +A guide object +} +\description{ +This guide is a version of the \code{\link[=guide_legend]{guide_legend()}} guide for binned scales. It +differs in that it places ticks correctly between the keys, and sports a +small axis to better show the binning. Like \code{\link[=guide_legend]{guide_legend()}} it can be used +for all non-position aesthetics though colour and fill defaults to +\code{\link[=guide_coloursteps]{guide_coloursteps()}}, and it will merge aesthetics together into the same +guide if they are mapped in the same way. +} +\examples{ +p <- ggplot(mtcars) + + geom_point(aes(disp, mpg, size = hp)) + + scale_size_binned() + +# Standard look +p + +# Remove the axis or style it +p + guides(size = guide_bins(axis = FALSE)) + +p + guides(size = guide_bins(show.limits = TRUE)) + +p + guides(size = guide_bins( + axis.arrow = arrow(length = unit(1.5, 'mm'), ends = 'both') +)) + +# Guides are merged together if possible +ggplot(mtcars) + + geom_point(aes(disp, mpg, size = hp, colour = hp)) + + scale_size_binned() + + scale_colour_binned(guide = "bins") + +} +\seealso{ +Other guides: \code{\link{guide_colourbar}}, + \code{\link{guide_coloursteps}}, + \code{\link{guide_legend}}, \code{\link{guides}} +} +\concept{guides} diff --git a/man/guide_colourbar.Rd b/man/guide_colourbar.Rd index 6fc3e0a239..c7eebdfa4d 100644 --- a/man/guide_colourbar.Rd +++ b/man/guide_colourbar.Rd @@ -3,8 +3,6 @@ \name{guide_colourbar} \alias{guide_colourbar} \alias{guide_colorbar} -\alias{guide_coloursteps} -\alias{guide_colorsteps} \title{Continuous colour bar guide} \usage{ guide_colourbar(title = waiver(), title.position = NULL, @@ -28,12 +26,6 @@ guide_colorbar(title = waiver(), title.position = NULL, draw.llim = TRUE, direction = NULL, default.unit = "line", reverse = FALSE, order = 0, available_aes = c("colour", "color", "fill"), ...) - -guide_coloursteps(even.steps = TRUE, show.limits = NULL, - ticks = FALSE, nbin = 100, ...) - -guide_colorsteps(even.steps = TRUE, show.limits = NULL, - ticks = FALSE, nbin = 100, ...) } \arguments{ \item{title}{A character string or expression indicating a title of guide. @@ -128,12 +120,6 @@ If 0 (default), the order is determined by a secret algorithm.} for which a colourbar can be drawn.} \item{...}{ignored.} - -\item{even.steps}{Should the bin sizes reflect their size or be even across all -bins? Defaults to \code{TRUE}} - -\item{show.limits}{Should labels for the outer limits of the bins be printed? -Default is \code{NULL} which makes the guide use the setting from the scale} } \value{ A guide object @@ -200,7 +186,8 @@ p2 + scale_size(guide = guide_legend(direction = "vertical")) } \seealso{ -Other guides: \code{\link{guide_legend}}, - \code{\link{guides}} +Other guides: \code{\link{guide_bins}}, + \code{\link{guide_coloursteps}}, + \code{\link{guide_legend}}, \code{\link{guides}} } \concept{guides} diff --git a/man/guide_coloursteps.Rd b/man/guide_coloursteps.Rd new file mode 100644 index 0000000000..dd73dfff61 --- /dev/null +++ b/man/guide_coloursteps.Rd @@ -0,0 +1,120 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/guide-colorsteps.R +\name{guide_coloursteps} +\alias{guide_coloursteps} +\alias{guide_colorsteps} +\title{Discretized colourbar guide} +\usage{ +guide_coloursteps(even.steps = TRUE, show.limits = NULL, + ticks = FALSE, ...) + +guide_colorsteps(even.steps = TRUE, show.limits = NULL, + ticks = FALSE, ...) +} +\arguments{ +\item{even.steps}{Should the rendered size of the bins be equal, or should +they be proportional to their length in the data space? Defaults to \code{TRUE}} + +\item{show.limits}{Should labels for the outer limits of the bins be printed? +Default is \code{NULL} which makes the guide use the setting from the scale} + +\item{ticks}{A logical specifying if tick marks on the colourbar should be +visible.} + +\item{...}{Arguments passed on to \code{guide_colourbar} +\describe{ + \item{barwidth}{A numeric or a \code{\link[grid:unit]{grid::unit()}} object specifying +the width of the colourbar. Default value is \code{legend.key.width} or +\code{legend.key.size} in \code{\link[=theme]{theme()}} or theme.} + \item{barheight}{A numeric or a \code{\link[grid:unit]{grid::unit()}} object specifying +the height of the colourbar. Default value is \code{legend.key.height} or +\code{legend.key.size} in \code{\link[=theme]{theme()}} or theme.} + \item{frame.colour}{A string specifying the colour of the frame +drawn around the bar. If \code{NULL} (the default), no frame is drawn.} + \item{frame.linewidth}{A numeric specifying the width of the frame +drawn around the bar.} + \item{frame.linetype}{A numeric specifying the linetype of the frame +drawn around the bar.} + \item{ticks.colour}{A string specifying the colour of the tick marks.} + \item{ticks.linewidth}{A numeric specifying the width of the tick marks.} + \item{draw.ulim}{A logical specifying if the upper limit tick marks should +be visible.} + \item{draw.llim}{A logical specifying if the lower limit tick marks should +be visible.} + \item{direction}{A character string indicating the direction of the guide. +One of "horizontal" or "vertical."} + \item{default.unit}{A character string indicating \code{\link[grid:unit]{grid::unit()}} +for \code{barwidth} and \code{barheight}.} + \item{reverse}{logical. If \code{TRUE} the colourbar is reversed. By default, +the highest value is on the top and the lowest value is on the bottom} + \item{title}{A character string or expression indicating a title of guide. +If \code{NULL}, the title is not shown. By default +(\code{\link[=waiver]{waiver()}}), the name of the scale object or the name +specified in \code{\link[=labs]{labs()}} is used for the title.} + \item{title.position}{A character string indicating the position of a +title. One of "top" (default for a vertical guide), "bottom", "left" +(default for a horizontal guide), or "right."} + \item{title.theme}{A theme object for rendering the title text. Usually the +object of \code{\link[=element_text]{element_text()}} is expected. By default, the theme is +specified by \code{legend.title} in \code{\link[=theme]{theme()}} or theme.} + \item{title.hjust}{A number specifying horizontal justification of the +title text.} + \item{title.vjust}{A number specifying vertical justification of the title +text.} + \item{label}{logical. If \code{TRUE} then the labels are drawn. If +\code{FALSE} then the labels are invisible.} + \item{label.position}{A character string indicating the position of a +label. One of "top", "bottom" (default for horizontal guide), "left", or +"right" (default for vertical guide).} + \item{label.theme}{A theme object for rendering the label text. Usually the +object of \code{\link[=element_text]{element_text()}} is expected. By default, the theme is +specified by \code{legend.text} in \code{\link[=theme]{theme()}}.} + \item{label.hjust}{A numeric specifying horizontal justification of the +label text.} + \item{label.vjust}{A numeric specifying vertical justification of the label +text.} + \item{order}{positive integer less than 99 that specifies the order of +this guide among multiple guides. This controls the order in which +multiple guides are displayed, not the contents of the guide itself. +If 0 (default), the order is determined by a secret algorithm.} +}} +} +\value{ +A guide object +} +\description{ +This guide is version of \code{\link[=guide_colourbar]{guide_colourbar()}} for binned colour and fill +scales. It shows areas between breaks as a single constant colour instead of +the gradient known from the colourbar counterpart. +} +\examples{ +df <- reshape2::melt(outer(1:10, 1:10), varnames = c("X1", "X2")) + +p <- ggplot(df, aes(X1, X2)) + geom_tile(aes(fill = value)) + +# Coloursteps guide is the default for binned colour scales +p + scale_fill_binned() + +# By default each bin in the guide is the same size irrespectively of how +# their sizes relate in data space +p + scale_fill_binned(breaks = c(10, 25, 50)) + +# This can be changed with the `even.steps` argument +p + scale_fill_binned( + breaks = c(10, 25, 50), + guide = guide_coloursteps(even.steps = FALSE) +) + +# By default the limits is not shown, but this can be changed +p + scale_fill_binned(guide = guide_coloursteps(show.limits = TRUE)) + +# (can also be set in the scale) +p + scale_fill_binned(show.limits = TRUE) + +} +\seealso{ +Other guides: \code{\link{guide_bins}}, + \code{\link{guide_colourbar}}, + \code{\link{guide_legend}}, \code{\link{guides}} +} +\concept{guides} diff --git a/man/guide_legend.Rd b/man/guide_legend.Rd index bd53036d09..7dadfbfc52 100644 --- a/man/guide_legend.Rd +++ b/man/guide_legend.Rd @@ -157,7 +157,8 @@ p + guides(col = guide_legend(reverse = TRUE)) } } \seealso{ -Other guides: \code{\link{guide_colourbar}}, - \code{\link{guides}} +Other guides: \code{\link{guide_bins}}, + \code{\link{guide_colourbar}}, + \code{\link{guide_coloursteps}}, \code{\link{guides}} } \concept{guides} diff --git a/man/guides.Rd b/man/guides.Rd index b3f01d6c70..43928a73cd 100644 --- a/man/guides.Rd +++ b/man/guides.Rd @@ -68,7 +68,9 @@ ggplot(mpg, aes(displ, cty)) + } } \seealso{ -Other guides: \code{\link{guide_colourbar}}, +Other guides: \code{\link{guide_bins}}, + \code{\link{guide_colourbar}}, + \code{\link{guide_coloursteps}}, \code{\link{guide_legend}} } \concept{guides} diff --git a/man/scale_alpha.Rd b/man/scale_alpha.Rd index 95f3ad255f..93f1da10ca 100644 --- a/man/scale_alpha.Rd +++ b/man/scale_alpha.Rd @@ -21,7 +21,7 @@ scale_alpha_discrete(...) scale_alpha_ordinal(..., range = c(0.1, 1)) } \arguments{ -\item{...}{Other arguments passed on to \code{\link[=continuous_scale]{continuous_scale()}} +\item{...}{Other arguments passed on to \code{\link[=continuous_scale]{continuous_scale()}}, \link{binned_scale}, or \code{\link[=discrete_scale]{discrete_scale()}} as appropriate, to control name, limits, breaks, labels and so forth.} diff --git a/man/scale_binned.Rd b/man/scale_binned.Rd index 69e1eb79b1..1227d3e7a1 100644 --- a/man/scale_binned.Rd +++ b/man/scale_binned.Rd @@ -5,15 +5,17 @@ \alias{scale_y_binned} \title{Positional scales for binning continuous data (x & y)} \usage{ -scale_x_binned(name = waiver(), n.breaks = 10, breaks = waiver(), - labels = waiver(), limits = NULL, expand = waiver(), - oob = squish, na.value = NA_real_, right = TRUE, - show.limits = FALSE, trans = "identity", position = "bottom") +scale_x_binned(name = waiver(), n.breaks = 10, nice.breaks = TRUE, + breaks = waiver(), labels = waiver(), limits = NULL, + expand = waiver(), oob = squish, na.value = NA_real_, + right = TRUE, show.limits = FALSE, trans = "identity", + position = "bottom") -scale_y_binned(name = waiver(), n.breaks = 10, breaks = waiver(), - labels = waiver(), limits = NULL, expand = waiver(), - oob = squish, na.value = NA_real_, right = TRUE, - show.limits = FALSE, trans = "identity", position = "left") +scale_y_binned(name = waiver(), n.breaks = 10, nice.breaks = TRUE, + breaks = waiver(), labels = waiver(), limits = NULL, + expand = waiver(), oob = squish, na.value = NA_real_, + right = TRUE, show.limits = FALSE, trans = "identity", + position = "left") } \arguments{ \item{name}{The name of the scale. Used as the axis or legend title. If @@ -22,8 +24,13 @@ mapping used for that aesthetic. If \code{NULL}, the legend title will be omitted.} \item{n.breaks}{The number of break points to create if breaks are not given -directly. It will attempt to find nice breakpoint and may thus not give the -exact number of breaks as requested.} +directly.} + +\item{nice.breaks}{Logical. Should breaks be attempted placed at nice values +instead of exactly evenly spaced between the limits. If \code{TRUE} (default) +the scale will ask the transformation object to create breaks, and this +may result in a different number of breaks than requested. Ignored if +breaks are given explicetly.} \item{breaks}{One of: \itemize{ diff --git a/man/scale_brewer.Rd b/man/scale_brewer.Rd index f74477e353..4d2a5ae1bd 100644 --- a/man/scale_brewer.Rd +++ b/man/scale_brewer.Rd @@ -33,9 +33,9 @@ scale_fill_blender(..., type = "seq", palette = 1, direction = -1, na.value = "grey50", guide = "coloursteps", aesthetics = "fill") } \arguments{ -\item{...}{Other arguments passed on to \code{\link[=discrete_scale]{discrete_scale()}} or, for -\code{distiller} scales, \code{\link[=continuous_scale]{continuous_scale()}} to control name, -limits, breaks, labels and so forth.} +\item{...}{Other arguments passed on to \code{\link[=discrete_scale]{discrete_scale()}}, \code{\link[=continuous_scale]{continuous_scale()}}, +or \code{\link[=binned_scale]{binned_scale()}}, for \code{brewer}, \code{distiller}, and \code{blender} variants +respectively, to control name, limits, breaks, labels and so forth.} \item{type}{One of seq (sequential), div (diverging) or qual (qualitative)} @@ -78,7 +78,8 @@ look good. Your mileage may vary. } \note{ The \code{distiller} scales extend brewer to continuous scales by smoothly -interpolating 7 colours from any palette to a continuous scale. +interpolating 7 colours from any palette to a continuous scale. The \code{blender} +scales provide binned versions of the brewer scales. } \section{Palettes}{ @@ -123,6 +124,10 @@ v <- ggplot(faithfuld) + v v + scale_fill_distiller() v + scale_fill_distiller(palette = "Spectral") + +# or use blender variants to discretize continuous data +v + scale_fill_blender() + } \seealso{ Other colour scales: \code{\link{scale_alpha}}, diff --git a/man/scale_colour_continuous.Rd b/man/scale_colour_continuous.Rd index f0ad9fba5a..a1b5753848 100644 --- a/man/scale_colour_continuous.Rd +++ b/man/scale_colour_continuous.Rd @@ -3,8 +3,11 @@ \name{scale_colour_continuous} \alias{scale_colour_continuous} \alias{scale_fill_continuous} +\alias{scale_colour_binned} +\alias{scale_fill_binned} \alias{scale_color_continuous} -\title{Continuous colour scales} +\alias{scale_color_binned} +\title{Continuous and binned colour scales} \usage{ scale_colour_continuous(..., type = getOption("ggplot2.continuous.colour", default = "gradient")) @@ -57,5 +60,6 @@ v + scale_fill_viridis_c() } \seealso{ \code{\link[=scale_colour_gradient]{scale_colour_gradient()}}, \code{\link[=scale_colour_viridis_c]{scale_colour_viridis_c()}}, -\code{\link[=scale_fill_gradient]{scale_fill_gradient()}}, and \code{\link[=scale_fill_viridis_c]{scale_fill_viridis_c()}} +\code{\link[=scale_colour_steps]{scale_colour_steps()}}, \code{\link[=scale_colour_viridis_b]{scale_colour_viridis_b()}}, \code{\link[=scale_fill_gradient]{scale_fill_gradient()}}, +\code{\link[=scale_fill_viridis_c]{scale_fill_viridis_c()}}, \code{\link[=scale_fill_steps]{scale_fill_steps()}}, and \code{\link[=scale_fill_viridis_b]{scale_fill_viridis_b()}} } diff --git a/man/scale_gradient.Rd b/man/scale_gradient.Rd index d5dea1d74f..77cd4aa054 100644 --- a/man/scale_gradient.Rd +++ b/man/scale_gradient.Rd @@ -7,7 +7,6 @@ \alias{scale_fill_gradient2} \alias{scale_colour_gradientn} \alias{scale_fill_gradientn} -\alias{scale_colour_binned} \alias{scale_colour_datetime} \alias{scale_color_datetime} \alias{scale_colour_date} @@ -16,7 +15,6 @@ \alias{scale_fill_date} \alias{scale_color_binned} \alias{scale_color_gradient} -\alias{scale_color_steps} \alias{scale_color_gradient2} \alias{scale_color_gradientn} \title{Gradient colour scales} diff --git a/man/scale_linetype.Rd b/man/scale_linetype.Rd index ef2657b68e..2a82557802 100644 --- a/man/scale_linetype.Rd +++ b/man/scale_linetype.Rd @@ -9,7 +9,7 @@ \usage{ scale_linetype(..., na.value = "blank") -scale_linetype_binned(...) +scale_linetype_binned(..., na.value = "blank") scale_linetype_continuous(...) @@ -63,7 +63,8 @@ as output \description{ Default line types based on a set supplied by Richard Pearson, University of Manchester. Continuous values can not be mapped to -line types. +line types unless \code{scale_linetype_binned()} is used. Still, as linetypes has +no inherent order, this use is not advised. } \examples{ base <- ggplot(economics_long, aes(date, value01)) diff --git a/man/scale_shape.Rd b/man/scale_shape.Rd index 00d1cc8d55..049aaf06ec 100644 --- a/man/scale_shape.Rd +++ b/man/scale_shape.Rd @@ -66,7 +66,8 @@ as output If you have more than six levels, you will get a warning message, and the seventh and subsequence levels will not appear on the plot. Use \code{\link[=scale_shape_manual]{scale_shape_manual()}} to supply your own values. You can not map -a continuous variable to shape. +a continuous variable to shape unless \code{scale_shape_binned()} is used. Still, +as shape has no inherent order, this use is not advised.. } \examples{ dsmall <- diamonds[sample(nrow(diamonds), 100), ] diff --git a/man/scale_size.Rd b/man/scale_size.Rd index b63b35b936..c56a82be71 100644 --- a/man/scale_size.Rd +++ b/man/scale_size.Rd @@ -8,6 +8,7 @@ \alias{scale_size_discrete} \alias{scale_size_ordinal} \alias{scale_size_area} +\alias{scale_size_binned_area} \alias{scale_size_datetime} \alias{scale_size_date} \title{Scales for area or radius} @@ -21,6 +22,8 @@ scale_size(name = waiver(), breaks = waiver(), labels = waiver(), guide = "legend") scale_size_area(..., max_size = 6) + +scale_size_binned_area(..., max_size = 6) } \arguments{ \item{name}{The name of the scale. Used as the axis or legend title. If @@ -78,6 +81,15 @@ transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} \item{guide}{A function used to create a guide or its name. See \code{\link[=guides]{guides()}} for more information.} +\item{n.breaks}{The number of break points to create if breaks are not given +directly.} + +\item{nice.breaks}{Logical. Should breaks be attempted placed at nice values +instead of exactly evenly spaced between the limits. If \code{TRUE} (default) +the scale will ask the transformation object to create breaks, and this +may result in a different number of breaks than requested. Ignored if +breaks are given explicetly.} + \item{...}{Arguments passed on to \code{continuous_scale} \describe{ \item{name}{The name of the scale. Used as the axis or legend title. If @@ -162,7 +174,9 @@ expand the scale by 5\% on each side for continuous variables, and by aesthetic is most commonly used for points and text, and humans perceive the area of points (not their radius), so this provides for optimal perception. \code{scale_size_area} ensures that a value of 0 is mapped -to a size of 0. +to a size of 0. \code{scale_size_binned} is a binned version of \code{scale_size} that +scales by area (but does not ensure 0 equals an area of zero). For a binned +equivalent of \code{scale_size_area} use \code{scale_size_binned_area}. } \examples{ p <- ggplot(mpg, aes(displ, hwy, size = hwy)) + @@ -174,6 +188,9 @@ p + scale_size(range = c(0, 10)) # If you want zero value to have zero size, use scale_size_area: p + scale_size_area() +# Binning can sometimes make it easier to match the scaled data to the legend +p + scale_size_binned() + # This is most useful when size is a count ggplot(mpg, aes(class, cyl)) + geom_count() + diff --git a/man/scale_steps.Rd b/man/scale_steps.Rd index 4f62cfba93..9155ee3357 100644 --- a/man/scale_steps.Rd +++ b/man/scale_steps.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/scale-steps.R +% Please edit documentation in R/scale-steps.R, R/zxx.r \name{scale_colour_steps} \alias{scale_colour_steps} \alias{scale_colour_steps2} @@ -7,6 +7,9 @@ \alias{scale_fill_steps} \alias{scale_fill_steps2} \alias{scale_fill_stepsn} +\alias{scale_color_steps} +\alias{scale_color_steps2} +\alias{scale_color_stepsn} \title{Binned gradient colour scales} \usage{ scale_colour_steps(..., low = "#132B43", high = "#56B1F7", @@ -37,16 +40,15 @@ scale_fill_stepsn(..., colours, values = NULL, space = "Lab", \item{...}{Arguments passed on to \code{binned_scale} \describe{ \item{n.breaks}{The number of break points to create if breaks are not given -directly. It will attempt to find nice breakpoint and may thus not give the -exact number of breaks as requested.} +directly.} + \item{nice.breaks}{Logical. Should breaks be attempted placed at nice values +instead of exactly evenly spaced between the limits. If \code{TRUE} (default) +the scale will ask the transformation object to create breaks, and this +may result in a different number of breaks than requested. Ignored if +breaks are given explicetly.} \item{right}{Should values on the border between bins be part of the right (upper) bin?} \item{show.limits}{should the limits of the scale appear as ticks} - \item{scale_name}{The name of the scale that should be used for error messages -associated with this scale.} - \item{palette}{A palette function that when called with a numeric vector with -values between 0 and 1 returns the corresponding output values -(e.g., \code{\link[scales:area_pal]{scales::area_pal()}}).} \item{name}{The name of the scale. Used as the axis or legend title. If \code{waiver()}, the default, the name of the scale is taken from the first mapping used for that aesthetic. If \code{NULL}, the legend title will be @@ -80,11 +82,6 @@ Note that setting limits on positional scales will \strong{remove} data outside If the purpose is to zoom, use the limit argument in the coordinate system (see \code{\link[=coord_cartesian]{coord_cartesian()}}). }} - \item{rescaler}{A function used to scale the input values to the -range [0, 1]. This is always \code{\link[scales:rescale]{scales::rescale()}}, except for -diverging and n colour gradients (i.e., \code{\link[=scale_colour_gradient2]{scale_colour_gradient2()}}, -\code{\link[=scale_colour_gradientn]{scale_colour_gradientn()}}). The \code{rescaler} is ignored by position -scales, which ways use \code{\link[scales:rescale]{scales::rescale()}}.} \item{oob}{One of: \itemize{ \item Function that handles limits outside of the scale limits @@ -116,24 +113,43 @@ transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} \item{super}{The super class to use for the constructed scale} }} -\item{low, high}{Colours for low and high ends of the gradient.} +\item{low}{Colours for low and high ends of the gradient.} + +\item{high}{Colours for low and high ends of the gradient.} \item{space}{colour space in which to calculate gradient. Must be "Lab" - other values are deprecated.} \item{na.value}{Colour to use for missing values} -\item{guide}{Type of legend. Use \code{"coloursteps"} for continuous -colour bar, or \code{"bins"} for discrete colour legend.} +\item{guide}{Type of legend. Use \code{"colourbar"} for continuous +colour bar, or \code{"legend"} for discrete colour legend.} \item{aesthetics}{Character string or vector of character strings listing the name(s) of the aesthetic(s) that this scale works with. This can be useful, for example, to apply colour settings to the \code{colour} and \code{fill} aesthetics at the same time, via \code{aesthetics = c("colour", "fill")}.} + +\item{mid}{colour for mid point} + +\item{midpoint}{The midpoint (in data value) of the diverging scale. +Defaults to 0.} + +\item{colours}{Vector of colours to use for n-colour gradient.} + +\item{values}{if colours should not be evenly positioned along the gradient +this vector gives the position (between 0 and 1) for each colour in the +\code{colours} vector. See \code{\link[=rescale]{rescale()}} for a convenience function +to map an arbitrary range to between 0 and 1.} + +\item{colors}{Vector of colours to use for n-colour gradient.} } \description{ \code{scale_*_steps} creates a two colour binned gradient (low-high), -\code{scale_*_stepsn} creates a n-colour binned gradient. +\code{scale_*_steps2} creates a diverging binned colour gradient (low-mid-high), +and \code{scale_*_stepsn} creates a n-colour binned gradient. These scales are +binned variants of the \link[=scale_colour_gradient]{gradient scale} family and +works in the same way. } \details{ Default colours are generated with \pkg{munsell} and @@ -146,51 +162,23 @@ Munsell colour system. df <- data.frame( x = runif(100), y = runif(100), - z1 = rnorm(100), - z2 = abs(rnorm(100)) + z1 = rnorm(100) ) -df_na <- data.frame( - value = seq(1, 20), - x = runif(20), - y = runif(20), - z1 = c(rep(NA, 10), rnorm(10)) -) - -# Default colour scale colours from light blue to dark blue -ggplot(df, aes(x, y)) + - geom_point(aes(colour = z2)) - -# For diverging colour scales use gradient2 +# Use scale_colour_steps for a standard binned gradient ggplot(df, aes(x, y)) + geom_point(aes(colour = z1)) + - scale_colour_gradient2() + scale_colour_steps() -# Use your own colour scale with gradientn +# Get a divergent binned scale with the *2 variant ggplot(df, aes(x, y)) + geom_point(aes(colour = z1)) + - scale_colour_gradientn(colours = terrain.colors(10)) - -# Equivalent fill scales do the same job for the fill aesthetic -ggplot(faithfuld, aes(waiting, eruptions)) + - geom_raster(aes(fill = density)) + - scale_fill_gradientn(colours = terrain.colors(10)) + scale_colour_steps2() -# Adjust colour choices with low and high +# Define your own colour ramp to extract binned colours from ggplot(df, aes(x, y)) + - geom_point(aes(colour = z2)) + - scale_colour_gradient(low = "white", high = "black") -# Avoid red-green colour contrasts because ~10\% of men have difficulty -# seeing them - -# Use `na.value = NA` to hide missing values but keep the original axis range -ggplot(df_na, aes(x = value, y)) + - geom_bar(aes(fill = z1), stat = "identity") + - scale_fill_gradient(low = "yellow", high = "red", na.value = NA) - - ggplot(df_na, aes(x, y)) + - geom_point(aes(colour = z1)) + - scale_colour_gradient(low = "yellow", high = "red", na.value = NA) + geom_point(aes(colour = z1)) + + scale_colour_stepsn(colours = terrain.colors(10)) } \seealso{ diff --git a/man/scale_viridis.Rd b/man/scale_viridis.Rd index 9e7bbf5e24..d266cab34b 100644 --- a/man/scale_viridis.Rd +++ b/man/scale_viridis.Rd @@ -37,8 +37,9 @@ scale_fill_viridis_b(..., alpha = 1, begin = 0, end = 1, na.value = "grey50", guide = "coloursteps", aesthetics = "fill") } \arguments{ -\item{...}{Other arguments passed on to \code{\link[=discrete_scale]{discrete_scale()}} or -\code{\link[=continuous_scale]{continuous_scale()}} to control name, limits, breaks, labels and so forth.} +\item{...}{Other arguments passed on to \code{\link[=discrete_scale]{discrete_scale()}}, +\code{\link[=continuous_scale]{continuous_scale()}}, or \link{binned_scale} to control name, limits, breaks, +labels and so forth.} \item{alpha}{The alpha transparency, a number in [0,1], see argument alpha in \code{\link[grDevices]{hsv}}.} @@ -111,6 +112,10 @@ p + scale_fill_viridis_d(direction = -1) geom_tile(aes(waiting, eruptions, fill = density))) v + scale_fill_viridis_c() v + scale_fill_viridis_c(option = "plasma") + +# Use viridis_b to bin continuous data before mapping +v + scale_fill_viridis_b() + } \seealso{ Other colour scales: \code{\link{scale_alpha}}, From 4fef5ba53ef486436837259d196f2b5fb8fbbe4d Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Thu, 26 Sep 2019 14:01:13 +0200 Subject: [PATCH 28/30] Fixing all check warnings --- R/scale-size.r | 17 ++++++++--------- R/zxx.r | 5 ----- man/scale_gradient.Rd | 1 - man/scale_size.Rd | 11 ++++++++--- 4 files changed, 16 insertions(+), 18 deletions(-) diff --git a/R/scale-size.r b/R/scale-size.r index 35e6e0608c..ea6f81003a 100644 --- a/R/scale-size.r +++ b/R/scale-size.r @@ -50,14 +50,7 @@ scale_size_continuous <- function(name = waiver(), breaks = waiver(), labels = w #' @rdname scale_size #' @export -#' @usage NULL -scale_size_binned <- function(name = waiver(), breaks = waiver(), labels = waiver(), - limits = NULL, range = c(1, 6), n.breaks = NULL, - nice.breaks = TRUE, trans = "identity", guide = "bins") { - binned_scale("size", "area_b", area_pal(range), name = name, - breaks = breaks, labels = labels, limits = limits, trans = trans, - n.breaks = n.breaks, nice.breaks = nice.breaks, guide = guide) -} +scale_size <- scale_size_continuous #' @rdname scale_size #' @export @@ -71,7 +64,13 @@ scale_radius <- function(name = waiver(), breaks = waiver(), labels = waiver(), #' @rdname scale_size #' @export -scale_size <- scale_size_continuous +scale_size_binned <- function(name = waiver(), breaks = waiver(), labels = waiver(), + limits = NULL, range = c(1, 6), n.breaks = NULL, + nice.breaks = TRUE, trans = "identity", guide = "bins") { + binned_scale("size", "area_b", area_pal(range), name = name, + breaks = breaks, labels = labels, limits = limits, trans = trans, + n.breaks = n.breaks, nice.breaks = nice.breaks, guide = guide) +} #' @rdname scale_size #' @export diff --git a/R/zxx.r b/R/zxx.r index c040952497..4f560cfaed 100644 --- a/R/zxx.r +++ b/R/zxx.r @@ -140,11 +140,6 @@ scale_color_continuous <- scale_colour_continuous #' @usage NULL scale_color_binned <- scale_colour_binned -#' @export -#' @rdname scale_gradient -#' @usage NULL -scale_color_binned <- scale_colour_binned - #' @export #' @rdname scale_hue #' @usage NULL diff --git a/man/scale_gradient.Rd b/man/scale_gradient.Rd index 77cd4aa054..d59e93fff7 100644 --- a/man/scale_gradient.Rd +++ b/man/scale_gradient.Rd @@ -13,7 +13,6 @@ \alias{scale_color_date} \alias{scale_fill_datetime} \alias{scale_fill_date} -\alias{scale_color_binned} \alias{scale_color_gradient} \alias{scale_color_gradient2} \alias{scale_color_gradientn} diff --git a/man/scale_size.Rd b/man/scale_size.Rd index c56a82be71..31c659c4e7 100644 --- a/man/scale_size.Rd +++ b/man/scale_size.Rd @@ -3,8 +3,8 @@ \name{scale_size} \alias{scale_size} \alias{scale_size_continuous} -\alias{scale_size_binned} \alias{scale_radius} +\alias{scale_size_binned} \alias{scale_size_discrete} \alias{scale_size_ordinal} \alias{scale_size_area} @@ -13,14 +13,19 @@ \alias{scale_size_date} \title{Scales for area or radius} \usage{ -scale_radius(name = waiver(), breaks = waiver(), labels = waiver(), +scale_size(name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, range = c(1, 6), trans = "identity", guide = "legend") -scale_size(name = waiver(), breaks = waiver(), labels = waiver(), +scale_radius(name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, range = c(1, 6), trans = "identity", guide = "legend") +scale_size_binned(name = waiver(), breaks = waiver(), + labels = waiver(), limits = NULL, range = c(1, 6), + n.breaks = NULL, nice.breaks = TRUE, trans = "identity", + guide = "bins") + scale_size_area(..., max_size = 6) scale_size_binned_area(..., max_size = 6) From fdae520bdd8eb1ab6e702f9db2e1a66c41fe1be5 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Thu, 26 Sep 2019 14:17:47 +0200 Subject: [PATCH 29/30] Add tests for new guides --- tests/figs/deps.txt | 2 +- .../guides/guide-bins-can-remove-axis.svg | 67 ++++++++ .../guides/guide-bins-can-show-arrows.svg | 73 ++++++++ .../guides/guide-bins-can-show-limits.svg | 75 +++++++++ .../figs/guides/guide-bins-can-show-ticks.svg | 67 ++++++++ .../guides/guide-bins-looks-as-it-should.svg | 71 ++++++++ .../guides/guide-bins-work-horizontally.svg | 71 ++++++++ ...teps-can-have-bins-relative-to-binsize.svg | 157 ++++++++++++++++++ .../guide-coloursteps-can-show-limits.svg | 63 +++++++ .../guide-coloursteps-looks-as-it-should.svg | 61 +++++++ tests/testthat/test-guides.R | 43 +++++ 11 files changed, 749 insertions(+), 1 deletion(-) create mode 100644 tests/figs/guides/guide-bins-can-remove-axis.svg create mode 100644 tests/figs/guides/guide-bins-can-show-arrows.svg create mode 100644 tests/figs/guides/guide-bins-can-show-limits.svg create mode 100644 tests/figs/guides/guide-bins-can-show-ticks.svg create mode 100644 tests/figs/guides/guide-bins-looks-as-it-should.svg create mode 100644 tests/figs/guides/guide-bins-work-horizontally.svg create mode 100644 tests/figs/guides/guide-coloursteps-can-have-bins-relative-to-binsize.svg create mode 100644 tests/figs/guides/guide-coloursteps-can-show-limits.svg create mode 100644 tests/figs/guides/guide-coloursteps-looks-as-it-should.svg diff --git a/tests/figs/deps.txt b/tests/figs/deps.txt index 059d357267..0f64e23e67 100644 --- a/tests/figs/deps.txt +++ b/tests/figs/deps.txt @@ -1,3 +1,3 @@ - vdiffr-svg-engine: 1.0 -- vdiffr: 0.3.0 +- vdiffr: 0.3.1 - freetypeharfbuzz: 0.2.5 diff --git a/tests/figs/guides/guide-bins-can-remove-axis.svg b/tests/figs/guides/guide-bins-can-remove-axis.svg new file mode 100644 index 0000000000..383f841c10 --- /dev/null +++ b/tests/figs/guides/guide-bins-can-remove-axis.svg @@ -0,0 +1,67 @@ + + + + + + + + + + + + + + + + + + + + + + +5.0 +5.5 +6.0 +6.5 +7.0 + + + + + + + + + + +1.0 +1.5 +2.0 +2.5 +3.0 +x +y + +x + + + + + + + + +1.5 +2.0 +2.5 +guide_bins can remove axis + diff --git a/tests/figs/guides/guide-bins-can-show-arrows.svg b/tests/figs/guides/guide-bins-can-show-arrows.svg new file mode 100644 index 0000000000..3415446818 --- /dev/null +++ b/tests/figs/guides/guide-bins-can-show-arrows.svg @@ -0,0 +1,73 @@ + + + + + + + + + + + + + + + + + + + + + + +5.0 +5.5 +6.0 +6.5 +7.0 + + + + + + + + + + +1.0 +1.5 +2.0 +2.5 +3.0 +x +y + +x + + + + + + + + + + + + + + +1.5 +2.0 +2.5 +guide_bins can show arrows + diff --git a/tests/figs/guides/guide-bins-can-show-limits.svg b/tests/figs/guides/guide-bins-can-show-limits.svg new file mode 100644 index 0000000000..c4b804a4d4 --- /dev/null +++ b/tests/figs/guides/guide-bins-can-show-limits.svg @@ -0,0 +1,75 @@ + + + + + + + + + + + + + + + + + + + + + + +5.0 +5.5 +6.0 +6.5 +7.0 + + + + + + + + + + +1.0 +1.5 +2.0 +2.5 +3.0 +x +y + +x + + + + + + + + + + + + + + +1.0 +1.5 +2.0 +2.5 +3.0 +guide_bins can show limits + diff --git a/tests/figs/guides/guide-bins-can-show-ticks.svg b/tests/figs/guides/guide-bins-can-show-ticks.svg new file mode 100644 index 0000000000..3746b63a12 --- /dev/null +++ b/tests/figs/guides/guide-bins-can-show-ticks.svg @@ -0,0 +1,67 @@ + + + + + + + + + + + + + + + + + + + + + + +5.0 +5.5 +6.0 +6.5 +7.0 + + + + + + + + + +1 +2 +3 +4 +x +y + + + + + +1.5 +2.0 +3.0 +x + + + + + + +guide_bins can show ticks + diff --git a/tests/figs/guides/guide-bins-looks-as-it-should.svg b/tests/figs/guides/guide-bins-looks-as-it-should.svg new file mode 100644 index 0000000000..650baf4365 --- /dev/null +++ b/tests/figs/guides/guide-bins-looks-as-it-should.svg @@ -0,0 +1,71 @@ + + + + + + + + + + + + + + + + + + + + + + +5.0 +5.5 +6.0 +6.5 +7.0 + + + + + + + + + + +1.0 +1.5 +2.0 +2.5 +3.0 +x +y + +x + + + + + + + + + + + + +1.5 +2.0 +2.5 +guide_bins looks as it should + diff --git a/tests/figs/guides/guide-bins-work-horizontally.svg b/tests/figs/guides/guide-bins-work-horizontally.svg new file mode 100644 index 0000000000..7d5b3222bb --- /dev/null +++ b/tests/figs/guides/guide-bins-work-horizontally.svg @@ -0,0 +1,71 @@ + + + + + + + + + + + + + + + + + + + + + + +5.0 +5.5 +6.0 +6.5 +7.0 + + + + + + + + + + +1.0 +1.5 +2.0 +2.5 +3.0 +x +y + +x + + + + + + + + + + + + +1.5 +2.0 +2.5 +guide_bins work horizontally + diff --git a/tests/figs/guides/guide-coloursteps-can-have-bins-relative-to-binsize.svg b/tests/figs/guides/guide-coloursteps-can-have-bins-relative-to-binsize.svg new file mode 100644 index 0000000000..009180678b --- /dev/null +++ b/tests/figs/guides/guide-coloursteps-can-have-bins-relative-to-binsize.svg @@ -0,0 +1,157 @@ + + + + + + + + + + + + + + + + + + + + + + +5.0 +5.5 +6.0 +6.5 +7.0 + + + + + + + + + +1 +2 +3 +4 +x +y + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1.5 +2.0 +3.0 +x +guide_coloursteps can have bins relative to binsize + diff --git a/tests/figs/guides/guide-coloursteps-can-show-limits.svg b/tests/figs/guides/guide-coloursteps-can-show-limits.svg new file mode 100644 index 0000000000..a894fc9fcd --- /dev/null +++ b/tests/figs/guides/guide-coloursteps-can-show-limits.svg @@ -0,0 +1,63 @@ + + + + + + + + + + + + + + + + + + + + + + +5.0 +5.5 +6.0 +6.5 +7.0 + + + + + + + + + +1 +2 +3 +4 +x +y + + + + + +1 +1.5 +2.0 +3.0 +4 +x +guide_coloursteps can show limits + diff --git a/tests/figs/guides/guide-coloursteps-looks-as-it-should.svg b/tests/figs/guides/guide-coloursteps-looks-as-it-should.svg new file mode 100644 index 0000000000..ba8a0c49b2 --- /dev/null +++ b/tests/figs/guides/guide-coloursteps-looks-as-it-should.svg @@ -0,0 +1,61 @@ + + + + + + + + + + + + + + + + + + + + + + +5.0 +5.5 +6.0 +6.5 +7.0 + + + + + + + + + +1 +2 +3 +4 +x +y + + + + + +1.5 +2.0 +3.0 +x +guide_coloursteps looks as it should + diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index 6ef54fcaf5..36537b23af 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -336,3 +336,46 @@ test_that("guides can handle multiple aesthetics for one scale", { expect_doppelganger("one combined colorbar for colour and fill aesthetics", p) }) + +test_that("bin guide can be styled correctly", { + df <- data_frame(x = c(1, 2, 3), + y = c(6, 5, 7)) + + p <- ggplot(df, aes(x, y, size = x)) + + geom_point() + + scale_size_binned() + + expect_doppelganger("guide_bins looks as it should", p) + expect_doppelganger("guide_bins can show limits", + p + guides(size = guide_bins(show.limits = TRUE)) + ) + expect_doppelganger("guide_bins can show arrows", + p + guides(size = guide_bins(axis.arrow = arrow(length = unit(1.5, "mm"), ends = "both"))) + ) + expect_doppelganger("guide_bins can remove axis", + p + guides(size = guide_bins(axis = FALSE)) + ) + expect_doppelganger("guide_bins work horizontally", + p + guides(size = guide_bins(direction = "horizontal")) + ) +}) + +test_that("coloursteps guide can be styled correctly", { + df <- data_frame(x = c(1, 2, 4), + y = c(6, 5, 7)) + + p <- ggplot(df, aes(x, y, colour = x)) + + geom_point() + + scale_colour_binned(breaks = c(1.5, 2, 3)) + + expect_doppelganger("guide_coloursteps looks as it should", p) + expect_doppelganger("guide_coloursteps can show limits", + p + guides(colour = guide_coloursteps(show.limits = TRUE)) + ) + expect_doppelganger("guide_coloursteps can have bins relative to binsize", + p + guides(colour = guide_coloursteps(even.steps = FALSE)) + ) + expect_doppelganger("guide_bins can show ticks", + p + guides(colour = guide_coloursteps(ticks = TRUE)) + ) +}) From 9039d6b23508c21bf2c9b482436b0d459921ef66 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Mon, 30 Sep 2019 11:16:44 +0200 Subject: [PATCH 30/30] Rename blender -> fermenter --- NAMESPACE | 6 +++--- R/scale-brewer.r | 14 +++++++------- R/zxx.r | 2 +- man/scale_brewer.Rd | 19 ++++++++++--------- 4 files changed, 21 insertions(+), 20 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index e86ee8173b..63107c1648 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -435,13 +435,13 @@ export(scale_alpha_identity) export(scale_alpha_manual) export(scale_alpha_ordinal) export(scale_color_binned) -export(scale_color_blender) export(scale_color_brewer) export(scale_color_continuous) export(scale_color_date) export(scale_color_datetime) export(scale_color_discrete) export(scale_color_distiller) +export(scale_color_fermenter) export(scale_color_gradient) export(scale_color_gradient2) export(scale_color_gradientn) @@ -456,13 +456,13 @@ export(scale_color_stepsn) export(scale_color_viridis_c) export(scale_color_viridis_d) export(scale_colour_binned) -export(scale_colour_blender) export(scale_colour_brewer) export(scale_colour_continuous) export(scale_colour_date) export(scale_colour_datetime) export(scale_colour_discrete) export(scale_colour_distiller) +export(scale_colour_fermenter) export(scale_colour_gradient) export(scale_colour_gradient2) export(scale_colour_gradientn) @@ -481,13 +481,13 @@ export(scale_continuous_identity) export(scale_discrete_identity) export(scale_discrete_manual) export(scale_fill_binned) -export(scale_fill_blender) export(scale_fill_brewer) export(scale_fill_continuous) export(scale_fill_date) export(scale_fill_datetime) export(scale_fill_discrete) export(scale_fill_distiller) +export(scale_fill_fermenter) export(scale_fill_gradient) export(scale_fill_gradient2) export(scale_fill_gradientn) diff --git a/R/scale-brewer.r b/R/scale-brewer.r index dade5151d0..aa5d95d11d 100644 --- a/R/scale-brewer.r +++ b/R/scale-brewer.r @@ -8,7 +8,7 @@ #' #' @note #' The `distiller` scales extend brewer to continuous scales by smoothly -#' interpolating 7 colours from any palette to a continuous scale. The `blender` +#' interpolating 7 colours from any palette to a continuous scale. The `fermenter` #' scales provide binned versions of the brewer scales. #' #' @details @@ -34,7 +34,7 @@ #' the list of palettes of appropriate `type`. The list of available palettes can found #' in the Palettes section. #' @param ... Other arguments passed on to [discrete_scale()], [continuous_scale()], -#' or [binned_scale()], for `brewer`, `distiller`, and `blender` variants +#' or [binned_scale()], for `brewer`, `distiller`, and `fermenter` variants #' respectively, to control name, limits, breaks, labels and so forth. #' @family colour scales #' @rdname scale_brewer @@ -72,7 +72,7 @@ #' v + scale_fill_distiller(palette = "Spectral") #' #' # or use blender variants to discretize continuous data -#' v + scale_fill_blender() +#' v + scale_fill_fermenter() #' scale_colour_brewer <- function(..., type = "seq", palette = 1, direction = 1, aesthetics = "colour") { discrete_scale(aesthetics, "brewer", brewer_pal(type, palette, direction), ...) @@ -111,23 +111,23 @@ scale_fill_distiller <- function(..., type = "seq", palette = 1, direction = -1, #' @export #' @rdname scale_brewer -scale_colour_blender <- function(..., type = "seq", palette = 1, direction = -1, na.value = "grey50", guide = "coloursteps", aesthetics = "colour") { +scale_colour_fermenter <- function(..., type = "seq", palette = 1, direction = -1, na.value = "grey50", guide = "coloursteps", aesthetics = "colour") { # warn about using a qualitative brewer palette to generate the gradient type <- match.arg(type, c("seq", "div", "qual")) if (type == "qual") { warning("Using a discrete colour palette in a binned scale.\n Consider using type = \"seq\" or type = \"div\" instead", call. = FALSE) } - binned_scale(aesthetics, "blender", binned_pal(brewer_pal(type, palette, direction)), na.value = na.value, guide = guide, ...) + binned_scale(aesthetics, "fermenter", binned_pal(brewer_pal(type, palette, direction)), na.value = na.value, guide = guide, ...) } #' @export #' @rdname scale_brewer -scale_fill_blender <- function(..., type = "seq", palette = 1, direction = -1, na.value = "grey50", guide = "coloursteps", aesthetics = "fill") { +scale_fill_fermenter <- function(..., type = "seq", palette = 1, direction = -1, na.value = "grey50", guide = "coloursteps", aesthetics = "fill") { type <- match.arg(type, c("seq", "div", "qual")) if (type == "qual") { warning("Using a discrete colour palette in a binned scale.\n Consider using type = \"seq\" or type = \"div\" instead", call. = FALSE) } - binned_scale(aesthetics, "distiller", binned_pal(brewer_pal(type, palette, direction)), na.value = na.value, guide = guide, ...) + binned_scale(aesthetics, "fermenter", binned_pal(brewer_pal(type, palette, direction)), na.value = na.value, guide = guide, ...) } # icon.brewer <- function() { diff --git a/R/zxx.r b/R/zxx.r index 4f560cfaed..b90bd9804c 100644 --- a/R/zxx.r +++ b/R/zxx.r @@ -128,7 +128,7 @@ scale_color_distiller <- scale_colour_distiller #' @export #' @rdname scale_brewer #' @usage NULL -scale_color_blender <- scale_colour_blender +scale_color_fermenter <- scale_colour_fermenter #' @export #' @rdname scale_colour_continuous diff --git a/man/scale_brewer.Rd b/man/scale_brewer.Rd index 4d2a5ae1bd..dffed48fe3 100644 --- a/man/scale_brewer.Rd +++ b/man/scale_brewer.Rd @@ -5,11 +5,11 @@ \alias{scale_fill_brewer} \alias{scale_colour_distiller} \alias{scale_fill_distiller} -\alias{scale_colour_blender} -\alias{scale_fill_blender} +\alias{scale_colour_fermenter} +\alias{scale_fill_fermenter} \alias{scale_color_brewer} \alias{scale_color_distiller} -\alias{scale_color_blender} +\alias{scale_color_fermenter} \title{Sequential, diverging and qualitative colour scales from colorbrewer.org} \usage{ scale_colour_brewer(..., type = "seq", palette = 1, direction = 1, @@ -26,15 +26,16 @@ scale_fill_distiller(..., type = "seq", palette = 1, direction = -1, values = NULL, space = "Lab", na.value = "grey50", guide = "colourbar", aesthetics = "fill") -scale_colour_blender(..., type = "seq", palette = 1, direction = -1, - na.value = "grey50", guide = "coloursteps", aesthetics = "colour") +scale_colour_fermenter(..., type = "seq", palette = 1, + direction = -1, na.value = "grey50", guide = "coloursteps", + aesthetics = "colour") -scale_fill_blender(..., type = "seq", palette = 1, direction = -1, +scale_fill_fermenter(..., type = "seq", palette = 1, direction = -1, na.value = "grey50", guide = "coloursteps", aesthetics = "fill") } \arguments{ \item{...}{Other arguments passed on to \code{\link[=discrete_scale]{discrete_scale()}}, \code{\link[=continuous_scale]{continuous_scale()}}, -or \code{\link[=binned_scale]{binned_scale()}}, for \code{brewer}, \code{distiller}, and \code{blender} variants +or \code{\link[=binned_scale]{binned_scale()}}, for \code{brewer}, \code{distiller}, and \code{fermenter} variants respectively, to control name, limits, breaks, labels and so forth.} \item{type}{One of seq (sequential), div (diverging) or qual (qualitative)} @@ -78,7 +79,7 @@ look good. Your mileage may vary. } \note{ The \code{distiller} scales extend brewer to continuous scales by smoothly -interpolating 7 colours from any palette to a continuous scale. The \code{blender} +interpolating 7 colours from any palette to a continuous scale. The \code{fermenter} scales provide binned versions of the brewer scales. } \section{Palettes}{ @@ -126,7 +127,7 @@ v + scale_fill_distiller() v + scale_fill_distiller(palette = "Spectral") # or use blender variants to discretize continuous data -v + scale_fill_blender() +v + scale_fill_fermenter() } \seealso{