diff --git a/DESCRIPTION b/DESCRIPTION index 282dfe7..c6afd47 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -29,5 +29,6 @@ RoxygenNote: 7.2.3 Imports: lifecycle, rlang, + timechange, tsibble VignetteBuilder: knitr diff --git a/NAMESPACE b/NAMESPACE index 595c3d2..37aa9f1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,6 +5,7 @@ S3method(autoplot,tbl_ts) export(CoordCalendar) export(autolayer) export(autoplot) +export(cal_gregorian) export(coord_calendar) import(rlang) import(tsibble) diff --git a/R/cal_wrap.R b/R/cal_wrap.R new file mode 100644 index 0000000..360de8e --- /dev/null +++ b/R/cal_wrap.R @@ -0,0 +1,10 @@ +calendar_wrap <- function(x, wrap_points = cal_gregorian("week")) { + time <- convert_time(x) + + if(is.function(wrap_points)) { + wrap_points <- wrap_points(range(time, na.rm = TRUE)) + } + i <- as.integer(cut(time, wrap_points)) + x <- x - as.numeric(wrap_points)[i] + x +} diff --git a/R/coord-calendar.R b/R/coord-calendar.R new file mode 100644 index 0000000..328e1b3 --- /dev/null +++ b/R/coord-calendar.R @@ -0,0 +1,103 @@ +#' Calendar coordinates +#' +#' @export +coord_calendar <- function(period = "week", xlim = NULL, ylim = NULL, expand = TRUE, + default = FALSE, clip = "on") { + ggplot2::ggproto(NULL, CoordCalendar, + period = period, + limits = list(x = xlim, y = ylim), + expand = expand, + default = default, + clip = clip + ) +} + +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +CoordCalendar <- ggplot2::ggproto("CoordCalendar", ggplot2::CoordCartesian, + aspect = function(details) 1, + + range = function(self, panel_params) { + list( + x = panel_params$x.range, + y = panel_params$y.range + ) + }, + + # Currently only works for x, should work for c("x", "xmin", "xmax", "xend", "xintercept") + # transform_position is the appropriate helper for this, but this is incompatible with the group hack (as is xmin, xmax, xend) + transform = function(self, data, panel_params) { + # Not sure what to do with training panel guides yet + if(any(is.infinite(data$x))) return(data) + + # Convert x from numeric for handling time + time <- if (data$x[[1]] > 1e7) { + structure(data$x, class = c("POSIXct", "POSIXt")) + } else if (max(data$x) < 1e5) { + structure(data$x, class = "Date") + } else { + # Already done? + # Need to figure this out so inputs to $transform are consistent + return(data) + } + + wrap_points <- cal_gregorian(self$period)(range(time, na.rm = TRUE)) + # data$group <- + grp <- as.integer(cut(time, wrap_points)) + data$x <- data$x - as.numeric(wrap_points)[grp] #[data$group] + + data + }, + + setup_panel_params = function(self, scale_x, scale_y, params = list()) { + # environment(ggplot2::CoordCartesian$setup_panel_params)$setup_panel_params(self, scale_x, scale_y, params) + + # Find reasonable limits for x + lim_x <- c(0, max(diff(as.numeric(cal_gregorian(self$period)(self$limits$x %||% scale_x$range$range))))) + + # calculate break information + out_x <- scale_x$break_info(lim_x) + + # range in coord space has already been calculated + # needs to be in increasing order for transform_value() to work + # out_x$range <- range(continuous_ranges$continuous_range_coord) + out_x <- list( + # Note that a ViewScale requires a limit and a range that are before the + # Coord's transformation, so we pass `continuous_range`, not `continuous_range_coord`. + ggplot2:::view_scale_primary(scale_x, lim_x, lim_x), + sec = ggplot2:::view_scale_secondary(scale_x, lim_x, lim_x), + range = out_x$range, + labels = out_x$labels, + major = out_x$major_source, + minor = out_x$minor_source, + sec.labels = out_x$sec.labels, + sec.major = out_x$sec.major_source, + sec.minor = out_x$sec.minor_source + ) + names(out_x) <- c("x", paste("x", names(out_x)[-1], sep = ".")) + + out_x <- ggplot2:::view_scales_from_scale(scale_x, self$limits$x, self$expand) + out_x$x.range <- lim_x + c( + out_x, + ggplot2:::view_scales_from_scale(scale_y, self$limits$y, self$expand) + ) + }, + + modify_scales = function(self, scales_x, scales_y) { + # body(scales_x[[1L]]$trans$transform)[[2]] <- rlang::expr(browser()) + # body(scales_x[[1L]]$trans$transform)[[4]] <- rlang::expr(as.numeric(x) %% !!lubridate::period_to_seconds(lubridate::as.period(self$period))) + + invisible() + } + + # setup_data = function(data, params = list()) { + # data + # }, + # + # setup_layout = function(layout, params) { + # layout + # }, +) diff --git a/R/seq-gen.R b/R/seq-gen.R new file mode 100644 index 0000000..bbaec92 --- /dev/null +++ b/R/seq-gen.R @@ -0,0 +1,21 @@ +#' @export +cal_gregorian <- function(period = "week", week_start = 1) { + function(x) { + if(any(!is.finite(x))) return(x) + + # Convert to date, should not needed later? + out <- convert_time(x) + + # out <- as.Date(x, origin = "1970-01-01") + # Only designed to work for period = "week" for now. + # wday <- 1 + (as.numeric(out) + (6 - week_start))%%7 + + out <- seq( + from = timechange::time_floor(out[1], period, week_start), + to = timechange::time_ceiling(out[2], period, week_start), + by = period + ) + out + # vctrs::vec_cast(out, x) + } +} diff --git a/R/utils.R b/R/utils.R new file mode 100644 index 0000000..d856d05 --- /dev/null +++ b/R/utils.R @@ -0,0 +1,7 @@ +convert_time <- function(x) { + if (max(x) > 1e5) { + structure(x, class = c("POSIXct", "POSIXt")) + } else { + structure(x, class = "Date") + } +} diff --git a/README.Rmd b/README.Rmd index 946bd99..d3a1de0 100644 --- a/README.Rmd +++ b/README.Rmd @@ -36,7 +36,24 @@ remotes::install_github("tidyverts/ggtime") ```{r example} library(ggtime) library(tsibble) +library(ggplot2) tsibbledata::aus_production %>% autoplot(Bricks) + +cal_trans_x <- function() { + scales::trans_new( + name = "calendar", + transform = ggtime:::calendar_wrap, + inverse = identity, + breaks = scales::breaks_pretty(), + domain = c(0, 60*60*24*7) + ) +} + +pedestrian[with(pedestrian, Sensor == "Southern Cross Station" & Date < "2015-03-01"),] |> + autoplot(Count) + + # coord_calendar(xlim = c(Sys.time(), Sys.Date() + lubridate::days(1))) + ggplot2::coord_trans(x = cal_trans_x(), xlim = as.POSIXct(c("2024-03-25 00:00:00", "2024-03-31 23:59:59"))) + + scale_x_datetime(date_breaks = "day", date_labels = "%a") ``` diff --git a/README.md b/README.md index 63d41a9..c6dd622 100644 --- a/README.md +++ b/README.md @@ -29,15 +29,46 @@ remotes::install_github("tidyverts/ggtime") ``` r library(ggtime) +#> Registered S3 method overwritten by 'tsibble': +#> method from +#> as_tibble.grouped_df dplyr library(tsibble) #> #> Attaching package: 'tsibble' #> The following objects are masked from 'package:base': #> #> intersect, setdiff, union +library(ggplot2) tsibbledata::aus_production %>% autoplot(Bricks) -#> Warning: Removed 20 rows containing missing values (`geom_line()`). +#> Warning: Removed 20 rows containing missing values or values outside the scale range +#> (`geom_line()`). ``` + +``` r + +cal_trans_x <- function() { + scales::trans_new( + name = "calendar", + transform = ggtime:::calendar_wrap, + inverse = identity, + breaks = scales::breaks_pretty(), + domain = c(0, 60*60*24*7) + ) +} + +pedestrian[with(pedestrian, Sensor == "Southern Cross Station" & Date < "2015-03-01"),] |> + autoplot(Count) + + # coord_calendar(xlim = c(Sys.time(), Sys.Date() + lubridate::days(1))) + ggplot2::coord_trans(x = cal_trans_x(), xlim = as.POSIXct(c("2024-03-25 00:00:00", "2024-03-31 23:59:59"))) + + scale_x_datetime(date_breaks = "day", date_labels = "%a") +#> Warning in max(x): no non-missing arguments to max; returning -Inf +#> Warning in min.default(structure(numeric(0), class = "Date"), na.rm = FALSE): +#> no non-missing arguments to min; returning Inf +#> Warning in max.default(structure(numeric(0), class = "Date"), na.rm = FALSE): +#> no non-missing arguments to max; returning -Inf +``` + + diff --git a/man/coord_calendar.Rd b/man/coord_calendar.Rd new file mode 100644 index 0000000..aafd395 --- /dev/null +++ b/man/coord_calendar.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/coord-calendar.R +\name{coord_calendar} +\alias{coord_calendar} +\title{Calendar coordinates} +\usage{ +coord_calendar( + period = "week", + xlim = NULL, + ylim = NULL, + expand = TRUE, + default = FALSE, + clip = "on" +) +} +\description{ +Calendar coordinates +} diff --git a/man/figures/README-example-2.png b/man/figures/README-example-2.png new file mode 100644 index 0000000..a2bea25 Binary files /dev/null and b/man/figures/README-example-2.png differ