Add new tests and fix examples

ropensci · Feb 11, 2021 · d8e99bb · d8e99bb
1 parent 231a72e
commit d8e99bb
Show file tree

Hide file tree

Showing 68 changed files with 1,704 additions and 476 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -10,12 +10,12 @@ Authors@R:
       person(given = "Ana Amelia",
              family = "Benedito-Silva",
              email = "aamelia@usp.br",
-             role = c("aut", "exp", "sad"),
+             role = c("aut", "sad"),
              comment = c(ORCID = "0000-0003-4976-2623")),
       person(given = "Mario",
              family = "Pedrazzoli",
              email = "pedrazzo@usp.br",
-             role = c("aut", "exp", "sad"),
+             role = c("aut", "sad"),
              comment = c(ORCID = "0000-0002-5257-591X")),
       person(given = "GIPSO",
              role = c("fnd", "cph")),
@@ -32,19 +32,21 @@ LazyData: true
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.1.1
 Depends:
-    hms,
-    lubridate,
     R (>= 3.6)
 Imports: 
     checkmate,
     dplyr,
-    lifecycle
+    hms,
+    lifecycle,
+    lubridate
 Suggests:
     covr,
     crayon,
+    datasets,
     ggplot2,
     grDevices,
     knitr,
+    mockr,
     rmarkdown,
     spelling,
     stats,

diff --git a/NAMESPACE b/NAMESPACE
@@ -47,3 +47,4 @@ importFrom(dplyr,across)
 importFrom(hms,hms)
 importFrom(lifecycle,deprecate_soft)
 importFrom(lubridate,duration)
+importFrom(lubridate,period)
diff --git a/R/assign_date.R b/R/assign_date.R
@@ -1,10 +1,10 @@
-#' Assign dates to two sequential hour values
+#' Assign dates to two sequential hours
 #'
 #' @description
 #'
 #' `r lifecycle::badge("maturing")`
 #'
-#' `assign_date()` assign dates to two sequential hour values. It can facilitate
+#' `assign_date()` assign dates to two sequential hours. It can facilitate
 #' time arithmetic by locating time values without date reference on a
 #' timeline.
 #'
@@ -94,7 +94,30 @@
 #' @export
 #'
 #' @examples
-#' ## __ To return `start` and `end` as interval __
+#' ## __ Scalar example __
+#' start <- hms::parse_hms("23:11:00")
+#' end <- hms::parse_hms("05:30:00")
+#' assign_date(start, end)
+#' #> [1] 1970-01-01 23:11:00 UTC--1970-01-02 05:30:00 UTC # Expected
+#'
+#' start <- hms::parse_hms("10:15:00")
+#' end <- hms::parse_hms("13:25:00")
+#' assign_date(start, end)
+#' #> [1] 1970-01-01 10:15:00 UTC--1970-01-01 13:25:00 UTC # Expected
+#'
+#' start <- hms::parse_hms("05:42:00")
+#' end <- hms::as_hms(NA)
+#' assign_date(start, end)
+#' #> [1] NA--NA # Expected
+#'
+#' ## __ Vector example __
+#' start <- c(hms::parse_hms("09:45:00"), hms::parse_hms("20:30:00"))
+#' end <- c(hms::parse_hms("21:15:00"), hms::parse_hms("04:30:00"))
+#' assign_date(start, end)
+#' #> [1] 1970-01-01 09:45:00 UTC--1970-01-01 21:15:00 UTC # Expected
+#' #> [2] 1970-01-01 20:30:00 UTC--1970-01-02 04:30:00 UTC # Expected
+#'
+#' ## __ To return `start` and `end` as interval (default)__
 #' start <- hms::parse_hms("12:34:00")
 #' end <- hms::parse_hms("01:25:00")
 #' assign_date(start, end)
@@ -110,11 +133,13 @@
 #' #> $end # Expected
 #' #> [1] "1970-01-02 00:00:01 UTC" # Expected
 #'
-#' ## __ To return only the `start` output __
+#' ## __ To return only `start` or `end` __
 #' start <- lubridate::parse_date_time("01:10:00", "HMS")
 #' end <- lubridate::parse_date_time("11:45:00", "HMS")
 #' assign_date(start, end, return = "start")
 #' #> [1] "1970-01-01 01:10:00 UTC" # Expected
+#' assign_date(start, end, return = "end")
+#' #> [1] "1970-01-01 11:45:00 UTC" # Expected
 #'
 #' ## __ To assign a 24h interval to ambiguities __
 #' start <- lubridate::as_datetime("1985-01-15 12:00:00")
@@ -130,6 +155,10 @@ assign_date <- function(start, end, return = "interval", ambiguity = 0,
     checkmate::assert_multi_class(start, c("hms", "POSIXct", "POSIXlt"))
     checkmate::assert_multi_class(end, c("hms", "POSIXct", "POSIXlt"))
     assert_identical(start, end, type = "length")
+    checkmate::assert_numeric(as.numeric(hms::as_hms(start)),
+                              lower = 0, upper = 86400)
+    checkmate::assert_numeric(as.numeric(hms::as_hms(end)),
+                              lower = 0, upper = 86400)
     checkmate::assert_choice(return, c("list", "interval", "start", "end"))
     checkmate::assert_choice(ambiguity, c(0, 24 , NA))
     checkmate::assert_string(start_name)

diff --git a/R/convert.R b/R/convert.R
@@ -209,7 +209,7 @@
 #' O'Reilly Media. Retrieved from <https://r4ds.had.co.nz>.
 #'
 #' @examples
-#' ## __ Conversion from date/time objects to units __
+#' ## __ Converting from date/time objects to units __
 #' convert(lubridate::dhours(), "numeric", output_unit = "M")
 #' #> [1] 60 # Expected
 #' convert(lubridate::days(), "numeric", output_unit = "rad")
@@ -225,7 +225,7 @@
 #' convert_tu(hms::parse_hm("15:45:00"), "H") # Wrapper function
 #' #> [1] 15.75 # Expected
 #'
-#' ## __ Conversion from units to date/time objects __
+#' ## __ Converting from units to date/time objects __
 #' convert(360, "Period", input_unit = "deg")
 #' #> [1] "1d 0H 0M 0S" # Expected
 #' convert(6.5, "Posixct", input_unit = "H")
@@ -239,7 +239,7 @@
 #' convert_ut(1.308997, "Duration", "rad") # Wrapper function
 #' #> [1] "18000s (~5 hours)" # Expected
 #'
-#' ## __ Conversion between date/time objects __
+#' ## __ Converting between date/time objects __
 #' convert(lubridate::dseconds(120), "hms")
 #' #> 00:02:00 # Expected
 #' convert(hms::as_hms("13:45:05"), "POSIXct")
@@ -254,7 +254,7 @@
 #' convert_tt(x, "Duration") # Wrapper function
 #' #> [1] "45065s (~12.52 hours)" # Expected
 #'
-#' ## __ Conversion between units __
+#' ## __ Converting between units __
 #' convert(1.308997, "numeric", input_unit = "rad", output_unit = "H")
 #' #> [1] 5 # Expected
 #' convert(60, "numeric", input_unit = "deg", output_unit = "rad")
@@ -268,7 +268,7 @@
 #' convert_uu(40, "d", "deg") # Wrapper function
 #' #> [1] 14400 # Expected
 #'
-#' ## __ Conversion from character or numeric objects to date/time objects __
+#' ## __ Converting from character or numeric objects to date/time objects __
 #' convert("19:55:17", "Duration", orders = "HMS")
 #' #> [1] "71717s (~19.92 hours)" # Expected
 #' convert("21:00", "Period", orders = "HM")
@@ -288,7 +288,7 @@
 #' convert_pt("03/07/1982 13:00", "POSIXlt", "dmy HM") # Wrapper function
 #' #> [1] "1982-07-03 13:00:00 UTC" # Expected
 #'
-#' ## __ Conversion from character or numeric objects to units __
+#' ## __ Converting from character or numeric objects to units __
 #' convert("0145", "numeric", orders = "HM", output_unit = "M")
 #' #> [1] 105 # Expected
 #' convert(45, "numeric", orders = "M", output_unit = "H")
@@ -302,7 +302,7 @@
 #' convert_pu("01:00", "HM", "rad") # Wrapper function
 #' #> [1] 0.2617994 # Expected
 #'
-#' ## __ Conversion of columns of a data frame __
+#' ## __ Converting columns of a data frame __
 #' \dontrun{
 #' out <- convert(datasets::mtcars, "posixct", cols = c("cyl", "carb"),
 #'                   orders = "H")
@@ -366,9 +366,6 @@ convert.character <- function(x, class, ..., orders = NULL, tz = "UTC",
                                  ignore_date = ignore_date,
                                  close_round = close_round,
                                  quiet = quiet)
-
-            if (class %in% "integer") return(as.integer(x))
-            if (class %in% c("double", "numeric")) return(x)
         } else if (!is.null(input_unit) && check &&
                    !(class %in% c("integer", "double", "numeric"))) {
             return(convert_to_date_time(shush(as.numeric(x)),
@@ -456,8 +453,6 @@ convert.character <- function(x, class, ..., orders = NULL, tz = "UTC",
             x <- as.POSIXlt(x)
             lubridate::force_tz(x, tz = tz)
         }
-    } else {
-        stop("Critical error.", call. = FALSE)
     }
 
 }
@@ -524,8 +519,6 @@ convert.Duration <- function(x, class, ..., tz = "UTC", output_unit = NULL,
     } else if (class == "posixlt") {
         x <- as.POSIXlt(hms::as_hms(as.numeric(x)))
         lubridate::force_tz(x, tz = tz)
-    } else {
-        stop("Critical error.", call. = FALSE)
     }
 
 }
@@ -601,8 +594,6 @@ convert.hms <- function(x, class, ..., tz = "UTC", output_unit = NULL,
     } else if (class == "posixlt") {
         x <- as.POSIXlt(hms::as_hms(x))
         lubridate::force_tz(x, tz = tz)
-    } else {
-        stop("Critical error.", call. = FALSE)
     }
 
 }
@@ -653,8 +644,6 @@ convert.Date <- function(x, class, ..., tz = "UTC", output_unit = NULL,
         lubridate::force_tz(lubridate::as_datetime(x), tz = tz)
     } else if (class == "posixlt") {
         as.POSIXlt(lubridate::force_tz(lubridate::as_datetime(x), tz = tz))
-    } else {
-        stop("Critical error.", call. = FALSE)
     }
 
 }
@@ -703,8 +692,6 @@ convert.POSIXt <- function(x, class, ..., tz = "UTC", output_unit = NULL,
         lubridate::force_tz(as.POSIXct(x), tz = tz)
     } else if (class == "posixlt") {
         lubridate::force_tz(as.POSIXlt(x), tz = tz)
-    } else {
-        stop("Critical error.", call. = FALSE)
     }
 
 }
@@ -754,8 +741,6 @@ convert.Interval <- function(x, class, ..., tz = "UTC", output_unit = NULL,
     } else if (class == "posixlt") {
         x <- as.POSIXlt(hms::as_hms(as.numeric(x)))
         lubridate::force_tz(x, tz = tz)
-    } else {
-        stop("Critical error.", call. = FALSE)
     }
 
 }
@@ -795,8 +780,6 @@ convert.data.frame <- function(x, class, ..., cols = NULL, where = NULL,
     } else if (!is.null(cols)) {
         out <- dplyr::mutate(x, dplyr::across(cols, call))
         invisible(out)
-    } else {
-        stop("Critical error.", call. = FALSE)
     }
 
 }
@@ -1121,8 +1104,6 @@ convert_to_unit <- function(x, input_unit = NULL, output_unit = "H",
         x <- x * rad_second
     } else if (output_unit == "deg") {
         x <- x * deg_second
-    } else {
-        stop("Critical error.", call. = FALSE)
     }
 
     if (isTRUE(close_round)) {

diff --git a/R/fd.R b/R/fd.R
@@ -32,8 +32,15 @@
 #' @export
 #'
 #' @examples
+#' ## __ Scalar example __
 #' fd(5)
 #' #> [1] 2 # Expected
+#' fd(4)
+#' #> [1] 3 # Expected
+#' fd(as.numeric(NA))
+#' #> [1] NA # Expected
+#'
+#' ## __ Vector example __
 #' fd(0:7)
 #' #> [1] 7 6 5 4 3 2 1 0 # Expected
 #' fd(c(1, NA))

diff --git a/R/gu.R b/R/gu.R
@@ -77,7 +77,7 @@
 #' gu(hms::as_hms(NA), lubridate::dminutes(90))
 #' #> NA # Expected
 #'
-#' ## __ Vectorized example __
+#' ## __ Vector example __
 #' se <- c(hms::parse_hms("12:30:00"), hms::parse_hms("23:45:00"))
 #' si <- c(lubridate::dminutes(10), lubridate::dminutes(70))
 #' gu(se, si)

diff --git a/R/le_week.R b/R/le_week.R
@@ -54,35 +54,56 @@
 #'
 #' @examples
 #' ## __ Scalar example __
-#' le_week(lubridate::dhours(1.5), lubridate::dhours(3.7), 5)
+#' le_w <- lubridate::dhours(1.5)
+#' le_f <- lubridate::dhours(3.7)
+#' wd <- 5
+#' le_week(le_w, le_f, wd)
 #' #> [1] "7662.85714285714s (~2.13 hours)" # Expected
-#' le_week(lubridate::dhours(3), lubridate::dhours(1.5), 6)
+#'
+#' le_w <- lubridate::dhours(3)
+#' le_f <- lubridate::dhours(1.5)
+#' wd <- 6
+#' le_week(le_w, le_f, wd)
 #' #> [1] "10028.5714285714s (~2.79 hours)" # Expected
-#' le_week(lubridate::dhours(5.6), lubridate::as.duration(NA), 3)
+#'
+#' le_w <- lubridate::dhours(5.6)
+#' le_f <- lubridate::as.duration(NA)
+#' wd <- 3
+#' le_week(le_w, le_f, wd)
 #' #> [1] NA # Expected
 #'
-#' ## __ Vectorized example __
+#' ## __ Vector example __
 #' le_w <- c(lubridate::dhours(3), lubridate::dhours(2.45))
 #' le_f <- c(lubridate::dhours(3), lubridate::dhours(3.75))
 #' wd <- c(4, 5)
 #' le_week(le_w, le_f, wd)
 #' #> [1] "10800s (~3 hours)" # Expected
 #' #> [2] "10157.1428571429s (~2.82 hours)" # Expected
 #'
-#' ## __ Checking second output from vectorized example __
-#' i <- 2
-#' x <- c(le_w[i], le_f[i])
-#' w <- c(wd[i], fd(wd[i]))
-#' lubridate::as.duration(stats::weighted.mean(x, w))
+#' ## __ Checking second output from vector example __
+#' if (requireNamespace("stats", quietly = TRUE)) {
+#'     i <- 2
+#'     x <- c(le_w[i], le_f[i])
+#'     w <- c(wd[i], fd(wd[i]))
+#'     lubridate::as.duration(stats::weighted.mean(x, w))
 #' #> [1] "10157.1428571429s (~2.82 hours)" # Expected
+#' }
 #'
 #' ## __ Converting the output to `hms` __
-#' x <- le_week(lubridate::dhours(1.25), lubridate::dhours(6.23), 3)
+#' le_w <- lubridate::dhours(1.25)
+#' le_f <- lubridate::dhours(6.23)
+#' wd <- 3
+#' x <- le_week(le_w, le_f, wd)
+#' x
+#' #> [1] "14744.5714285714s (~4.1 hours)" # Expected
 #' convert(x, "hms")
 #' #> 04:05:44.571429 # Expected
 #'
 #' ## __ Rounding the output at the seconds level __
-#' x <- le_week(lubridate::dhours(3.4094), lubridate::dhours(6.2345), 2)
+#' le_w <- lubridate::dhours(3.4094)
+#' le_f <- lubridate::dhours(6.2345)
+#' wd <- 2
+#' x <- le_week(le_w, le_f, wd)
 #' x
 #' #> [1] "19538.3828571429s (~5.43 hours)" # Expected
 #' round_time(x)

diff --git a/R/mctq-package.R b/R/mctq-package.R
@@ -6,7 +6,7 @@
 ## usethis namespace: start
 #' @importFrom dplyr across
 #' @importFrom lifecycle deprecate_soft
-#' @importFrom lubridate duration
+#' @importFrom lubridate duration period
 #' @importFrom hms hms
 ## usethis namespace: end
 NULL