feat: add get_interval_duration()

Author: TimTaylor

pkg/NAMESPACE

@@ -198,6 +198,16 @@ S3method(get_firstday,grates_yearweek_sunday)
 S3method(get_firstday,grates_yearweek_thursday)
 S3method(get_firstday,grates_yearweek_tuesday)
 S3method(get_firstday,grates_yearweek_wednesday)
+S3method(get_interval_duration,default)
+S3method(get_interval_duration,grates_epiweek)
+S3method(get_interval_duration,grates_int_period)
+S3method(get_interval_duration,grates_isoweek)
+S3method(get_interval_duration,grates_month)
+S3method(get_interval_duration,grates_period)
+S3method(get_interval_duration,grates_year)
+S3method(get_interval_duration,grates_yearmonth)
+S3method(get_interval_duration,grates_yearquarter)
+S3method(get_interval_duration,grates_yearweek)
 S3method(get_n,default)
 S3method(get_n,grates_int_period)
 S3method(get_n,grates_month)
@@ -343,6 +353,7 @@ export(date_end)
 export(date_start)
 export(epiweek)
 export(get_firstday)
+export(get_interval_duration)
 export(get_n)
 export(get_offset)
 export(get_week)

pkg/NEWS.md

@@ -1,5 +1,16 @@
 # grates (development version)
 
+* New function `get_interval_duration()` which returns the number of days
+  covered by an element of a grates object, e.g. the following is TRUE
+  
+  ```
+  identical(
+      get_interval_duration(yearmonth(2020, 1:3)),
+      c(31, 29, 31)
+  )
+  ```
+    
+
 ## breaking change
 
 * `as.double()` for `<grates_int_period>` objects now returns the same result

pkg/R/accessors.R

@@ -207,3 +207,68 @@ get_offset.default <- function(x, ...) {
 get_offset.grates_period <- function(x, ...) {
     attr(x, "offset")
 }
+
+# -------------------------------------------------------------------------
+#' @name grouped_date_accessors
+#' @export
+get_interval_duration <- function(x, ...) {
+    UseMethod("get_interval_duration")
+}
+
+# -------------------------------------------------------------------------
+#' @rdname grouped_date_accessors
+#' @export
+get_interval_duration.default <- function(x, ...) {
+    stopf("Not implemented for class [%s].", toString(class(x)))
+}
+
+# -------------------------------------------------------------------------
+#' @rdname grouped_date_accessors
+#' @export
+get_interval_duration.grates_yearweek <- function(x, ...) {
+    rep(7, length(x))
+}
+
+# -------------------------------------------------------------------------
+#' @rdname grouped_date_accessors
+#' @export
+get_interval_duration.grates_int_period <- function(x, ...) {
+    rep(attr(x, "n"), length(x))
+}
+
+# -------------------------------------------------------------------------
+#' @rdname grouped_date_accessors
+#' @export
+get_interval_duration.grates_isoweek <- get_interval_duration.grates_yearweek
+
+# -------------------------------------------------------------------------
+#' @rdname grouped_date_accessors
+#' @export
+get_interval_duration.grates_epiweek <- get_interval_duration.grates_yearweek
+
+# -------------------------------------------------------------------------
+#' @rdname grouped_date_accessors
+#' @export
+get_interval_duration.grates_yearmonth <- function(x, ...) {
+    as.double(as.Date(x + 1) - as.Date(x), units = "days")
+}
+
+# -------------------------------------------------------------------------
+#' @rdname grouped_date_accessors
+#' @export
+get_interval_duration.grates_month <- get_interval_duration.grates_yearmonth
+
+# -------------------------------------------------------------------------
+#' @rdname grouped_date_accessors
+#' @export
+get_interval_duration.grates_yearquarter <- get_interval_duration.grates_yearmonth
+
+# -------------------------------------------------------------------------
+#' @rdname grouped_date_accessors
+#' @export
+get_interval_duration.grates_year <- get_interval_duration.grates_yearmonth
+
+# -------------------------------------------------------------------------
+#' @rdname grouped_date_accessors
+#' @export
+get_interval_duration.grates_period <- get_interval_duration.grates_int_period

pkg/man/grouped_date_accessors.Rd

@@ -314,3 +314,14 @@ test_that("epiweek boundary functions work", {
     expect_identical(date_start(weeks), starts)
     expect_identical(date_end(weeks), ends)
 })
+
+test_that("epiweek get_interval_duration works", {
+    dates <- as.Date("2020-01-01") + 0:14
+    weeks <- as_epiweek(dates)
+    expect_identical(
+        get_interval_duration(weeks),
+        expected = rep(7, length(dates))
+    )
+})
+
+

pkg/tests/testthat/test-epiweek.R

@@ -255,3 +255,11 @@ test_that("int_period, miscellaneous work", {
     )
     expect_false(is.numeric(new_int_period(1)))
 })
+
+test_that("int_period get_interval_duration works", {
+    dates <- as_int_period(0:14, 3)
+    expect_identical(
+        get_interval_duration(dates),
+        expected = rep(3L, length(dates))
+    )
+})

pkg/tests/testthat/test-int_period.R

@@ -313,3 +313,12 @@ test_that("isoweek boundary functions work", {
     expect_identical(date_start(weeks), starts)
     expect_identical(date_end(weeks), ends)
 })
+
+test_that("isoweek get_interval_duration works", {
+    dates <- as.Date("2020-01-01") + 0:14
+    weeks <- as_isoweek(dates)
+    expect_identical(
+        get_interval_duration(weeks),
+        expected = rep(7, length(dates))
+    )
+})

pkg/tests/testthat/test-isoweek.R

@@ -319,3 +319,11 @@ test_that("month boundary functions work", {
     expect_identical(date_start(months), starts)
     expect_identical(date_end(months), ends)
 })
+
+test_that("month get_interval_duration works", {
+    dates <- c(fastymd::fymd(2020,seq(1,12,2),1), fastymd::fymd(2021,seq(1,12,2),1))
+    months <- as_month(dates, n = 2)
+    leap   <- c(31 + 29, 31 + 30, 31 + 30, 31 + 31, 30 + 31, 30 + 31)
+    normal <- c(31 + 28, 31 + 30, 31 + 30, 31 + 31, 30 + 31, 30 + 31)
+    expect_identical(get_interval_duration(months), c(leap,normal))
+})

pkg/tests/testthat/test-month.R

@@ -427,3 +427,12 @@ test_that("period, character offset works", {
     dat <- as_period(dates, n = 2, offset = "2020-01-02")
     expect_identical(as_period(dates, n = 2), expected = dat)
 })
+
+test_that("period get_interval_duration works", {
+    dates <- as.Date("2020-01-01") + (0:61)
+    dat <- as_period(dates, n = 2, offset = "2020-01-01")
+    expect_identical(
+        get_interval_duration(dat),
+        expected = rep(2L, length(dates))
+    )
+})

pkg/tests/testthat/test-period.R

@@ -272,3 +272,10 @@ test_that("year boundary functions work", {
     expect_identical(date_start(years), starts)
     expect_identical(date_end(years), ends)
 })
+
+test_that("year get_interval_duration works", {
+    years <- grates::year(2020:2021)
+    leap   <- c(31 + 29 + 31 + 30 + 31 + 30 + 31 + 31 + 30 + 31 + 30 + 31)
+    normal <- c(31 + 28 + 31 + 30 + 31 + 30 + 31 + 31 + 30 + 31 + 30 + 31)
+    expect_identical(get_interval_duration(years), c(leap, normal))
+})