fix/feat: add as.double methods for int_period to match as.integer

Author: TimTaylor

pkg/NAMESPACE

@@ -108,6 +108,7 @@ S3method(as.data.frame,grates_year)
 S3method(as.data.frame,grates_yearmonth)
 S3method(as.data.frame,grates_yearquarter)
 S3method(as.data.frame,grates_yearweek)
+S3method(as.double,grates_int_period)
 S3method(as.double,grates_isoweek)
 S3method(as.double,grates_year)
 S3method(as.double,grates_yearmonth)

pkg/NEWS.md

@@ -1,5 +1,12 @@
 # grates (development version)
 
+## breaking change
+
+* `as.double()` for `<grates_int_period>` objects now returns the same result
+  (subject to type) as `as.integer()`. Both return the lower bound of related
+  interval. Note that `<grates_int_period>` objects should still be treated 
+  as experimental for the time being.
+
 # grates 1.7.2
 
 * Small updates to the vignette's css and js.

pkg/R/int_period-class.R

@@ -282,6 +282,14 @@ as.integer.grates_int_period <- function(x, ...) {
     as.integer(x * n)
 }
 
+# -------------------------------------------------------------------------
+#' @export
+as.double.grates_int_period <- function(x, ...) {
+    n <- attr(x, "n")
+    x <- unclass(x)
+    as.double(x * n)
+}
+
 # -------------------------------------------------------------------------
 #' @export
 as.Date.grates_int_period <- function(x, ...) {

pkg/R/int_period-scale.R

@@ -129,11 +129,11 @@ scale_type.grates_int_period <- function(x) {
     # breaks function
     brks <- function(x) {
         if (inherits(breaks, "waiver")) {
-            dat <- scales::breaks_pretty(n.breaks)(as.numeric(x))
+            dat <- scales::breaks_pretty(n.breaks)(as.numeric(unclass(x)))
             dat <- as.integer(floor(dat))
-            dat <- as.numeric(new_int_period(dat, n = n))
+            dat <- as.numeric(unclass(new_int_period(dat, n = n)))
         } else {
-            dat <- as.numeric(breaks)
+            dat <- as.numeric(unclass(breaks))
         }
         dat - shift
     }
@@ -151,8 +151,8 @@ scale_type.grates_int_period <- function(x) {
 
     scales::trans_new(
         "grates_int_period",
-        transform = as.numeric,
-        inverse = as.numeric,
+        transform = function(x) as.numeric(unclass(x)),
+        inverse = function(x) as.numeric(unclass(x)),
         breaks = brks,
         format = fmt
     )

pkg/R/utils.R

@@ -31,7 +31,7 @@ stopf <- function(fmt, ..., .use_call = TRUE, .call = sys.call(-1L)) {
     grates_classes <- c(
         "grates_yearweek" , "grates_isoweek", "grates_epiweek",
         "grates_yearmonth", "grates_month"  , "grates_yearquarter",
-        "grates_year"     , "grates_period"
+        "grates_year"     , "grates_period" , "grates_int_period"
     )
     # nolint end
 

pkg/tests/testthat/test-int_period.R

@@ -28,6 +28,8 @@ test_that("int_period, negative values work", {
     dates2 <- seq.int(from = -7 * 30 - 28, length.out = 4, by = 7)
     expect_identical(as.integer(as_int_period(dates, n = 7)), dates)
     expect_identical(as.integer(as_int_period(dates, n = 7) - 4), dates2)
+    expect_identical(as.double(as_int_period(dates, n = 7)), as.double(dates))
+    expect_identical(as.double(as_int_period(dates, n = 7) - 4), as.double(dates2))
 })
 
 test_that("as_int_period, misc errors and warnings", {