From 189d7a0b1a9170705edc32998384f45822a48db3 Mon Sep 17 00:00:00 2001 From: earowang Date: Sun, 9 Oct 2022 11:23:51 +1100 Subject: [PATCH] time() -> time_ts() (no export) closes #277 --- .github/workflows/pkgdown.yaml | 4 +- NAMESPACE | 6 --- NEWS.md | 1 + R/filter-index.R | 68 +++++++++++++++++------------- R/tsibble2ts.R | 24 +++++------ tests/testthat/test-filter-index.R | 42 +++++++++--------- tests/testthat/test-tsibble2ts.R | 3 +- 7 files changed, 74 insertions(+), 74 deletions(-) diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 740f59dd..7b436c6e 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -21,9 +21,9 @@ jobs: with: use-public-rspm: true - - uses: r-lib/actions/setup-r-dependencies@v1 + - uses: r-lib/actions/setup-r-dependencies@v2 with: - extra-packages: r-lib/pkgdown + extra-packages: any::pkgdown, local::. needs: website - name: Deploy package diff --git a/NAMESPACE b/NAMESPACE index 0ad2e077..26076d32 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -114,12 +114,6 @@ S3method(summarise,grouped_ts) S3method(summarise,tbl_ts) S3method(tbl_sum,grouped_ts) S3method(tbl_sum,tbl_ts) -S3method(time,Date) -S3method(time,POSIXt) -S3method(time,numeric) -S3method(time,yearmonth) -S3method(time,yearquarter) -S3method(time,yearweek) S3method(transmute,grouped_ts) S3method(transmute,tbl_ts) S3method(type_sum,tbl_ts) diff --git a/NEWS.md b/NEWS.md index 193d8f3e..9a0b21b7 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,7 @@ * Fixed the argument of `.full` in `*_gaps()` when inputs like `T`, `F` are valid. (#275) * Fixed validation of `index2` in `build_tsibble()` when a column name contains "index". (#284) +* No longer export `time()` methods (renamed to `time_ts()`) to contaminate `time()` in `stats::window()`. (#277) # tsibble 1.1.2 diff --git a/R/filter-index.R b/R/filter-index.R index bfbe7fb1..f7c28f71 100644 --- a/R/filter-index.R +++ b/R/filter-index.R @@ -101,15 +101,23 @@ time_in <- function(x, ...) { f <- new_formula(f, f) } env <- f_env(f) - lhs[[i]] <- start(x, eval_bare(is_dot_null(f_lhs(f)), env = env)) - rhs[[i]] <- end(x, eval_bare(is_dot_null(f_rhs(f)), env = env)) + lhs[[i]] <- start_window(x, eval_bare(is_dot_null(f_lhs(f)), env = env)) + rhs[[i]] <- end_window(x, eval_bare(is_dot_null(f_rhs(f)), env = env)) lgl[[i]] <- eval_bare(x >= lhs[[i]] & x < rhs[[i]]) } reduce(lgl, `|`) } -start.numeric <- function(x, y = NULL, ...) { +start_window <- function(x, y = NULL, ...) { + UseMethod("start_window") +} + +end_window <- function(x, y = NULL, ...) { + UseMethod("end_window") +} + +start_window.numeric <- function(x, y = NULL, ...) { if (is_null(y)) { min(x) } else { @@ -117,7 +125,7 @@ start.numeric <- function(x, y = NULL, ...) { } } -end.numeric <- function(x, y = NULL, ...) { +end_window.numeric <- function(x, y = NULL, ...) { if (is_null(y)) { max(x) + 1 } else { @@ -125,7 +133,7 @@ end.numeric <- function(x, y = NULL, ...) { } } -start.difftime <- function(x, y = NULL, ...) { +start_window.difftime <- function(x, y = NULL, ...) { if (!requireNamespace("hms", quietly = TRUE)) { abort("Package `hms` required.\nPlease install and try again.") } @@ -137,7 +145,7 @@ start.difftime <- function(x, y = NULL, ...) { } } -end.difftime <- function(x, y = NULL, ...) { +end_window.difftime <- function(x, y = NULL, ...) { if (is_null(y)) { hms::as_hms(max(x) + 1) } else { @@ -147,7 +155,7 @@ end.difftime <- function(x, y = NULL, ...) { } } -start.Date <- function(x, y = NULL, ...) { +start_window.Date <- function(x, y = NULL, ...) { if (is_null(y)) { min(x) } else { @@ -159,7 +167,7 @@ start.Date <- function(x, y = NULL, ...) { } } -end.Date <- function(x, y = NULL, ...) { +end_window.Date <- function(x, y = NULL, ...) { if (is_null(y)) { max(x) + period(1, "day") } else { @@ -185,7 +193,7 @@ end.Date <- function(x, y = NULL, ...) { } } -start.POSIXct <- function(x, y = NULL, ...) { +start_window.POSIXct <- function(x, y = NULL, ...) { if (is_null(y)) { min(x) } else { @@ -196,7 +204,7 @@ start.POSIXct <- function(x, y = NULL, ...) { } } -end.POSIXct <- function(x, y = NULL, ...) { +end_window.POSIXct <- function(x, y = NULL, ...) { if (is_null(y)) { max(x) + period(1, "second") } else { @@ -226,80 +234,80 @@ end.POSIXct <- function(x, y = NULL, ...) { } } -start.yearweek <- function(x, y = NULL, ...) { +start_window.yearweek <- function(x, y = NULL, ...) { wk_start <- week_start(x) x <- as_date(x) if (!is_null(y)) { abort_not_chr(y, class = "yearweek") y <- as.character(as_date(yearweek(y, week_start = wk_start))) } - yearweek(start(x = x, y = y), week_start = wk_start) + yearweek(start_window(x = x, y = y), week_start = wk_start) } -end.yearweek <- function(x, y = NULL, ...) { +end_window.yearweek <- function(x, y = NULL, ...) { wk_start <- week_start(x) x <- as_date(x) if (!is_null(y)) { abort_not_chr(y, class = "yearweek") y <- as.character(as_date(yearweek(y, week_start = wk_start))) } - yearweek(end(x = x, y = y), week_start = wk_start) + 1 + yearweek(end_window(x = x, y = y), week_start = wk_start) + 1 } -start.yearmonth <- function(x, y = NULL, ...) { +start_window.yearmonth <- function(x, y = NULL, ...) { x <- as_date(x) if (!is_null(y)) { abort_not_chr(y, class = "yearmonth") y <- as.character(as_date(yearmonth(y))) } - yearmonth(start(x = x, y = y)) + yearmonth(start_window(x = x, y = y)) } -end.yearmonth <- function(x, y = NULL, ...) { +end_window.yearmonth <- function(x, y = NULL, ...) { x <- as_date(x) if (!is_null(y)) { abort_not_chr(y, class = "yearmonth") y <- as.character(as_date(yearmonth(y))) } - yearmonth(end(x = x, y = y)) + 1 + yearmonth(end_window(x = x, y = y)) + 1 } -start.yearquarter <- function(x, y = NULL, ...) { +start_window.yearquarter <- function(x, y = NULL, ...) { x <- as_date(x) if (!is_null(y)) { abort_not_chr(y, class = "yearquarter") y <- as.character(as_date(yearquarter(y))) } - yearquarter(start(x = x, y = y)) + yearquarter(start_window(x = x, y = y)) } -end.yearquarter <- function(x, y = NULL, ...) { +end_window.yearquarter <- function(x, y = NULL, ...) { x <- as_date(x) if (!is_null(y)) { abort_not_chr(y, class = "yearquarter") y <- as.character(as_date(yearquarter(y))) } - yearquarter(end(x = x, y = y)) + 1 + yearquarter(end_window(x = x, y = y)) + 1 } -start.yearmon <- function(x, y = NULL, ...) { +start_window.yearmon <- function(x, y = NULL, ...) { x <- yearmonth(x) - start(x, y = y) + start_window(x, y = y) } -end.yearmon <- function(x, y = NULL, ...) { +end_window.yearmon <- function(x, y = NULL, ...) { x <- yearmonth(x) - end(x, y = y) + end_window(x, y = y) } -start.yearqtr <- function(x, y = NULL, ...) { +start_window.yearqtr <- function(x, y = NULL, ...) { x <- yearquarter(x) - start(x, y = y) + start_window(x, y = y) } -end.yearqtr <- function(x, y = NULL, ...) { +end_window.yearqtr <- function(x, y = NULL, ...) { x <- yearquarter(x) - end(x, y = y) + end_window(x, y = y) } is_dot_null <- function(x) { # x is a sym diff --git a/R/tsibble2ts.R b/R/tsibble2ts.R index 6974f348..14fdcf17 100644 --- a/R/tsibble2ts.R +++ b/R/tsibble2ts.R @@ -49,7 +49,7 @@ as.ts.tbl_ts <- function(x, value, frequency = NULL, fill = NA_real_, ...) { pivot_wider_ts <- function(data, frequency = NULL) { index <- index_var(data) df_rows <- data[[index]] - idx_time <- time(df_rows) + idx_time <- time_ts(df_rows) rows <- vec_unique(df_rows) key_rows <- key_rows(data) mvars <- measured_vars(data) @@ -69,34 +69,33 @@ pivot_wider_ts <- function(data, frequency = NULL) { ts(res, start(idx_time), frequency = frequency) } -#' @export -time.yearweek <- function(x, ...) { +time_ts <- function(x, ...) { + UseMethod("time_ts") +} + +time_ts.yearweek <- function(x, ...) { freq <- guess_frequency(x) y <- decimal_date(x) ts(y, start = min0(y), frequency = freq) } -#' @export -time.yearmonth <- function(x, ...) { +time_ts.yearmonth <- function(x, ...) { freq <- guess_frequency(x) y <- year(x) + (month(x) - 1) / freq ts(y, start = min0(y), frequency = freq) } -#' @export -time.yearquarter <- function(x, ...) { +time_ts.yearquarter <- function(x, ...) { freq <- guess_frequency(x) y <- year(x) + (quarter(x) - 1) / freq ts(y, start = min0(y), frequency = freq) } -#' @export -time.numeric <- function(x, ...) { +time_ts.numeric <- function(x, ...) { ts(x, start = min0(x), frequency = 1) } -#' @export -time.Date <- function(x, frequency = NULL, ...) { +time_ts.Date <- function(x, frequency = NULL, ...) { if (is.null(frequency)) { frequency <- guess_frequency(x) } @@ -104,8 +103,7 @@ time.Date <- function(x, frequency = NULL, ...) { ts(x, start = min0(y), frequency = frequency) } -#' @export -time.POSIXt <- function(x, frequency = NULL, ...) { +time_ts.POSIXt <- function(x, frequency = NULL, ...) { if (is.null(frequency)) { frequency <- guess_frequency(x) } diff --git a/tests/testthat/test-filter-index.R b/tests/testthat/test-filter-index.R index 7cdd8be2..4b58ec85 100644 --- a/tests/testthat/test-filter-index.R +++ b/tests/testthat/test-filter-index.R @@ -1,29 +1,29 @@ x <- c("2016", "2016-10", "2016-12-09") test_that("class: Date", { - expect_error(start(pedestrian$Date, 2017), "Must be") - expect_equal(start(pedestrian$Date), as.Date("2015-01-01")) + expect_error(start_window(pedestrian$Date, 2017), "Must be") + expect_equal(start_window(pedestrian$Date), as.Date("2015-01-01")) expect_equal( - start(pedestrian$Date, x), + start_window(pedestrian$Date, x), as.Date(c("2016-01-01", "2016-10-01", "2016-12-09")) ) - expect_equal(end(pedestrian$Date), as.Date("2017-01-01")) + expect_equal(end_window(pedestrian$Date), as.Date("2017-01-01")) expect_equal( - end(pedestrian$Date, x), + end_window(pedestrian$Date, x), as.Date(c("2017-01-01", "2016-11-01", "2016-12-10")) ) }) test_that("class: year*", { yrwk <- new_yearweek(unique(pedestrian$Date)) - expect_equal(start(yrwk), yearweek(as.Date("2015-01-01"))) + expect_equal(start_window(yrwk), yearweek(as.Date("2015-01-01"))) expect_equal( - start(yrwk, x), + start_window(yrwk, x), yearweek(as.Date(c("2015-12-28", "2016-09-26", "2016-12-05"))) ) - expect_equal(end(pedestrian$Date), as.Date("2017-01-01")) + expect_equal(end_window(pedestrian$Date), as.Date("2017-01-01")) expect_equal( - end(pedestrian$Date, x), + end_window(pedestrian$Date, x), as.Date(c("2017-01-01", "2016-11-01", "2016-12-10")) ) x <- yearquarter(c("2013 Q3", "2013 Qtr 3", "Quarter 4 2015")) @@ -33,7 +33,7 @@ test_that("class: year*", { test_that("class: yearweek with no-default week start #261", { yrwk <- new_yearweek(unique(pedestrian$Date), week_start = 7) - expect_equal(start(yrwk), yearweek(as.Date("2015-01-01"), week_start = 7)) + expect_equal(start_window(yrwk), yearweek(as.Date("2015-01-01"), week_start = 7)) }) si <- sessionInfo() @@ -45,18 +45,18 @@ tz <- "Australia/Melbourne" test_that("class: POSIXct", { skip_on_cran() - expect_error(start(pedestrian$Date_Time, 2017), "Must be") - expect_equal(start(pedestrian$Date_Time), ymd("2015-01-01", tz = tz)) + expect_error(start_window(pedestrian$Date_Time, 2017), "Must be") + expect_equal(start_window(pedestrian$Date_Time), ymd("2015-01-01", tz = tz)) expect_equal( - start(pedestrian$Date_Time, y), + start_window(pedestrian$Date_Time, y), ymd_hm( c("2016-01-01 00:00", "2016-10-01 00:00", "2016-12-09 00:00", "2016-12-09 10:00"), tz = tz ) ) - expect_equal(end(pedestrian$Date_Time), ymd_hms("2016-12-31 23:00:01", tz = tz)) + expect_equal(end_window(pedestrian$Date_Time), ymd_hms("2016-12-31 23:00:01", tz = tz)) expect_equal( - end(pedestrian$Date_Time, y), + end_window(pedestrian$Date_Time, y), ymd_hms( c("2017-01-01 00:00:00", "2016-11-01 00:00:00", "2016-12-10 00:00:00", "2016-12-09 10:00:01"), tz = tz @@ -66,12 +66,12 @@ test_that("class: POSIXct", { test_that("class: hms", { z <- hms::as_hms(unique(pedestrian$Date_Time)) - expect_error(start(z, y = 11), "Must be") - expect_equal(start(z), hms::as_hms("00:00:00")) - # expect_error(start(z, y = "11:00"), "cannot be expressed as difftime") - expect_equal(start(z, y = "11:00:00"), hms::as_hms("11:00:00")) - expect_equal(end(z), hms::as_hms("23:00:01")) - expect_equal(end(z, y = "21:00:00"), hms::as_hms("21:00:01")) + expect_error(start_window(z, y = 11), "Must be") + expect_equal(start_window(z), hms::as_hms("00:00:00")) + # expect_error(start_window(z, y = "11:00"), "cannot be expressed as difftime") + expect_equal(start_window(z, y = "11:00:00"), hms::as_hms("11:00:00")) + expect_equal(end_window(z), hms::as_hms("23:00:01")) + expect_equal(end_window(z, y = "21:00:00"), hms::as_hms("21:00:01")) }) test_that("filter_index()", { diff --git a/tests/testthat/test-tsibble2ts.R b/tests/testthat/test-tsibble2ts.R index 5f138d81..56cd52f6 100644 --- a/tests/testthat/test-tsibble2ts.R +++ b/tests/testthat/test-tsibble2ts.R @@ -82,8 +82,7 @@ test_that("as.ts.tbl_ts(fill = )", { test_that("time.* and guess_frequency.*", { dat <- seq(as.Date("2017-01-01"), as.Date("2017-01-31"), by = 1) - y <- time(dat) - expect_s3_class(y, "ts") + y <- time_ts(dat) expect_equal(frequency(y), 7) expect_equal(guess_frequency(dat), 7) dat_min <- seq(