From 5eb22edd6409f51108d2cd1fe71522b2970a3873 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 13 Jan 2025 10:32:11 +0100 Subject: [PATCH 01/12] Allow `transform = "hms"` in `datetime_scale()` --- R/scale-date.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/R/scale-date.R b/R/scale-date.R index 436b9b129d..6f7b6e0992 100644 --- a/R/scale-date.R +++ b/R/scale-date.R @@ -324,7 +324,8 @@ datetime_scale <- function(aesthetics, transform, trans = deprecated(), scale_class <- switch( transform, date = ScaleContinuousDate, - time = ScaleContinuousDatetime + time = ScaleContinuousDatetime, + ScaleContinuous ) } else { scale_class <- ScaleContinuous @@ -332,7 +333,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( From 49f51c92d82bee35b29f425fdc3d8fb8a517bb03 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 13 Jan 2025 10:32:56 +0100 Subject: [PATCH 02/12] add date arguments to time scales --- R/scale-date.R | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/R/scale-date.R b/R/scale-date.R index 6f7b6e0992..5693cef0c3 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, @@ -254,8 +257,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, From 2d7f1e022b23ab2b4bbf9235100b00d504dfce2b Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 13 Jan 2025 10:33:20 +0100 Subject: [PATCH 03/12] use `datetime_scale()` in time scales --- R/scale-date.R | 34 ++++++++++++++++++++++------------ 1 file changed, 22 insertions(+), 12 deletions(-) diff --git a/R/scale-date.R b/R/scale-date.R index 5693cef0c3..c557ef62be 100644 --- a/R/scale-date.R +++ b/R/scale-date.R @@ -236,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) } @@ -270,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 From a8c0ec0a0bfeabf4fce37066513f6a375eb48d55 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 13 Jan 2025 10:33:33 +0100 Subject: [PATCH 04/12] allow for additional underscore args --- tests/testthat/_snaps/prohibited-functions.md | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/tests/testthat/_snaps/prohibited-functions.md b/tests/testthat/_snaps/prohibited-functions.md index 007e6521c4..09c932f487 100644 --- a/tests/testthat/_snaps/prohibited-functions.md +++ b/tests/testthat/_snaps/prohibited-functions.md @@ -149,7 +149,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" @@ -163,7 +164,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" From e7c29d76b861c206cd2aaeaf0c9bbcb492ef3230 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 13 Jan 2025 11:06:19 +0100 Subject: [PATCH 05/12] inherit position scale --- R/scale-date.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/scale-date.R b/R/scale-date.R index c557ef62be..fd6a85183e 100644 --- a/R/scale-date.R +++ b/R/scale-date.R @@ -341,7 +341,7 @@ datetime_scale <- function(aesthetics, transform, trans = deprecated(), transform, date = ScaleContinuousDate, time = ScaleContinuousDatetime, - ScaleContinuous + ScaleContinuousPosition ) } else { scale_class <- ScaleContinuous From adcd2cb13ee94048af044e46a9abe832dac6ff9c Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 13 Jan 2025 11:06:57 +0100 Subject: [PATCH 06/12] `label_time()` can handle both *and* classes --- R/scale-date.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/scale-date.R b/R/scale-date.R index fd6a85183e..25fe79a2a1 100644 --- a/R/scale-date.R +++ b/R/scale-date.R @@ -330,7 +330,7 @@ datetime_scale <- function(aesthetics, transform, trans = deprecated(), check_string(date_labels) labels <- function(self, x) { tz <- self$timezone %||% "UTC" - label_date(date_labels, tz)(x) + label_time(date_labels, tz)(x) } } From a98d9e26e2f609fab953e97068fd63aef32c19af Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 13 Jan 2025 11:15:31 +0100 Subject: [PATCH 07/12] add test --- tests/testthat/test-scale-date.R | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/tests/testthat/test-scale-date.R b/tests/testthat/test-scale-date.R index a90d203eba..6a43162457 100644 --- a/tests/testthat/test-scale-date.R +++ b/tests/testthat/test-scale-date.R @@ -47,6 +47,19 @@ 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", { + + 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)) From 64c4737953979f872f2a27ab61aa71265f5222aa Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 13 Jan 2025 11:37:44 +0100 Subject: [PATCH 08/12] add news bullet --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index e19471d2e2..7cd855fa03 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # ggplot2 (development version) +* Added `scale_{x/y}_time(date_breaks, date_minor_breaks, date_labels)` + (@teunbrand, #4335). * `geom_ribbon()` now appropriately warns about, and removes, missing values (@teunbrand, #6243). * `guide_*()` can now accept two inside legend theme elements: From da24f4a01520f733fb66f64e54abae801a30993c Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 13 Jan 2025 11:43:23 +0100 Subject: [PATCH 09/12] redocument --- man/scale_date.Rd | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/man/scale_date.Rd b/man/scale_date.Rd index 86c82e0271..d9d9e8a588 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, From cf68b7665c25cdfa9fb39902c7d21b80f1a8776d Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 13 Jan 2025 12:12:52 +0100 Subject: [PATCH 10/12] work in a skip --- tests/testthat/test-scale-date.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test-scale-date.R b/tests/testthat/test-scale-date.R index 6a43162457..48259e3261 100644 --- a/tests/testthat/test-scale-date.R +++ b/tests/testthat/test-scale-date.R @@ -48,6 +48,7 @@ test_that("not cached across calls", { }) 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() From c2d9409396882d4f54ffc47ac705c1cf79f0bc7b Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 13 Jan 2025 12:46:29 +0100 Subject: [PATCH 11/12] Revert "`label_time()` can handle both *and* classes" This reverts commit adcd2cb13ee94048af044e46a9abe832dac6ff9c. --- R/scale-date.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/scale-date.R b/R/scale-date.R index 25fe79a2a1..fd6a85183e 100644 --- a/R/scale-date.R +++ b/R/scale-date.R @@ -330,7 +330,7 @@ datetime_scale <- function(aesthetics, transform, trans = deprecated(), check_string(date_labels) labels <- function(self, x) { tz <- self$timezone %||% "UTC" - label_time(date_labels, tz)(x) + label_date(date_labels, tz)(x) } } From 467990b2521203bc093afd25257e651fd9df70a5 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 13 Jan 2025 12:50:07 +0100 Subject: [PATCH 12/12] separate labelling logic --- R/scale-date.R | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/R/scale-date.R b/R/scale-date.R index fd6a85183e..3cb71d9701 100644 --- a/R/scale-date.R +++ b/R/scale-date.R @@ -328,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) + } } }