diff --git a/NAMESPACE b/NAMESPACE index 878563096d..e285d7114e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -368,6 +368,8 @@ export(render_strips) export(resolution) export(scale_alpha) export(scale_alpha_continuous) +export(scale_alpha_date) +export(scale_alpha_datetime) export(scale_alpha_discrete) export(scale_alpha_identity) export(scale_alpha_manual) diff --git a/NEWS.md b/NEWS.md index 92468e350f..f1c0b52416 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,10 @@ # ggplot2 2.2.1.9000 +* Updated datetime scales for `alpha`, `size`, `colour`, and `fill` can take + `date_breaks` and `date_labels` arguments (@karawoo, #1526). + +* `scale_alpha()` gains date and date-time variants (@karawoo, #1526). + * Axes positioned on the top and to the right can now customize their ticks and lines separately (@thomasp85, #1899) diff --git a/R/scale-alpha.r b/R/scale-alpha.r index 522266974b..0d602a1133 100644 --- a/R/scale-alpha.r +++ b/R/scale-alpha.r @@ -32,3 +32,17 @@ scale_alpha_discrete <- function(..., range = c(0.1, 1)) { discrete_scale("alpha", "alpha_d", function(n) seq(range[1], range[2], length.out = n), ...) } + +#' @rdname scale_alpha +#' @export +#' @usage NULL +scale_alpha_datetime <- function(..., range = c(0.1, 1)) { + datetime_scale("alpha", "time", palette = rescale_pal(range), ...) +} + +#' @rdname scale_alpha +#' @export +#' @usage NULL +scale_alpha_date <- function(..., range = c(0.1, 1)){ + datetime_scale("alpha", "date", palette = rescale_pal(range), ...) +} diff --git a/R/scale-date.r b/R/scale-date.r index 7d61bbebde..03f0483755 100644 --- a/R/scale-date.r +++ b/R/scale-date.r @@ -45,52 +45,95 @@ NULL #' @rdname scale_date #' @export scale_x_date <- function(name = waiver(), - breaks = waiver(), date_breaks = waiver(), - labels = waiver(), date_labels = waiver(), - minor_breaks = waiver(), date_minor_breaks = waiver(), - limits = NULL, expand = waiver(), position = "bottom") { + breaks = waiver(), + date_breaks = waiver(), + labels = waiver(), + date_labels = waiver(), + minor_breaks = waiver(), + date_minor_breaks = waiver(), + limits = NULL, + expand = waiver(), + position = "bottom") { - scale_datetime(c("x", "xmin", "xmax", "xend"), "date", + datetime_scale( + c("x", "xmin", "xmax", "xend"), + "date", name = name, - breaks = breaks, date_breaks = date_breaks, - labels = labels, date_labels = date_labels, - minor_breaks = minor_breaks, date_minor_breaks = date_minor_breaks, - limits = limits, expand = expand, position = position + palette = identity, + breaks = breaks, + date_breaks = date_breaks, + labels = labels, + date_labels = date_labels, + minor_breaks = minor_breaks, + date_minor_breaks = date_minor_breaks, + guide = "none", + limits = limits, + expand = expand, + position = position ) } #' @rdname scale_date #' @export scale_y_date <- function(name = waiver(), - breaks = waiver(), date_breaks = waiver(), - labels = waiver(), date_labels = waiver(), - minor_breaks = waiver(), date_minor_breaks = waiver(), - limits = NULL, expand = waiver(), position = "left") { + breaks = waiver(), + date_breaks = waiver(), + labels = waiver(), + date_labels = waiver(), + minor_breaks = waiver(), + date_minor_breaks = waiver(), + limits = NULL, + expand = waiver(), + position = "left") { - scale_datetime(c("y", "ymin", "ymax", "yend"), "date", + datetime_scale( + c("y", "ymin", "ymax", "yend"), + "date", name = name, - breaks = breaks, date_breaks = date_breaks, - labels = labels, date_labels = date_labels, - minor_breaks = minor_breaks, date_minor_breaks = date_minor_breaks, - limits = limits, expand = expand, position = position + palette = identity, + breaks = breaks, + date_breaks = date_breaks, + labels = labels, + date_labels = date_labels, + minor_breaks = minor_breaks, + date_minor_breaks = date_minor_breaks, + guide = "none", + limits = limits, + expand = expand, + position = position ) } #' @export #' @rdname scale_date scale_x_datetime <- function(name = waiver(), - breaks = waiver(), date_breaks = waiver(), - labels = waiver(), date_labels = waiver(), - minor_breaks = waiver(), date_minor_breaks = waiver(), - timezone = NULL, limits = NULL, expand = waiver(), + breaks = waiver(), + date_breaks = waiver(), + labels = waiver(), + date_labels = waiver(), + minor_breaks = waiver(), + date_minor_breaks = waiver(), + timezone = NULL, + limits = NULL, + expand = waiver(), position = "bottom") { - scale_datetime(c("x", "xmin", "xmax", "xend"), "time", + datetime_scale( + c("x", "xmin", "xmax", "xend"), + "time", name = name, - breaks = breaks, date_breaks = date_breaks, - labels = labels, date_labels = date_labels, - minor_breaks = minor_breaks, date_minor_breaks = date_minor_breaks, - timezone = timezone, limits = limits, expand = expand, position = position + palette = identity, + breaks = breaks, + date_breaks = date_breaks, + labels = labels, + date_labels = date_labels, + minor_breaks = minor_breaks, + date_minor_breaks = date_minor_breaks, + timezone = timezone, + guide = "none", + limits = limits, + expand = expand, + position = position ) } @@ -98,18 +141,33 @@ scale_x_datetime <- function(name = waiver(), #' @rdname scale_date #' @export scale_y_datetime <- function(name = waiver(), - breaks = waiver(), date_breaks = waiver(), - labels = waiver(), date_labels = waiver(), - minor_breaks = waiver(), date_minor_breaks = waiver(), - timezone = NULL, limits = NULL, expand = waiver(), + breaks = waiver(), + date_breaks = waiver(), + labels = waiver(), + date_labels = waiver(), + minor_breaks = waiver(), + date_minor_breaks = waiver(), + timezone = NULL, + limits = NULL, + expand = waiver(), position = "left") { - scale_datetime(c("y", "ymin", "ymax", "yend"), "time", + datetime_scale( + c("y", "ymin", "ymax", "yend"), + "time", name = name, - breaks = breaks, date_breaks = date_breaks, - labels = labels, date_labels = date_labels, - minor_breaks = minor_breaks, date_minor_breaks = date_minor_breaks, - timezone = timezone, limits = limits, expand = expand, position = position + palette = identity, + breaks = breaks, + date_breaks = date_breaks, + labels = labels, + date_labels = date_labels, + minor_breaks = minor_breaks, + date_minor_breaks = date_minor_breaks, + timezone = timezone, + guide = "none", + limits = limits, + expand = expand, + position = position ) } @@ -168,12 +226,13 @@ scale_y_time <- function(name = waiver(), ) } -scale_datetime <- function(aesthetics, trans, +## rename to datetime_scale +datetime_scale <- function(aesthetics, trans, palette, breaks = pretty_breaks(), minor_breaks = waiver(), labels = waiver(), date_breaks = waiver(), date_labels = waiver(), date_minor_breaks = waiver(), timezone = NULL, - ...) { + guide = "legend", ...) { # Backward compatibility @@ -197,20 +256,35 @@ scale_datetime <- function(aesthetics, trans, date = "date", time = "datetime" ) - scale_class <- switch(trans, - date = ScaleContinuousDate, - time = ScaleContinuousDatetime - ) + + # x/y position aesthetics should use ScaleContinuousDate or + # ScaleContinuousDatetime; others use ScaleContinuous + if (all(aesthetics %in% c("x", "xmin", "xmax", "xend", "y", "ymin", "ymax", "yend"))) { + scale_class <- switch( + trans, + date = ScaleContinuousDate, + time = ScaleContinuousDatetime + ) + } else { + scale_class <- ScaleContinuous + } + sc <- continuous_scale( - aesthetics, name, identity, - breaks = breaks, minor_breaks = minor_breaks, labels = labels, - guide = "none", trans = trans, ..., super = scale_class + aesthetics, + name, + palette = palette, + breaks = breaks, + minor_breaks = minor_breaks, + labels = labels, + guide = guide, + trans = trans, + ..., + super = scale_class ) sc$timezone <- timezone sc } - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL diff --git a/R/scale-size.r b/R/scale-size.r index 439391dc59..d337fc79a8 100644 --- a/R/scale-size.r +++ b/R/scale-size.r @@ -80,14 +80,13 @@ scale_size_area <- function(..., max_size = 6) { #' @rdname scale_size #' @export #' @usage NULL -scale_size_datetime <- function() { - scale_size_continuous(trans = "time") +scale_size_datetime <- function(..., range = c(1, 6)) { + datetime_scale("size", "time", palette = area_pal(range), ...) } #' @rdname scale_size #' @export #' @usage NULL -scale_size_date <- function() { - scale_size_continuous(trans = "date") +scale_size_date <- function(..., range = c(1, 6)) { + datetime_scale("size", "date", palette = area_pal(range), ...) } - diff --git a/R/zxx.r b/R/zxx.r index e3d8e67ce5..42ac96eb30 100644 --- a/R/zxx.r +++ b/R/zxx.r @@ -13,15 +13,39 @@ scale_colour_continuous <- scale_colour_gradient #' @export #' @rdname scale_gradient #' @usage NULL -scale_colour_datetime <- function() { - scale_colour_continuous(trans = "time") +scale_colour_datetime <- function(..., + low = "#132B43", + high = "#56B1F7", + space = "Lab", + na.value = "grey50", + guide = "colourbar") { + datetime_scale( + "colour", + "time", + palette = seq_gradient_pal(low, high, space), + na.value = na.value, + guide = guide, + ... + ) } #' @export #' @rdname scale_gradient #' @usage NULL -scale_colour_date <- function() { - scale_colour_continuous(trans = "date") +scale_colour_date <- function(..., + low = "#132B43", + high = "#56B1F7", + space = "Lab", + na.value = "grey50", + guide = "colourbar") { + datetime_scale( + "colour", + "date", + palette = seq_gradient_pal(low, high, space), + na.value = na.value, + guide = guide, + ... + ) } #' @export @@ -37,15 +61,40 @@ scale_fill_continuous <- scale_fill_gradient #' @export #' @rdname scale_gradient #' @usage NULL -scale_fill_datetime <- function() { - scale_fill_continuous(trans = "time") +scale_fill_datetime <- function(..., + low = "#132B43", + high = "#56B1F7", + space = "Lab", + na.value = "grey50", + guide = "colourbar") { + datetime_scale( + "fill", + "time", + palette = seq_gradient_pal(low, high, space), + na.value = na.value, + guide = guide, + ... + ) + } #' @export #' @rdname scale_gradient #' @usage NULL -scale_fill_date <- function() { - scale_fill_continuous(trans = "date") +scale_fill_date <- function(..., + low = "#132B43", + high = "#56B1F7", + space = "Lab", + na.value = "grey50", + guide = "colourbar") { + datetime_scale( + "fill", + "date", + palette = seq_gradient_pal(low, high, space), + na.value = na.value, + guide = guide, + ... + ) } diff --git a/man/scale_alpha.Rd b/man/scale_alpha.Rd index d51e5e863e..374e625a2a 100644 --- a/man/scale_alpha.Rd +++ b/man/scale_alpha.Rd @@ -4,6 +4,8 @@ \alias{scale_alpha} \alias{scale_alpha_continuous} \alias{scale_alpha_discrete} +\alias{scale_alpha_datetime} +\alias{scale_alpha_date} \title{Alpha transparency scales} \usage{ scale_alpha(..., range = c(0.1, 1)) diff --git a/tests/testthat/test-scale-date.R b/tests/testthat/test-scale-date.R index 82605732b3..8aff4cc5c8 100644 --- a/tests/testthat/test-scale-date.R +++ b/tests/testthat/test-scale-date.R @@ -48,3 +48,25 @@ test_that("not cached across calls", { expect_equal(layer_scales(p1)$x$timezone, "UTC") expect_equal(layer_scales(p2)$x$timezone, "Australia/Lord_Howe") }) + +test_that("datetime size scales work", { + p <- ggplot(df, aes(y = y)) + geom_point(aes(time1, size = time1)) + + # Default size range is c(1, 6) + expect_equal(range(layer_data(p)$size), c(1, 6)) +}) + +test_that("datetime alpha scales work", { + p <- ggplot(df, aes(y = y)) + geom_point(aes(time1, alpha = time1)) + + # Default alpha range is c(0.1, 1.0) + expect_equal(range(layer_data(p)$alpha), c(0.1, 1.0)) +}) + +test_that("datetime colour scales work", { + p <- ggplot(df, aes(y = y)) + + geom_point(aes(time1, colour = time1)) + + scale_colour_datetime() + + expect_equal(range(layer_data(p)$colour), c("#132B43", "#56B1F7")) +})