Merge pull request #2 from ssi-dk:telkamp7/issue1

Rewrite the tsd function as an S3 Object

DESCRIPTION

@@ -24,12 +24,10 @@ Imports:
     base,
     dplyr,
     lifecycle,
-    lubridate,
     magrittr,
     purrr,
     rlang,
     stats,
-    tibble,
-    tsibble
+    tibble
 Config/Needs/website: rmarkdown
 VignetteBuilder: knitr

R/tsd.R

@@ -50,36 +50,18 @@ tsd <- function(observed, time, time_interval = c("day", "week", "month")) {
   # Throw an error if any of the inputs are not supported
   time_interval <- rlang::arg_match(time_interval)
 
-  # Select the correct 'time_interval' and create the 'tsd' return object
-  ans <- switch(time_interval,
-    day = tibble(time = time, observed = observed) %>%
-      tsibble::build_tsibble(
-        index = time,
-        interval = tsibble::new_interval(
-          day = 1
-        )
-      ) %>%
-      tsibble::fill_gaps() %>%
-      dplyr::mutate(periodInYear = lubridate::yday(time)),
-    week = tibble(time = tsibble::yearweek(time), observed = observed) %>%
-      tsibble::build_tsibble(
-        index = time,
-        interval = tsibble::new_interval(
-          week = 1
-        )
-      ) %>%
-      tsibble::fill_gaps() %>%
-      dplyr::mutate(periodInYear = lubridate::isoweek(time)),
-    month = tibble(time = tsibble::yearmonth(time), observed = observed) %>%
-      tsibble::build_tsibble(
-        index = time,
-        interval = tsibble::new_interval(
-          month = 1
-        )
-      ) %>%
-      tsibble::fill_gaps() %>%
-      dplyr::mutate(periodInYear = lubridate::month(time))
+  # Collect the input in a tibble
+  tbl <- tibble::tibble(
+    time = time,
+    observed = observed
   )
 
-  return(ans)
+  # Create the time series data object
+  tsd <- tibble::new_tibble(
+    x = tbl,
+    class = "aedseo_tsd",
+    time_interval = time_interval
+  )
+
+  return(tsd)
 }

tests/testthat/test-tsd.R

@@ -1,123 +1,9 @@
-test_that("'tsd' handle implicit missingnes by inserting NA", {
+test_that("Can correctly make an 'aedseo_tsd' class object", {
   tsd_day <- tsd(
     observed = c(10, 15, 20, 18),
     time = as.Date(c("2023-01-01", "2023-01-02", "2023-01-03", "2023-01-05")),
     time_interval = "day"
-  ) %>%
-    dplyr::reframe(sumNA = sum(is.na(observed)))
-  tsd_week <- tsd(
-    observed = c(10, 15, 20, 18),
-    time = as.Date(c("2023-01-01", "2023-01-08", "2023-01-15", "2023-01-29")),
-    time_interval = "week"
-  ) %>%
-    dplyr::reframe(sumNA = sum(is.na(observed)))
-  tsd_month <- tsd(
-    observed = c(10, 15, 20, 18),
-    time = as.Date(c("2023-01-01", "2023-02-01", "2023-03-01", "2023-05-01")),
-    time_interval = "month"
-  ) %>%
-    dplyr::reframe(sumNA = sum(is.na(observed)))
-  expect_true(
-    tsd_day$sumNA > 0
-  )
-  expect_true(
-    tsd_week$sumNA > 0
-  )
-  expect_true(
-    tsd_month$sumNA > 0
-  )
-})
-test_that("'tsd' does not have gaps", {
-  tsd_day <- tsd(
-    observed = c(10, 15, 20, 18),
-    time = as.Date(c("2023-01-01", "2023-01-02", "2023-01-03", "2023-01-05")),
-    time_interval = "day"
-  )
-  tsd_week <- tsd(
-    observed = c(10, 15, 20, 18),
-    time = as.Date(c("2023-01-01", "2023-01-08", "2023-01-15", "2023-01-29")),
-    time_interval = "week"
-  )
-  tsd_month <- tsd(
-    observed = c(10, 15, 20, 18),
-    time = as.Date(c("2023-01-01", "2023-02-01", "2023-03-01", "2023-05-01")),
-    time_interval = "month"
-  )
-  expect_false(
-    tsibble::has_gaps(tsd_day)$.gaps
-  )
-  expect_false(
-    tsibble::has_gaps(tsd_week)$.gaps
-  )
-  expect_false(
-    tsibble::has_gaps(tsd_month)$.gaps
-  )
-})
-test_that("'tsd' correctly identifies intervals", {
-  tsd_1day <- tsd(
-    observed = 10,
-    time = as.Date("2023-01-01"),
-    time_interval = "day"
-  ) %>%
-    attr(
-      which = "interval"
-    )
-  tsd_day <- tsd(
-    observed = c(10, 15, 20, 18),
-    time = as.Date(c("2023-01-01", "2023-01-02", "2023-01-03", "2023-01-05")),
-    time_interval = "day"
-  ) %>%
-    attr(
-      which = "interval"
-    )
-  tsd_1week <- tsd(
-    observed = 10,
-    time = as.Date("2023-01-01"),
-    time_interval = "week"
-  ) %>%
-    attr(
-      which = "interval"
-    )
-  tsd_week <- tsd(
-    observed = c(10, 15, 20, 18),
-    time = as.Date(c("2023-01-01", "2023-01-08", "2023-01-15", "2023-01-29")),
-    time_interval = "week"
-  ) %>%
-    attr(
-      which = "interval"
-    )
-  tsd_1month <- tsd(
-    observed = 10,
-    time = as.Date("2023-01-01"),
-    time_interval = "month"
-  ) %>%
-    attr(
-      which = "interval"
-    )
-  tsd_month <- tsd(
-    observed = c(10, 15, 20, 18),
-    time = as.Date(c("2023-01-01", "2023-02-01", "2023-03-01", "2023-05-01")),
-    time_interval = "month"
-  ) %>%
-    attr(
-      which = "interval"
-    )
-  expect_true(
-    tsd_1day == tsibble::new_interval(day = 1)
-  )
-  expect_true(
-    tsd_1week == tsibble::new_interval(week = 1)
-  )
-  expect_true(
-    tsd_1month == tsibble::new_interval(month = 1)
-  )
-  expect_true(
-    tsd_day == tsibble::new_interval(day = 1)
-  )
-  expect_true(
-    tsd_week == tsibble::new_interval(week = 1)
-  )
-  expect_true(
-    tsd_month == tsibble::new_interval(month = 1)
   )
+
+  expect_s3_class(object = tsd_day, class = "aedseo_tsd")
 })

vignettes/aedseo_introduction.Rmd

@@ -17,7 +17,6 @@ knitr::opts_chunk$set(
 ```{r setup}
 library(aedseo)
 library(tibble)
-library(tsibble)
 library(tidyr)
 library(dplyr)
 library(ggplot2)
@@ -147,10 +146,10 @@ sim_data %>%
 
 ## Applying the algorithm
 
-In the following section, the application of the algorithm to the simulated data is outlined. The first step is to transform the simulated data into a `tsibble` object using the `tsd()` function.
+In the following section, the application of the algorithm to the simulated data is outlined. The first step is to transform the simulated data into a `aedseo_tsd` object using the `tsd()` function.
 
 ```{r}
-# Construct a 'tsibble' object with the time series data
+# Construct an 'aedseo_tsd' object with the time series data
 tsd_data <- tsd(
   observed = simulation$simulation,
   time = dates,