From f82879419f93b192cf2d0a4040ece2dafb0d6f16 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Tue, 28 Jan 2025 13:25:24 +0100 Subject: [PATCH] =?UTF-8?q?=E2=9C=A8=20Using=20date=20breaks/minor=20break?= =?UTF-8?q?s/labels=20in=20time=20scales.=20(#6282)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * Allow `transform = "hms"` in `datetime_scale()` * add date arguments to time scales * use `datetime_scale()` in time scales * allow for additional underscore args * inherit position scale * `label_time()` can handle both *and* classes * add test * add news bullet * redocument * work in a skip * Revert "`label_time()` can handle both *and* classes" This reverts commit adcd2cb13ee94048af044e46a9abe832dac6ff9c. * separate labelling logic --- NEWS.md | 2 + R/scale-date.R | 56 +++++++++++++------ man/scale_date.Rd | 6 ++ tests/testthat/_snaps/prohibited-functions.md | 6 +- tests/testthat/test-scale-date.R | 14 +++++ 5 files changed, 65 insertions(+), 19 deletions(-) diff --git a/NEWS.md b/NEWS.md index 1419f620be..c8abcc17de 100644 --- a/NEWS.md +++ b/NEWS.md @@ -296,6 +296,8 @@ * All scales now expose the `aesthetics` parameter (@teunbrand, #5841) * New `theme(legend.key.justification)` to control the alignment of legend keys (@teunbrand, #3669). +* Added `scale_{x/y}_time(date_breaks, date_minor_breaks, date_labels)` + (@teunbrand, #4335). # ggplot2 3.5.1 diff --git a/R/scale-date.R b/R/scale-date.R index dff564e71e..e518c7ac11 100644 --- a/R/scale-date.R +++ b/R/scale-date.R @@ -223,8 +223,11 @@ scale_y_datetime <- function(name = waiver(), #' @rdname scale_date scale_x_time <- function(name = waiver(), breaks = waiver(), + date_breaks = waiver(), minor_breaks = waiver(), + date_minor_breaks = waiver(), labels = waiver(), + date_labels = waiver(), limits = NULL, expand = waiver(), oob = censor, @@ -233,20 +236,25 @@ scale_x_time <- function(name = waiver(), position = "bottom", sec.axis = waiver()) { - scale_x_continuous( + sc <- datetime_scale( + ggplot_global$x_aes, + "hms", name = name, + 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 = guide, limits = limits, expand = expand, oob = oob, - na.value = na.value, - guide = guide, - position = position, - transform = scales::transform_hms(), - sec.axis = sec.axis + position = position ) + + set_sec_axis(sec.axis, sc) } @@ -254,8 +262,11 @@ scale_x_time <- function(name = waiver(), #' @export scale_y_time <- function(name = waiver(), breaks = waiver(), + date_breaks = waiver(), minor_breaks = waiver(), + date_minor_breaks = waiver(), labels = waiver(), + date_labels = waiver(), limits = NULL, expand = waiver(), oob = censor, @@ -264,20 +275,25 @@ scale_y_time <- function(name = waiver(), position = "left", sec.axis = waiver()) { - scale_y_continuous( + sc <- datetime_scale( + ggplot_global$y_aes, + "hms", name = name, + 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 = guide, limits = limits, expand = expand, oob = oob, - na.value = na.value, - guide = guide, - position = position, - transform = scales::transform_hms(), - sec.axis = sec.axis + position = position ) + + set_sec_axis(sec.axis, sc) } #' Date/time scale constructor @@ -312,9 +328,13 @@ datetime_scale <- function(aesthetics, transform, trans = deprecated(), } if (!is.waiver(date_labels)) { check_string(date_labels) - labels <- function(self, x) { - tz <- self$timezone %||% "UTC" - label_date(date_labels, tz)(x) + if (transform == "hms") { + labels <- label_time(date_labels) + } else { + labels <- function(self, x) { + tz <- self$timezone %||% "UTC" + label_date(date_labels, tz)(x) + } } } @@ -324,7 +344,8 @@ datetime_scale <- function(aesthetics, transform, trans = deprecated(), scale_class <- switch( transform, date = ScaleContinuousDate, - time = ScaleContinuousDatetime + time = ScaleContinuousDatetime, + ScaleContinuousPosition ) } else { scale_class <- ScaleContinuous @@ -332,7 +353,8 @@ datetime_scale <- function(aesthetics, transform, trans = deprecated(), transform <- switch(transform, date = transform_date(), - time = transform_time(timezone) + time = transform_time(timezone), + hms = transform_hms() ) sc <- continuous_scale( diff --git a/man/scale_date.Rd b/man/scale_date.Rd index bce3946d9a..9eb6643130 100644 --- a/man/scale_date.Rd +++ b/man/scale_date.Rd @@ -78,8 +78,11 @@ scale_y_datetime( scale_x_time( name = waiver(), breaks = waiver(), + date_breaks = waiver(), minor_breaks = waiver(), + date_minor_breaks = waiver(), labels = waiver(), + date_labels = waiver(), limits = NULL, expand = waiver(), oob = censor, @@ -92,8 +95,11 @@ scale_x_time( scale_y_time( name = waiver(), breaks = waiver(), + date_breaks = waiver(), minor_breaks = waiver(), + date_minor_breaks = waiver(), labels = waiver(), + date_labels = waiver(), limits = NULL, expand = waiver(), oob = censor, diff --git a/tests/testthat/_snaps/prohibited-functions.md b/tests/testthat/_snaps/prohibited-functions.md index 4612a484bf..34e58d5d14 100644 --- a/tests/testthat/_snaps/prohibited-functions.md +++ b/tests/testthat/_snaps/prohibited-functions.md @@ -143,7 +143,8 @@ [4] "date_minor_breaks" $scale_x_time - [1] "minor_breaks" + [1] "date_breaks" "minor_breaks" "date_minor_breaks" + [4] "date_labels" $scale_y_continuous [1] "minor_breaks" @@ -157,7 +158,8 @@ [4] "date_minor_breaks" $scale_y_time - [1] "minor_breaks" + [1] "date_breaks" "minor_breaks" "date_minor_breaks" + [4] "date_labels" $sf_transform_xy [1] "target_crs" "source_crs" "authority_compliant" diff --git a/tests/testthat/test-scale-date.R b/tests/testthat/test-scale-date.R index a90d203eba..48259e3261 100644 --- a/tests/testthat/test-scale-date.R +++ b/tests/testthat/test-scale-date.R @@ -47,6 +47,20 @@ test_that("not cached across calls", { expect_equal(get_panel_scales(p2)$x$timezone, "Australia/Lord_Howe") }) +test_that("time scale date breaks and labels work", { + skip_if_not_installed("hms") + + d <- c(base_time(), base_time() + 5 * 24 * 3600) - base_time() + + sc <- scale_x_time(date_breaks = "1 day", date_labels = "%d") + sc$train(d) + + breaks <- sc$get_breaks() + expect_length(breaks, 6) + labels <- sc$get_labels(breaks) + expect_equal(labels, paste0("0", 1:6)) +}) + test_that("datetime size scales work", { p <- ggplot(df, aes(y = y)) + geom_point(aes(time1, size = time1))