Refactor 'sum_time()'

DESCRIPTION

@@ -68,4 +68,4 @@ Encoding: UTF-8
 Language: en-US
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.1.1
+RoxygenNote: 7.1.2

NAMESPACE

@@ -59,6 +59,7 @@ export(sjl_weighted)
 export(sloss_week)
 export(so)
 export(sum_time)
+export(sum_times)
 export(tbt)
 importFrom(dplyr,"%>%")
 importFrom(dplyr,across)

NEWS.md

@@ -17,6 +17,7 @@
 * `round_time()` is now a S3 generic.
 * `shortest_interval()` was renamed to `shorter_interval()`.
 * `shorter_interval()` will now return only `Interval` objects.
+* `sum_time()` now have different arguments and was divided in two functions: `sum_time()` (for non-vectorized sums) and `sum_times()` (for vectorized sums).
 * Several functions were optimized.
 * The test suite was optimized.
 

R/gu.R

@@ -92,5 +92,5 @@ gu <- function(se, si) {
     assert_duration(si)
     assert_identical(se, si, type = "length")
 
-    sum_time(se, si, class = "hms", circular = TRUE, vectorize = TRUE)
+    sum_times(se, si, cycle = lubridate::ddays())
 }

R/ms.R

@@ -97,7 +97,7 @@ ms <- function(so, sd) {
     assert_duration(sd)
     assert_identical(so, sd, type = "length")
 
-    sum_time(so, (sd / 2), class = "hms", circular = TRUE, vectorize = TRUE)
+    sum_times(so, (sd / 2), cycle = lubridate::ddays())
 }
 
 #' Compute MCTQ corrected local time of mid-sleep on work-free days
@@ -290,14 +290,14 @@ msf_sc <- function(msf, sd_w, sd_f, sd_week, alarm_f) {
     ## `sc` exists to remove unnecessary warnings of the lubridate package when
     ## subtracting objects of class `Duration`.
 
-    sc <- sum_time(sd_f, - sd_week, class = "Duration", vectorize = TRUE)
+    sc <- sum_times(sd_f, - sd_week, cycle = lubridate::ddays()) %>%
+        lubridate::as.duration()
     sc <- sc / 2
 
     dplyr::case_when(
         alarm_f == TRUE ~ hms::as_hms(NA),
         sd_f <= sd_w ~ msf,
-        sd_f > sd_w ~ sum_time(msf, - sc, class = "hms",
-                               circular = TRUE, vectorize = TRUE)
+        sd_f > sd_w ~ sum_times(msf, - sc, cycle = lubridate::ddays())
     )
 }
 

R/random_mctq.R

@@ -436,7 +436,7 @@ random_shift_mctq <- function(n_w = c(n_w_m = 6, n_w_e = 4, n_w_n = 6),
     for (i in c("bt_w_m", "bt_w_e", "bt_w_n", "bt_f_m", "bt_f_e", "bt_f_n")) {
         sample <- sample_time(min = min, max = max, by = by, prob = prob)
         name <- paste0("sprep_", str_extract_(i, "._.$"))
-        assign(i, sum_time(get(name), - sample, circular = TRUE))
+        assign(i, sum_time(get(name), - sample, cycle = lubridate::ddays()))
     }
 
     # Create `slat_w_*` and `slat_f_*` -----
@@ -510,7 +510,7 @@ random_shift_mctq <- function(n_w = c(n_w_m = 6, n_w_e = 4, n_w_n = 6),
         se_w_m = list(
             name = "se_w_m",
             min = sum_time(sprep_w_m, slat_w_m, hms::parse_hm("02:05"),
-                           circular = TRUE),
+                           cycle = lubridate::ddays()),
             max = hms::parse_hm("05:00"), # Changed
             mean = hms::parse_hm("04:35"),
             sd = hms::parse_hm("00:35")),
@@ -521,7 +521,7 @@ random_shift_mctq <- function(n_w = c(n_w_m = 6, n_w_e = 4, n_w_n = 6),
         se_w_e = list(
             name = "se_w_e",
             min = sum_time(sprep_w_e, slat_w_e, hms::parse_hm("03:40"),
-                           circular = TRUE),
+                           cycle = lubridate::ddays()),
             max = hms::parse_hm("12:25"),
             mean = hms::parse_hm("08:25"),
             sd = hms::parse_hm("01:20")),
@@ -532,7 +532,7 @@ random_shift_mctq <- function(n_w = c(n_w_m = 6, n_w_e = 4, n_w_n = 6),
         se_w_n = list(
             name = "se_w_n",
             min = sum_time(sprep_w_n, slat_w_n, hms::parse_hm("02:00"), # Chan.
-                           circular = TRUE),
+                           cycle = lubridate::ddays()),
             max = hms::parse_hm("18:05"),
             mean = hms::parse_hm("13:30"),
             sd = hms::parse_hm("01:30")),
@@ -678,7 +678,7 @@ random_shift_mctq <- function(n_w = c(n_w_m = 6, n_w_e = 4, n_w_n = 6),
                 "nape_f_n")) {
         name <- get(paste0("napo_", str_extract_(i, "._.$")))
         sample <- sample_time(min = min, max = max, by = by, prob = prob)
-        assign(i, sum_time(name, sample, circular = TRUE))
+        assign(i, sum_time(name, sample, cycle = lubridate::ddays()))
     }
 
     # Create `nap_w_*` and `nap_f_*` -----

R/sd.R

@@ -102,7 +102,8 @@ sdu <- function(so, se) {
     checkmate::assert_class(se, "hms")
     assert_identical(so, se, type = "length")
 
-    sum_time(se, - so, class = "Duration", circular = TRUE, vectorize = TRUE)
+    sum_times(se, - so, cycle = lubridate::ddays()) %>%
+        lubridate::as.duration()
 }
 
 #' Compute MCTQ nap duration (only for MCTQ\eqn{^{Shift}}{ Shift})
@@ -188,8 +189,8 @@ napd <- function(napo, nape) {
     checkmate::assert_class(nape, "hms")
     assert_identical(napo, nape, type = "length")
 
-    sum_time(nape, - napo, class = "Duration", circular = TRUE,
-             vectorize = TRUE)
+    sum_times(nape, - napo, cycle = lubridate::ddays()) %>%
+        lubridate::as.duration()
 }
 
 #' Compute MCTQ 24 hours sleep duration (only for MCTQ\eqn{^{Shift}}{ Shift})
@@ -300,8 +301,7 @@ sd24 <- function(sd, napd, nap) {
 
     dplyr::case_when(
         nap == FALSE ~ sd,
-        TRUE ~ sum_time(sd, napd, class = "Duration", circular = FALSE,
-                        vectorize = TRUE)
+        TRUE ~ lubridate::as.duration(sum_times(sd, napd))
     )
 }
 

R/sjl.R

@@ -217,8 +217,8 @@ sjl <- function(msw, msf, abs = TRUE, method = "shorter") {
     assert_identical(msw, msf, type = "length")
 
     if (method == "difference") {
-        out <- sum_time(msf, - msw, class = "Duration", circular = FALSE,
-                 vectorize = TRUE)
+        out <- sum_times(msf, - msw) %>%
+            lubridate::as.duration()
     } else {
         if (method == "shorter") {
             interval <- shush(shorter_interval(msw, msf))

R/sloss_week.R

@@ -108,8 +108,8 @@ sloss_week <- function(sd_w, sd_f, wd) {
 
     wd <- as.integer(wd)
     sd_week <- sd_week(sd_w, sd_f, wd)
-    sum_1 <- sum_time(sd_week, - sd_w, class = "Duration", vectorize = TRUE)
-    sum_2 <- sum_time(sd_week, - sd_f, class = "Duration", vectorize = TRUE)
+    sum_1 <- sum_times(sd_week, - sd_w) %>% lubridate::as.duration()
+    sum_2 <- sum_times(sd_week, - sd_f) %>% lubridate::as.duration()
 
     dplyr::case_when(
         sd_week > sd_w ~ sum_1 * wd,

R/so.R

@@ -104,5 +104,5 @@ so <- function(sprep, slat) {
     assert_duration(slat)
     assert_identical(sprep, slat, type = "length")
 
-    sum_time(sprep, slat, class = "hms", circular = TRUE, vectorize = TRUE)
+    sum_times(sprep, slat, cycle = lubridate::ddays())
 }