diff --git a/DESCRIPTION b/DESCRIPTION index 2d9bce90..f85bd865 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -27,13 +27,16 @@ Imports: vctrs (>= 0.6.1) Suggests: covr, + ggplot2 (>= 3.4.2.9000), knitr, magrittr, pillar, rmarkdown, + scales (>= 1.2.1), slider (>= 0.3.0), testthat (>= 3.0.0), - withr + withr, + vdiffr (>= 1.0.5) LinkingTo: cpp11 (>= 0.4.3), tzdb (>= 0.3.0.9000) @@ -48,4 +51,5 @@ LazyData: true Roxygen: list(markdown = TRUE) RoxygenNote: 7.2.3 Remotes: - r-lib/tzdb + r-lib/tzdb, + tidyverse/ggplot2#5304 diff --git a/NAMESPACE b/NAMESPACE index f6be1476..6913f04f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -782,6 +782,27 @@ export(is_zoned_time) export(iso_year_week_day) export(naive_time_info) export(naive_time_parse) +export(scale_alpha_year_month_day) +export(scale_alpha_year_quarter_day) +export(scale_alpha_year_week_day) +export(scale_color_year_month_day) +export(scale_color_year_quarter_day) +export(scale_color_year_week_day) +export(scale_colour_year_month_day) +export(scale_colour_year_quarter_day) +export(scale_colour_year_week_day) +export(scale_fill_year_month_day) +export(scale_fill_year_quarter_day) +export(scale_fill_year_week_day) +export(scale_size_year_month_day) +export(scale_size_year_quarter_day) +export(scale_size_year_week_day) +export(scale_x_year_month_day) +export(scale_x_year_quarter_day) +export(scale_x_year_week_day) +export(scale_y_year_month_day) +export(scale_y_year_quarter_day) +export(scale_y_year_week_day) export(set_day) export(set_hour) export(set_index) diff --git a/NEWS.md b/NEWS.md index 9c002dbc..3e779700 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,23 @@ # clock (development version) +* New experimental ggplot2 scales for calendar types, including (#233): + + * `scale_*_year_month_day()`, which supports year and month precision + year-month-day vectors. + + * `scale_*_year_quarter_day()`, which supports year and quarter precision + year-quarter-day vectors. + + * `scale_*_year_week_day()`, which supports year and week precision + year-week-day vectors. + + Note that these scales are limited in the precisions they support. This is + purposeful, and for the most part the scales are limited to the precisions + that you can perform arithmetic with (i.e. you can't add days to + year-month-day, so the scale doesn't support day precision). For precisions at + or more precise than day, the native ggplot2 scales for Date and POSIXct are + still a better option. + * New `date_spanning_seq()` for generating a regular sequence along the full span of a date or date-time vector (i.e. along `[min(x), max(x)]`). It is similar to `tidyr::full_seq()`, but is a bit simpler and currently has better diff --git a/R/clock-package.R b/R/clock-package.R index 09b607de..3d868dc2 100644 --- a/R/clock-package.R +++ b/R/clock-package.R @@ -9,3 +9,6 @@ #' @useDynLib clock, .registration = TRUE ## usethis namespace: end NULL + +# Singleton environment +the <- new_environment() diff --git a/R/scale-calendar.R b/R/scale-calendar.R new file mode 100644 index 00000000..2891158a --- /dev/null +++ b/R/scale-calendar.R @@ -0,0 +1,329 @@ +#' Position scales: calendar +#' +#' @description +#' `r lifecycle::badge("experimental")` +#' +#' Position scales for use with ggplot2. +#' +#' - `scale_x_year_month_day()` and `scale_y_year_month_day()` are only valid on +#' year and month precision inputs. +#' +#' - `scale_x_year_quarter_day()` and `scale_y_year_quarter_day()` are only +#' valid on year and quarter precision inputs. +#' +#' - `scale_x_year_week_day()` and `scale_y_year_week_day()` are only +#' valid on year and week precision inputs. +#' +#' For day precision and finer, we currently still recommend using Date and +#' POSIXct with [ggplot2::scale_x_date()] and [ggplot2::scale_x_datetime()]. +#' +#' @inheritParams rlang::args_dots_empty +#' @inheritParams ggplot2::scale_x_continuous +#' +#' @param breaks One of: +#' +#' - `NULL` for no breaks. +#' +#' - `ggplot2::waiver()` for default breaks, or to use breaks specified by +#' `date_breaks`. +#' +#' - A calendar type of the same type as the input giving positions of breaks. +#' +#' - A function that takes the limits as input and returns breaks as output. +#' +#' @param date_breaks A single duration object giving the distance between the +#' breaks, like `duration_months(1)` or `duration_weeks(2)`. If both `breaks` +#' and `date_breaks` are specified, `date_breaks` wins. +#' +#' @param minor_breaks Same as `breaks`, but applied to minor breaks. +#' +#' @param date_minor_breaks Same as `date_breaks`, but applied to minor breaks. +#' +#' @param date_labels For year-month-day only, a string giving the formatting +#' specification for the labels, such as `"%B %Y"`. The full list of format +#' tokens is available at [format.clock_zoned_time()]. Note that you should +#' only use month and year specific codes. +#' +#' @param date_locale For year-month-day only, the locale used when +#' `date_labels` is also specified. +#' +#' @name calendar-scales-position +#' +#' @examplesIf rlang::is_installed("ggplot2") && rlang::is_installed("scales") +#' library(ggplot2) +#' library(vctrs) +#' +#' # --------------------------------------------------------------------------- +#' # Monthly data +#' +#' set.seed(1234) +#' +#' from <- year_month_day(2019, 1) +#' +#' df <- vec_rbind( +#' data_frame( +#' g = "stock 1", +#' date = from + duration_months(cumsum(sample(1:2, size = 100, replace = TRUE))), +#' price = cumsum(1 + rnorm(100)) +#' ), +#' data_frame( +#' g = "stock 2", +#' date = from + duration_months(cumsum(sample(1:2, size = 100, replace = TRUE))), +#' price = cumsum(1 + rnorm(100)) +#' ) +#' ) +#' +#' # Defaults automatically know you have monthly data +#' ggplot(df, aes(date, price, group = g, color = g)) + +#' geom_line() +#' +#' # Fully customize as needed +#' ggplot(df, aes(date, price, group = g, color = g)) + +#' geom_line() + +#' scale_x_year_month_day( +#' date_breaks = duration_months(24), +#' date_minor_breaks = duration_months(6), +#' date_labels = "%Y" +#' ) +#' +#' ggplot(df, aes(date, price, group = g, color = g)) + +#' geom_line() + +#' scale_x_year_month_day( +#' date_labels = "%B\n%Y", +#' date_locale = clock_locale("fr") +#' ) +#' +#' # --------------------------------------------------------------------------- +#' # Quarterly data +#' +#' set.seed(1234) +#' +#' from1 <- year_quarter_day(2019, 1) +#' from2 <- year_quarter_day(2000, 2) +#' +#' df <- vec_rbind( +#' data_frame( +#' g = "stock 1", +#' date = from1 + duration_quarters(cumsum(sample(1:5, size = 50, replace = TRUE))), +#' price = cumsum(1 + rnorm(50)) +#' ), +#' data_frame( +#' g = "stock 2", +#' date = from2 + duration_quarters(cumsum(sample(1:5, size = 50, replace = TRUE))), +#' price = cumsum(1 + rnorm(50)) +#' ) +#' ) +#' +#' ggplot(df, aes(date, price, group = g, color = g)) + +#' geom_line() +#' +#' # Zooming with `coord_cartesian()` +#' ggplot(df, aes(date, price, group = g, color = g)) + +#' geom_line() + +#' coord_cartesian(xlim = year_quarter_day(c(2020, 2040), 1)) +#' +#' # --------------------------------------------------------------------------- +#' # Weekly data +#' +#' set.seed(123) +#' +#' # A monday +#' x <- naive_time_parse("2018-12-31", precision = "day") +#' x <- x + duration_weeks(sort(sample(100, size = 50))) +#' +#' # ISO calendar +#' x <- as_year_week_day(x, start = clock_weekdays$monday) +#' x <- calendar_narrow(x, "week") +#' +#' df <- data_frame( +#' date = x, +#' value = cumsum(rnorm(50, mean = .2)) +#' ) +#' +#' ggplot(df, aes(date, value)) + +#' geom_line() + +#' scale_x_year_week_day() +#' +#' ggplot(df, aes(date, value)) + +#' geom_line() + +#' scale_x_year_week_day( +#' date_breaks = duration_weeks(16), +#' date_minor_breaks = duration_weeks(2) +#' ) +NULL + +#' Gradient color scales: calendar +#' +#' @description +#' `r lifecycle::badge("experimental")` +#' +#' Gradient color scales for use with ggplot2. +#' +#' - `scale_color_year_month_day()` and `scale_fill_year_month_day()` are only +#' valid on year and month precision inputs. +#' +#' - `scale_color_year_quarter_day()` and `scale_fill_year_quarter_day()` are +#' only valid on year and quarter precision inputs. +#' +#' - `scale_color_year_week_day()` and `scale_fill_year_week_day()` are only +#' valid on year and week precision inputs. +#' +#' For day precision and finer, we currently still recommend using Date and +#' POSIXct with [ggplot2::scale_color_date()] and +#' [ggplot2::scale_color_datetime()]. +#' +#' @inheritParams rlang::args_dots_empty +#' @inheritParams ggplot2::scale_color_date +#' +#' @name calendar-scales-color +#' +#' @examplesIf rlang::is_installed("ggplot2") && rlang::is_installed("scales") +#' library(ggplot2) +#' library(vctrs) +#' +#' # --------------------------------------------------------------------------- +#' # Color +#' +#' set.seed(123) +#' +#' date <- year_quarter_day(2019, 1) + duration_quarters(1:100) +#' height <- ifelse( +#' date < year_quarter_day(2033, 1), +#' sample(30:50, size = 50, replace = TRUE), +#' sample(40:60, size = 50, replace = TRUE) +#' ) +#' weight <- ifelse( +#' date < year_quarter_day(2028, 1), +#' sample(100:150, size = 50, replace = TRUE), +#' sample(100:180, size = 50, replace = TRUE) +#' ) +#' +#' df <- data_frame( +#' date = date, +#' height = height, +#' weight = weight +#' ) +#' +#' ggplot(df, aes(height, weight, color = date)) + +#' geom_point() + +#' scale_colour_year_quarter_day( +#' low = "red", +#' high = "blue" +#' ) +#' +#' # --------------------------------------------------------------------------- +#' # Fill +#' +#' economics$date <- as_year_month_day(economics$date) +#' economics$date <- calendar_narrow(economics$date, "month") +#' +#' ggplot(economics, aes(x = date, y = unemploy, fill = date)) + +#' geom_col() +NULL + +#' Alpha transparency scales: calendar +#' +#' @description +#' `r lifecycle::badge("experimental")` +#' +#' Alpha transparency scales for use with ggplot2. +#' +#' - `scale_alpha_year_month_day()` is only valid on year and month precision +#' inputs. +#' +#' - `scale_alpha_year_quarter_day()` is only valid on year and quarter +#' precision inputs. +#' +#' - `scale_alpha_year_week_day()` is only valid on year and week precision +#' inputs. +#' +#' For day precision and finer, we currently still recommend using Date and +#' POSIXct with [ggplot2::scale_alpha_date()] and +#' [ggplot2::scale_alpha_datetime()]. +#' +#' @inheritParams rlang::args_dots_empty +#' @inheritParams ggplot2::scale_alpha_date +#' +#' @name calendar-scales-alpha +#' +#' @examplesIf rlang::is_installed("ggplot2") && rlang::is_installed("scales") +#' library(ggplot2) +#' library(vctrs) +#' +#' set.seed(123) +#' +#' date <- year_quarter_day(2019, 1) + duration_quarters(1:100) +#' height <- ifelse( +#' date < year_quarter_day(2033, 1), +#' sample(30:50, size = 50, replace = TRUE), +#' sample(40:60, size = 50, replace = TRUE) +#' ) +#' weight <- ifelse( +#' date < year_quarter_day(2028, 1), +#' sample(100:150, size = 50, replace = TRUE), +#' sample(100:180, size = 50, replace = TRUE) +#' ) +#' +#' df <- data_frame( +#' date = date, +#' height = height, +#' weight = weight +#' ) +#' +#' ggplot(df, aes(height, weight, alpha = date)) + +#' geom_point() +NULL + +#' Size scales: calendar +#' +#' @description +#' `r lifecycle::badge("experimental")` +#' +#' Size scales for use with ggplot2. +#' +#' - `scale_size_year_month_day()` is only valid on year and month precision +#' inputs. +#' +#' - `scale_size_year_quarter_day()` is only valid on year and quarter +#' precision inputs. +#' +#' - `scale_size_year_week_day()` is only valid on year and week precision +#' inputs. +#' +#' For day precision and finer, we currently still recommend using Date and +#' POSIXct with [ggplot2::scale_size_date()] and +#' [ggplot2::scale_size_datetime()]. +#' +#' @inheritParams rlang::args_dots_empty +#' @inheritParams ggplot2::scale_size_date +#' +#' @name calendar-scales-size +#' +#' @examplesIf rlang::is_installed("ggplot2") && rlang::is_installed("scales") +#' library(ggplot2) +#' library(vctrs) +#' +#' set.seed(123) +#' +#' date <- year_quarter_day(2019, 1) + duration_quarters(1:100) +#' height <- ifelse( +#' date < year_quarter_day(2033, 1), +#' sample(30:50, size = 50, replace = TRUE), +#' sample(40:60, size = 50, replace = TRUE) +#' ) +#' weight <- ifelse( +#' date < year_quarter_day(2028, 1), +#' sample(100:150, size = 50, replace = TRUE), +#' sample(100:180, size = 50, replace = TRUE) +#' ) +#' +#' df <- data_frame( +#' date = date, +#' height = height, +#' weight = weight +#' ) +#' +#' ggplot(df, aes(height, weight, size = date)) + +#' geom_point() + +#' scale_size_year_quarter_day(range = c(1, 10)) +NULL diff --git a/R/scale-gregorian-year-month-day.R b/R/scale-gregorian-year-month-day.R new file mode 100644 index 00000000..eb1a4183 --- /dev/null +++ b/R/scale-gregorian-year-month-day.R @@ -0,0 +1,307 @@ +# @export .onLoad() +scale_type.clock_year_month_day <- function(x) { + c("year_month_day", "continuous") +} + +# ------------------------------------------------------------------------------ + +#' @export +#' @rdname calendar-scales-position +scale_x_year_month_day <- function(..., + name = ggplot2::waiver(), + breaks = ggplot2::waiver(), + date_breaks = ggplot2::waiver(), + minor_breaks = ggplot2::waiver(), + date_minor_breaks = ggplot2::waiver(), + n.breaks = NULL, + labels = ggplot2::waiver(), + date_labels = ggplot2::waiver(), + date_locale = clock_locale(), + limits = NULL, + oob = scales::censor, + expand = ggplot2::waiver(), + guide = ggplot2::waiver(), + position = "bottom") { + check_dots_empty0(...) + check_installed("scales") + check_installed("ggplot2") + + scale <- year_month_day_scale( + aesthetics = ggplot2_x_aes(), + palette = identity, + name = name, + breaks = breaks, + date_breaks = date_breaks, + minor_breaks = minor_breaks, + date_minor_breaks = date_minor_breaks, + n.breaks = n.breaks, + labels = labels, + date_labels = date_labels, + date_locale = date_locale, + limits = limits, + oob = oob, + expand = expand, + guide = guide, + position = position, + super = the$ScaleContinuousPositionYearMonthDay + ) + + scale +} + +#' @export +#' @rdname calendar-scales-position +scale_y_year_month_day <- function(..., + name = ggplot2::waiver(), + breaks = ggplot2::waiver(), + date_breaks = ggplot2::waiver(), + minor_breaks = ggplot2::waiver(), + date_minor_breaks = ggplot2::waiver(), + n.breaks = NULL, + labels = ggplot2::waiver(), + date_labels = ggplot2::waiver(), + date_locale = clock_locale(), + limits = NULL, + oob = scales::censor, + expand = ggplot2::waiver(), + guide = ggplot2::waiver(), + position = "left") { + check_dots_empty0(...) + check_installed("scales") + check_installed("ggplot2") + + scale <- year_month_day_scale( + aesthetics = ggplot2_y_aes(), + palette = identity, + name = name, + breaks = breaks, + date_breaks = date_breaks, + minor_breaks = minor_breaks, + date_minor_breaks = date_minor_breaks, + n.breaks = n.breaks, + labels = labels, + date_labels = date_labels, + date_locale = date_locale, + limits = limits, + oob = oob, + expand = expand, + guide = guide, + position = position, + super = the$ScaleContinuousPositionYearMonthDay + ) + + scale +} + +#' @export +#' @rdname calendar-scales-color +scale_colour_year_month_day <- function(..., + low = "#132B43", + high = "#56B1F7", + na.value = "grey50", + guide = "colourbar") { + check_dots_empty0(...) + check_installed("scales") + check_installed("ggplot2") + + year_month_day_scale( + aesthetics = "colour", + palette = scales::seq_gradient_pal(low, high), + na.value = na.value, + guide = guide + ) +} + +#' @export +#' @rdname calendar-scales-color +scale_color_year_month_day <- scale_colour_year_month_day + +#' @export +#' @rdname calendar-scales-color +scale_fill_year_month_day <- function(..., + low = "#132B43", + high = "#56B1F7", + na.value = "grey50", + guide = "colourbar") { + check_dots_empty0(...) + check_installed("scales") + check_installed("ggplot2") + + year_month_day_scale( + aesthetics = "fill", + palette = scales::seq_gradient_pal(low, high), + na.value = na.value, + guide = guide + ) +} + +#' @export +#' @rdname calendar-scales-alpha +scale_alpha_year_month_day <- function(..., range = c(0.1, 1)) { + check_dots_empty0(...) + check_installed("scales") + check_installed("ggplot2") + + year_month_day_scale( + aesthetics = "alpha", + palette = scales::rescale_pal(range) + ) +} + +#' @export +#' @rdname calendar-scales-size +scale_size_year_month_day <- function(..., range = c(1, 6)) { + check_dots_empty0(...) + check_installed("scales") + check_installed("ggplot2") + + year_month_day_scale( + aesthetics = "size", + palette = scales::area_pal(range) + ) +} + +# ------------------------------------------------------------------------------ + +year_month_day_scale <- function(aesthetics, + palette, + ..., + name = ggplot2::waiver(), + breaks = ggplot2::waiver(), + date_breaks = ggplot2::waiver(), + minor_breaks = ggplot2::waiver(), + date_minor_breaks = ggplot2::waiver(), + n.breaks = NULL, + labels = ggplot2::waiver(), + date_labels = ggplot2::waiver(), + date_locale = clock_locale(), + limits = NULL, + oob = scales::censor, + expand = ggplot2::waiver(), + na.value = NA_real_, + guide = ggplot2::waiver(), + position = "bottom", + super = the$ScaleContinuousYearMonthDay) { + check_dots_empty0(...) + + if (!is.waive(date_breaks)) { + breaks <- breaks_duration(date_breaks) + } + if (!is.waive(date_minor_breaks)) { + minor_breaks <- breaks_duration(date_minor_breaks) + } + if (!is.waive(date_labels)) { + labels <- function(x) { + year_month_day_trans_format(x, format = date_labels, locale = date_locale) + } + } + + # Insert a fake `trans` that gets updated by the ggproto `$transform()` method + # which is called before anything else + trans <- year_month_day_trans(epoch = NULL) + + ggplot2::continuous_scale( + aesthetics = aesthetics, + scale_name = "year_month_day", + palette = palette, + name = name, + breaks = breaks, + minor_breaks = minor_breaks, + n.breaks = n.breaks, + labels = labels, + limits = limits, + oob = oob, + expand = expand, + na.value = na.value, + trans = trans, + guide = guide, + position = position, + super = super + ) +} + +year_month_day_trans <- function(epoch = NULL) { + scales::trans_new( + name = "year_month_day", + transform = calendar_trans_transform_fn(epoch), + inverse = calendar_trans_inverse_fn(epoch), + breaks = calendar_trans_breaks, + domain = calendar_trans_domain(epoch), + format = year_month_day_trans_format + ) +} + +year_month_day_epoch <- function(precision) { + precision <- precision_to_string(precision) + calendar_widen(year_month_day(1970), precision) +} + +# ------------------------------------------------------------------------------ + +year_month_day_trans_format <- function(x, + format = NULL, + locale = clock_locale()) { + if (is_null(format)) { + precision <- calendar_precision_attribute(x) + format <- year_month_day_trans_format_default(precision) + } + + # Assumes year or month precision + x <- calendar_widen(x, "day") + x <- as_sys_time(x) + + format(x, format = format, locale = locale) +} + +year_month_day_trans_format_default <- function(precision) { + if (precision == PRECISION_YEAR) { + "%Y" + } else if (precision == PRECISION_MONTH) { + "%b %Y" + } else { + abort("Unsupported `precision`.", .internal = TRUE) + } +} + +# ------------------------------------------------------------------------------ + +make_ScaleContinuousYearMonthDay <- function() { + # Forced to wrap in a generator function so we can keep ggplot2 in Suggests. + # Initialized on load. + ggplot2::ggproto( + "ScaleContinuousYearMonthDay", + ggplot2::ScaleContinuous, + epoch = NULL, + transform = year_month_day_transform + ) +} + +make_ScaleContinuousPositionYearMonthDay <- function() { + # Forced to wrap in a generator function so we can keep ggplot2 in Suggests. + # Initialized on load. + ggplot2::ggproto( + "ScaleContinuousPositionYearMonthDay", + ggplot2::ScaleContinuousPosition, + epoch = NULL, + transform = year_month_day_transform + ) +} + +year_month_day_transform <- function(self, x) { + # Refresh the `$trans` object with the actual data `epoch`. + # Same trick as `ScaleContinuousDatetime` for the time zone. + precision <- calendar_precision_attribute(x) + + if (precision > PRECISION_MONTH) { + cli::cli_abort("{.cls year_month_day} inputs can only be {.str year} or {.str month} precision.") + } + + if (is.null(self$epoch)) { + self$epoch <- year_month_day_epoch(precision) + self$trans <- year_month_day_trans(self$epoch) + } else if (calendar_precision_attribute(self$epoch) != precision) { + cli::cli_abort("All {.cls year_month_day} inputs must have the same precision.") + } + + ggplot2::ggproto_parent(ggplot2::ScaleContinuousPosition, self)$transform(x) +} diff --git a/R/scale-quarterly-year-quarter-day.R b/R/scale-quarterly-year-quarter-day.R new file mode 100644 index 00000000..c28a6e31 --- /dev/null +++ b/R/scale-quarterly-year-quarter-day.R @@ -0,0 +1,267 @@ +# @export .onLoad() +scale_type.clock_year_quarter_day <- function(x) { + c("year_quarter_day", "continuous") +} + +# ------------------------------------------------------------------------------ + +#' @export +#' @rdname calendar-scales-position +scale_x_year_quarter_day <- function(..., + name = ggplot2::waiver(), + breaks = ggplot2::waiver(), + date_breaks = ggplot2::waiver(), + minor_breaks = ggplot2::waiver(), + date_minor_breaks = ggplot2::waiver(), + n.breaks = NULL, + labels = ggplot2::waiver(), + limits = NULL, + oob = scales::censor, + expand = ggplot2::waiver(), + guide = ggplot2::waiver(), + position = "bottom") { + check_dots_empty0(...) + check_installed("scales") + check_installed("ggplot2") + + scale <- year_quarter_day_scale( + aesthetics = ggplot2_x_aes(), + palette = identity, + name = name, + breaks = breaks, + date_breaks = date_breaks, + minor_breaks = minor_breaks, + date_minor_breaks = date_minor_breaks, + n.breaks = n.breaks, + labels = labels, + limits = limits, + oob = oob, + expand = expand, + guide = guide, + position = position, + super = the$ScaleContinuousPositionYearQuarterDay + ) + + scale +} + +#' @export +#' @rdname calendar-scales-position +scale_y_year_quarter_day <- function(..., + name = ggplot2::waiver(), + breaks = ggplot2::waiver(), + date_breaks = ggplot2::waiver(), + minor_breaks = ggplot2::waiver(), + date_minor_breaks = ggplot2::waiver(), + n.breaks = NULL, + labels = ggplot2::waiver(), + limits = NULL, + oob = scales::censor, + expand = ggplot2::waiver(), + guide = ggplot2::waiver(), + position = "left") { + check_dots_empty0(...) + check_installed("scales") + check_installed("ggplot2") + + scale <- year_quarter_day_scale( + aesthetics = ggplot2_y_aes(), + palette = identity, + name = name, + breaks = breaks, + date_breaks = date_breaks, + minor_breaks = minor_breaks, + date_minor_breaks = date_minor_breaks, + n.breaks = n.breaks, + labels = labels, + limits = limits, + oob = oob, + expand = expand, + guide = guide, + position = position, + super = the$ScaleContinuousPositionYearQuarterDay + ) + + scale +} + +#' @export +#' @rdname calendar-scales-color +scale_colour_year_quarter_day <- function(..., + low = "#132B43", + high = "#56B1F7", + na.value = "grey50", + guide = "colourbar") { + check_dots_empty0(...) + check_installed("scales") + check_installed("ggplot2") + + year_quarter_day_scale( + aesthetics = "colour", + palette = scales::seq_gradient_pal(low, high), + na.value = na.value, + guide = guide + ) +} + +#' @export +#' @rdname calendar-scales-color +scale_color_year_quarter_day <- scale_colour_year_quarter_day + +#' @export +#' @rdname calendar-scales-color +scale_fill_year_quarter_day <- function(..., + low = "#132B43", + high = "#56B1F7", + na.value = "grey50", + guide = "colourbar") { + check_dots_empty0(...) + check_installed("scales") + check_installed("ggplot2") + + year_quarter_day_scale( + aesthetics = "fill", + palette = scales::seq_gradient_pal(low, high), + na.value = na.value, + guide = guide + ) +} + +#' @export +#' @rdname calendar-scales-alpha +scale_alpha_year_quarter_day <- function(..., range = c(0.1, 1)) { + check_dots_empty0(...) + check_installed("scales") + check_installed("ggplot2") + + year_quarter_day_scale( + aesthetics = "alpha", + palette = scales::rescale_pal(range) + ) +} + +#' @export +#' @rdname calendar-scales-size +scale_size_year_quarter_day <- function(..., range = c(1, 6)) { + check_dots_empty0(...) + check_installed("scales") + check_installed("ggplot2") + + year_quarter_day_scale( + aesthetics = "size", + palette = scales::area_pal(range) + ) +} + +# ------------------------------------------------------------------------------ + +year_quarter_day_scale <- function(aesthetics, + palette, + ..., + name = ggplot2::waiver(), + breaks = ggplot2::waiver(), + date_breaks = ggplot2::waiver(), + minor_breaks = ggplot2::waiver(), + date_minor_breaks = ggplot2::waiver(), + n.breaks = NULL, + labels = ggplot2::waiver(), + limits = NULL, + oob = scales::censor, + expand = ggplot2::waiver(), + na.value = NA_real_, + guide = ggplot2::waiver(), + position = "bottom", + super = the$ScaleContinuousYearQuarterDay) { + check_dots_empty0(...) + + if (!is.waive(date_breaks)) { + breaks <- breaks_duration(date_breaks) + } + if (!is.waive(date_minor_breaks)) { + minor_breaks <- breaks_duration(date_minor_breaks) + } + + # Insert a fake `trans` that gets updated by the ggproto `$transform()` method + # which is called before anything else + trans <- year_quarter_day_trans(epoch = NULL) + + ggplot2::continuous_scale( + aesthetics = aesthetics, + scale_name = "year_quarter_day", + palette = palette, + name = name, + breaks = breaks, + minor_breaks = minor_breaks, + n.breaks = n.breaks, + labels = labels, + limits = limits, + oob = oob, + expand = expand, + na.value = na.value, + trans = trans, + guide = guide, + position = position, + super = super + ) +} + +year_quarter_day_trans <- function(epoch = NULL) { + scales::trans_new( + name = "year_quarter_day", + transform = calendar_trans_transform_fn(epoch), + inverse = calendar_trans_inverse_fn(epoch), + breaks = calendar_trans_breaks, + domain = calendar_trans_domain(epoch) + ) +} + +year_quarter_day_epoch <- function(precision, start) { + precision <- precision_to_string(precision) + calendar_widen(year_quarter_day(1970, start = start), precision) +} + +# ------------------------------------------------------------------------------ + +make_ScaleContinuousYearQuarterDay <- function() { + # Forced to wrap in a generator function so we can keep ggplot2 in Suggests. + # Initialized on load. + ggplot2::ggproto( + "ScaleContinuousYearQuarterDay", + ggplot2::ScaleContinuous, + epoch = NULL, + transform = year_quarter_day_transform + ) +} + +make_ScaleContinuousPositionYearQuarterDay <- function() { + # Forced to wrap in a generator function so we can keep ggplot2 in Suggests. + # Initialized on load. + ggplot2::ggproto( + "ScaleContinuousPositionYearQuarterDay", + ggplot2::ScaleContinuousPosition, + epoch = NULL, + transform = year_quarter_day_transform + ) +} + +year_quarter_day_transform <- function(self, x) { + # Refresh the `$trans` object with the actual data `epoch`. + # Same trick as `ScaleContinuousDatetime` for the time zone. + precision <- calendar_precision_attribute(x) + start <- quarterly_start(x) + + if (precision > PRECISION_QUARTER) { + cli::cli_abort("{.cls year_quarter_day} inputs can only be {.str year} or {.str quarter} precision.") + } + + if (is_null(self$epoch)) { + self$epoch <- year_quarter_day_epoch(precision, start) + self$trans <- year_quarter_day_trans(self$epoch) + } else if (calendar_precision_attribute(self$epoch) != precision) { + cli::cli_abort("All {.cls year_quarter_day} inputs must have the same precision.") + } else if (quarterly_start(self$epoch) != start) { + cli::cli_abort("All {.cls year_quarter_day} inputs must have the same start.") + } + + ggplot2::ggproto_parent(ggplot2::ScaleContinuousPosition, self)$transform(x) +} diff --git a/R/scale-utils.R b/R/scale-utils.R new file mode 100644 index 00000000..3ea94a56 --- /dev/null +++ b/R/scale-utils.R @@ -0,0 +1,174 @@ +check_trans_epoch <- function(epoch) { + if (!is_null(epoch)) { + return(invisible(NULL)) + } + abort("`epoch` can't be `NULL` at this time.", .internal = TRUE) +} + +# ------------------------------------------------------------------------------ + +calendar_trans_transform_fn <- function(epoch) { + force(epoch) + + function(x) { + check_trans_epoch(epoch) + # `x` is original units, output is integer + out <- as.integer(x - epoch) + out + } +} + +calendar_trans_inverse_fn <- function(epoch) { + force(epoch) + + function(x) { + check_trans_epoch(epoch) + precision <- calendar_precision_attribute(epoch) + + x <- round_limits(x) + + # `x` is integer / double, output is original units + out <- duration_helper(x, precision) + epoch + + out + } +} + +round_limits <- function(x) { + if (is.double(x) && length(x) == 2L && any(x != floor(x), na.rm = TRUE)) { + # This handles when limits are expanded by a multiplicative factor. + # For continuous scales a 5% expansion is applied by default. + # Limits of `c(NA_real_, NA_real_)` are sometimes passed through here so + # the `na.rm = TRUE` is required. + # AFAIK this isn't triggered at any other time. + c(floor(x[1L]), ceiling(x[2L])) + } else { + x + } +} + +calendar_trans_breaks <- function(x, n = 5) { + from <- x[[1L]] + to <- x[[2L]] + seq_expanded_n(from, to, n = n) +} + +calendar_trans_domain <- function(epoch) { + if (is_null(epoch)) { + NULL + } else { + vec_c(clock_minimum(epoch), clock_maximum(epoch)) + } +} + +# ------------------------------------------------------------------------------ + +breaks_duration <- function(by) { + force(by) + + function(x) { + from <- x[[1L]] + to <- x[[2L]] + seq_expanded(from, to, by) + } +} + +seq_expanded_n <- function(from, to, ..., n = 5L) { + # Constructs an equally spaced sequence that is roughly along `from -> to`. + # If it can't create an equally spaced sequence of `n` pieces, it expands + # `to` until it can. Keeping `from` the same is important because it ensure + # that major and minor breaks stay aligned. + + check_dots_empty0(...) + check_number_whole(n) + + # Avoid problematic `n` values + n <- pmax(n, 2L) + + # Division is based on number of ranges, not number of breaks + # i.e. [2, 10), [10, 18) is 2 ranges, 3 breaks + n <- n - 1L + + difference <- to - from + precision <- duration_precision_attribute(difference) + + if (difference < duration_helper(n, precision)) { + # Force `by` to at least be `1` + difference <- duration_helper(n, precision) + } + + # If there is any remainder, i.e. `difference %% n != 0L`, then that will + # be handled by `seq_expanded()` to ensure that the sequence covers the full + # range + by <- difference %/% n + + seq_expanded(from, to, by) +} + +seq_expanded <- function(from, to, by) { + # Figure out how much to add to `to` to ensure that the sequence generates a + # "full" sequence. We always add to `to` so that major and minor breaks are + # aligned on `from` so that you can use a multiple of `date_minor_breaks` as + # the `date_breaks` value and get a sensible result, like: + # `date_breaks = duration_months(24), date_minor_breaks = duration_months(6)` + difference <- (to - from) + + precision <- duration_precision_attribute(difference) + + # `by` is always cast to the precision of the inputs! + by <- duration_collect_by(by, precision) + + # How far "over" `by` are we? + over <- difference %% by + + if (over > duration_helper(0L, precision)) { + # How much do we need to divide between `from` and `to` to get a regular seq? + extra <- by - over + to <- to + extra + } + + seq(from, to = to, by = by) +} + +# ------------------------------------------------------------------------------ + +ggplot2_x_aes <- function() { + # ggplot2:::ggplot_global$x_aes + c( + "x", + "xmin", + "xmax", + "xend", + "xintercept", + "xmin_final", + "xmax_final", + "xlower", + "xmiddle", + "xupper", + "x0" + ) +} + +ggplot2_y_aes <- function() { + # ggplot2:::ggplot_global$y_aes + c( + "y", + "ymin", + "ymax", + "yend", + "yintercept", + "ymin_final", + "ymax_final", + "lower", + "middle", + "upper", + "y0" + ) +} + +# ------------------------------------------------------------------------------ + +is.waive <- function(x) { + # ggplot2:::is.waive() + inherits(x, "waiver") +} diff --git a/R/scale-week-year-week-day.R b/R/scale-week-year-week-day.R new file mode 100644 index 00000000..978f274d --- /dev/null +++ b/R/scale-week-year-week-day.R @@ -0,0 +1,402 @@ +# @export .onLoad() +scale_type.clock_year_week_day <- function(x) { + c("year_week_day", "continuous") +} + +# ------------------------------------------------------------------------------ + +#' @export +#' @rdname calendar-scales-position +scale_x_year_week_day <- function(..., + name = ggplot2::waiver(), + breaks = ggplot2::waiver(), + date_breaks = ggplot2::waiver(), + minor_breaks = ggplot2::waiver(), + date_minor_breaks = ggplot2::waiver(), + n.breaks = NULL, + labels = ggplot2::waiver(), + limits = NULL, + oob = scales::censor, + expand = ggplot2::waiver(), + guide = ggplot2::waiver(), + position = "bottom") { + check_dots_empty0(...) + check_installed("scales") + check_installed("ggplot2") + + scale <- year_week_day_scale( + aesthetics = ggplot2_x_aes(), + palette = identity, + name = name, + breaks = breaks, + date_breaks = date_breaks, + minor_breaks = minor_breaks, + date_minor_breaks = date_minor_breaks, + n.breaks = n.breaks, + labels = labels, + limits = limits, + oob = oob, + expand = expand, + guide = guide, + position = position, + super = the$ScaleContinuousPositionYearWeekDay + ) + + scale +} + +#' @export +#' @rdname calendar-scales-position +scale_y_year_week_day <- function(..., + name = ggplot2::waiver(), + breaks = ggplot2::waiver(), + date_breaks = ggplot2::waiver(), + minor_breaks = ggplot2::waiver(), + date_minor_breaks = ggplot2::waiver(), + n.breaks = NULL, + labels = ggplot2::waiver(), + limits = NULL, + oob = scales::censor, + expand = ggplot2::waiver(), + guide = ggplot2::waiver(), + position = "left") { + check_dots_empty0(...) + check_installed("scales") + check_installed("ggplot2") + + scale <- year_week_day_scale( + aesthetics = ggplot2_y_aes(), + palette = identity, + name = name, + breaks = breaks, + date_breaks = date_breaks, + minor_breaks = minor_breaks, + date_minor_breaks = date_minor_breaks, + n.breaks = n.breaks, + labels = labels, + limits = limits, + oob = oob, + expand = expand, + guide = guide, + position = position, + super = the$ScaleContinuousPositionYearWeekDay + ) + + scale +} + +#' @export +#' @rdname calendar-scales-color +scale_colour_year_week_day <- function(..., + low = "#132B43", + high = "#56B1F7", + na.value = "grey50", + guide = "colourbar") { + check_dots_empty0(...) + check_installed("scales") + check_installed("ggplot2") + + year_week_day_scale( + aesthetics = "colour", + palette = scales::seq_gradient_pal(low, high), + na.value = na.value, + guide = guide + ) +} + +#' @export +#' @rdname calendar-scales-color +scale_color_year_week_day <- scale_colour_year_week_day + +#' @export +#' @rdname calendar-scales-color +scale_fill_year_week_day <- function(..., + low = "#132B43", + high = "#56B1F7", + na.value = "grey50", + guide = "colourbar") { + check_dots_empty0(...) + check_installed("scales") + check_installed("ggplot2") + + year_week_day_scale( + aesthetics = "fill", + palette = scales::seq_gradient_pal(low, high), + na.value = na.value, + guide = guide + ) +} + +#' @export +#' @rdname calendar-scales-alpha +scale_alpha_year_week_day <- function(..., range = c(0.1, 1)) { + check_dots_empty0(...) + check_installed("scales") + check_installed("ggplot2") + + year_week_day_scale( + aesthetics = "alpha", + palette = scales::rescale_pal(range) + ) +} + +#' @export +#' @rdname calendar-scales-size +scale_size_year_week_day <- function(..., range = c(1, 6)) { + check_dots_empty0(...) + check_installed("scales") + check_installed("ggplot2") + + year_week_day_scale( + aesthetics = "size", + palette = scales::area_pal(range) + ) +} + +# ------------------------------------------------------------------------------ + +year_week_day_scale <- function(aesthetics, + palette, + ..., + name = ggplot2::waiver(), + breaks = ggplot2::waiver(), + date_breaks = ggplot2::waiver(), + minor_breaks = ggplot2::waiver(), + date_minor_breaks = ggplot2::waiver(), + n.breaks = NULL, + labels = ggplot2::waiver(), + limits = NULL, + oob = scales::censor, + expand = ggplot2::waiver(), + na.value = NA_real_, + guide = ggplot2::waiver(), + position = "bottom", + super = the$ScaleContinuousYearWeekDay) { + check_dots_empty0(...) + + if (!is.waive(date_breaks)) { + breaks <- breaks_duration_year_week_day(date_breaks) + } + if (!is.waive(date_minor_breaks)) { + minor_breaks <- breaks_duration_year_week_day(date_minor_breaks) + } + + # Insert a fake `trans` that gets updated by the ggproto `$transform()` method + # which is called before anything else + trans <- year_week_day_trans(epoch = NULL) + + ggplot2::continuous_scale( + aesthetics = aesthetics, + scale_name = "year_week_day", + palette = palette, + name = name, + breaks = breaks, + minor_breaks = minor_breaks, + n.breaks = n.breaks, + labels = labels, + limits = limits, + oob = oob, + expand = expand, + na.value = na.value, + trans = trans, + guide = guide, + position = position, + super = super + ) +} + +year_week_day_trans <- function(epoch = NULL) { + # year-week-day transforms are complicated by the fact that year-week-day + # (correctly) doesn't support math on week precision inputs. But in this + # case we go ahead and assume the user provided fully valid dates, allowing + # us to build in week precision math by converting to and from sys-time. + scales::trans_new( + name = "year_week_day", + transform = year_week_day_trans_transform_fn(epoch), + inverse = year_week_day_trans_inverse_fn(epoch), + breaks = year_week_day_trans_breaks(epoch), + domain = calendar_trans_domain(epoch) + ) +} + +year_week_day_epoch <- function(precision, start) { + precision <- precision_to_string(precision) + calendar_widen(year_week_day(1970, start = start), precision) +} + +# ------------------------------------------------------------------------------ + +year_week_day_trans_transform_fn <- function(epoch) { + force(epoch) + + function(x) { + check_trans_epoch(epoch) + precision <- calendar_precision_attribute(epoch) + + if (precision == PRECISION_YEAR) { + calendar_trans_transform_fn(epoch)(x) + } else if (precision == PRECISION_WEEK) { + as.integer(year_week_day_as_weeks(x, epoch)) + } else { + abort("Unknown precision.", .internal = TRUE) + } + } +} + +year_week_day_trans_inverse_fn <- function(epoch) { + force(epoch) + + function(x) { + check_trans_epoch(epoch) + precision <- calendar_precision_attribute(epoch) + + if (precision == PRECISION_YEAR) { + calendar_trans_inverse_fn(epoch)(x) + } else if (precision == PRECISION_WEEK) { + x <- round_limits(x) + year_week_day_add_weeks(epoch, x) + } else { + abort("Unknown precision.", .internal = TRUE) + } + } +} + +year_week_day_trans_breaks <- function(epoch) { + force(epoch) + + function(x, n = 5L) { + check_trans_epoch(epoch) + precision <- calendar_precision_attribute(epoch) + + if (precision == PRECISION_YEAR) { + calendar_trans_breaks(x, n = n) + } else if (precision == PRECISION_WEEK) { + x <- year_week_day_as_weeks(x, epoch) + x <- calendar_trans_breaks(x, n = n) + year_week_day_from_weeks(x, epoch) + } else { + abort("Unknown precision.", .internal = TRUE) + } + } +} + +# ------------------------------------------------------------------------------ + +# These helpers add support for: +# - Week based math +# - Conversion to and from `duration` based on some epoch +# +# They assume that `x` has no invalid dates. +# +# These should never be exported from clock itself, as they blur the lines +# between calendar and time-points. But they are nice here for plotting +# convenience, as otherwise you wouldn't be able to plot a year-week calendar. + +year_week_day_add_weeks <- function(x, n) { + start <- week_start(x) + + x <- set_day(x, 1) + + # Better be sure about no invalid weeks here! Not safe! + x <- as_sys_time(x) + + x <- add_weeks(x, n) + + x <- as_year_week_day(x, start = start) + + x <- calendar_narrow(x, "week") + + x +} + +year_week_day_as_weeks <- function(x, epoch) { + x <- set_day(x, 1) + epoch <- set_day(epoch, 1) + + # Better be sure about no invalid weeks here! Not safe! + x <- as_sys_time(x) + epoch <- as_sys_time(epoch) + + out <- x - epoch + + duration_cast(out, "week") +} + +year_week_day_from_weeks <- function(x, epoch) { + start <- week_start(epoch) + + epoch <- set_day(epoch, 1L) + epoch <- as_sys_time(epoch) + + out <- epoch + x + + out <- as_year_week_day(out, start = start) + + calendar_narrow(out, "week") +} + +# ------------------------------------------------------------------------------ + +breaks_duration_year_week_day <- function(by) { + force(by) + + function(x) { + breaks <- breaks_duration(by) + + precision <- calendar_precision_attribute(x) + start <- week_start(x) + epoch <- year_week_day_epoch(precision, start) + + x <- year_week_day_as_weeks(x, epoch) + x <- breaks(x) + x <- year_week_day_from_weeks(x, epoch) + + x + } +} + +# ------------------------------------------------------------------------------ + +make_ScaleContinuousYearWeekDay <- function() { + # Forced to wrap in a generator function so we can keep ggplot2 in Suggests. + # Initialized on load. + ggplot2::ggproto( + "ScaleContinuousYearWeekDay", + ggplot2::ScaleContinuous, + epoch = NULL, + transform = year_week_day_transform + ) +} + +make_ScaleContinuousPositionYearWeekDay <- function() { + # Forced to wrap in a generator function so we can keep ggplot2 in Suggests. + # Initialized on load. + ggplot2::ggproto( + "ScaleContinuousPositionYearWeekDay", + ggplot2::ScaleContinuousPosition, + epoch = NULL, + transform = year_week_day_transform + ) +} + +year_week_day_transform <- function(self, x) { + # Refresh the `$trans` object with the actual data `epoch`. + # Same trick as `ScaleContinuousDatetime` for the time zone. + precision <- calendar_precision_attribute(x) + start <- week_start(x) + + if (precision > PRECISION_WEEK) { + cli::cli_abort("{.cls year_week_day} inputs can only be {.str year} or {.str week} precision.") + } + + if (is_null(self$epoch)) { + self$epoch <- year_week_day_epoch(precision, start) + self$trans <- year_week_day_trans(self$epoch) + } else if (calendar_precision_attribute(self$epoch) != precision) { + cli::cli_abort("All {.cls year_week_day} inputs must have the same precision.") + } else if (week_start(self$epoch) != start) { + cli::cli_abort("All {.cls year_week_day} inputs must have the same start.") + } + + ggplot2::ggproto_parent(ggplot2::ScaleContinuousPosition, self)$transform(x) +} diff --git a/R/zzz.R b/R/zzz.R index d0df2155..014e25ba 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -19,6 +19,17 @@ clock_init_zoned_time_utils(clock_ns) clock_init_weekday_utils(clock_ns) + on_package_load("ggplot2", { + the$ScaleContinuousYearMonthDay <- make_ScaleContinuousYearMonthDay() + the$ScaleContinuousPositionYearMonthDay <- make_ScaleContinuousPositionYearMonthDay() + + the$ScaleContinuousYearQuarterDay <- make_ScaleContinuousYearQuarterDay() + the$ScaleContinuousPositionYearQuarterDay <- make_ScaleContinuousPositionYearQuarterDay() + + the$ScaleContinuousYearWeekDay <- make_ScaleContinuousYearWeekDay() + the$ScaleContinuousPositionYearWeekDay <- make_ScaleContinuousPositionYearWeekDay() + }) + vctrs::s3_register("pillar::pillar_shaft", "clock_calendar", pillar_shaft.clock_calendar) vctrs::s3_register("pillar::pillar_shaft", "clock_time_point", pillar_shaft.clock_time_point) vctrs::s3_register("pillar::pillar_shaft", "clock_zoned_time", pillar_shaft.clock_zoned_time) @@ -30,6 +41,10 @@ vctrs::s3_register("slider::slider_minus", "Date.clock_duration", slider_minus.Date.clock_duration) vctrs::s3_register("slider::slider_minus", "POSIXct.clock_duration", slider_minus.POSIXct.clock_duration) vctrs::s3_register("slider::slider_minus", "POSIXlt.clock_duration", slider_minus.POSIXlt.clock_duration) + + vctrs::s3_register("ggplot2::scale_type", "clock_year_month_day", scale_type.clock_year_month_day) + vctrs::s3_register("ggplot2::scale_type", "clock_year_quarter_day", scale_type.clock_year_quarter_day) + vctrs::s3_register("ggplot2::scale_type", "clock_year_week_day", scale_type.clock_year_week_day) } # nocov end diff --git a/_pkgdown.yml b/_pkgdown.yml index fab3c570..946884eb 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -224,6 +224,10 @@ reference: contents: - clock-codes +- title: Scales + contents: + - starts_with("scale_") + - title: Developer contents: - vec_arith.clock_year_month_day diff --git a/man/calendar-scales-alpha.Rd b/man/calendar-scales-alpha.Rd new file mode 100644 index 00000000..bf3eaf03 --- /dev/null +++ b/man/calendar-scales-alpha.Rd @@ -0,0 +1,68 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/scale-calendar.R, +% R/scale-gregorian-year-month-day.R, R/scale-quarterly-year-quarter-day.R, +% R/scale-week-year-week-day.R +\name{calendar-scales-alpha} +\alias{calendar-scales-alpha} +\alias{scale_alpha_year_month_day} +\alias{scale_alpha_year_quarter_day} +\alias{scale_alpha_year_week_day} +\title{Alpha transparency scales: calendar} +\usage{ +scale_alpha_year_month_day(..., range = c(0.1, 1)) + +scale_alpha_year_quarter_day(..., range = c(0.1, 1)) + +scale_alpha_year_week_day(..., range = c(0.1, 1)) +} +\arguments{ +\item{...}{These dots are for future extensions and must be empty.} + +\item{range}{Output range of alpha values. Must lie between 0 and 1.} +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +Alpha transparency scales for use with ggplot2. +\itemize{ +\item \code{scale_alpha_year_month_day()} is only valid on year and month precision +inputs. +\item \code{scale_alpha_year_quarter_day()} is only valid on year and quarter +precision inputs. +\item \code{scale_alpha_year_week_day()} is only valid on year and week precision +inputs. +} + +For day precision and finer, we currently still recommend using Date and +POSIXct with \code{\link[ggplot2:scale_alpha]{ggplot2::scale_alpha_date()}} and +\code{\link[ggplot2:scale_alpha]{ggplot2::scale_alpha_datetime()}}. +} +\examples{ +\dontshow{if (rlang::is_installed("ggplot2") && rlang::is_installed("scales")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +library(ggplot2) +library(vctrs) + +set.seed(123) + +date <- year_quarter_day(2019, 1) + duration_quarters(1:100) +height <- ifelse( + date < year_quarter_day(2033, 1), + sample(30:50, size = 50, replace = TRUE), + sample(40:60, size = 50, replace = TRUE) +) +weight <- ifelse( + date < year_quarter_day(2028, 1), + sample(100:150, size = 50, replace = TRUE), + sample(100:180, size = 50, replace = TRUE) +) + +df <- data_frame( + date = date, + height = height, + weight = weight +) + +ggplot(df, aes(height, weight, alpha = date)) + + geom_point() +\dontshow{\}) # examplesIf} +} diff --git a/man/calendar-scales-color.Rd b/man/calendar-scales-color.Rd new file mode 100644 index 00000000..8046f656 --- /dev/null +++ b/man/calendar-scales-color.Rd @@ -0,0 +1,161 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/scale-calendar.R, +% R/scale-gregorian-year-month-day.R, R/scale-quarterly-year-quarter-day.R, +% R/scale-week-year-week-day.R +\name{calendar-scales-color} +\alias{calendar-scales-color} +\alias{scale_colour_year_month_day} +\alias{scale_color_year_month_day} +\alias{scale_fill_year_month_day} +\alias{scale_colour_year_quarter_day} +\alias{scale_color_year_quarter_day} +\alias{scale_fill_year_quarter_day} +\alias{scale_colour_year_week_day} +\alias{scale_color_year_week_day} +\alias{scale_fill_year_week_day} +\title{Gradient color scales: calendar} +\usage{ +scale_colour_year_month_day( + ..., + low = "#132B43", + high = "#56B1F7", + na.value = "grey50", + guide = "colourbar" +) + +scale_color_year_month_day( + ..., + low = "#132B43", + high = "#56B1F7", + na.value = "grey50", + guide = "colourbar" +) + +scale_fill_year_month_day( + ..., + low = "#132B43", + high = "#56B1F7", + na.value = "grey50", + guide = "colourbar" +) + +scale_colour_year_quarter_day( + ..., + low = "#132B43", + high = "#56B1F7", + na.value = "grey50", + guide = "colourbar" +) + +scale_color_year_quarter_day( + ..., + low = "#132B43", + high = "#56B1F7", + na.value = "grey50", + guide = "colourbar" +) + +scale_fill_year_quarter_day( + ..., + low = "#132B43", + high = "#56B1F7", + na.value = "grey50", + guide = "colourbar" +) + +scale_colour_year_week_day( + ..., + low = "#132B43", + high = "#56B1F7", + na.value = "grey50", + guide = "colourbar" +) + +scale_color_year_week_day( + ..., + low = "#132B43", + high = "#56B1F7", + na.value = "grey50", + guide = "colourbar" +) + +scale_fill_year_week_day( + ..., + low = "#132B43", + high = "#56B1F7", + na.value = "grey50", + guide = "colourbar" +) +} +\arguments{ +\item{...}{These dots are for future extensions and must be empty.} + +\item{low, high}{Colours for low and high ends of the gradient.} + +\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.} +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +Gradient color scales for use with ggplot2. +\itemize{ +\item \code{scale_color_year_month_day()} and \code{scale_fill_year_month_day()} are only +valid on year and month precision inputs. +\item \code{scale_color_year_quarter_day()} and \code{scale_fill_year_quarter_day()} are +only valid on year and quarter precision inputs. +\item \code{scale_color_year_week_day()} and \code{scale_fill_year_week_day()} are only +valid on year and week precision inputs. +} + +For day precision and finer, we currently still recommend using Date and +POSIXct with \code{\link[ggplot2:scale_gradient]{ggplot2::scale_color_date()}} and +\code{\link[ggplot2:scale_gradient]{ggplot2::scale_color_datetime()}}. +} +\examples{ +\dontshow{if (rlang::is_installed("ggplot2") && rlang::is_installed("scales")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +library(ggplot2) +library(vctrs) + +# --------------------------------------------------------------------------- +# Color + +set.seed(123) + +date <- year_quarter_day(2019, 1) + duration_quarters(1:100) +height <- ifelse( + date < year_quarter_day(2033, 1), + sample(30:50, size = 50, replace = TRUE), + sample(40:60, size = 50, replace = TRUE) +) +weight <- ifelse( + date < year_quarter_day(2028, 1), + sample(100:150, size = 50, replace = TRUE), + sample(100:180, size = 50, replace = TRUE) +) + +df <- data_frame( + date = date, + height = height, + weight = weight +) + +ggplot(df, aes(height, weight, color = date)) + + geom_point() + + scale_colour_year_quarter_day( + low = "red", + high = "blue" + ) + +# --------------------------------------------------------------------------- +# Fill + +economics$date <- as_year_month_day(economics$date) +economics$date <- calendar_narrow(economics$date, "month") + +ggplot(economics, aes(x = date, y = unemploy, fill = date)) + + geom_col() +\dontshow{\}) # examplesIf} +} diff --git a/man/calendar-scales-position.Rd b/man/calendar-scales-position.Rd new file mode 100644 index 00000000..1b0e3540 --- /dev/null +++ b/man/calendar-scales-position.Rd @@ -0,0 +1,321 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/scale-calendar.R, +% R/scale-gregorian-year-month-day.R, R/scale-quarterly-year-quarter-day.R, +% R/scale-week-year-week-day.R +\name{calendar-scales-position} +\alias{calendar-scales-position} +\alias{scale_x_year_month_day} +\alias{scale_y_year_month_day} +\alias{scale_x_year_quarter_day} +\alias{scale_y_year_quarter_day} +\alias{scale_x_year_week_day} +\alias{scale_y_year_week_day} +\title{Position scales: calendar} +\usage{ +scale_x_year_month_day( + ..., + name = ggplot2::waiver(), + breaks = ggplot2::waiver(), + date_breaks = ggplot2::waiver(), + minor_breaks = ggplot2::waiver(), + date_minor_breaks = ggplot2::waiver(), + n.breaks = NULL, + labels = ggplot2::waiver(), + date_labels = ggplot2::waiver(), + date_locale = clock_locale(), + limits = NULL, + oob = scales::censor, + expand = ggplot2::waiver(), + guide = ggplot2::waiver(), + position = "bottom" +) + +scale_y_year_month_day( + ..., + name = ggplot2::waiver(), + breaks = ggplot2::waiver(), + date_breaks = ggplot2::waiver(), + minor_breaks = ggplot2::waiver(), + date_minor_breaks = ggplot2::waiver(), + n.breaks = NULL, + labels = ggplot2::waiver(), + date_labels = ggplot2::waiver(), + date_locale = clock_locale(), + limits = NULL, + oob = scales::censor, + expand = ggplot2::waiver(), + guide = ggplot2::waiver(), + position = "left" +) + +scale_x_year_quarter_day( + ..., + name = ggplot2::waiver(), + breaks = ggplot2::waiver(), + date_breaks = ggplot2::waiver(), + minor_breaks = ggplot2::waiver(), + date_minor_breaks = ggplot2::waiver(), + n.breaks = NULL, + labels = ggplot2::waiver(), + limits = NULL, + oob = scales::censor, + expand = ggplot2::waiver(), + guide = ggplot2::waiver(), + position = "bottom" +) + +scale_y_year_quarter_day( + ..., + name = ggplot2::waiver(), + breaks = ggplot2::waiver(), + date_breaks = ggplot2::waiver(), + minor_breaks = ggplot2::waiver(), + date_minor_breaks = ggplot2::waiver(), + n.breaks = NULL, + labels = ggplot2::waiver(), + limits = NULL, + oob = scales::censor, + expand = ggplot2::waiver(), + guide = ggplot2::waiver(), + position = "left" +) + +scale_x_year_week_day( + ..., + name = ggplot2::waiver(), + breaks = ggplot2::waiver(), + date_breaks = ggplot2::waiver(), + minor_breaks = ggplot2::waiver(), + date_minor_breaks = ggplot2::waiver(), + n.breaks = NULL, + labels = ggplot2::waiver(), + limits = NULL, + oob = scales::censor, + expand = ggplot2::waiver(), + guide = ggplot2::waiver(), + position = "bottom" +) + +scale_y_year_week_day( + ..., + name = ggplot2::waiver(), + breaks = ggplot2::waiver(), + date_breaks = ggplot2::waiver(), + minor_breaks = ggplot2::waiver(), + date_minor_breaks = ggplot2::waiver(), + n.breaks = NULL, + labels = ggplot2::waiver(), + limits = NULL, + oob = scales::censor, + expand = ggplot2::waiver(), + guide = ggplot2::waiver(), + position = "left" +) +} +\arguments{ +\item{...}{These dots are for future extensions and must be empty.} + +\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{ggplot2::waiver()} for default breaks, or to use breaks specified by +\code{date_breaks}. +\item A calendar type of the same type as the input giving positions of breaks. +\item A function that takes the limits as input and returns breaks as output. +}} + +\item{date_breaks}{A single duration object giving the distance between the +breaks, like \code{duration_months(1)} or \code{duration_weeks(2)}. If both \code{breaks} +and \code{date_breaks} are specified, \code{date_breaks} wins.} + +\item{minor_breaks}{Same as \code{breaks}, but applied to minor breaks.} + +\item{date_minor_breaks}{Same as \code{date_breaks}, but applied to minor breaks.} + +\item{n.breaks}{An integer guiding the number of major breaks. The algorithm +may choose a slightly different number to ensure nice break labels. Will +only have an effect if \code{breaks = waiver()}. Use \code{NULL} to use the default +number of breaks given by the transformation.} + +\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 An expression vector (must be the same length as breaks). See ?plotmath for details. +\item A function that takes the breaks as input and returns labels +as output. Also accepts rlang \link[rlang:as_function]{lambda} function +notation. +}} + +\item{date_labels}{For year-month-day only, a string giving the formatting +specification for the labels, such as \code{"\%B \%Y"}. The full list of format +tokens is available at \code{\link[=format.clock_zoned_time]{format.clock_zoned_time()}}. Note that you should +only use month and year specific codes.} + +\item{date_locale}{For year-month-day only, the locale used when +\code{date_labels} is also specified.} + +\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. Also accepts rlang \link[rlang:as_function]{lambda} function +notation. +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[ggplot2:coord_cartesian]{coord_cartesian()}}). +}} + +\item{oob}{One of: +\itemize{ +\item Function that handles limits outside of the scale limits +(out of bounds). Also accepts rlang \link[rlang:as_function]{lambda} +function notation. +\item The default (\code{\link[scales:oob]{scales::censor()}}) replaces out of +bounds values with \code{NA}. +\item \code{\link[scales:oob]{scales::squish()}} for squishing out of bounds values into range. +\item \code{\link[scales:oob]{scales::squish_infinite()}} for squishing infinite 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[ggplot2: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{guide}{A function used to create a guide or its name. See +\code{\link[ggplot2: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.} +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +Position scales for use with ggplot2. +\itemize{ +\item \code{scale_x_year_month_day()} and \code{scale_y_year_month_day()} are only valid on +year and month precision inputs. +\item \code{scale_x_year_quarter_day()} and \code{scale_y_year_quarter_day()} are only +valid on year and quarter precision inputs. +\item \code{scale_x_year_week_day()} and \code{scale_y_year_week_day()} are only +valid on year and week precision inputs. +} + +For day precision and finer, we currently still recommend using Date and +POSIXct with \code{\link[ggplot2:scale_date]{ggplot2::scale_x_date()}} and \code{\link[ggplot2:scale_date]{ggplot2::scale_x_datetime()}}. +} +\examples{ +\dontshow{if (rlang::is_installed("ggplot2") && rlang::is_installed("scales")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +library(ggplot2) +library(vctrs) + +# --------------------------------------------------------------------------- +# Monthly data + +set.seed(1234) + +from <- year_month_day(2019, 1) + +df <- vec_rbind( + data_frame( + g = "stock 1", + date = from + duration_months(cumsum(sample(1:2, size = 100, replace = TRUE))), + price = cumsum(1 + rnorm(100)) + ), + data_frame( + g = "stock 2", + date = from + duration_months(cumsum(sample(1:2, size = 100, replace = TRUE))), + price = cumsum(1 + rnorm(100)) + ) +) + +# Defaults automatically know you have monthly data +ggplot(df, aes(date, price, group = g, color = g)) + + geom_line() + +# Fully customize as needed +ggplot(df, aes(date, price, group = g, color = g)) + + geom_line() + + scale_x_year_month_day( + date_breaks = duration_months(24), + date_minor_breaks = duration_months(6), + date_labels = "\%Y" + ) + +ggplot(df, aes(date, price, group = g, color = g)) + + geom_line() + + scale_x_year_month_day( + date_labels = "\%B\n\%Y", + date_locale = clock_locale("fr") + ) + +# --------------------------------------------------------------------------- +# Quarterly data + +set.seed(1234) + +from1 <- year_quarter_day(2019, 1) +from2 <- year_quarter_day(2000, 2) + +df <- vec_rbind( + data_frame( + g = "stock 1", + date = from1 + duration_quarters(cumsum(sample(1:5, size = 50, replace = TRUE))), + price = cumsum(1 + rnorm(50)) + ), + data_frame( + g = "stock 2", + date = from2 + duration_quarters(cumsum(sample(1:5, size = 50, replace = TRUE))), + price = cumsum(1 + rnorm(50)) + ) +) + +ggplot(df, aes(date, price, group = g, color = g)) + + geom_line() + +# Zooming with `coord_cartesian()` +ggplot(df, aes(date, price, group = g, color = g)) + + geom_line() + + coord_cartesian(xlim = year_quarter_day(c(2020, 2040), 1)) + +# --------------------------------------------------------------------------- +# Weekly data + +set.seed(123) + +# A monday +x <- naive_time_parse("2018-12-31", precision = "day") +x <- x + duration_weeks(sort(sample(100, size = 50))) + +# ISO calendar +x <- as_year_week_day(x, start = clock_weekdays$monday) +x <- calendar_narrow(x, "week") + +df <- data_frame( + date = x, + value = cumsum(rnorm(50, mean = .2)) +) + +ggplot(df, aes(date, value)) + + geom_line() + + scale_x_year_week_day() + +ggplot(df, aes(date, value)) + + geom_line() + + scale_x_year_week_day( + date_breaks = duration_weeks(16), + date_minor_breaks = duration_weeks(2) + ) +\dontshow{\}) # examplesIf} +} diff --git a/man/calendar-scales-size.Rd b/man/calendar-scales-size.Rd new file mode 100644 index 00000000..443e0cda --- /dev/null +++ b/man/calendar-scales-size.Rd @@ -0,0 +1,70 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/scale-calendar.R, +% R/scale-gregorian-year-month-day.R, R/scale-quarterly-year-quarter-day.R, +% R/scale-week-year-week-day.R +\name{calendar-scales-size} +\alias{calendar-scales-size} +\alias{scale_size_year_month_day} +\alias{scale_size_year_quarter_day} +\alias{scale_size_year_week_day} +\title{Size scales: calendar} +\usage{ +scale_size_year_month_day(..., range = c(1, 6)) + +scale_size_year_quarter_day(..., range = c(1, 6)) + +scale_size_year_week_day(..., range = c(1, 6)) +} +\arguments{ +\item{...}{These dots are for future extensions and must be empty.} + +\item{range}{a numeric vector of length 2 that specifies the minimum and +maximum size of the plotting symbol after transformation.} +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +Size scales for use with ggplot2. +\itemize{ +\item \code{scale_size_year_month_day()} is only valid on year and month precision +inputs. +\item \code{scale_size_year_quarter_day()} is only valid on year and quarter +precision inputs. +\item \code{scale_size_year_week_day()} is only valid on year and week precision +inputs. +} + +For day precision and finer, we currently still recommend using Date and +POSIXct with \code{\link[ggplot2:scale_size]{ggplot2::scale_size_date()}} and +\code{\link[ggplot2:scale_size]{ggplot2::scale_size_datetime()}}. +} +\examples{ +\dontshow{if (rlang::is_installed("ggplot2") && rlang::is_installed("scales")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +library(ggplot2) +library(vctrs) + +set.seed(123) + +date <- year_quarter_day(2019, 1) + duration_quarters(1:100) +height <- ifelse( + date < year_quarter_day(2033, 1), + sample(30:50, size = 50, replace = TRUE), + sample(40:60, size = 50, replace = TRUE) +) +weight <- ifelse( + date < year_quarter_day(2028, 1), + sample(100:150, size = 50, replace = TRUE), + sample(100:180, size = 50, replace = TRUE) +) + +df <- data_frame( + date = date, + height = height, + weight = weight +) + +ggplot(df, aes(height, weight, size = date)) + + geom_point() + + scale_size_year_quarter_day(range = c(1, 10)) +\dontshow{\}) # examplesIf} +} diff --git a/tests/testthat/_snaps/scale-gregorian-year-month-day.md b/tests/testthat/_snaps/scale-gregorian-year-month-day.md new file mode 100644 index 00000000..23e82e85 --- /dev/null +++ b/tests/testthat/_snaps/scale-gregorian-year-month-day.md @@ -0,0 +1,34 @@ +# can't use invalid `date_breaks` or `date_minor_breaks` + + Code + ggplot2::ggplot_build(p) + Condition + Error in `duration_collect_by()`: + ! Can't convert `by` > to >. + Can't cast between calendrical durations and chronological durations. + +--- + + Code + ggplot2::ggplot_build(p) + Condition + Error in `duration_collect_by()`: + ! Can't convert `by` > to >. + Can't cast between calendrical durations and chronological durations. + +# can't use with unsupported precision + + Code + ggplot2::ggplot_build(p) + Condition + Error in `transform()`: + ! inputs can only be "year" or "month" precision. + +# can't mix precisions + + Code + ggplot2::ggplot_build(p) + Condition + Error in `transform()`: + ! All inputs must have the same precision. + diff --git a/tests/testthat/_snaps/scale-gregorian-year-month-day/1-data-point.svg b/tests/testthat/_snaps/scale-gregorian-year-month-day/1-data-point.svg new file mode 100644 index 00000000..05e16ce5 --- /dev/null +++ b/tests/testthat/_snaps/scale-gregorian-year-month-day/1-data-point.svg @@ -0,0 +1,50 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +0.950 +0.975 +1.000 +1.025 +1.050 + + + + + + +Jan 2019 +x +y +1 data point + + diff --git a/tests/testthat/_snaps/scale-gregorian-year-month-day/alpha-scale.svg b/tests/testthat/_snaps/scale-gregorian-year-month-day/alpha-scale.svg new file mode 100644 index 00000000..2163891e --- /dev/null +++ b/tests/testthat/_snaps/scale-gregorian-year-month-day/alpha-scale.svg @@ -0,0 +1,64 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +50 +55 +60 +65 +70 + + + + + + + + + + + +10 +11 +12 +13 +14 +15 +height +weight +alpha scale + + diff --git a/tests/testthat/_snaps/scale-gregorian-year-month-day/color-scale.svg b/tests/testthat/_snaps/scale-gregorian-year-month-day/color-scale.svg new file mode 100644 index 00000000..699eb0bd --- /dev/null +++ b/tests/testthat/_snaps/scale-gregorian-year-month-day/color-scale.svg @@ -0,0 +1,82 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +50 +55 +60 +65 +70 + + + + + + + + + + + +10 +11 +12 +13 +14 +15 +height +weight + +date + + + + + + + + + + + +Feb 2019 +Mar 2019 +Apr 2019 +May 2019 +Jun 2019 +color scale + + diff --git a/tests/testthat/_snaps/scale-gregorian-year-month-day/colour-scale.svg b/tests/testthat/_snaps/scale-gregorian-year-month-day/colour-scale.svg new file mode 100644 index 00000000..447d9a22 --- /dev/null +++ b/tests/testthat/_snaps/scale-gregorian-year-month-day/colour-scale.svg @@ -0,0 +1,82 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +50 +55 +60 +65 +70 + + + + + + + + + + + +10 +11 +12 +13 +14 +15 +height +weight + +date + + + + + + + + + + + +Feb 2019 +Mar 2019 +Apr 2019 +May 2019 +Jun 2019 +colour scale + + diff --git a/tests/testthat/_snaps/scale-gregorian-year-month-day/date-breaks.svg b/tests/testthat/_snaps/scale-gregorian-year-month-day/date-breaks.svg new file mode 100644 index 00000000..38dcc34c --- /dev/null +++ b/tests/testthat/_snaps/scale-gregorian-year-month-day/date-breaks.svg @@ -0,0 +1,58 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +5 +10 +15 +20 + + + + + + + + + + +Jan 2019 +May 2019 +Sep 2019 +Jan 2020 +May 2020 +Sep 2020 +x +y +date_breaks + + diff --git a/tests/testthat/_snaps/scale-gregorian-year-month-day/date-labels.svg b/tests/testthat/_snaps/scale-gregorian-year-month-day/date-labels.svg new file mode 100644 index 00000000..8d0fe22c --- /dev/null +++ b/tests/testthat/_snaps/scale-gregorian-year-month-day/date-labels.svg @@ -0,0 +1,62 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +1 +2 +3 +4 +5 + + + + + + + + + + + + +2019 January +2019 February +2019 March +2019 April +2019 May +2019 June +2019 July +x +y +date_labels + + diff --git a/tests/testthat/_snaps/scale-gregorian-year-month-day/fill-scale.svg b/tests/testthat/_snaps/scale-gregorian-year-month-day/fill-scale.svg new file mode 100644 index 00000000..5add0f72 --- /dev/null +++ b/tests/testthat/_snaps/scale-gregorian-year-month-day/fill-scale.svg @@ -0,0 +1,76 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +25 +50 +75 +100 + + + + + + + + +10 +12 +14 +height +weight + +date + + + + + + + + + + + +Feb 2019 +Mar 2019 +Apr 2019 +May 2019 +Jun 2019 +fill scale + + diff --git a/tests/testthat/_snaps/scale-gregorian-year-month-day/size-scale.svg b/tests/testthat/_snaps/scale-gregorian-year-month-day/size-scale.svg new file mode 100644 index 00000000..538891ab --- /dev/null +++ b/tests/testthat/_snaps/scale-gregorian-year-month-day/size-scale.svg @@ -0,0 +1,64 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +50 +55 +60 +65 +70 + + + + + + + + + + + +10 +11 +12 +13 +14 +15 +height +weight +size scale + + diff --git a/tests/testthat/_snaps/scale-gregorian-year-month-day/vector.svg b/tests/testthat/_snaps/scale-gregorian-year-month-day/vector.svg new file mode 100644 index 00000000..11878038 --- /dev/null +++ b/tests/testthat/_snaps/scale-gregorian-year-month-day/vector.svg @@ -0,0 +1,62 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +1 +2 +3 +4 +5 + + + + + + + + + + + + +Jan 2019 +Feb 2019 +Mar 2019 +Apr 2019 +May 2019 +Jun 2019 +Jul 2019 +x +y +vector + + diff --git a/tests/testthat/_snaps/scale-gregorian-year-month-day/y-scale.svg b/tests/testthat/_snaps/scale-gregorian-year-month-day/y-scale.svg new file mode 100644 index 00000000..c4fa4a64 --- /dev/null +++ b/tests/testthat/_snaps/scale-gregorian-year-month-day/y-scale.svg @@ -0,0 +1,68 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Jan 2019 +Feb 2019 +Mar 2019 +Apr 2019 +May 2019 +Jun 2019 +Jul 2019 + + + + + + + + + + + + + +10 +11 +12 +13 +14 +15 +height +date +y scale + + diff --git a/tests/testthat/_snaps/scale-gregorian-year-month-day/year-precision.svg b/tests/testthat/_snaps/scale-gregorian-year-month-day/year-precision.svg new file mode 100644 index 00000000..2f4073fd --- /dev/null +++ b/tests/testthat/_snaps/scale-gregorian-year-month-day/year-precision.svg @@ -0,0 +1,54 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +3 +6 +9 + + + + + + + + +2019 +2022 +2025 +2028 +2031 +x +y +year precision + + diff --git a/tests/testthat/_snaps/scale-quarterly-year-quarter-day.md b/tests/testthat/_snaps/scale-quarterly-year-quarter-day.md new file mode 100644 index 00000000..ee185881 --- /dev/null +++ b/tests/testthat/_snaps/scale-quarterly-year-quarter-day.md @@ -0,0 +1,34 @@ +# can't use invalid `date_breaks` or `date_minor_breaks` + + Code + ggplot2::ggplot_build(p) + Condition + Error in `duration_collect_by()`: + ! Can't convert `by` > to >. + Can't cast between calendrical durations and chronological durations. + +--- + + Code + ggplot2::ggplot_build(p) + Condition + Error in `duration_collect_by()`: + ! Can't convert `by` > to >. + Can't cast between calendrical durations and chronological durations. + +# can't use with unsupported precision + + Code + ggplot2::ggplot_build(p) + Condition + Error in `transform()`: + ! inputs can only be "year" or "quarter" precision. + +# can't mix precisions + + Code + ggplot2::ggplot_build(p) + Condition + Error in `transform()`: + ! All inputs must have the same precision. + diff --git a/tests/testthat/_snaps/scale-quarterly-year-quarter-day/1-data-point.svg b/tests/testthat/_snaps/scale-quarterly-year-quarter-day/1-data-point.svg new file mode 100644 index 00000000..3c1dc778 --- /dev/null +++ b/tests/testthat/_snaps/scale-quarterly-year-quarter-day/1-data-point.svg @@ -0,0 +1,50 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +0.950 +0.975 +1.000 +1.025 +1.050 + + + + + + +2019-Q1 +x +y +1 data point + + diff --git a/tests/testthat/_snaps/scale-quarterly-year-quarter-day/alpha-scale.svg b/tests/testthat/_snaps/scale-quarterly-year-quarter-day/alpha-scale.svg new file mode 100644 index 00000000..2163891e --- /dev/null +++ b/tests/testthat/_snaps/scale-quarterly-year-quarter-day/alpha-scale.svg @@ -0,0 +1,64 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +50 +55 +60 +65 +70 + + + + + + + + + + + +10 +11 +12 +13 +14 +15 +height +weight +alpha scale + + diff --git a/tests/testthat/_snaps/scale-quarterly-year-quarter-day/color-scale.svg b/tests/testthat/_snaps/scale-quarterly-year-quarter-day/color-scale.svg new file mode 100644 index 00000000..5bc3680f --- /dev/null +++ b/tests/testthat/_snaps/scale-quarterly-year-quarter-day/color-scale.svg @@ -0,0 +1,82 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +50 +55 +60 +65 +70 + + + + + + + + + + + +10 +11 +12 +13 +14 +15 +height +weight + +date + + + + + + + + + + + +2019-Q2 +2019-Q3 +2019-Q4 +2020-Q1 +2020-Q2 +color scale + + diff --git a/tests/testthat/_snaps/scale-quarterly-year-quarter-day/colour-scale.svg b/tests/testthat/_snaps/scale-quarterly-year-quarter-day/colour-scale.svg new file mode 100644 index 00000000..19cf5752 --- /dev/null +++ b/tests/testthat/_snaps/scale-quarterly-year-quarter-day/colour-scale.svg @@ -0,0 +1,82 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +50 +55 +60 +65 +70 + + + + + + + + + + + +10 +11 +12 +13 +14 +15 +height +weight + +date + + + + + + + + + + + +2019-Q2 +2019-Q3 +2019-Q4 +2020-Q1 +2020-Q2 +colour scale + + diff --git a/tests/testthat/_snaps/scale-quarterly-year-quarter-day/date-breaks.svg b/tests/testthat/_snaps/scale-quarterly-year-quarter-day/date-breaks.svg new file mode 100644 index 00000000..85c548e3 --- /dev/null +++ b/tests/testthat/_snaps/scale-quarterly-year-quarter-day/date-breaks.svg @@ -0,0 +1,58 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +5 +10 +15 +20 + + + + + + + + + + +2019-Q1 +2020-Q1 +2021-Q1 +2022-Q1 +2023-Q1 +2024-Q1 +x +y +date_breaks + + diff --git a/tests/testthat/_snaps/scale-quarterly-year-quarter-day/fill-scale.svg b/tests/testthat/_snaps/scale-quarterly-year-quarter-day/fill-scale.svg new file mode 100644 index 00000000..5f493469 --- /dev/null +++ b/tests/testthat/_snaps/scale-quarterly-year-quarter-day/fill-scale.svg @@ -0,0 +1,76 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +25 +50 +75 +100 + + + + + + + + +10 +12 +14 +height +weight + +date + + + + + + + + + + + +2019-Q2 +2019-Q3 +2019-Q4 +2020-Q1 +2020-Q2 +fill scale + + diff --git a/tests/testthat/_snaps/scale-quarterly-year-quarter-day/size-scale.svg b/tests/testthat/_snaps/scale-quarterly-year-quarter-day/size-scale.svg new file mode 100644 index 00000000..538891ab --- /dev/null +++ b/tests/testthat/_snaps/scale-quarterly-year-quarter-day/size-scale.svg @@ -0,0 +1,64 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +50 +55 +60 +65 +70 + + + + + + + + + + + +10 +11 +12 +13 +14 +15 +height +weight +size scale + + diff --git a/tests/testthat/_snaps/scale-quarterly-year-quarter-day/vector.svg b/tests/testthat/_snaps/scale-quarterly-year-quarter-day/vector.svg new file mode 100644 index 00000000..eb110eaf --- /dev/null +++ b/tests/testthat/_snaps/scale-quarterly-year-quarter-day/vector.svg @@ -0,0 +1,62 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +1 +2 +3 +4 +5 + + + + + + + + + + + + +2019-Q1 +2019-Q2 +2019-Q3 +2019-Q4 +2020-Q1 +2020-Q2 +2020-Q3 +x +y +vector + + diff --git a/tests/testthat/_snaps/scale-quarterly-year-quarter-day/y-scale.svg b/tests/testthat/_snaps/scale-quarterly-year-quarter-day/y-scale.svg new file mode 100644 index 00000000..4956f4d1 --- /dev/null +++ b/tests/testthat/_snaps/scale-quarterly-year-quarter-day/y-scale.svg @@ -0,0 +1,68 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +2019-Q1 +2019-Q2 +2019-Q3 +2019-Q4 +2020-Q1 +2020-Q2 +2020-Q3 + + + + + + + + + + + + + +10 +11 +12 +13 +14 +15 +height +date +y scale + + diff --git a/tests/testthat/_snaps/scale-quarterly-year-quarter-day/year-precision.svg b/tests/testthat/_snaps/scale-quarterly-year-quarter-day/year-precision.svg new file mode 100644 index 00000000..2f4073fd --- /dev/null +++ b/tests/testthat/_snaps/scale-quarterly-year-quarter-day/year-precision.svg @@ -0,0 +1,54 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +3 +6 +9 + + + + + + + + +2019 +2022 +2025 +2028 +2031 +x +y +year precision + + diff --git a/tests/testthat/_snaps/scale-week-year-week-day.md b/tests/testthat/_snaps/scale-week-year-week-day.md new file mode 100644 index 00000000..39006193 --- /dev/null +++ b/tests/testthat/_snaps/scale-week-year-week-day.md @@ -0,0 +1,34 @@ +# can't use invalid `date_breaks` or `date_minor_breaks` + + Code + ggplot2::ggplot_build(p) + Condition + Error in `duration_collect_by()`: + ! Can't convert `by` > to >. + Can't cast to a less precise precision. + +--- + + Code + ggplot2::ggplot_build(p) + Condition + Error in `duration_collect_by()`: + ! Can't convert `by` > to >. + Can't cast to a less precise precision. + +# can't use with unsupported precision + + Code + ggplot2::ggplot_build(p) + Condition + Error in `transform()`: + ! inputs can only be "year" or "week" precision. + +# can't mix precisions + + Code + ggplot2::ggplot_build(p) + Condition + Error in `transform()`: + ! All inputs must have the same precision. + diff --git a/tests/testthat/_snaps/scale-week-year-week-day/1-data-point.svg b/tests/testthat/_snaps/scale-week-year-week-day/1-data-point.svg new file mode 100644 index 00000000..02de09a7 --- /dev/null +++ b/tests/testthat/_snaps/scale-week-year-week-day/1-data-point.svg @@ -0,0 +1,50 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +0.950 +0.975 +1.000 +1.025 +1.050 + + + + + + +2019-W01 +x +y +1 data point + + diff --git a/tests/testthat/_snaps/scale-week-year-week-day/alpha-scale.svg b/tests/testthat/_snaps/scale-week-year-week-day/alpha-scale.svg new file mode 100644 index 00000000..2163891e --- /dev/null +++ b/tests/testthat/_snaps/scale-week-year-week-day/alpha-scale.svg @@ -0,0 +1,64 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +50 +55 +60 +65 +70 + + + + + + + + + + + +10 +11 +12 +13 +14 +15 +height +weight +alpha scale + + diff --git a/tests/testthat/_snaps/scale-week-year-week-day/color-scale.svg b/tests/testthat/_snaps/scale-week-year-week-day/color-scale.svg new file mode 100644 index 00000000..ad6ddfc0 --- /dev/null +++ b/tests/testthat/_snaps/scale-week-year-week-day/color-scale.svg @@ -0,0 +1,82 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +50 +55 +60 +65 +70 + + + + + + + + + + + +10 +11 +12 +13 +14 +15 +height +weight + +date + + + + + + + + + + + +2019-W01 +2019-W02 +2019-W03 +2019-W04 +2019-W05 +color scale + + diff --git a/tests/testthat/_snaps/scale-week-year-week-day/colour-scale.svg b/tests/testthat/_snaps/scale-week-year-week-day/colour-scale.svg new file mode 100644 index 00000000..8206637b --- /dev/null +++ b/tests/testthat/_snaps/scale-week-year-week-day/colour-scale.svg @@ -0,0 +1,82 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +50 +55 +60 +65 +70 + + + + + + + + + + + +10 +11 +12 +13 +14 +15 +height +weight + +date + + + + + + + + + + + +2019-W01 +2019-W02 +2019-W03 +2019-W04 +2019-W05 +colour scale + + diff --git a/tests/testthat/_snaps/scale-week-year-week-day/date-breaks.svg b/tests/testthat/_snaps/scale-week-year-week-day/date-breaks.svg new file mode 100644 index 00000000..ad12998e --- /dev/null +++ b/tests/testthat/_snaps/scale-week-year-week-day/date-breaks.svg @@ -0,0 +1,58 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +5 +10 +15 +20 + + + + + + + + + + +2019-W01 +2019-W05 +2019-W09 +2019-W13 +2019-W17 +2019-W21 +x +y +date_breaks + + diff --git a/tests/testthat/_snaps/scale-week-year-week-day/fill-scale.svg b/tests/testthat/_snaps/scale-week-year-week-day/fill-scale.svg new file mode 100644 index 00000000..7f37e4eb --- /dev/null +++ b/tests/testthat/_snaps/scale-week-year-week-day/fill-scale.svg @@ -0,0 +1,76 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +25 +50 +75 +100 + + + + + + + + +10 +12 +14 +height +weight + +date + + + + + + + + + + + +2019-W01 +2019-W02 +2019-W03 +2019-W04 +2019-W05 +fill scale + + diff --git a/tests/testthat/_snaps/scale-week-year-week-day/size-scale.svg b/tests/testthat/_snaps/scale-week-year-week-day/size-scale.svg new file mode 100644 index 00000000..538891ab --- /dev/null +++ b/tests/testthat/_snaps/scale-week-year-week-day/size-scale.svg @@ -0,0 +1,64 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +50 +55 +60 +65 +70 + + + + + + + + + + + +10 +11 +12 +13 +14 +15 +height +weight +size scale + + diff --git a/tests/testthat/_snaps/scale-week-year-week-day/vector.svg b/tests/testthat/_snaps/scale-week-year-week-day/vector.svg new file mode 100644 index 00000000..3f8f987c --- /dev/null +++ b/tests/testthat/_snaps/scale-week-year-week-day/vector.svg @@ -0,0 +1,62 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +1 +2 +3 +4 +5 + + + + + + + + + + + + +2018-W52 +2019-W01 +2019-W02 +2019-W03 +2019-W04 +2019-W05 +2019-W06 +x +y +vector + + diff --git a/tests/testthat/_snaps/scale-week-year-week-day/y-scale.svg b/tests/testthat/_snaps/scale-week-year-week-day/y-scale.svg new file mode 100644 index 00000000..d179e391 --- /dev/null +++ b/tests/testthat/_snaps/scale-week-year-week-day/y-scale.svg @@ -0,0 +1,68 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +2018-W52 +2019-W01 +2019-W02 +2019-W03 +2019-W04 +2019-W05 +2019-W06 + + + + + + + + + + + + + +10 +11 +12 +13 +14 +15 +height +date +y scale + + diff --git a/tests/testthat/_snaps/scale-week-year-week-day/year-precision.svg b/tests/testthat/_snaps/scale-week-year-week-day/year-precision.svg new file mode 100644 index 00000000..2f4073fd --- /dev/null +++ b/tests/testthat/_snaps/scale-week-year-week-day/year-precision.svg @@ -0,0 +1,54 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +3 +6 +9 + + + + + + + + +2019 +2022 +2025 +2028 +2031 +x +y +year precision + + diff --git a/tests/testthat/test-scale-gregorian-year-month-day.R b/tests/testthat/test-scale-gregorian-year-month-day.R new file mode 100644 index 00000000..99504214 --- /dev/null +++ b/tests/testthat/test-scale-gregorian-year-month-day.R @@ -0,0 +1,186 @@ +skip_if_not_installed("ggplot2") +skip_if_not_installed("vdiffr") + +# test_that("works with 0 data points", { +# df <- data_frame( +# x = year_month_day(integer(), integer()), +# y = double() +# ) +# +# p <- ggplot2::ggplot(df, ggplot2::aes(x, y)) + +# ggplot2::geom_line() +# +# # Fails because `ggplot2:::ScalesList$transform_df()` early exists on +# # empty data frames rather than training with them +# expect_no_error(ggplot2::ggplot_build(p)) +# }) + +test_that("works with 1 data point", { + df <- data_frame( + x = year_month_day(2019, 1), + y = 1 + ) + + p <- ggplot2::ggplot(df, ggplot2::aes(x, y)) + + ggplot2::geom_point() + + vdiffr::expect_doppelganger("1 data point", { + p + }) +}) + +test_that("works with a vector of data", { + df <- data_frame( + x = year_month_day(2019, 1) + duration_months(1:5), + y = 1:5 + ) + + p <- ggplot2::ggplot(df, ggplot2::aes(x, y)) + + ggplot2::geom_line() + + vdiffr::expect_doppelganger("vector", { + p + }) +}) + +test_that("works with changing the `date_breaks`", { + df <- data_frame( + x = year_month_day(2019, 1) + duration_months(1:20), + y = 1:20 + ) + + # Note that minor breaks should look nice if you use a multiple + # of them as the major breaks + p <- ggplot2::ggplot(df, ggplot2::aes(x, y)) + + ggplot2::geom_line() + + scale_x_year_month_day( + date_breaks = duration_months(4), + date_minor_breaks = duration_months(2) + ) + + vdiffr::expect_doppelganger("date_breaks", { + p + }) +}) + +test_that("works with changing `date_labels`", { + df <- data_frame( + x = year_month_day(2019, 1) + duration_months(1:5), + y = 1:5 + ) + + p <- ggplot2::ggplot(df, ggplot2::aes(x, y)) + + ggplot2::geom_line() + + scale_x_year_month_day(date_labels = "%Y %B") + + vdiffr::expect_doppelganger("date_labels", { + p + }) +}) + +test_that("can't use invalid `date_breaks` or `date_minor_breaks`", { + df <- data_frame( + x = year_month_day(2019, 1) + duration_months(1:5), + y = 1:5 + ) + + p <- ggplot2::ggplot(df, ggplot2::aes(x, y)) + + ggplot2::geom_line() + + scale_x_year_month_day(date_breaks = duration_days(1)) + + expect_snapshot(error = TRUE, { + ggplot2::ggplot_build(p) + }) + + p <- ggplot2::ggplot(df, ggplot2::aes(x, y)) + + ggplot2::geom_line() + + scale_x_year_month_day(date_minor_breaks = duration_days(1)) + + expect_snapshot(error = TRUE, { + ggplot2::ggplot_build(p) + }) +}) + +test_that("can't use with unsupported precision", { + df <- data_frame( + x = year_month_day(2019, 1, 2), + y = 1 + ) + + p <- ggplot2::ggplot(df, ggplot2::aes(x, y)) + + ggplot2::geom_line() + + expect_snapshot(error = TRUE, { + ggplot2::ggplot_build(p) + }) +}) + +test_that("can't mix precisions", { + df <- data_frame( + x = year_month_day(2019, 1), + y = 1 + ) + df2 <- data_frame( + x = year_month_day(2019), + y = 1 + ) + + p <- ggplot2::ggplot() + + ggplot2::geom_line(data = df, mapping = ggplot2::aes(x, y)) + + ggplot2::geom_line(data = df2, mapping = ggplot2::aes(x, y)) + + expect_snapshot(error = TRUE, { + ggplot2::ggplot_build(p) + }) +}) + +test_that("works with year precision", { + df <- data_frame( + x = year_month_day(2020:2030), + y = 1:11 + ) + + p <- ggplot2::ggplot(df, ggplot2::aes(x, y)) + + ggplot2::geom_line() + + vdiffr::expect_doppelganger("year precision", { + p + }) +}) + +test_that("less common scales have basic support", { + date <- year_month_day(2019, 1) + duration_months(1:5) + height <- c(10, 12, 15, 12, 14) + weight <- c(50, 55, 65, 50, 70) + + df <- data_frame( + date = date, + height = height, + weight = weight + ) + + vdiffr::expect_doppelganger("y scale", { + ggplot2::ggplot(df, ggplot2::aes(x = height, y = date)) + + ggplot2::geom_point() + }) + vdiffr::expect_doppelganger("size scale", { + ggplot2::ggplot(df, ggplot2::aes(height, weight, size = date)) + + ggplot2::geom_point() + }) + vdiffr::expect_doppelganger("color scale", { + ggplot2::ggplot(df, ggplot2::aes(height, weight, color = date)) + + ggplot2::geom_point() + }) + vdiffr::expect_doppelganger("colour scale", { + ggplot2::ggplot(df, ggplot2::aes(height, weight, colour = date)) + + ggplot2::geom_point() + }) + vdiffr::expect_doppelganger("fill scale", { + ggplot2::ggplot(df, ggplot2::aes(height, weight, fill = date)) + + ggplot2::geom_col() + }) + vdiffr::expect_doppelganger("alpha scale", { + ggplot2::ggplot(df, ggplot2::aes(height, weight, alpha = date)) + + ggplot2::geom_point() + }) +}) diff --git a/tests/testthat/test-scale-quarterly-year-quarter-day.R b/tests/testthat/test-scale-quarterly-year-quarter-day.R new file mode 100644 index 00000000..cf0ecfcb --- /dev/null +++ b/tests/testthat/test-scale-quarterly-year-quarter-day.R @@ -0,0 +1,171 @@ +skip_if_not_installed("ggplot2") +skip_if_not_installed("vdiffr") + +# test_that("works with 0 data points", { +# df <- data_frame( +# x = year_quarter_day(integer(), integer()), +# y = double() +# ) +# +# p <- ggplot2::ggplot(df, ggplot2::aes(x, y)) + +# ggplot2::geom_line() +# +# # Fails because `ggplot2:::ScalesList$transform_df()` early exists on +# # empty data frames rather than training with them +# expect_no_error(ggplot2::ggplot_build(p)) +# }) + +test_that("works with 1 data point", { + df <- data_frame( + x = year_quarter_day(2019, 1), + y = 1 + ) + + p <- ggplot2::ggplot(df, ggplot2::aes(x, y)) + + ggplot2::geom_point() + + vdiffr::expect_doppelganger("1 data point", { + p + }) +}) + +test_that("works with a vector of data", { + df <- data_frame( + x = year_quarter_day(2019, 1) + duration_quarters(1:5), + y = 1:5 + ) + + p <- ggplot2::ggplot(df, ggplot2::aes(x, y)) + + ggplot2::geom_line() + + vdiffr::expect_doppelganger("vector", { + p + }) +}) + +test_that("works with changing the `date_breaks`", { + df <- data_frame( + x = year_quarter_day(2019, 1) + duration_quarters(1:20), + y = 1:20 + ) + + # Note that minor breaks should look nice if you use a multiple + # of them as the major breaks + p <- ggplot2::ggplot(df, ggplot2::aes(x, y)) + + ggplot2::geom_line() + + scale_x_year_quarter_day( + date_breaks = duration_quarters(4), + date_minor_breaks = duration_quarters(2) + ) + + vdiffr::expect_doppelganger("date_breaks", { + p + }) +}) + +test_that("can't use invalid `date_breaks` or `date_minor_breaks`", { + df <- data_frame( + x = year_quarter_day(2019, 1) + duration_quarters(1:5), + y = 1:5 + ) + + p <- ggplot2::ggplot(df, ggplot2::aes(x, y)) + + ggplot2::geom_line() + + scale_x_year_quarter_day(date_breaks = duration_days(1)) + + expect_snapshot(error = TRUE, { + ggplot2::ggplot_build(p) + }) + + p <- ggplot2::ggplot(df, ggplot2::aes(x, y)) + + ggplot2::geom_line() + + scale_x_year_quarter_day(date_minor_breaks = duration_days(1)) + + expect_snapshot(error = TRUE, { + ggplot2::ggplot_build(p) + }) +}) + +test_that("can't use with unsupported precision", { + df <- data_frame( + x = year_quarter_day(2019, 1, 2), + y = 1 + ) + + p <- ggplot2::ggplot(df, ggplot2::aes(x, y)) + + ggplot2::geom_line() + + expect_snapshot(error = TRUE, { + ggplot2::ggplot_build(p) + }) +}) + +test_that("can't mix precisions", { + df <- data_frame( + x = year_quarter_day(2019, 1), + y = 1 + ) + df2 <- data_frame( + x = year_quarter_day(2019), + y = 1 + ) + + p <- ggplot2::ggplot() + + ggplot2::geom_line(data = df, mapping = ggplot2::aes(x, y)) + + ggplot2::geom_line(data = df2, mapping = ggplot2::aes(x, y)) + + expect_snapshot(error = TRUE, { + ggplot2::ggplot_build(p) + }) +}) + +test_that("works with year precision", { + df <- data_frame( + x = year_quarter_day(2020:2030), + y = 1:11 + ) + + p <- ggplot2::ggplot(df, ggplot2::aes(x, y)) + + ggplot2::geom_line() + + vdiffr::expect_doppelganger("year precision", { + p + }) +}) + +test_that("less common scales have basic support", { + date <- year_quarter_day(2019, 1) + duration_quarters(1:5) + height <- c(10, 12, 15, 12, 14) + weight <- c(50, 55, 65, 50, 70) + + df <- data_frame( + date = date, + height = height, + weight = weight + ) + + vdiffr::expect_doppelganger("y scale", { + ggplot2::ggplot(df, ggplot2::aes(x = height, y = date)) + + ggplot2::geom_point() + }) + vdiffr::expect_doppelganger("size scale", { + ggplot2::ggplot(df, ggplot2::aes(height, weight, size = date)) + + ggplot2::geom_point() + }) + vdiffr::expect_doppelganger("color scale", { + ggplot2::ggplot(df, ggplot2::aes(height, weight, color = date)) + + ggplot2::geom_point() + }) + vdiffr::expect_doppelganger("colour scale", { + ggplot2::ggplot(df, ggplot2::aes(height, weight, colour = date)) + + ggplot2::geom_point() + }) + vdiffr::expect_doppelganger("fill scale", { + ggplot2::ggplot(df, ggplot2::aes(height, weight, fill = date)) + + ggplot2::geom_col() + }) + vdiffr::expect_doppelganger("alpha scale", { + ggplot2::ggplot(df, ggplot2::aes(height, weight, alpha = date)) + + ggplot2::geom_point() + }) +}) diff --git a/tests/testthat/test-scale-utils.R b/tests/testthat/test-scale-utils.R new file mode 100644 index 00000000..d0436390 --- /dev/null +++ b/tests/testthat/test-scale-utils.R @@ -0,0 +1,44 @@ +# ------------------------------------------------------------------------------ +# seq_expanded_n() + +test_that("subtracts 1 from `n`", { + # Known test where if `1` isn't subtracted from `n`, + # then we get more breaks than this + from <- duration_years(2) + to <- duration_years(18) + + expect_identical( + seq_expanded_n(from, to, n = 3), + duration_years(c(2, 10, 18)) + ) +}) + +test_that("works with `n = 0`", { + from <- duration_years(2) + to <- duration_years(18) + + expect_identical( + seq_expanded_n(from, to, n = 0), + duration_years(c(2, 18)) + ) +}) + +test_that("works with `n = 1`", { + from <- duration_years(2) + to <- duration_years(18) + + expect_identical( + seq_expanded_n(from, to, n = 1), + duration_years(c(2, 18)) + ) +}) + +test_that("works with `to - from = 0`", { + from <- duration_years(2) + to <- duration_years(2) + + expect_identical( + seq_expanded_n(from, to, n = 3), + duration_years(2) + ) +}) diff --git a/tests/testthat/test-scale-week-year-week-day.R b/tests/testthat/test-scale-week-year-week-day.R new file mode 100644 index 00000000..0456f6ba --- /dev/null +++ b/tests/testthat/test-scale-week-year-week-day.R @@ -0,0 +1,171 @@ +skip_if_not_installed("ggplot2") +skip_if_not_installed("vdiffr") + +# test_that("works with 0 data points", { +# df <- data_frame( +# x = year_week_day(integer(), integer()), +# y = double() +# ) +# +# p <- ggplot2::ggplot(df, ggplot2::aes(x, y)) + +# ggplot2::geom_line() +# +# # Fails because `ggplot2:::ScalesList$transform_df()` early exists on +# # empty data frames rather than training with them +# expect_no_error(ggplot2::ggplot_build(p)) +# }) + +test_that("works with 1 data point", { + df <- data_frame( + x = year_week_day(2019, 1), + y = 1 + ) + + p <- ggplot2::ggplot(df, ggplot2::aes(x, y)) + + ggplot2::geom_point() + + vdiffr::expect_doppelganger("1 data point", { + p + }) +}) + +test_that("works with a vector of data", { + df <- data_frame( + x = year_week_day(2019, 1:5), + y = 1:5 + ) + + p <- ggplot2::ggplot(df, ggplot2::aes(x, y)) + + ggplot2::geom_line() + + vdiffr::expect_doppelganger("vector", { + p + }) +}) + +test_that("works with changing the `date_breaks`", { + df <- data_frame( + x = year_week_day_add_weeks(year_week_day(2019, 1), 1:20), + y = 1:20 + ) + + # Note that minor breaks should look nice if you use a multiple + # of them as the major breaks + p <- ggplot2::ggplot(df, ggplot2::aes(x, y)) + + ggplot2::geom_line() + + scale_x_year_week_day( + date_breaks = duration_weeks(4), + date_minor_breaks = duration_weeks(2) + ) + + vdiffr::expect_doppelganger("date_breaks", { + p + }) +}) + +test_that("can't use invalid `date_breaks` or `date_minor_breaks`", { + df <- data_frame( + x = year_week_day(2019, 1:5), + y = 1:5 + ) + + p <- ggplot2::ggplot(df, ggplot2::aes(x, y)) + + ggplot2::geom_line() + + scale_x_year_week_day(date_breaks = duration_days(1)) + + expect_snapshot(error = TRUE, { + ggplot2::ggplot_build(p) + }) + + p <- ggplot2::ggplot(df, ggplot2::aes(x, y)) + + ggplot2::geom_line() + + scale_x_year_week_day(date_minor_breaks = duration_days(1)) + + expect_snapshot(error = TRUE, { + ggplot2::ggplot_build(p) + }) +}) + +test_that("can't use with unsupported precision", { + df <- data_frame( + x = year_week_day(2019, 1, 2), + y = 1 + ) + + p <- ggplot2::ggplot(df, ggplot2::aes(x, y)) + + ggplot2::geom_line() + + expect_snapshot(error = TRUE, { + ggplot2::ggplot_build(p) + }) +}) + +test_that("can't mix precisions", { + df <- data_frame( + x = year_week_day(2019, 1), + y = 1 + ) + df2 <- data_frame( + x = year_week_day(2019), + y = 1 + ) + + p <- ggplot2::ggplot() + + ggplot2::geom_line(data = df, mapping = ggplot2::aes(x, y)) + + ggplot2::geom_line(data = df2, mapping = ggplot2::aes(x, y)) + + expect_snapshot(error = TRUE, { + ggplot2::ggplot_build(p) + }) +}) + +test_that("works with year precision", { + df <- data_frame( + x = year_week_day(2020:2030), + y = 1:11 + ) + + p <- ggplot2::ggplot(df, ggplot2::aes(x, y)) + + ggplot2::geom_line() + + vdiffr::expect_doppelganger("year precision", { + p + }) +}) + +test_that("less common scales have basic support", { + date <- year_week_day(2019, 1:5) + height <- c(10, 12, 15, 12, 14) + weight <- c(50, 55, 65, 50, 70) + + df <- data_frame( + date = date, + height = height, + weight = weight + ) + + vdiffr::expect_doppelganger("y scale", { + ggplot2::ggplot(df, ggplot2::aes(x = height, y = date)) + + ggplot2::geom_point() + }) + vdiffr::expect_doppelganger("size scale", { + ggplot2::ggplot(df, ggplot2::aes(height, weight, size = date)) + + ggplot2::geom_point() + }) + vdiffr::expect_doppelganger("color scale", { + ggplot2::ggplot(df, ggplot2::aes(height, weight, color = date)) + + ggplot2::geom_point() + }) + vdiffr::expect_doppelganger("colour scale", { + ggplot2::ggplot(df, ggplot2::aes(height, weight, colour = date)) + + ggplot2::geom_point() + }) + vdiffr::expect_doppelganger("fill scale", { + ggplot2::ggplot(df, ggplot2::aes(height, weight, fill = date)) + + ggplot2::geom_col() + }) + vdiffr::expect_doppelganger("alpha scale", { + ggplot2::ggplot(df, ggplot2::aes(height, weight, alpha = date)) + + ggplot2::geom_point() + }) +})