diff --git a/DESCRIPTION b/DESCRIPTION index c20a3cd7a5..7af9aac5ab 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -153,7 +153,9 @@ Collate: 'grob-dotstack.r' 'grob-null.r' 'grouping.r' + 'guide-bins.R' 'guide-colorbar.r' + 'guide-colorsteps.R' 'guide-legend.r' 'guides-.r' 'guides-axis.r' @@ -186,6 +188,7 @@ Collate: 'save.r' 'scale-.r' 'scale-alpha.r' + 'scale-binned.R' 'scale-brewer.r' 'scale-colour.r' 'scale-continuous.r' @@ -200,6 +203,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 28b49f80ad..de8c8cf4df 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -68,19 +68,24 @@ S3method(grobWidth,zeroGrob) S3method(grobX,absoluteGrob) S3method(grobY,absoluteGrob) S3method(guide_gengrob,axis) +S3method(guide_gengrob,bins) S3method(guide_gengrob,colorbar) S3method(guide_gengrob,guide_none) S3method(guide_gengrob,legend) S3method(guide_geom,axis) +S3method(guide_geom,bins) S3method(guide_geom,colorbar) S3method(guide_geom,guide_none) S3method(guide_geom,legend) S3method(guide_merge,axis) +S3method(guide_merge,bins) S3method(guide_merge,colorbar) S3method(guide_merge,guide_none) S3method(guide_merge,legend) S3method(guide_train,axis) +S3method(guide_train,bins) S3method(guide_train,colorbar) +S3method(guide_train,colorsteps) S3method(guide_train,guide_none) S3method(guide_train,legend) S3method(guide_transform,axis) @@ -201,6 +206,8 @@ export(PositionJitterdodge) export(PositionNudge) export(PositionStack) export(Scale) +export(ScaleBinned) +export(ScaleBinnedPosition) export(ScaleContinuous) export(ScaleContinuousDate) export(ScaleContinuousDatetime) @@ -370,8 +377,11 @@ export(ggproto_parent) export(ggsave) export(ggtitle) export(guide_axis) +export(guide_bins) export(guide_colorbar) +export(guide_colorsteps) export(guide_colourbar) +export(guide_coloursteps) export(guide_gengrob) export(guide_geom) export(guide_legend) @@ -438,12 +448,14 @@ export(scale_alpha_discrete) export(scale_alpha_identity) export(scale_alpha_manual) export(scale_alpha_ordinal) +export(scale_color_binned) 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) @@ -452,14 +464,19 @@ export(scale_color_hue) 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) 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) @@ -468,17 +485,23 @@ export(scale_colour_hue) 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) export(scale_discrete_identity) export(scale_discrete_manual) +export(scale_fill_binned) 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) @@ -487,15 +510,21 @@ export(scale_fill_hue) 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) @@ -503,6 +532,8 @@ export(scale_shape_manual) 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) @@ -511,6 +542,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) @@ -519,6 +551,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/NEWS.md b/NEWS.md index 5dd0bea39b..ac58e9c933 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) + * Position guides can now be customized using the new `guide_axis()`, which can be passed to position `scale_*()` functions or via `guides()`. The new axis guide (`guide_axis()`) comes with diff --git a/R/guide-bins.R b/R/guide-bins.R new file mode 100644 index 0000000000..88a21e1c10 --- /dev/null +++ b/R/guide-bins.R @@ -0,0 +1,587 @@ +#' 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(), + 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, + + # key + keywidth = NULL, + keyheight = NULL, + + # ticks + axis = TRUE, + axis.colour = "black", + axis.linewidth = 0.5, + axis.arrow = NULL, + + # general + direction = NULL, + default.unit = "line", + override.aes = list(), + reverse = FALSE, + order = 0, + show.limits = NULL, + ...) { + + 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, + + # key + keywidth = keywidth, + keyheight = keyheight, + + # ticks + axis = axis, + axis.colour = axis.colour, + axis.linewidth = axis.linewidth, + axis.arrow = axis.arrow, + + # general + direction = direction, + default.unit = default.unit, + reverse = reverse, + order = order, + show.limits = show.limits, + + # parameter + available_aes = c("any"), + ..., + name = "bins"), + class = c("guide", "bins") + ) +} + +#' @export +guide_train.bins <- function(guide, scale, aesthetic = NULL) { + 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(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$reverse) key <- key[nrow(key):1, ] + + guide$key <- key + guide$hash <- with( + guide, + digest::digest(list(title, key$.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) { + if (!guide$show.limits) { + guide$key$.label[c(1, nrow(guide$key))] <- NA + } + + # default setting + 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 + + # 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 %||% + calc_element("text", theme)$size %||% 11 + + # 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 + + # 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) + + 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.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 + + # 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) + }) + if (!guide$show.limits) { + grob.labels[c(1, length(grob.labels))] <- list(zeroGrob()) + } + } + + label_widths <- width_cm(grob.labels) + label_heights <- height_cm(grob.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) + )[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 = n_keys) + } + key_sizes <- apply(key_size_mat, 1, max) + + if (guide$direction == "horizontal") { + key.nrow <- 1 + key.ncol <- n_keys + label.nrow <- 1 + label.ncol <- n_keys + 1 + } else { + key.nrow <- n_keys + key.ncol <- 1 + label.nrow <- n_keys + 1 + label.ncol <- 1 + } + + key_sizes <- matrix(key_sizes, key.nrow, key.ncol) + label_sizes <- matrix(label_widths, label.nrow, label.ncol) + + key_widths <- max(key_width, apply(key_sizes, 2, max)) + key_heights <- max(key_height, apply(key_sizes, 1, 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 = 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 = if (label.position %in% c("right", "bottom")) 3 else 1 + ) + tick_loc <- label_loc + 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) + } + + # layout the title over key-label + switch(guide$title.position, + "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 + + 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(n_keys), draw_key), recursive = FALSE) + + # background + grob.background <- element_render(theme, "legend.background") + + ngeom <- length(guide$geoms) + 1 + 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$axis) { + grob.ticks <- zeroGrob() + grob.axis <- zeroGrob() + } else { + if (guide$direction == "horizontal") { + 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 <- 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$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) { + 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( + gt, + grob.background, + name = "background", + clip = "off", + t = 1, + r = -1, + b = -1, + l = 1 + ) + 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(title_row), + r = 1 + max(title_col), + b = 1 + max(title_row), + l = 1 + min(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, + grob.ticks, + 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( + grob.labels, + hjust = hjust, + vjust = vjust, + int_angle = label.theme$angle, + debug = label.theme$debug + ), + name = paste("label", label_loc$R, label_loc$C, sep = "-"), + clip = "off", + t = 1 + label_loc$R, + r = 1 + label_loc$C, + b = 1 + label_loc$R, + l = 1 + label_loc$C + ) + 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) + ) + + } +} diff --git a/R/guide-colorbar.r b/R/guide-colorbar.r index 4250443b9d..26a959ad3f 100644 --- a/R/guide-colorbar.r +++ b/R/guide-colorbar.r @@ -566,25 +566,3 @@ guide_gengrob.colorbar <- function(guide, theme) { #' @export #' @rdname guide_colourbar guide_colorbar <- guide_colourbar - -#' 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 9ccd77b42d..76e32d006d 100644 --- a/R/scale-.r +++ b/R/scale-.r @@ -186,6 +186,70 @@ 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. +#' @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? +#' @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, nice.breaks = TRUE, + 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, + rescaler = rescaler, + oob = oob, + n.breaks = n.breaks, + nice.breaks = nice.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*` @@ -472,11 +536,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 "discrete" - 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 }, @@ -810,6 +871,193 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale, } ) +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +ScaleBinned <- ggproto("ScaleBinned", Scale, + range = continuous_range(), + na.value = NA_real_, + rescaler = rescale, + oob = squish, + n.breaks = NULL, + nice.breaks = TRUE, + right = TRUE, + after.stat = FALSE, + show.limits = FALSE, + + is_discrete = function() FALSE, + + 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) + }, + + transform = function(self, x) { + new_x <- self$trans$transform(x) + 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) { + 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(breaks, limits) + + x_binned <- cut(x, breaks, + labels = FALSE, + include.lowest = TRUE, + right = self$right + ) + + if (!is.null(self$palette.cache)) { + pal <- self$palette.cache + } else { + pal <- self$palette(breaks[-1] - diff(breaks) / 2) + self$palette.cache <- pal + } + + pal[x_binned] + } + }, + + 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) + }, + + 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 (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) + } + } 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]) + 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 + } 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) + } else { + breaks <- self$breaks + } + + # Breaks must be within limits + breaks <- breaks[breaks >= limits[1] & breaks <= limits[2]] + self$breaks <- breaks + + self$trans$transform(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) + + 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))) + } + + # labels + labels <- self$get_labels(major) + + list(range = range, labels = labels, + major = pal, minor = NULL, + major_source = major, minor_source = NULL) + } +) + # In place modification of a scale to change the primary axis scale_flip_position <- function(scale) { scale$position <- switch(scale$position, @@ -821,3 +1069,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-alpha.r b/R/scale-alpha.r index 967ae92d9a..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. @@ -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-binned.R b/R/scale-binned.R new file mode 100644 index 0000000000..4a869bc726 --- /dev/null +++ b/R/scale-binned.R @@ -0,0 +1,110 @@ +#' 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.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, 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, 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, nice.breaks = nice.breaks, right = right, trans = trans, + show.limits = show.limits, guide = "none", position = position, super = ScaleBinnedPosition + ) +} + +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @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) { + # 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 - 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 # Return integer form so stat treat it like a discrete scale + } + }, + reset = function(self) { + self$after.stat <- TRUE + limits <- self$get_limits() + breaks <- self$get_breaks(limits) + self$range$reset() + self$range$train(c(limits, breaks)) + }, + + get_breaks = function(self, limits = self$get_limits()) { + breaks <- ggproto_parent(ScaleBinned, self)$get_breaks(limits) + if (self$show.limits) { + breaks <- sort(unique(c(self$get_limits(), breaks))) + } + breaks + } +) diff --git a/R/scale-brewer.r b/R/scale-brewer.r index ccbfc869ac..aa5d95d11d 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 `fermenter` +#' 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 `fermenter` 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_fermenter() +#' scale_colour_brewer <- function(..., type = "seq", palette = 1, direction = 1, aesthetics = "colour") { discrete_scale(aesthetics, "brewer", brewer_pal(type, palette, direction), ...) } @@ -104,6 +109,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_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, "fermenter", binned_pal(brewer_pal(type, palette, direction)), na.value = na.value, guide = guide, ...) +} + +#' @export +#' @rdname scale_brewer +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, "fermenter", binned_pal(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-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 874c25d6ff..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 @@ -33,6 +34,12 @@ scale_linetype <- function(..., na.value = "blank") { na.value = na.value, ...) } +#' @rdname scale_linetype +#' @export +scale_linetype_binned <- function(..., na.value = "blank") { + 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..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`? @@ -38,6 +39,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..ea6f81003a 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() + @@ -42,6 +48,10 @@ scale_size_continuous <- function(name = waiver(), breaks = waiver(), labels = w guide = guide) } +#' @rdname scale_size +#' @export +scale_size <- scale_size_continuous + #' @rdname scale_size #' @export scale_radius <- function(name = waiver(), breaks = waiver(), labels = waiver(), @@ -54,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 @@ -91,6 +107,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 new file mode 100644 index 0000000000..d671569754 --- /dev/null +++ b/R/scale-steps.R @@ -0,0 +1,91 @@ +#' Binned gradient colour scales +#' +#' `scale_*_steps` creates a two colour binned gradient (low-high), +#' `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 +#' 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 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 +#' @rdname scale_steps +#' @export +#' @examples +#' df <- data.frame( +#' x = runif(100), +#' y = runif(100), +#' z1 = rnorm(100) +#' ) +#' +#' # Use scale_colour_steps for a standard binned gradient +#' ggplot(df, aes(x, y)) + +#' geom_point(aes(colour = z1)) + +#' scale_colour_steps() +#' +#' # Get a divergent binned scale with the *2 variant +#' ggplot(df, aes(x, y)) + +#' geom_point(aes(colour = z1)) + +#' scale_colour_steps2() +#' +#' # Define your own colour ramp to extract binned colours from +#' ggplot(df, aes(x, y)) + +#' geom_point(aes(colour = z1)) + +#' scale_colour_stepsn(colours = terrain.colors(10)) +#' + +#' @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..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( @@ -111,3 +116,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/R/zxx.r b/R/zxx.r index 28dc498ca1..b90bd9804c 100644 --- a/R/zxx.r +++ b/R/zxx.r @@ -125,11 +125,21 @@ scale_color_brewer <- scale_colour_brewer #' @usage NULL scale_color_distiller <- scale_colour_distiller +#' @export +#' @rdname scale_brewer +#' @usage NULL +scale_color_fermenter <- scale_colour_fermenter + #' @export #' @rdname scale_colour_continuous #' @usage NULL scale_color_continuous <- scale_colour_continuous +#' @export +#' @rdname scale_colour_continuous +#' @usage NULL +scale_color_binned <- scale_colour_binned + #' @export #' @rdname scale_hue #' @usage NULL @@ -150,6 +160,21 @@ scale_color_gradient2 <- scale_colour_gradient2 #' @usage NULL scale_color_gradientn <- scale_colour_gradientn +#' @export +#' @rdname scale_steps +#' @usage NULL +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 #' @usage NULL diff --git a/man/binned_scale.Rd b/man/binned_scale.Rd new file mode 100644 index 0000000000..0da32bd185 --- /dev/null +++ b/man/binned_scale.Rd @@ -0,0 +1,123 @@ +% 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, + rescaler = rescale, oob = squish, expand = waiver(), + 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.} + +\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{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.} + +\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{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{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.} + +\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} +} +\description{ +Binning scale constructor +} +\keyword{internal} diff --git a/man/ggplot2-ggproto.Rd b/man/ggplot2-ggproto.Rd index df35148ece..75605bc356 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/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 63330959ff..c7eebdfa4d 100644 --- a/man/guide_colourbar.Rd +++ b/man/guide_colourbar.Rd @@ -186,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 fdd86fffc4..93f1da10ca 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,12 +14,14 @@ 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)) } \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.} @@ -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_binned.Rd b/man/scale_binned.Rd new file mode 100644 index 0000000000..1227d3e7a1 --- /dev/null +++ b/man/scale_binned.Rd @@ -0,0 +1,123 @@ +% 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.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, 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 +\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.} + +\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{ +\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{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{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{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}{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.} +} +\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. +} +\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_brewer.Rd b/man/scale_brewer.Rd index c44e785402..dffed48fe3 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_fermenter} +\alias{scale_fill_fermenter} \alias{scale_color_brewer} \alias{scale_color_distiller} +\alias{scale_color_fermenter} \title{Sequential, diverging and qualitative colour scales from colorbrewer.org} \usage{ scale_colour_brewer(..., type = "seq", palette = 1, direction = 1, @@ -22,11 +25,18 @@ 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_fermenter(..., type = "seq", palette = 1, + direction = -1, na.value = "grey50", guide = "coloursteps", + aesthetics = "colour") + +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()}} 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{fermenter} variants +respectively, to control name, limits, breaks, labels and so forth.} \item{type}{One of seq (sequential), div (diverging) or qual (qualitative)} @@ -69,7 +79,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{fermenter} +scales provide binned versions of the brewer scales. } \section{Palettes}{ @@ -114,12 +125,17 @@ 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_fermenter() + } \seealso{ 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_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_continuous.Rd b/man/scale_continuous.Rd index 925196344c..c853b8c83d 100644 --- a/man/scale_continuous.Rd +++ b/man/scale_continuous.Rd @@ -188,7 +188,8 @@ p1 + scale_y_continuous(trans = scales::reciprocal_trans()) } \seealso{ -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 444a4cacd2..8e0391d7ce 100644 --- a/man/scale_date.Rd +++ b/man/scale_date.Rd @@ -160,7 +160,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 cd73d626b1..3284d62b76 100644 --- a/man/scale_discrete.Rd +++ b/man/scale_discrete.Rd @@ -124,7 +124,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} diff --git a/man/scale_gradient.Rd b/man/scale_gradient.Rd index ad3ef69a5d..d59e93fff7 100644 --- a/man/scale_gradient.Rd +++ b/man/scale_gradient.Rd @@ -225,6 +225,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 0f4b1c491b..3e55326b3e 100644 --- a/man/scale_grey.Rd +++ b/man/scale_grey.Rd @@ -103,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 e5c5d6ff36..6a5f5dcde5 100644 --- a/man/scale_hue.Rd +++ b/man/scale_hue.Rd @@ -136,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 dd4588a11e..2a82557802 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(..., na.value = "blank") + scale_linetype_continuous(...) scale_linetype_discrete(..., na.value = "blank") @@ -60,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 2763e5e984..049aaf06ec 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} @@ -63,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 17614721fc..31c659c4e7 100644 --- a/man/scale_size.Rd +++ b/man/scale_size.Rd @@ -4,22 +4,31 @@ \alias{scale_size} \alias{scale_size_continuous} \alias{scale_radius} +\alias{scale_size_binned} \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} \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) } \arguments{ \item{name}{The name of the scale. Used as the axis or legend title. If @@ -77,6 +86,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 @@ -161,7 +179,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)) + @@ -173,6 +193,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 new file mode 100644 index 0000000000..9155ee3357 --- /dev/null +++ b/man/scale_steps.Rd @@ -0,0 +1,195 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/scale-steps.R, R/zxx.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} +\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", + 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.} + \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{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{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}{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{"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_*_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 +\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) +) + +# Use scale_colour_steps for a standard binned gradient +ggplot(df, aes(x, y)) + + geom_point(aes(colour = z1)) + + scale_colour_steps() + +# Get a divergent binned scale with the *2 variant +ggplot(df, aes(x, y)) + + geom_point(aes(colour = z1)) + + scale_colour_steps2() + +# Define your own colour ramp to extract binned colours from +ggplot(df, aes(x, y)) + + geom_point(aes(colour = z1)) + + scale_colour_stepsn(colours = terrain.colors(10)) + +} +\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..d266cab34b 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,10 +27,19 @@ 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 -\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}}.} @@ -101,12 +112,17 @@ 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}}, \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} 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 0fa2b90a91..87e3898f0d 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -423,3 +423,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)) + ) +})