From f0f9aaa23351e998f8be7d5100abf1f0445d2cff Mon Sep 17 00:00:00 2001 From: Daniel Vartanian Date: Sun, 30 May 2021 21:34:17 -0300 Subject: [PATCH] Update test suite --- R/convert.R | 18 +- R/qplot_walk.R | 4 +- R/utils-checks.R | 162 +++++--- R/utils-clock_roll.R | 34 +- R/utils.R | 96 ++--- tests/testthat/test-assign_date.R | 152 ++++---- tests/testthat/test-convert-character.R | 78 ++-- tests/testthat/test-convert-data-frame.R | 47 ++- tests/testthat/test-convert-date.R | 87 +++-- tests/testthat/test-convert-duration.R | 94 +++-- tests/testthat/test-convert-hms.R | 94 +++-- tests/testthat/test-convert-interval.R | 159 +++++--- tests/testthat/test-convert-numeric.R | 83 ++-- tests/testthat/test-convert-posixt.R | 115 +++--- tests/testthat/test-convert.R | 287 +++++++------- tests/testthat/test-fd.R | 16 +- tests/testthat/test-gu.R | 42 +-- tests/testthat/test-le_week.R | 96 +++-- tests/testthat/test-ms.R | 51 +-- tests/testthat/test-msf_sc.R | 202 +++++----- tests/testthat/test-napd.R | 40 +- tests/testthat/test-pretty_mctq.R | 11 +- tests/testthat/test-qplot_walk.R | 71 ++-- tests/testthat/test-random_mctq.R | 354 ++++++++++------- tests/testthat/test-raw_data.R | 3 +- tests/testthat/test-round_time.R | 45 +-- tests/testthat/test-sd.R | 40 +- tests/testthat/test-sd24.R | 61 ++- tests/testthat/test-sd_overall.R | 111 +++--- tests/testthat/test-sd_week.R | 95 +++-- tests/testthat/test-shorter_interval.R | 122 +++--- tests/testthat/test-sjl.R | 238 ++++++------ tests/testthat/test-sjl_weighted.R | 82 ++-- tests/testthat/test-sloss_week.R | 75 ++-- tests/testthat/test-so.R | 42 +-- tests/testthat/test-sum_time.R | 332 +++++++++------- tests/testthat/test-tbt.R | 42 +-- tests/testthat/test-utils-checks.R | 275 +++++++++----- tests/testthat/test-utils-clock_roll.R | 19 +- tests/testthat/test-utils-dialogs.R | 45 ++- tests/testthat/test-utils-na_as.R | 7 +- tests/testthat/test-utils.R | 462 +++++++++-------------- 42 files changed, 2269 insertions(+), 2220 deletions(-) diff --git a/R/convert.R b/R/convert.R index 79221ba..97f77f6 100644 --- a/R/convert.R +++ b/R/convert.R @@ -432,7 +432,7 @@ convert.Duration <- function(x, class, ..., tz = "UTC", output_unit = NULL, class <- tolower(class) if (class == "logical") { - shush(warning("'x' cannot be converted to 'logical'", + shush(warning("'x' cannot be converted to 'logical'.", call. = FALSE), quiet) as.logical(rep(NA, length(x))) } else if (class == "character") { @@ -510,7 +510,7 @@ convert.hms <- function(x, class, ..., tz = "UTC", output_unit = NULL, class <- tolower(class) if (class == "logical") { - shush(warning("'x' cannot be converted to 'logical'", + shush(warning("'x' cannot be converted to 'logical'.", call. = FALSE), quiet) as.logical(rep(NA, length(x))) } else if (class == "character") { @@ -571,7 +571,7 @@ convert.Date <- function(x, class, ..., tz = "UTC", quiet = FALSE) { } if (class == "logical") { - shush(warning("'x' cannot be converted to 'logical'", + shush(warning("'x' cannot be converted to 'logical'.", call. = FALSE), quiet) as.logical(rep(NA, length(x))) } else if (class == "character") { @@ -624,7 +624,7 @@ convert.POSIXt <- function(x, class, ..., tz = "UTC", output_unit = NULL, } if (class == "logical") { - shush(warning("'x' cannot be converted to 'logical'", + shush(warning("'x' cannot be converted to 'logical'.", call. = FALSE), quiet) as.logical(rep(NA, length(x))) } else if (class == "character") { @@ -683,13 +683,13 @@ convert.Interval <- function(x, class, ..., tz = "UTC", output_unit = NULL, } if (class %in% c("posixct", "posixlt")) { - shush(warning("'x' was converted to the interval time span with", + shush(warning("'x' was converted to the interval time span with ", "'1970-01-01 as origin (UNIX epoch).", call. = FALSE), quiet) } if (class == "logical") { - shush(warning("'x' cannot be converted to 'logical'", + shush(warning("'x' cannot be converted to 'logical'.", call. = FALSE), quiet) as.logical(rep(NA, length(x))) } else if (class == "character") { @@ -774,7 +774,7 @@ convert.data.frame <- function(x, class, ..., cols = NULL, where = NULL, #' @rdname convert #' @export convert_tu <- function(x, output_unit, ...) { - assert_time(x) + assert_temporal(x) convert(x, class = "numeric", output_unit = output_unit, ... = ...) } @@ -1042,7 +1042,7 @@ convert_to_seconds <- function(x, input_unit = NULL, checkmate::assert_flag(ignore_date) checkmate::assert_flag(quiet) - if (!is_time(x) && is.null(input_unit)) { + if (!test_temporal(x) && is.null(input_unit)) { stop("When 'x' is 'integer' or 'numeric', 'input_unit' cannot be ", "'NULL'.", call. = FALSE) } @@ -1072,7 +1072,7 @@ convert_to_seconds <- function(x, input_unit = NULL, } else if (input_unit == "deg") { x / deg_second } - } else if (is_time(x)) { + } else if (test_temporal(x)) { if (lubridate::is.duration(x) || lubridate::is.period(x) || hms::is_hms(x) || lubridate::is.interval(x)) { as.numeric(x) diff --git a/R/qplot_walk.R b/R/qplot_walk.R index 513dc25..94b7c4a 100644 --- a/R/qplot_walk.R +++ b/R/qplot_walk.R @@ -146,7 +146,7 @@ qplot_walk <- function(data, ..., cols = NULL, pattern = NULL, if (any(c("x", "y", "data") %in% names(list(...)))) { stop("'x', 'y' and `data` are reserved arguments for ", - "`qplot_walk()`.", call. = FALSE) + "'qplot_walk()'.", call. = FALSE) } if (is.data.frame(data)) { @@ -207,7 +207,7 @@ qplot_walk <- function(data, ..., cols = NULL, pattern = NULL, cols <- grep(pattern, names(data), value = TRUE) if (length(cols) == 0) { - stop("None match was found in `names(data)`.", call. = FALSE) + stop("None match was found in 'names(data)'.", call. = FALSE) } } diff --git a/R/utils-checks.R b/R/utils-checks.R index 7728464..e0f6c1b 100644 --- a/R/utils-checks.R +++ b/R/utils-checks.R @@ -1,30 +1,7 @@ -check_any_na <- function(x, name = deparse(substitute(x))) { - if (any(is.na(x))) { - paste0(single_quote_(name), " cannot have any missing values") - } else { - TRUE - } -} - -assert_any_na <- checkmate::makeAssertionFunction(check_any_na) - -check_not_all_na <- function(x, name = deparse(substitute(x))) { - if (all(is.na(x))) { - paste0(single_quote_(name), " cannot have all values as missing") - } else { - TRUE - } -} - -assert_not_all_na <- checkmate::makeAssertionFunction(check_not_all_na) +test_length_one <- function(x) if (length(x) == 1) TRUE else FALSE -check_length_one <- function(x, any.missing = TRUE, - name = deparse(substitute(x))) { - checkmate::assert_flag(any.missing) - - if (any(is.na(x)) && isFALSE(any.missing)) { - paste0(single_quote_(name), " cannot have missing values") - } else if (!(length(x) == 1)) { +check_length_one <- function(x, name = deparse(substitute(x))) { + if (!(test_length_one(x))) { paste0(single_quote_(name), " must have length 1, not length ", length(x)) } else { @@ -34,13 +11,15 @@ check_length_one <- function(x, any.missing = TRUE, assert_length_one <- checkmate::makeAssertionFunction(check_length_one) +test_has_length <- function(x) if (length(x) >= 1) TRUE else FALSE + check_has_length <- function(x, any.missing = TRUE, name = deparse(substitute(x))) { checkmate::assert_flag(any.missing) if (any(is.na(x)) && isFALSE(any.missing)) { paste0(single_quote_(name), " cannot have missing values") - } else if (length(x) < 1) { + } else if (!test_has_length(x)) { paste0(single_quote_(name), " must have length greater than zero") } else { TRUE @@ -49,6 +28,23 @@ check_has_length <- function(x, any.missing = TRUE, assert_has_length <- checkmate::makeAssertionFunction(check_has_length) +test_whole_number <- function(x, any.missing = TRUE, null.ok = FALSE, + tol = .Machine$double.eps^0.5) { + checkmate::assert_flag(any.missing) + checkmate::assert_flag(null.ok) + checkmate::assert_number(tol) + + if (is.null(x) && isTRUE(null.ok)) { + TRUE + } else if (any(is.na(x)) && isFALSE(any.missing)) { + FALSE + } else if (!test_numeric_(x) || !identical(x, abs(x))) { + FALSE + } else { + all(abs(x - round(x)) < tol, na.rm = any.missing) + } +} + check_whole_number <- function(x, any.missing = TRUE, null.ok = FALSE, name = deparse(substitute(x))) { checkmate::assert_flag(any.missing) @@ -59,8 +55,9 @@ check_whole_number <- function(x, any.missing = TRUE, null.ok = FALSE, } else if (any(is.na(x)) && isFALSE(any.missing)) { paste0(single_quote_(name), " cannot have missing values") } else if (is.null(x) && isFALSE(null.ok)) { - paste0(single_quote_(name), " cannot be 'NULL'") - } else if (!all(is_whole_number(x), na.rm = TRUE)) { + paste0(single_quote_(name), " cannot have 'NULL' values") + } else if (!test_whole_number(x, any.missing = any.missing, + null.ok = null.ok)) { paste0(single_quote_(name), " must consist of whole numbers") } else { TRUE @@ -69,10 +66,24 @@ check_whole_number <- function(x, any.missing = TRUE, null.ok = FALSE, assert_whole_number <- checkmate::makeAssertionFunction(check_whole_number) -## `check_numeric_()` and `assert_numeric_()` were created as a workaround to -## deal with cases like `is.numeric(lubridate::duration())`. See +## `*_numeric_()` was created as a workaround to deal with cases like +## `is.numeric(lubridate::duration())`. See ## https://github.com/tidyverse/lubridate/issues/942 to learn more. +test_numeric_ <- function(x, any.missing = TRUE, null.ok = FALSE) { + checkmate::assert_flag(any.missing) + checkmate::assert_flag(null.ok) + + if (is.null(x) && isTRUE(null.ok)) { + TRUE + } else if (any(is.na(x)) && isFALSE(any.missing)) { + FALSE + } else { + classes <- c("integer", "double", "numeric") + checkmate::test_subset(class(x)[1], classes) + } +} + check_numeric_ <- function(x, any.missing = TRUE, null.ok = FALSE, name = deparse(substitute(x))) { checkmate::assert_flag(any.missing) @@ -84,7 +95,7 @@ check_numeric_ <- function(x, any.missing = TRUE, null.ok = FALSE, paste0(single_quote_(name), " cannot have missing values") } else if (is.null(x) && isFALSE(null.ok)) { paste0(single_quote_(name), " cannot have 'NULL' values") - } else if (!is_numeric_(x)) { + } else if (!test_numeric_(x)) { paste0("Must be of type 'numeric', not ", class_collapse(x)) } else { TRUE @@ -93,6 +104,19 @@ check_numeric_ <- function(x, any.missing = TRUE, null.ok = FALSE, assert_numeric_ <- checkmate::makeAssertionFunction(check_numeric_) +test_duration <- function(x, any.missing = TRUE, null.ok = FALSE) { + checkmate::assert_flag(any.missing) + checkmate::assert_flag(null.ok) + + if (is.null(x) && isTRUE(null.ok)) { + TRUE + } else if (any(is.na(x)) && isFALSE(any.missing)) { + FALSE + } else { + lubridate::is.duration(x) + } +} + check_duration <- function(x, any.missing = TRUE, null.ok = FALSE, name = deparse(substitute(x))) { checkmate::assert_flag(any.missing) @@ -104,7 +128,7 @@ check_duration <- function(x, any.missing = TRUE, null.ok = FALSE, paste0(single_quote_(name), " cannot have missing values") } else if (is.null(x) && isFALSE(null.ok)) { paste0(single_quote_(name), " cannot have 'NULL' values") - } else if (!lubridate::is.duration(x)) { + } else if (!test_duration(x)) { paste0("Must be of type 'Duration', not ", class_collapse(x)) } else { TRUE @@ -113,6 +137,19 @@ check_duration <- function(x, any.missing = TRUE, null.ok = FALSE, assert_duration <- checkmate::makeAssertionFunction(check_duration) +test_posixt <- function(x, any.missing = TRUE, null.ok = FALSE) { + checkmate::assert_flag(any.missing) + checkmate::assert_flag(null.ok) + + if (is.null(x) && isTRUE(null.ok)) { + TRUE + } else if (any(is.na(x)) && isFALSE(any.missing)) { + FALSE + } else { + lubridate::is.POSIXt(x) + } +} + check_posixt <- function(x, any.missing = TRUE, null.ok = FALSE, name = deparse(substitute(x))) { checkmate::assert_flag(any.missing) @@ -124,7 +161,7 @@ check_posixt <- function(x, any.missing = TRUE, null.ok = FALSE, paste0(single_quote_(name), " cannot have missing values") } else if (is.null(x) && isFALSE(null.ok)) { paste0(single_quote_(name), " cannot have 'NULL' values") - } else if (!lubridate::is.POSIXt(x)) { + } else if (!test_posixt(x)) { paste0("Must be of type 'POSIXct' or 'POSIXlt', not ", class_collapse(x)) } else { @@ -134,12 +171,29 @@ check_posixt <- function(x, any.missing = TRUE, null.ok = FALSE, assert_posixt <- checkmate::makeAssertionFunction(check_posixt) -test_time <- function(x, any.missing = TRUE, null.ok = FALSE) { - out <- check_time(x, any.missing, null.ok) - if (isTRUE(out)) TRUE else FALSE +test_temporal <- function(x, any.missing = TRUE, null.ok = FALSE, rm = NULL) { + checkmate::assert_flag(any.missing) + checkmate::assert_flag(null.ok) + checkmate::assert_character(rm, any.missing = FALSE, null.ok = TRUE) + + if (is.null(x) && isTRUE(null.ok)) { + TRUE + } else if (any(is.na(x)) && isFALSE(any.missing)) { + FALSE + } else { + classes <- c("Duration", "Period", "difftime", "hms", "Date", "POSIXct", + "POSIXlt", "Interval") + + if (!is.null(rm)) { + rm <- paste0("^", rm, "$", collapse = "|") + classes <- str_subset_(classes, rm, negate = TRUE) + } + + checkmate::test_subset(class(x)[1], classes) + } } -check_time <- function(x, any.missing = TRUE, null.ok = FALSE, +check_temporal <- function(x, any.missing = TRUE, null.ok = FALSE, name = deparse(substitute(x))) { checkmate::assert_flag(any.missing) checkmate::assert_flag(null.ok) @@ -150,18 +204,23 @@ check_time <- function(x, any.missing = TRUE, null.ok = FALSE, paste0(single_quote_(name), " cannot have missing values") } else if (is.null(x) && isFALSE(null.ok)) { paste0(single_quote_(name), " cannot have 'NULL' values") - } else if (!is_time(x)) { - paste0("Must be a time object, not ", class_collapse(x)) + } else if (!test_temporal(x)) { + paste0("Must be a temporal object (see 'test_temporal()'), ", + "not ", class_collapse(x)) } else { TRUE } } -assert_time <- checkmate::makeAssertionFunction(check_time) +assert_temporal <- checkmate::makeAssertionFunction(check_temporal) assert_identical <- function(..., type = "value", any.missing = TRUE, null.ok = FALSE) { - checkmate::assert_list(list(...), min.len = 2) + + if (!checkmate::test_list(list(...), min.len = 2)) { + stop("'...' must have 2 or more elements.", call. = FALSE) + } + checkmate::assert_choice(type, c("value", "length", "class")) checkmate::assert_flag(any.missing) checkmate::assert_flag(null.ok) @@ -198,7 +257,21 @@ assert_identical <- function(..., type = "value", any.missing = TRUE, } } -# Used in parse_to_date_time() +## `*_custom_1()` are used in `parse_to_date_time()`. + +test_custom_1 <- function(x, any.missing = TRUE, null.ok = FALSE) { + checkmate::assert_flag(any.missing) + checkmate::assert_flag(null.ok) + + if (is.null(x) && isTRUE(null.ok)) { + TRUE + } else if (any(is.na(x)) && isFALSE(any.missing)) { + FALSE + } else { + is.character(x) || test_numeric_(x) + } +} + check_custom_1 <- function(x, any.missing = TRUE, null.ok = FALSE, name = deparse(substitute(x))) { checkmate::assert_flag(any.missing) @@ -210,7 +283,7 @@ check_custom_1 <- function(x, any.missing = TRUE, null.ok = FALSE, paste0(single_quote_(name), " cannot have missing values") } else if (is.null(x) && isFALSE(null.ok)) { paste0(single_quote_(name), " cannot have 'NULL' values") - } else if (!(is.character(x) || is_numeric_(x))) { + } else if (!test_custom_1(x)) { paste0(single_quote_(name), " must inherit from class 'character', ", "'integer', or 'numeric', but has class ", class_collapse(x)) } else { @@ -218,5 +291,4 @@ check_custom_1 <- function(x, any.missing = TRUE, null.ok = FALSE, } } -# Used in parse_to_date_time() assert_custom_1 <- checkmate::makeAssertionFunction(check_custom_1) diff --git a/R/utils-clock_roll.R b/R/utils-clock_roll.R index 5241c19..3463373 100644 --- a/R/utils-clock_roll.R +++ b/R/utils-clock_roll.R @@ -1,13 +1,13 @@ -clock_roll <- function(x) { +clock_roll <- function(time) { UseMethod("clock_roll") } #' @export -clock_roll.Duration <- function(x) { - if (all(as.numeric(x) > 0 & as.numeric(x) < 86400, na.rm = TRUE)) { - x +clock_roll.Duration <- function(time) { + if (all(as.numeric(time) > 0 & as.numeric(time) < 86400, na.rm = TRUE)) { + time } else { - x %>% lubridate::as_datetime() %>% + time %>% lubridate::as_datetime() %>% flat_posixt() %>% hms::as_hms() %>% lubridate::as.duration() @@ -15,11 +15,11 @@ clock_roll.Duration <- function(x) { } #' @export -clock_roll.Period <- function(x) { - if (all(as.numeric(x) > 0 & as.numeric(x) < 86400, na.rm = TRUE)) { - x +clock_roll.Period <- function(time) { + if (all(as.numeric(time) > 0 & as.numeric(time) < 86400, na.rm = TRUE)) { + time } else { - x %>% lubridate::as_datetime() %>% + time %>% lubridate::as_datetime() %>% flat_posixt() %>% hms::as_hms() %>% lubridate::as.period() @@ -27,12 +27,12 @@ clock_roll.Period <- function(x) { } #' @export -clock_roll.difftime <- function(x) { - out <- x +clock_roll.difftime <- function(time) { + out <- time units(out) <- "secs" if (all(as.numeric(out) > 0 & as.numeric(out) < 86400, na.rm = TRUE)) { - units(out) <- units(x) + units(out) <- units(time) out } else { out <- out %>% hms::as_hms() %>% @@ -42,17 +42,17 @@ clock_roll.difftime <- function(x) { as.numeric() %>% lubridate::as.difftime(units = "secs") - units(out) <- units(x) + units(out) <- units(time) out } } #' @export -clock_roll.hms <- function(x) { - if (all(as.numeric(x) > 0 & as.numeric(x) < 86400, na.rm = TRUE)) { - x +clock_roll.hms <- function(time) { + if (all(as.numeric(time) > 0 & as.numeric(time) < 86400, na.rm = TRUE)) { + time } else { - x %>% lubridate::as_datetime() %>% + time %>% lubridate::as_datetime() %>% flat_posixt() %>% hms::as_hms() } diff --git a/R/utils.R b/R/utils.R index 7d0acb4..dab856f 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,26 +1,26 @@ -flat_posixt <- function(x, force_utc = TRUE, base = "1970-01-01") { - assert_posixt(x, null.ok = FALSE) +flat_posixt <- function(posixt, force_utc = TRUE, base = "1970-01-01") { + assert_posixt(posixt, null.ok = FALSE) checkmate::assert_flag(force_utc) checkmate::assert_string(base, pattern = "\\d{4}-\\d{2}-\\d{2}") - lubridate::date(x) <- base + lubridate::date(posixt) <- base if (isTRUE(force_utc)) { - lubridate::force_tz(x, "UTC") + lubridate::force_tz(posixt, "UTC") } else { - x + posixt } } -midday_change <- function(x) { - checkmate::assert_multi_class(x, c("hms", "POSIXct", "POSIXlt")) +midday_change <- function(time) { + checkmate::assert_multi_class(time, c("hms", "POSIXct", "POSIXlt")) - if (hms::is_hms(x)) x <- as.POSIXct(x) - x <- flat_posixt(x) + if (hms::is_hms(time)) time <- as.POSIXct(time) + time <- flat_posixt(time) dplyr::case_when( - lubridate::hour(x) < 12 ~ change_day(x, 2), - TRUE ~ x + lubridate::hour(time) < 12 ~ change_day(time, 2), + TRUE ~ time ) } @@ -91,44 +91,9 @@ change_day <- function(x, day) { x } -is_time <- function(x, rm = NULL) { - checkmate::assert_character(rm, any.missing = FALSE, null.ok = TRUE) - - classes <- c("Duration", "Period", "difftime", "hms", "Date", "POSIXct", - "POSIXlt", "Interval") - - if (!is.null(rm)) { - rm <- paste0("^", rm, "$", collapse = "|") - classes <- str_subset_(classes, rm, negate = TRUE) - } - - checkmate::test_subset(class(x)[1], classes) -} - -is_numeric_ <- function(x) { - classes <- c("integer", "double", "numeric") - checkmate::test_subset(class(x)[1], classes) -} - -is_whole_number <- function(x, tol = .Machine$double.eps^0.5) { - if (!is_numeric_(x) || !identical(x, abs(x))) { - FALSE - } else { - abs(x - round(x)) < tol # Example function from `?integer` - } -} - -single_quote_ <- function(x) { - paste0("'", x, "'") -} - -backtick_ <- function(x) { - paste0("`", x, "`") -} - -class_collapse <- function(x) { - single_quote_(paste0(class(x), collapse = "/")) -} +single_quote_ <- function(x) paste0("'", x, "'") +backtick_ <- function(x) paste0("`", x, "`") +class_collapse <- function(x) single_quote_(paste0(class(x), collapse = "/")) paste_collapse <- function(x, sep = "", last = sep) { checkmate::assert_string(sep) @@ -188,13 +153,8 @@ swap <- function(x, y, condition = TRUE) { list(x = x, y = y) } -count_na <- function(x) { - length(which(is.na(x))) -} - -escape_regex <- function(x) { - gsub("([.|()\\^{}+$*?]|\\[|\\])", "\\\\\\1", x) -} +count_na <- function(x) length(which(is.na(x))) +escape_regex <- function(x) gsub("([.|()\\^{}+$*?]|\\[|\\])", "\\\\\\1", x) get_names <- function(...) { out <- lapply(substitute(list(...))[-1], deparse) @@ -225,30 +185,34 @@ fix_character <- function(x) { x } -str_extract_ <- function(string, pattern, ignore.case = FALSE, perl = TRUE, - fixed = FALSE, useBytes = FALSE, invert = FALSE) { +str_extract_ <- function(string, pattern, ignore_case = FALSE, perl = TRUE, + fixed = FALSE, use_bytes = FALSE, invert = FALSE) { checkmate::assert_string(pattern) - checkmate::assert_flag(ignore.case) + checkmate::assert_flag(ignore_case) checkmate::assert_flag(perl) checkmate::assert_flag(fixed) - checkmate::assert_flag(useBytes) + checkmate::assert_flag(use_bytes) checkmate::assert_flag(invert) - match <- regexpr(pattern, string, ignore.case = ignore.case, perl = perl, - fixed = fixed, useBytes = useBytes) + match <- regexpr(pattern, string, ignore.case = ignore_case, perl = perl, + fixed = fixed, useBytes = use_bytes) out <- rep(NA, length(string)) out[match != -1 & !is.na(match)] <- regmatches(string, match, invert = invert) out } -str_subset_ <- function(string, pattern, negate = FALSE, ignore.case = FALSE, - perl = TRUE, fixed = FALSE, useBytes = FALSE) { +str_subset_ <- function(string, pattern, negate = FALSE, ignore_case = FALSE, + perl = TRUE, fixed = FALSE, use_bytes = FALSE) { checkmate::assert_string(pattern) checkmate::assert_flag(negate) + checkmate::assert_flag(ignore_case) + checkmate::assert_flag(perl) + checkmate::assert_flag(fixed) + checkmate::assert_flag(use_bytes) - match <- grepl(pattern, string, ignore.case = ignore.case, perl = perl, - fixed = fixed, useBytes = useBytes) + match <- grepl(pattern, string, ignore.case = ignore_case, perl = perl, + fixed = fixed, useBytes = use_bytes) if (isTRUE(negate)) { out <- subset(string, !match) diff --git a/tests/testthat/test-assign_date.R b/tests/testthat/test-assign_date.R index f363578..80564c7 100644 --- a/tests/testthat/test-assign_date.R +++ b/tests/testthat/test-assign_date.R @@ -1,101 +1,99 @@ test_that("assign_date() | scalar test", { - start <- hms::parse_hm("02:10") - end <- hms::parse_hm("05:30") - object <- assign_date(start, end) - expected <- lubridate::interval( - lubridate::as_datetime("1970-01-01 02:10:00"), - lubridate::as_datetime("1970-01-01 05:30:00")) - expect_equal(object, expected) + expect_equal(assign_date(hms::parse_hm("02:10"), hms::parse_hm("05:30")), + lubridate::interval( + lubridate::as_datetime("1970-01-01 02:10:00"), + lubridate::as_datetime("1970-01-01 05:30:00"))) }) test_that("assign_date() | vector test", { - start <- c(hms::parse_hm("05:40"), hms::parse_hm("21:30")) - end <- c(hms::parse_hm("18:05"), hms::parse_hm("10:30")) - object <- assign_date(start, end) - expected <- c( - lubridate::interval( - lubridate::as_datetime("1970-01-01 05:40:00"), - lubridate::as_datetime("1970-01-01 18:05:00")), - lubridate::interval( - lubridate::as_datetime("1970-01-01 21:30:00"), - lubridate::as_datetime("1970-01-02 10:30:00"))) - expect_equal(object, expected) + expect_equal(assign_date(c(hms::parse_hm("05:40"), hms::parse_hm("21:30")), + c(hms::parse_hm("18:05"), hms::parse_hm("10:30"))), + c(lubridate::interval( + lubridate::as_datetime("1970-01-01 05:40:00"), + lubridate::as_datetime("1970-01-01 18:05:00")), + lubridate::interval( + lubridate::as_datetime("1970-01-01 21:30:00"), + lubridate::as_datetime("1970-01-02 10:30:00")))) }) test_that("assign_date() | `ambiguity` test", { - start <- lubridate::as_datetime("1985-01-15 12:00:00") - end <- lubridate::as_datetime("2020-09-10 12:00:00") - object <- assign_date(start, end, ambiguity = 0) - expected <- lubridate::interval( - lubridate::as_datetime("1970-01-01 12:00:00"), - lubridate::as_datetime("1970-01-01 12:00:00")) - expect_equal(object, expected) + expect_equal(assign_date(lubridate::as_datetime("1985-01-15 12:00:00"), + lubridate::as_datetime("2020-09-10 12:00:00"), + ambiguity = 0), + lubridate::interval( + lubridate::as_datetime("1970-01-01 12:00:00"), + lubridate::as_datetime("1970-01-01 12:00:00"))) - object <- assign_date(start, end, ambiguity = 24) - expected <- lubridate::interval( - lubridate::as_datetime("1970-01-01 12:00:00"), - lubridate::as_datetime("1970-01-02 12:00:00")) - expect_equal(object, expected) + expect_equal(assign_date(lubridate::as_datetime("1985-01-15 12:00:00"), + lubridate::as_datetime("2020-09-10 12:00:00"), + ambiguity = 24), + lubridate::interval( + lubridate::as_datetime("1970-01-01 12:00:00"), + lubridate::as_datetime("1970-01-02 12:00:00"))) - object <- assign_date(start, end, ambiguity = NA) - expected <- lubridate::as.interval(NA) - expect_equal(object, expected) + expect_equal(assign_date(lubridate::as_datetime("1985-01-15 12:00:00"), + lubridate::as_datetime("2020-09-10 12:00:00"), + ambiguity = NA), + lubridate::as.interval(NA)) }) test_that("assign_date() | `return` test", { - start <- hms::parse_hm("22:15") - end <- hms::parse_hm("00:00") - object <- assign_date(start, end, return = "list") - expected <- list(start = lubridate::as_datetime("1970-01-01 22:15:00"), - end = lubridate::as_datetime("1970-01-02 00:00:00")) - expect_equal(object, expected) + expect_equal(assign_date(hms::parse_hm("22:15"), + hms::parse_hm("00:00"), + return = "list", + start_name = "start", + end_name = "end"), + list(start = lubridate::as_datetime("1970-01-01 22:15:00"), + end = lubridate::as_datetime("1970-01-02 00:00:00"))) - start <- hms::parse_hm("01:10") - end <- hms::parse_hm("11:45") - object <- assign_date(start, end, return = "list") - expected <- list(start = lubridate::as_datetime("1970-01-01 01:10:00"), - end = lubridate::as_datetime("1970-01-01 11:45:00")) - expect_equal(object, expected) + expect_equal(assign_date(hms::parse_hm("01:10"), + hms::parse_hm("11:45"), + return = "list", + start_name = "start", + end_name = "end"), + list(start = lubridate::as_datetime("1970-01-01 01:10:00"), + end = lubridate::as_datetime("1970-01-01 11:45:00"))) - start <- lubridate::parse_date_time("01:10:00", "HMS") - end <- lubridate::parse_date_time("11:45:00", "HMS") - object <- assign_date(start, end, return = "start") - expect_equal(object, lubridate::as_datetime("1970-01-01 01:10:00")) + expect_equal(assign_date(lubridate::parse_date_time("01:10:00", "HMS"), + lubridate::parse_date_time("11:45:00", "HMS"), + return = "start"), + lubridate::as_datetime("1970-01-01 01:10:00")) - object <- assign_date(start, end, return = "end") - expect_equal(object, lubridate::as_datetime("1970-01-01 11:45:00")) + expect_equal(assign_date(lubridate::parse_date_time("01:10:00", "HMS"), + lubridate::parse_date_time("11:45:00", "HMS"), + return = "end"), + lubridate::as_datetime("1970-01-01 11:45:00")) - start <- lubridate::parse_date_time("21:45:00", "HMS") - end <- lubridate::parse_date_time("03:20:00", "HMS") - object <- assign_date(start, end, return = "start") - expect_equal(object, lubridate::as_datetime("1970-01-01 21:45:00")) + expect_equal(assign_date(lubridate::parse_date_time("21:45:00", "HMS"), + lubridate::parse_date_time("03:20:00", "HMS"), + return = "start"), + lubridate::as_datetime("1970-01-01 21:45:00")) - object <- assign_date(start, end, return = "end") - expect_equal(object, lubridate::as_datetime("1970-01-02 03:20:00")) + expect_equal(assign_date(lubridate::parse_date_time("21:45:00", "HMS"), + lubridate::parse_date_time("03:20:00", "HMS"), + return = "end"), + lubridate::as_datetime("1970-01-02 03:20:00")) }) test_that("assign_date() | `start_name` and `end_name` test", { - x <- hms::parse_hm("23:00") - y <- hms::parse_hm("01:00") - object <- assign_date(x, y, return = "list") - checkmate::expect_names(names(object), identical.to = c("x", "y")) + checkmate::expect_names(names(assign_date(hms::parse_hm("23:00"), + hms::parse_hm("01:00"), + return = "list")), + identical.to = c('hms::parse_hm("23:00")', + 'hms::parse_hm("01:00")')) }) test_that("assign_date() | error test", { - # Invalid values for `start` and `end` - expect_error(assign_date(1, hms::hms(1))) - expect_error(assign_date(hms::hms(1), 1)) - expect_error(assign_date(lubridate::as_datetime(1), 1)) - expect_error(assign_date(1, lubridate::as_datetime(1))) - - # `start` and `end` have different lengths - expect_error(assign_date(hms::hms(1), c(hms::hms(1), hms::hms(1)))) - - # Invalid values for `return`, `ambiguity`, `start_name` and `end_name` - start <- hms::parse_hm("07:25") - end <- hms::parse_hm("01:05") - expect_error(assign_date(start, end , return = "x")) - expect_error(assign_date(start, end , ambiguity = "x")) - expect_error(assign_date(start, end , start_name = 1)) - expect_error(assign_date(start, end , end_name = 1)) + expect_error(assign_date(1, hms::hms(1)), "Assertion on 'start' failed") + expect_error(assign_date(hms::hms(1), 1), "Assertion on 'end' failed") + expect_error(assign_date(hms::hms(1), c(hms::hms(1), hms::hms(1))), + "'start' and 'end' must have identical lengths") + expect_error(assign_date(hms::hms(1), hms::hms(1) , return = "x"), + "Assertion on 'tolower\\(return\\)' failed") + expect_error(assign_date(hms::hms(1), hms::hms(1) , ambiguity = "x"), + "Assertion on 'ambiguity' failed") + expect_error(assign_date(hms::hms(1), hms::hms(1) , start_name = 1), + "Assertion on 'start_name' failed") + expect_error(assign_date(hms::hms(1), hms::hms(1) , end_name = 1), + "Assertion on 'end_name' failed") }) diff --git a/tests/testthat/test-convert-character.R b/tests/testthat/test-convert-character.R index d116d8d..08db7d6 100644 --- a/tests/testthat/test-convert-character.R +++ b/tests/testthat/test-convert-character.R @@ -1,60 +1,44 @@ test_that("convert.character() | convert test", { - x <- "1" - quiet <- TRUE - - expect_equal(convert(x, "logical", quiet = quiet), NA) - expect_equal(convert(x, "character", quiet = quiet), "1") - expect_equal(convert(x, "integer", quiet = quiet), 1L) - expect_equal(convert(x, "double", quiet = quiet), 1) - expect_equal(convert(x, "numeric", quiet = quiet), 1) - - expect_equal(convert(x, "Duration", quiet = quiet), + expect_equal(convert("1", "logical", quiet = TRUE), NA) + expect_equal(convert("1", "character", quiet = TRUE), "1") + expect_equal(convert("1", "integer", quiet = TRUE), 1L) + expect_equal(convert("1", "double", quiet = TRUE), 1) + expect_equal(convert("1", "numeric", quiet = TRUE), 1) + expect_equal(convert("1", "Duration", quiet = TRUE), lubridate::duration("1")) - expect_equal(convert(x, "Period", quiet = quiet), lubridate::period("1")) - expect_equal(convert(x, "difftime", quiet = quiet), + expect_equal(convert("1", "Period", quiet = TRUE), lubridate::period("1")) + expect_equal(convert("1", "difftime", quiet = TRUE), lubridate::as.difftime("NA", units = "secs")) - expect_equal(convert(x, "hms", quiet = quiet), hms::hms(NA)) - expect_equal(convert(x, "Date", quiet = quiet), lubridate::as_date(NA)) - - tz <- "EST" - object <- convert(x, "POSIXct", tz = tz, quiet = quiet) - expected <- lubridate::force_tz( - lubridate::as_datetime(NA), tz) - expect_equal(object, expected) - - object <- convert(x, "POSIXlt", tz = tz, quiet = quiet) - expected <- as.POSIXlt(lubridate::force_tz( - lubridate::as_datetime(NA), tz)) - expect_equal(object, expected) + expect_equal(convert("1", "hms", quiet = TRUE), hms::hms(NA)) + expect_equal(convert("1", "Date", quiet = TRUE), lubridate::as_date(NA)) + expect_equal(convert("1", "POSIXct", tz = "EST", quiet = TRUE), + lubridate::force_tz(lubridate::as_datetime(NA), "EST")) + expect_equal(convert("1", "POSIXlt", tz = "EST", quiet = TRUE), + as.POSIXlt(lubridate::force_tz( + lubridate::as_datetime(NA), "EST"))) }) test_that("convert.character() | transform test", { - x <- "1" - - object <- convert(x, "numeric", input_unit = "H", output_unit = "M", - quiet = TRUE) - expect_identical(object, 60) - - object <- convert(x, "hms", orders = "H") - expect_identical(object, hms::parse_hm("01:00")) + expect_identical(convert("1", "numeric", input_unit = "H", + output_unit = "M", quiet = TRUE), + 60) + expect_identical(convert("1", "hms", orders = "H"), hms::parse_hm("01:00")) }) test_that("convert.character() | warning test", { - x <- "1" - - # "'x' was converted 'as is'." - expect_warning(convert(x, "logical", quiet = FALSE)) - # "'x' was converted 'as is'. This can produce [...]" - expect_warning(convert(x, "duration", quiet = FALSE)) - # "'difftime' units was set to seconds." - expect_warning(convert(x, "difftime", quiet = FALSE)) + expect_warning(convert("1", "logical", quiet = FALSE), + "'x' was converted 'as is'.") + expect_warning(convert("1", "duration", quiet = FALSE), + "'x' was converted 'as is'.") + expect_warning(convert("1", "difftime", quiet = FALSE), + "'difftime' units was set to seconds.") }) test_that("convert.character() | error test", { - x <- "1" - - # Invalid values for `class, `tz`, and `quiet` - expect_error(convert(x, 1, tz = "", quiet = TRUE)) - expect_error(convert(x, "hms", tz = 1, quiet = TRUE)) - expect_error(convert(x, "hms", tz = "", quiet = "")) + expect_error(convert("1", 1, tz = "", quiet = TRUE), + "Assertion on 'tolower\\(class\\)' failed") + expect_error(convert("1", "hms", tz = 1, quiet = TRUE), + "Assertion on 'tz' failed") + expect_error(convert("1", "hms", tz = "", quiet = ""), + "Assertion on 'quiet' failed") }) diff --git a/tests/testthat/test-convert-data-frame.R b/tests/testthat/test-convert-data-frame.R index 0e446d9..be6c233 100644 --- a/tests/testthat/test-convert-data-frame.R +++ b/tests/testthat/test-convert-data-frame.R @@ -1,30 +1,29 @@ test_that("convert.data.frame() | convert test", { - x <- dplyr::tibble(a = c(1, 1), b = c("1", "1")) - quiet <- TRUE + expect_equal(convert(dplyr::tibble(a = c(1, 1), b = c("1", "1")), + "hms", cols = "a", input_unit = "H", quiet = TRUE), + dplyr::tibble( + a = c(hms::parse_hm("01:00"), hms::parse_hm("01:00")), + b = c("1", "1"))) - object <- convert(x, "hms", cols = "a", input_unit = "H", quiet = quiet) - expected <- dplyr::tibble( - a = c(hms::parse_hm("01:00"), hms::parse_hm("01:00")), - b = c("1", "1")) - expect_equal(object, expected) - - object <- convert(x, "duration", where = is.character, input_unit = "H", - quiet = quiet) - expected <- dplyr::tibble( - a = c(1, 1), - b = c(lubridate::dhours(), lubridate::dhours())) - expect_equal(object, expected) + expect_equal(convert(dplyr::tibble(a = c(1, 1), b = c("1", "1")), + "duration", where = is.character, input_unit = "H", + quiet = TRUE), + dplyr::tibble( + a = c(1, 1), + b = c(lubridate::dhours(), lubridate::dhours()))) }) test_that("convert.data.frame() | error test", { - x <- dplyr::tibble(a = c(1, 1), b = c("1", "1")) - - # Invalid values for `class, `where`, `tz`, and `quiet` - expect_error(convert(x, 1, tz = "", quiet = TRUE)) - expect_error(convert(x, "hms", where = 1, tz = "", quiet = TRUE)) - expect_error(convert(x, "hms", where = is.numeric, tz = 1, quiet = TRUE)) - expect_error(convert(x, "hms", where = is.numeric, tz = "", quiet = "")) - - # "'cols' and 'where' cannot both be 'NULL'." - expect_error(convert(x, "hms")) + expect_error(convert(data.frame(), 1, tz = "", quiet = TRUE), + "Assertion on 'tolower\\(class\\)' failed") + expect_error(convert(data.frame(), "hms", where = 1, tz = "", quiet = TRUE), + "Assertion on 'where' failed") + expect_error(convert(data.frame(), "hms", where = is.numeric, tz = 1, + quiet = TRUE), + "Assertion on 'tz' failed") + expect_error(convert(data.frame(), "hms", where = is.numeric, tz = "", + quiet = ""), + "Assertion on 'quiet' failed") + expect_error(convert(data.frame(), "hms"), + "'cols' and 'where' cannot both be 'NULL'.") }) diff --git a/tests/testthat/test-convert-date.R b/tests/testthat/test-convert-date.R index 2d7d9e3..35570be 100644 --- a/tests/testthat/test-convert-date.R +++ b/tests/testthat/test-convert-date.R @@ -1,50 +1,57 @@ test_that("convert.Date() | convert test", { - x <- as.Date("2000-01-01") - quiet <- TRUE - - expect_equal(convert(x, "logical", quiet = quiet), NA) - expect_equal(convert(x, "character", quiet = quiet), "2000-01-01") - expect_equal(convert(x, "integer", quiet = quiet), 10957L) - expect_equal(convert(x, "double", quiet = quiet), 10957) - expect_equal(convert(x, "numeric", quiet = quiet), 10957) - expect_equal(convert(x, "Duration", quiet = quiet), + expect_equal(convert(as.Date("2000-01-01"), "logical", quiet = TRUE), NA) + expect_equal(convert(as.Date("2000-01-01"), "character", quiet = TRUE), + "2000-01-01") + expect_equal(convert(as.Date("2000-01-01"), "integer", quiet = TRUE), + 10957L) + expect_equal(convert(as.Date("2000-01-01"), "double", quiet = TRUE), 10957) + expect_equal(convert(as.Date("2000-01-01"), "numeric", quiet = TRUE), 10957) + expect_equal(convert(as.Date("2000-01-01"), "Duration", quiet = TRUE), lubridate::as.duration(NA)) - expect_equal(convert(x, "Period", quiet = quiet), lubridate::as.period(NA)) - expect_equal(convert(x, "difftime", quiet = quiet), + expect_equal(convert(as.Date("2000-01-01"), "Period", quiet = TRUE), + lubridate::as.period(NA)) + expect_equal(convert(as.Date("2000-01-01"), "difftime", quiet = TRUE), lubridate::as.difftime(lubridate::as.duration(NA))) - expect_equal(convert(x, "hms", quiet = quiet), hms::as_hms(NA)) - expect_equal(convert(x, "Date", quiet = quiet), x) - - tz <- "EST" - object <- convert(x, "POSIXct", tz = tz, quiet = quiet) - expected <- lubridate::force_tz(lubridate::as_datetime("2000-01-01"), tz) - expect_equal(object, expected) - - object <- convert(x, "POSIXlt", tz = tz, quiet = quiet) - expected <- as.POSIXlt(lubridate::force_tz( - lubridate::as_datetime("2000-01-01"), tz)) - expect_equal(object, expected) + expect_equal(convert(as.Date("2000-01-01"), "hms", quiet = TRUE), + hms::as_hms(NA)) + expect_equal(convert(as.Date("2000-01-01"), "Date", quiet = TRUE), + as.Date("2000-01-01")) + expect_equal(convert(as.Date("2000-01-01"), "POSIXct", tz = "EST", + quiet = TRUE), + lubridate::force_tz(lubridate::as_datetime("2000-01-01"), + "EST")) + expect_equal(convert(as.Date("2000-01-01"), "POSIXlt", tz = "EST", + quiet = TRUE), + as.POSIXlt(lubridate::force_tz( + lubridate::as_datetime("2000-01-01"), "EST"))) }) test_that("convert.Date() | warning test", { - x <- as.Date("2000-01-01") - - "'x' cannot be converted to 'logical'" - expect_warning(convert(x, "logical", quiet = FALSE)) - # "'x' was converted to total of days since [...]" - classes <- c("integer", "double", "numeric") - for (i in classes) expect_warning(convert(x, i, quiet = FALSE)) - - # "There's no time to convert." - classes <- c("duration", "period", "difftime", "hms") - for (i in classes) expect_warning(convert(x, i, quiet = FALSE)) + expect_warning(convert(as.Date("2000-01-01"), "logical", quiet = FALSE), + "'x' cannot be converted to 'logical'.") + + expect_warning(convert(as.Date("2000-01-01"), "integer", quiet = FALSE), + "'x' was converted to total of days since '1970-01-01'") + expect_warning(convert(as.Date("2000-01-01"), "double", quiet = FALSE), + "'x' was converted to total of days since '1970-01-01'") + expect_warning(convert(as.Date("2000-01-01"), "numeric", quiet = FALSE), + "'x' was converted to total of days since '1970-01-01'") + + expect_warning(convert(as.Date("2000-01-01"), "duration", quiet = FALSE), + "There's no time to convert.") + expect_warning(convert(as.Date("2000-01-01"), "period", quiet = FALSE), + "There's no time to convert.") + expect_warning(convert(as.Date("2000-01-01"), "difftime", quiet = FALSE), + "There's no time to convert.") + expect_warning(convert(as.Date("2000-01-01"), "hms", quiet = FALSE), + "There's no time to convert.") }) test_that("convert.Date() | error test", { - x <- as.Date("2000-01-01") - - # Invalid values for `class, `tz`, and `quiet` - expect_error(convert(x, 1, tz = "", quiet = TRUE)) - expect_error(convert(x, "hms", tz = 1, quiet = TRUE)) - expect_error(convert(x, "hms", tz = "", quiet = "")) + expect_error(convert(as.Date("2000-01-01"), 1, tz = "", quiet = TRUE), + "Assertion on 'tolower\\(class\\)' failed") + expect_error(convert(as.Date("2000-01-01"), "hms", tz = 1, quiet = TRUE), + "Assertion on 'tz' failed") + expect_error(convert(as.Date("2000-01-01"), "hms", tz = "", quiet = ""), + "Assertion on 'quiet' failed") }) diff --git a/tests/testthat/test-convert-duration.R b/tests/testthat/test-convert-duration.R index f85eab5..5d9c536 100644 --- a/tests/testthat/test-convert-duration.R +++ b/tests/testthat/test-convert-duration.R @@ -1,60 +1,58 @@ test_that("convert.Duration() | convert test", { - x <- lubridate::dhours() - quiet <- TRUE - - expect_equal(convert(x, "logical", quiet = quiet), NA) - expect_equal(convert(x, "character", quiet = quiet), "01:00:00") - expect_equal(convert(x, "integer", quiet = quiet), 3600L) - expect_equal(convert(x, "double", quiet = quiet), 3600) - expect_equal(convert(x, "numeric", quiet = quiet), 3600) - expect_equal(convert(x, "Duration", quiet = quiet), x) - expect_equal(convert(x, "Period", quiet = quiet), lubridate::hours()) - expect_equal(convert(x, "difftime", quiet = quiet), + expect_equal(convert(lubridate::dhours(), "logical", quiet = TRUE), NA) + expect_equal(convert(lubridate::dhours(), "character", quiet = TRUE), + "01:00:00") + expect_equal(convert(lubridate::dhours(), "integer", quiet = TRUE), 3600L) + expect_equal(convert(lubridate::dhours(), "double", quiet = TRUE), 3600) + expect_equal(convert(lubridate::dhours(), "numeric", quiet = TRUE), 3600) + expect_equal(convert(lubridate::dhours(), "Duration", quiet = TRUE), + lubridate::dhours()) + expect_equal(convert(lubridate::dhours(), "Period", quiet = TRUE), + lubridate::hours()) + expect_equal(convert(lubridate::dhours(), "difftime", quiet = TRUE), as.difftime(3600, units = "secs")) - expect_equal(convert(x, "hms", quiet = quiet), hms::parse_hm("01:00")) - expect_equal(convert(x, "Date", quiet = quiet), as.Date(NA)) - - tz <- "EST" - object <- convert(x, "POSIXct", tz = tz, quiet = quiet) - expected <- lubridate::force_tz( - lubridate::as_datetime("1970-01-01 01:00:00"), tz) - expect_equal(object, expected) - - object <- convert(x, "POSIXlt", tz = tz, quiet = quiet) - expected <- as.POSIXlt(lubridate::force_tz( - lubridate::as_datetime("1970-01-01 01:00:00"), tz)) - expect_equal(object, expected) + expect_equal(convert(lubridate::dhours(), "hms", quiet = TRUE), + hms::parse_hm("01:00")) + expect_equal(convert(lubridate::dhours(), "Date", quiet = TRUE), + as.Date(NA)) + expect_equal(convert(lubridate::dhours(), "POSIXct", tz = "EST", + quiet = TRUE), + lubridate::force_tz( + lubridate::as_datetime("1970-01-01 01:00:00"), "EST")) + expect_equal(convert(lubridate::dhours(), "POSIXlt", tz = "EST", + quiet = TRUE), + as.POSIXlt(lubridate::force_tz( + lubridate::as_datetime("1970-01-01 01:00:00"), "EST"))) }) test_that("convert.Duration() | transform test", { - x <- lubridate::dhours() - object <- convert(x, "numeric", output_unit = "M", quiet = TRUE) - expect_identical(object, 60) + expect_identical(convert(lubridate::dhours(), "numeric", output_unit = "M", + quiet = TRUE), + 60) }) test_that("convert.Duration() | warning test", { - x <- lubridate::dhours() - - "'x' cannot be converted to 'logical'" - expect_warning(convert(x, "logical", quiet = FALSE)) - # "'x' was formatted as HMS." - expect_warning(convert(x, "character", quiet = FALSE)) - # "'x' was converted to total of full seconds." - expect_warning(convert(x, "integer", quiet = FALSE)) - # "'x' was converted to total of seconds." - expect_warning(convert(x, "double", quiet = FALSE)) - expect_warning(convert(x, "numeric", quiet = FALSE)) - # "'difftime' units was set to seconds." - expect_warning(convert(x, "difftime", quiet = FALSE)) - # "There's no date to convert." - expect_warning(convert(x, "date", quiet = FALSE)) + expect_warning(convert(lubridate::dhours(), "logical", quiet = FALSE), + "'x' cannot be converted to 'logical'.") + expect_warning(convert(lubridate::dhours(), "character", quiet = FALSE), + "'x' was formatted as HMS.") + expect_warning(convert(lubridate::dhours(), "integer", quiet = FALSE), + "'x' was converted to total of full seconds.") + expect_warning(convert(lubridate::dhours(), "double", quiet = FALSE), + "'x' was converted to total of seconds.") + expect_warning(convert(lubridate::dhours(), "numeric", quiet = FALSE), + "'x' was converted to total of seconds.") + expect_warning(convert(lubridate::dhours(), "difftime", quiet = FALSE), + "'difftime' units was set to seconds.") + expect_warning(convert(lubridate::dhours(), "date", quiet = FALSE), + "There's no date to convert.") }) test_that("convert.Duration() | error test", { - x <- lubridate::dhours() - - # Invalid values for `class, `tz`, and `quiet` - expect_error(convert(x, 1, tz = "", quiet = TRUE)) - expect_error(convert(x, "hms", tz = 1, quiet = TRUE)) - expect_error(convert(x, "hms", tz = "", quiet = "")) + expect_error(convert(lubridate::dhours(), 1, tz = "", quiet = TRUE), + "Assertion on 'tolower\\(class\\)' failed") + expect_error(convert(lubridate::dhours(), "hms", tz = 1, quiet = TRUE), + "Assertion on 'tz' failed") + expect_error(convert(lubridate::dhours(), "hms", tz = "", quiet = ""), + "Assertion on 'quiet' failed") }) diff --git a/tests/testthat/test-convert-hms.R b/tests/testthat/test-convert-hms.R index 47a3391..dfc4a55 100644 --- a/tests/testthat/test-convert-hms.R +++ b/tests/testthat/test-convert-hms.R @@ -1,60 +1,58 @@ test_that("convert.hms() | convert test", { - x <- hms::parse_hm("01:00") - quiet <- TRUE - - expect_equal(convert(x, "logical", quiet = quiet), NA) - expect_equal(convert(x, "character", quiet = quiet), "01:00:00") - expect_equal(convert(x, "integer", quiet = quiet), 3600L) - expect_equal(convert(x, "double", quiet = quiet), 3600) - expect_equal(convert(x, "numeric", quiet = quiet), 3600) - expect_equal(convert(x, "Duration", quiet = quiet), lubridate::dhours()) - expect_equal(convert(x, "Period", quiet = quiet), lubridate::hours()) - expect_equal(convert(x, "difftime", quiet = quiet), + expect_equal(convert(hms::parse_hm("01:00"), "logical", quiet = TRUE), NA) + expect_equal(convert(hms::parse_hm("01:00"), "character", quiet = TRUE), + "01:00:00") + expect_equal(convert(hms::parse_hm("01:00"), "integer", quiet = TRUE), 3600L) + expect_equal(convert(hms::parse_hm("01:00"), "double", quiet = TRUE), 3600) + expect_equal(convert(hms::parse_hm("01:00"), "numeric", quiet = TRUE), 3600) + expect_equal(convert(hms::parse_hm("01:00"), "Duration", quiet = TRUE), + lubridate::dhours()) + expect_equal(convert(hms::parse_hm("01:00"), "Period", quiet = TRUE), + lubridate::hours()) + expect_equal(convert(hms::parse_hm("01:00"), "difftime", quiet = TRUE), as.difftime(3600, units = "secs")) - expect_equal(convert(x, "hms", quiet = quiet), x) - expect_equal(convert(x, "Date", quiet = quiet), as.Date(NA)) - - tz <- "EST" - object <- convert(x, "POSIXct", tz = tz, quiet = quiet) - expected <- lubridate::force_tz( - lubridate::as_datetime("1970-01-01 01:00:00"), tz) - expect_equal(object, expected) - - object <- convert(x, "POSIXlt", tz = tz, quiet = quiet) - expected <- as.POSIXlt(lubridate::force_tz( - lubridate::as_datetime("1970-01-01 01:00:00"), tz)) - expect_equal(object, expected) + expect_equal(convert(hms::parse_hm("01:00"), "hms", quiet = TRUE), + hms::parse_hm("01:00")) + expect_equal(convert(hms::parse_hm("01:00"), "Date", quiet = TRUE), + as.Date(NA)) + expect_equal(convert(hms::parse_hm("01:00"), "POSIXct", tz = "EST", + quiet = TRUE), + lubridate::force_tz( + lubridate::as_datetime("1970-01-01 01:00:00"), "EST")) + expect_equal(convert(hms::parse_hm("01:00"), "POSIXlt", tz = "EST", + quiet = TRUE), + as.POSIXlt(lubridate::force_tz( + lubridate::as_datetime("1970-01-01 01:00:00"), "EST"))) }) test_that("convert.hms() | transform test", { - x <- hms::parse_hm("01:00") - object <- convert(x, "numeric", output_unit = "M", quiet = TRUE) - expect_identical(object, 60) + expect_identical(convert(hms::parse_hm("01:00"), "numeric", + output_unit = "M", quiet = TRUE), + 60) }) test_that("convert.hms() | warning test", { - x <- hms::parse_hm("01:00") - - "'x' cannot be converted to 'logical'" - expect_warning(convert(x, "logical", quiet = FALSE)) - # "'x' was formatted as HMS." - expect_warning(convert(x, "character", quiet = FALSE)) - # "'x' was converted to total of full seconds." - expect_warning(convert(x, "integer", quiet = FALSE)) - # "'x' was converted to total of seconds." - expect_warning(convert(x, "double", quiet = FALSE)) - expect_warning(convert(x, "numeric", quiet = FALSE)) - # "'difftime' units was set to seconds." - expect_warning(convert(x, "difftime", quiet = FALSE)) - # "There's no date to convert." - expect_warning(convert(x, "date", quiet = FALSE)) + expect_warning(convert(hms::parse_hm("01:00"), "logical", quiet = FALSE), + "'x' cannot be converted to 'logical'.") + expect_warning(convert(hms::parse_hm("01:00"), "character", quiet = FALSE), + "'x' was formatted as HMS.") + expect_warning(convert(hms::parse_hm("01:00"), "integer", quiet = FALSE), + "'x' was converted to total of full seconds.") + expect_warning(convert(hms::parse_hm("01:00"), "double", quiet = FALSE), + "'x' was converted to total of seconds.") + expect_warning(convert(hms::parse_hm("01:00"), "numeric", quiet = FALSE), + "'x' was converted to total of seconds.") + expect_warning(convert(hms::parse_hm("01:00"), "difftime", quiet = FALSE), + "'difftime' units was set to seconds.") + expect_warning(convert(hms::parse_hm("01:00"), "date", quiet = FALSE), + "There's no date to convert.") }) test_that("convert.hms() | error test", { - x <- hms::parse_hm("01:00") - - # Invalid values for `class, `tz`, and `quiet` - expect_error(convert(x, 1, tz = "", quiet = TRUE)) - expect_error(convert(x, "hms", tz = 1, quiet = TRUE)) - expect_error(convert(x, "hms", tz = "", quiet = "")) + expect_error(convert(hms::parse_hm("01:00"), 1, tz = "", quiet = TRUE), + "Assertion on 'tolower\\(class\\)' failed") + expect_error(convert(hms::parse_hm("01:00"), "hms", tz = 1, quiet = TRUE), + "Assertion on 'tz' failed") + expect_error(convert(hms::parse_hm("01:00"), "hms", tz = "", quiet = ""), + "Assertion on 'quiet' failed") }) diff --git a/tests/testthat/test-convert-interval.R b/tests/testthat/test-convert-interval.R index b88aae1..883f7b1 100644 --- a/tests/testthat/test-convert-interval.R +++ b/tests/testthat/test-convert-interval.R @@ -1,65 +1,126 @@ test_that("convert.Interval() | convert test", { - x <- lubridate::as.interval(lubridate::dhours(), as.Date("2020-01-01")) - quiet <- TRUE - - expect_equal(convert(x, "logical", quiet = quiet), NA) - expect_equal(convert(x, "character", quiet = quiet), + expect_equal(convert(lubridate::as.interval(lubridate::dhours(), + as.Date("2020-01-01")), + "logical", quiet = TRUE), + NA) + expect_equal(convert(lubridate::as.interval(lubridate::dhours(), + as.Date("2020-01-01")), + "character", quiet = TRUE), "2020-01-01 UTC--2020-01-01 01:00:00 UTC") - expect_equal(convert(x, "integer", quiet = quiet), 3600L) - expect_equal(convert(x, "double", quiet = quiet), 3600) - expect_equal(convert(x, "numeric", quiet = quiet), 3600) - expect_equal(convert(x, "Duration", quiet = quiet), lubridate::dhours()) - expect_equal(convert(x, "Period", quiet = quiet), lubridate::hours()) - expect_equal(convert(x, "difftime", quiet = quiet), + expect_equal(convert(lubridate::as.interval(lubridate::dhours(), + as.Date("2020-01-01")), + "integer", quiet = TRUE), + 3600L) + expect_equal(convert(lubridate::as.interval(lubridate::dhours(), + as.Date("2020-01-01")), + "double", quiet = TRUE), + 3600) + expect_equal(convert(lubridate::as.interval(lubridate::dhours(), + as.Date("2020-01-01")), + "numeric", quiet = TRUE), + 3600) + expect_equal(convert(lubridate::as.interval(lubridate::dhours(), + as.Date("2020-01-01")), + "Duration", quiet = TRUE), + lubridate::dhours()) + expect_equal(convert(lubridate::as.interval(lubridate::dhours(), + as.Date("2020-01-01")), + "Period", quiet = TRUE), + lubridate::hours()) + expect_equal(convert(lubridate::as.interval(lubridate::dhours(), + as.Date("2020-01-01")), + "difftime", quiet = TRUE), as.difftime(3600, units = "secs")) - expect_equal(convert(x, "hms", quiet = quiet), hms::parse_hm("01:00")) - expect_equal(convert(x, "Date", quiet = quiet), as.Date(NA)) - - tz <- "EST" - object <- convert(x, "POSIXct", tz = tz, quiet = quiet) - expected <- lubridate::force_tz( - lubridate::as_datetime("1970-01-01 01:00:00"), tz) - expect_equal(object, expected) - - object <- convert(x, "POSIXlt", tz = tz, quiet = quiet) - expected <- as.POSIXlt(lubridate::force_tz( - lubridate::as_datetime("1970-01-01 01:00:00"), tz)) - expect_equal(object, expected) + expect_equal(convert(lubridate::as.interval(lubridate::dhours(), + as.Date("2020-01-01")), + "hms", quiet = TRUE), + hms::parse_hm("01:00")) + expect_equal(convert(lubridate::as.interval(lubridate::dhours(), + as.Date("2020-01-01")), + "Date", quiet = TRUE), + as.Date(NA)) + expect_equal(convert(lubridate::as.interval(lubridate::dhours(), + as.Date("2020-01-01")), + "POSIXct", tz = "EST", quiet = TRUE), + lubridate::force_tz( + lubridate::as_datetime("1970-01-01 01:00:00"), "EST")) + expect_equal(convert(lubridate::as.interval(lubridate::dhours(), + as.Date("2020-01-01")), + "POSIXlt", tz = "EST", quiet = TRUE), + as.POSIXlt(lubridate::force_tz( + lubridate::as_datetime("1970-01-01 01:00:00"), "EST"))) }) test_that("convert.Interval() | transform test", { - x <- lubridate::as.interval(lubridate::dhours(), as.Date("2020-01-01")) - object <- convert(x, "numeric", output_unit = "M", quiet = TRUE) - expect_identical(object, 60) + expect_identical(convert(lubridate::as.interval(lubridate::dhours(), + as.Date("2020-01-01")), + "numeric", output_unit = "M", quiet = TRUE), + 60) }) test_that("convert.Interval() | warning test", { - x <- lubridate::as.interval(lubridate::dhours(), as.Date("2020-01-01")) + expect_warning(convert(lubridate::as.interval(lubridate::dhours(), + as.Date("2020-01-01")), + "logical", quiet = FALSE), + "'x' cannot be converted to 'logical'.") - "'x' cannot be converted to 'logical'" - expect_warning(convert(x, "logical", quiet = FALSE)) - # "'x' was converted to total of full seconds of the [...]" - expect_warning(convert(x, "integer", quiet = FALSE)) - # "'x' was converted to total of seconds of the interval [...]" - expect_warning(convert(x, "double", quiet = FALSE)) - expect_warning(convert(x, "numeric", quiet = FALSE)) - # "There's no sigle date to convert." - expect_warning(convert(x, "date", quiet = FALSE)) + expect_warning(convert(lubridate::as.interval(lubridate::dhours(), + as.Date("2020-01-01")), + "integer", quiet = FALSE), + "'x' was converted to total of full seconds of the ") - # "'x' was converted to the interval time span." - classes <- c("duration", "period", "difftime", "hms") - for (i in classes) expect_warning(convert(x, i, quiet = FALSE)) + expect_warning(convert(lubridate::as.interval(lubridate::dhours(), + as.Date("2020-01-01")), + "double", quiet = FALSE), + "'x' was converted to total of seconds of the ") + expect_warning(convert(lubridate::as.interval(lubridate::dhours(), + as.Date("2020-01-01")), + "numeric", quiet = FALSE), + "'x' was converted to total of seconds of the ") - # "'x' was converted to the interval time span with [...]" - classes <- c("posixct", "posixlt") - for (i in classes) expect_warning(convert(x, i, quiet = FALSE)) + expect_warning(convert(lubridate::as.interval(lubridate::dhours(), + as.Date("2020-01-01")), + "date", quiet = FALSE), + "There's no sigle date to convert.") + + expect_warning(convert(lubridate::as.interval(lubridate::dhours(), + as.Date("2020-01-01")), + "duration", quiet = FALSE), + "'x' was converted to the interval time span.") + expect_warning(convert(lubridate::as.interval(lubridate::dhours(), + as.Date("2020-01-01")), + "period", quiet = FALSE), + "'x' was converted to the interval time span.") + expect_warning(convert(lubridate::as.interval(lubridate::dhours(), + as.Date("2020-01-01")), + "difftime", quiet = FALSE), + "'x' was converted to the interval time span.") + expect_warning(convert(lubridate::as.interval(lubridate::dhours(), + as.Date("2020-01-01")), + "hms", quiet = FALSE), + "'x' was converted to the interval time span.") + + expect_warning(convert(lubridate::as.interval(lubridate::dhours(), + as.Date("2020-01-01")), + "posixct", quiet = FALSE), + "'x' was converted to the interval time span with ") + expect_warning(convert(lubridate::as.interval(lubridate::dhours(), + as.Date("2020-01-01")), + "posixlt", quiet = FALSE), + "'x' was converted to the interval time span with ") }) test_that("convert.Interval() | error test", { - x <- lubridate::as.interval(lubridate::dhours(), as.Date("2020-01-01")) - - # Invalid values for `class, `tz`, and `quiet` - expect_error(convert(x, 1, tz = "", quiet = TRUE)) - expect_error(convert(x, "hms", tz = 1, quiet = TRUE)) - expect_error(convert(x, "hms", tz = "", quiet = "")) + expect_error(convert(lubridate::as.interval(lubridate::dhours(), + as.Date("2020-01-01")), + 1, tz = "", quiet = TRUE), + "Assertion on 'tolower\\(class\\)' failed") + expect_error(convert(lubridate::as.interval(lubridate::dhours(), + as.Date("2020-01-01")), + "hms", tz = 1, quiet = TRUE), + "Assertion on 'tz' failed") + expect_error(convert(lubridate::as.interval(lubridate::dhours(), + as.Date("2020-01-01")), + "hms", tz = "", quiet = ""), + "Assertion on 'quiet' failed") }) diff --git a/tests/testthat/test-convert-numeric.R b/tests/testthat/test-convert-numeric.R index 012c732..46f9f87 100644 --- a/tests/testthat/test-convert-numeric.R +++ b/tests/testthat/test-convert-numeric.R @@ -1,62 +1,47 @@ test_that("convert.numeric() | convert test", { - x <- 1 - quiet <- TRUE - - expect_equal(convert(x, "logical", quiet = quiet), TRUE) - expect_equal(convert(x, "character", quiet = quiet), "1") - expect_equal(convert(x, "integer", quiet = quiet), 1L) - expect_equal(convert(x, "double", quiet = quiet), 1) - expect_equal(convert(x, "numeric", quiet = quiet), 1) - - expect_equal(convert(x, "Duration", quiet = quiet), + expect_equal(convert(1, "logical", quiet = TRUE), TRUE) + expect_equal(convert(1, "character", quiet = TRUE), "1") + expect_equal(convert(1, "integer", quiet = TRUE), 1L) + expect_equal(convert(1, "double", quiet = TRUE), 1) + expect_equal(convert(1, "numeric", quiet = TRUE), 1) + expect_equal(convert(1, "Duration", quiet = TRUE), lubridate::duration(1)) - expect_equal(convert(x, "Period", quiet = quiet), lubridate::period(1)) - expect_equal(convert(x, "difftime", quiet = quiet), + expect_equal(convert(1, "Period", quiet = TRUE), lubridate::period(1)) + expect_equal(convert(1, "difftime", quiet = TRUE), lubridate::as.difftime(1, units = "secs")) - expect_equal(convert(x, "hms", quiet = quiet), hms::hms(1)) - expect_equal(convert(x, "Date", quiet = quiet), lubridate::as_date(1)) - - tz <- "EST" - object <- convert(x, "POSIXct", tz = tz, quiet = quiet) - expected <- lubridate::as_datetime(1, tz = tz) - expect_equal(object, expected) - - object <- convert(x, "POSIXlt", tz = tz, quiet = quiet) - expected <- as.POSIXlt(lubridate::as_datetime(1, tz = tz)) - expect_equal(object, expected) + expect_equal(convert(1, "hms", quiet = TRUE), hms::hms(1)) + expect_equal(convert(1, "Date", quiet = TRUE), lubridate::as_date(1)) + expect_equal(convert(1, "POSIXct", tz = "EST", quiet = TRUE), + lubridate::as_datetime(1, tz = "EST")) + expect_equal(convert(1, "POSIXlt", tz = "EST", quiet = TRUE), + as.POSIXlt(lubridate::as_datetime(1, tz = "EST"))) }) test_that("convert.numeric() | transform test", { - x <- 1 - - object <- convert(x, "numeric", input_unit = "H", output_unit = "M", - quiet = TRUE) - expect_identical(object, 60) - - object <- convert(x, "hms", orders = "H") - expect_identical(object, hms::parse_hm("01:00")) + expect_identical(convert(1, "numeric", input_unit = "H", output_unit = "M", + quiet = TRUE), + 60) + expect_identical(convert(1, "hms", orders = "H"), hms::parse_hm("01:00")) }) test_that("convert.numeric() | warning test", { - x <- 1 - - # "'x' was converted 'as is'." - expect_warning(convert(x, "logical", quiet = FALSE)) - # "'x' was converted 'as is'. This can produce [...]" - expect_warning(convert(x, "duration", quiet = FALSE)) - # "'difftime' units was set to seconds." - expect_warning(convert(x, "difftime", quiet = FALSE)) - # "'POSIXct' origin was set as '1970-01-01 UTC'." - expect_warning(convert(x, "posixct", quiet = FALSE)) - # "'POSIXlt' origin was set as '1970-01-01 UTC'." - expect_warning(convert(x, "posixlt", quiet = FALSE)) + expect_warning(convert(1, "logical", quiet = FALSE), + "'x' was converted 'as is'.") + expect_warning(convert(1, "duration", quiet = FALSE), + "'x' was converted 'as is'. This can produce ") + expect_warning(convert(1, "difftime", quiet = FALSE), + "'difftime' units was set to seconds.") + expect_warning(convert(1, "posixct", quiet = FALSE), + "'POSIXct' origin was set as '1970-01-01 UTC'.") + expect_warning(convert(1, "posixlt", quiet = FALSE), + "'POSIXlt' origin was set as '1970-01-01 UTC'.") }) test_that("convert.numeric() | error test", { - x <- 1 - - # Invalid values for `class, `tz`, and `quiet` - expect_error(convert(x, 1, tz = "", quiet = TRUE)) - expect_error(convert(x, "hms", tz = 1, quiet = TRUE)) - expect_error(convert(x, "hms", tz = "", quiet = "")) + expect_error(convert(1, 1, tz = "", quiet = TRUE), + "Assertion on 'tolower\\(class\\)' failed") + expect_error(convert(1, "hms", tz = 1, quiet = TRUE), + "Assertion on 'tz' failed") + expect_error(convert(1, "hms", tz = "", quiet = ""), + "Assertion on 'quiet' failed") }) diff --git a/tests/testthat/test-convert-posixt.R b/tests/testthat/test-convert-posixt.R index 02b5118..fda5940 100644 --- a/tests/testthat/test-convert-posixt.R +++ b/tests/testthat/test-convert-posixt.R @@ -1,58 +1,85 @@ test_that("convert.POSIXt() | convert test", { - x <- lubridate::as_datetime("2000-01-01 01:00:00") - quiet <- TRUE - - expect_equal(convert(x, "logical", quiet = quiet), NA) - expect_equal(convert(x, "character", quiet = quiet), "2000-01-01 01:00:00") - expect_equal(convert(x, "integer", quiet = quiet), 946688400L) - expect_equal(convert(x, "double", quiet = quiet), 946688400) - expect_equal(convert(x, "numeric", quiet = quiet), 946688400) - expect_equal(convert(x, "Duration", quiet = quiet), lubridate::dhours()) - expect_equal(convert(x, "Period", quiet = quiet), lubridate::hours()) - expect_equal(convert(x, "difftime", quiet = quiet), + expect_equal(convert(lubridate::as_datetime("2000-01-01 01:00:00"), + "logical", quiet = TRUE), + NA) + expect_equal(convert(lubridate::as_datetime("2000-01-01 01:00:00"), + "character", quiet = TRUE), + "2000-01-01 01:00:00") + expect_equal(convert(lubridate::as_datetime("2000-01-01 01:00:00"), + "integer", quiet = TRUE), + 946688400L) + expect_equal(convert(lubridate::as_datetime("2000-01-01 01:00:00"), + "double", quiet = TRUE), + 946688400) + expect_equal(convert(lubridate::as_datetime("2000-01-01 01:00:00"), + "numeric", quiet = TRUE), + 946688400) + expect_equal(convert(lubridate::as_datetime("2000-01-01 01:00:00"), + "Duration", quiet = TRUE), + lubridate::dhours()) + expect_equal(convert(lubridate::as_datetime("2000-01-01 01:00:00"), + "Period", quiet = TRUE), + lubridate::hours()) + expect_equal(convert(lubridate::as_datetime("2000-01-01 01:00:00"), + "difftime", quiet = TRUE), as.difftime(3600, units = "secs")) - expect_equal(convert(x, "hms", quiet = quiet), hms::parse_hm("01:00")) - expect_equal(convert(x, "Date", quiet = quiet), as.Date("2000-01-01")) - - tz <- "EST" - object <- convert(x, "POSIXct", tz = tz, quiet = quiet) - expected <- lubridate::force_tz( - lubridate::as_datetime("2000-01-01 01:00:00"), tz) - expect_equal(object, expected) - - object <- convert(x, "POSIXlt", tz = tz, quiet = quiet) - expected <- as.POSIXlt(lubridate::force_tz( - lubridate::as_datetime("2000-01-01 01:00:00"), tz)) - expect_equal(object, expected) + expect_equal(convert(lubridate::as_datetime("2000-01-01 01:00:00"), + "hms", quiet = TRUE), + hms::parse_hm("01:00")) + expect_equal(convert(lubridate::as_datetime("2000-01-01 01:00:00"), + "Date", quiet = TRUE), + as.Date("2000-01-01")) + expect_equal(convert(lubridate::as_datetime("2000-01-01 01:00:00"), + "POSIXct", tz = "EST", quiet = TRUE), + lubridate::force_tz( + lubridate::as_datetime("2000-01-01 01:00:00"), "EST")) + expect_equal(convert(lubridate::as_datetime("2000-01-01 01:00:00"), + "POSIXlt", tz = "EST", quiet = TRUE), + as.POSIXlt(lubridate::force_tz( + lubridate::as_datetime("2000-01-01 01:00:00"), "EST"))) }) test_that("convert.POSIXt() | transform test", { - x <- lubridate::as_datetime("2000-01-01 01:00:00") - object <- convert(x, "numeric", output_unit = "M", quiet = TRUE) - expect_identical(object, 60) + expect_identical(convert(lubridate::as_datetime("2000-01-01 01:00:00"), + "numeric", output_unit = "M", quiet = TRUE), + 60) }) test_that("convert.POSIXt() | warning test", { - x <- lubridate::as_datetime("2000-01-01 01:00:00") + expect_warning(convert(lubridate::as_datetime("2000-01-01 01:00:00"), + "logical", quiet = FALSE), + "'x' cannot be converted to 'logical'.") - "'x' cannot be converted to 'logical'" - expect_warning(convert(x, "logical", quiet = FALSE)) - # "'x' was converted to total of full seconds since [...]" - expect_warning(convert(x, "integer", quiet = FALSE)) - # "'x' was converted to total of seconds since [...]" - expect_warning(convert(x, "double", quiet = FALSE)) - expect_warning(convert(x, "numeric", quiet = FALSE)) + expect_warning(convert(lubridate::as_datetime("2000-01-01 01:00:00"), + "integer", quiet = FALSE), + "'x' was converted to total of full seconds since ") - # "'x' date was discarded. Only 'x' time [...]" - classes <- c("duration", "period", "difftime", "hms") - for (i in classes) expect_warning(convert(x, i, quiet = FALSE)) + expect_warning(convert(lubridate::as_datetime("2000-01-01 01:00:00"), + "double", quiet = FALSE), + "'x' was converted to total of seconds since ") + expect_warning(convert(lubridate::as_datetime("2000-01-01 01:00:00"), + "numeric", quiet = FALSE), + "'x' was converted to total of seconds since ") + + expect_warning(convert(lubridate::as_datetime("2000-01-01 01:00:00"), + "duration", quiet = FALSE), + "'x' date was discarded. Only 'x' time ") + expect_warning(convert(lubridate::as_datetime("2000-01-01 01:00:00"), + "difftime", quiet = FALSE), + "'x' date was discarded. Only 'x' time ") + expect_warning(convert(lubridate::as_datetime("2000-01-01 01:00:00"), + "hms", quiet = FALSE), + "'x' date was discarded. Only 'x' time ") }) test_that("convert.POSIXt() | error test", { - x <- lubridate::as_datetime("2000-01-01 01:00:00") - - # Invalid values for `class, `tz`, and `quiet` - expect_error(convert(x, 1, tz = "", quiet = TRUE)) - expect_error(convert(x, "hms", tz = 1, quiet = TRUE)) - expect_error(convert(x, "hms", tz = "", quiet = "")) + expect_error(convert(lubridate::as_datetime("2000-01-01 01:00:00"), 1, + tz = "", quiet = TRUE), + "Assertion on 'tolower\\(class\\)' failed") + expect_error(convert(lubridate::as_datetime("2000-01-01 01:00:00"), + "hms", tz = 1, quiet = TRUE), + "Assertion on 'tz' failed") + expect_error(convert(lubridate::as_datetime("2000-01-01 01:00:00"), + "hms", tz = "", quiet = ""), + "Assertion on 'quiet' failed") }) diff --git a/tests/testthat/test-convert.R b/tests/testthat/test-convert.R index cddf163..6bb6a8d 100644 --- a/tests/testthat/test-convert.R +++ b/tests/testthat/test-convert.R @@ -3,13 +3,13 @@ test_that("convert() | general test", { }) test_that("convert.Period() | general test", { - x <- lubridate::hours() - expect_equal(convert(x, "character", quiet = TRUE), "01:00:00") + expect_equal(convert(lubridate::hours(), "character", quiet = TRUE), + "01:00:00") }) test_that("convert.difftime() | general test", { - x <- as.difftime(1, units = "hours") - expect_equal(convert(x, "character", quiet = TRUE), "01:00:00") + expect_equal(convert(as.difftime(1, units = "hours"), "character", + quiet = TRUE), "01:00:00") }) test_that("convert_tu() | general test", { @@ -17,8 +17,8 @@ test_that("convert_tu() | general test", { }) test_that("convert_ut() | general test", { - expected <- hms::parse_hm("01:00") - expect_equal(convert_ut(1, "hms", "H", quiet = TRUE), expected) + expect_equal(convert_ut(1, "hms", "H", quiet = TRUE), + hms::parse_hm("01:00")) }) test_that("convert_uu() | general test", { @@ -26,8 +26,8 @@ test_that("convert_uu() | general test", { }) test_that("convert_pt() | general test", { - expected <- hms::parse_hm("01:00") - expect_equal(convert_pt(1, "hms", "H", quiet = TRUE), expected) + expect_equal(convert_pt(1, "hms", "H", quiet = TRUE), + hms::parse_hm("01:00")) }) test_that("convert_pu() | general test", { @@ -35,60 +35,51 @@ test_that("convert_pu() | general test", { }) test_that("parser_1() | general test", { - object <- parser_1(" 1 ", "duration", input_unit = "H", quiet = TRUE) - expect_equal(object, lubridate::dhours()) - - object <- parser_1(1, "double", input_unit = "H", output_unit = "deg", - quiet = TRUE) - expect_equal(object, 15) - - object <- parser_1(1, "hms", input_unit = "H", quiet = TRUE) - expect_equal(object, hms::parse_hm("01:00")) + expect_equal(parser_1(" 1 ", "duration", input_unit = "H", quiet = TRUE), + lubridate::dhours()) + expect_equal(parser_1(1, "double", input_unit = "H", output_unit = "deg", + quiet = TRUE), + 15) + expect_equal(parser_1(1, "hms", input_unit = "H", quiet = TRUE), + hms::parse_hm("01:00")) }) test_that("parser_1() | error test", { - # "To convert 'character' objects to units, all values must be [...]" - expect_error(parser_1(c("1", " NA", "a"), "hms")) - - # "'x' can only be converted to 'output_unit' if 'input_unit' [...]" - expect_error(parser_1(1, "hms", output_unit = "deg")) - - # "'x' can only be converted to 'output_unit' if 'class' [...]" - expect_error(parser_1(1, "hms", input_unit = "H", output_unit = "rad")) - - # "input_unit' and 'output_unit' must both be assigned, or be [...]" - expect_error(parser_1(1, "integer")) + expect_error(parser_1(c("1", " NA", "a"), "hms"), + "To convert 'character' objects to units, all values ") + expect_error(parser_1(1, "hms", output_unit = "deg"), + "'x' can only be converted to 'output_unit' if 'input_unit' ") + expect_error(parser_1(1, "hms", input_unit = "H", output_unit = "rad"), + "'x' can only be converted to 'output_unit' if 'class' ") + expect_error(parser_1(1, "integer"), + "input_unit' and 'output_unit' must both be assigned, or be ") }) test_that("parser_2() | general test", { - object <- parser_2(" 1 ", "duration", orders = "H", quiet = TRUE) - expect_equal(object, lubridate::dhours()) - - object <- parser_2(1, "integer", orders = "H", output_unit = "deg", - quiet = TRUE) - expect_equal(object, 15L) - - object <- parser_2(1, "numeric", orders = "H", output_unit = "rad", - quiet = TRUE) - expect_equal(object, (2 * pi) / 24) - - object <- parser_2(1, "hms", orders = "H", quiet = TRUE) - expect_equal(object, hms::parse_hm("01:00:00")) + expect_equal(parser_2(" 1 ", "duration", orders = "H", quiet = TRUE), + lubridate::dhours()) + expect_equal(parser_2(1, "integer", orders = "H", output_unit = "deg", + quiet = TRUE), + 15L) + expect_equal(parser_2(1, "numeric", orders = "H", output_unit = "rad", + quiet = TRUE), + (2 * pi) / 24) + expect_equal(parser_2(1, "hms", orders = "H", quiet = TRUE), + hms::parse_hm("01:00:00")) }) test_that("parser_3() | general test", { - object <- parser_3(lubridate::dhours(), "integer", output_unit = "H", - quiet = TRUE) - expect_equal(object, 1L) - - object <- parser_3(lubridate::dhours(), "numeric", output_unit = "M", - quiet = TRUE) - expect_equal(object, 60) + expect_equal(parser_3(lubridate::dhours(), "integer", output_unit = "H", + quiet = TRUE), + 1L) + expect_equal(parser_3(lubridate::dhours(), "numeric", output_unit = "M", + quiet = TRUE), + 60) }) test_that("parser_3() | error test", { - # "'x' can be only be converted to 'output_unit' if 'class' [...]" - expect_error(parser_3(lubridate::dhours(), "hms")) + expect_error(parser_3(lubridate::dhours(), "hms"), + "'x' can be only be converted to 'output_unit' if 'class' ") }) test_that("parse_to_date_time() | general test", { @@ -96,140 +87,136 @@ test_that("parse_to_date_time() | general test", { expect_equal(parse_to_date_time("NA", "H"), lubridate::as_datetime(NA)) expect_equal(parse_to_date_time(1, "H"), hms::parse_hm("01:00")) expect_equal(parse_to_date_time("01:59", "HM"), hms::parse_hm("01:59")) - - expected <- hms::parse_hms("01:59:59") - expect_equal(parse_to_date_time("01:59:59", "HMS"), expected) - - expected <- lubridate::ymd_hms("0000-01-01 01:00:59") - expect_equal(parse_to_date_time("01:59", "HS"), expected) - - expected <- lubridate::ymd_hms("2000-01-01 01:00:00") - expect_equal(parse_to_date_time("2000 1", "YH"), expected) + expect_equal(parse_to_date_time("01:59:59", "HMS"), + hms::parse_hms("01:59:59")) + expect_equal(parse_to_date_time("01:59", "HS"), + lubridate::ymd_hms("0000-01-01 01:00:59")) + expect_equal(parse_to_date_time("2000 1", "YH"), + lubridate::ymd_hms("2000-01-01 01:00:00")) }) test_that("parse_to_date_time() | warning test", { - # "All formats failed to parse. No formats found." - expect_warning(parse_to_date_time("a", "H", quiet = FALSE)) - - # na_diff, " failed to parse." - expect_warning(parse_to_date_time(c("1", "a"), "H", quiet = FALSE)) + expect_warning(parse_to_date_time("a", "H", quiet = FALSE), + "All formats failed to parse. No formats found.") + expect_warning(parse_to_date_time(c("1", "a"), "H", quiet = FALSE), + "1 failed to parse.") }) test_that("parse_to_date_time() | error test", { - # Invalid values for `x`, `orders`, `tz`, and `quiet` - expect_error(parse_to_date_time(lubridate::dhours())) - expect_error(parse_to_date_time(1, orders = 1)) - expect_error(parse_to_date_time(1, tz = 1)) - expect_error(parse_to_date_time(x, quiet = "")) + expect_error(parse_to_date_time(lubridate::dhours()), + "Assertion on 'x' failed") + expect_error(parse_to_date_time(1, orders = 1), + "Assertion on 'orders' failed") + expect_error(parse_to_date_time(1, tz = 1), + "Assertion on 'tz' failed") + expect_error(parse_to_date_time(1, quiet = ""), + "Assertion on 'quiet' failed") }) test_that("convert_to_seconds() | general test", { - month_length <- 30 * 24 * 60 * 60 - year_length <- month_length * 12 - - # if (any(class(x) %in% c("integer", "double", "numeric"))) expect_equal(convert_to_seconds(1, input_unit = "S"), 1) expect_equal(convert_to_seconds(1, input_unit = "M"), 60) expect_equal(convert_to_seconds(1, input_unit = "H"), 3600) expect_equal(convert_to_seconds(1, input_unit = "d"), 3600 * 24) expect_equal(convert_to_seconds(1, input_unit = "W"), 3600 * (24 * 7)) - expect_equal(convert_to_seconds( - 1, input_unit = "m", month_length = month_length), 3600 * (24 * 30)) - expect_equal(convert_to_seconds( - 1, input_unit = "y", year_length = year_length), 3600 * (24 * 30 * 12)) + expect_equal(convert_to_seconds(1, input_unit = "m", + month_length = 30 * 24 * 60 * 60), + 3600 * (24 * 30)) + expect_equal(convert_to_seconds(1, input_unit = "y", + year_length = 12 * 30 * 24 * 60 * 60), + 3600 * (12 * 30 * 24)) # pi = C / d; d = 2r; C = 24; pi = 24 / 2r; pi = 12 / r; r = 12 / pi - expect_equal(convert_to_seconds - (1, input_unit = "rad"), (12 / pi) * 60 * 60) + expect_equal(convert_to_seconds(1, input_unit = "rad"), + (12 / pi) * 60 * 60) # 360 deg = 24h; 360 deg = (24 * 60 * 60)s; deg = (24 * 60 * 60) / 360 - expect_equal(convert_to_seconds( - 1, input_unit = "deg"), (24 * 60 * 60) / 360) + expect_equal(convert_to_seconds(1, input_unit = "deg"), + (24 * 60 * 60) / 360) - # if (is_time(x)) + # if (test_temporal(x)) expect_equal(convert_to_seconds(lubridate::dhours()), 3600) expect_equal(convert_to_seconds(lubridate::hours()), 3600) expect_equal(convert_to_seconds(as.difftime(3600, units = "secs")), 3600) expect_equal(convert_to_seconds(hms::parse_hm("01:00")), 3600) - - object <- convert_to_seconds( as.Date("2000-01-01"), ignore_date = FALSE) - expect_equal(object, 946684800) - - object <- convert_to_seconds( as.Date("2000-01-01"), ignore_date = TRUE) - expect_equal(object, 0) - - object <- convert_to_seconds( - lubridate::as_datetime("2020-01-01 01:00:00"), ignore_date = FALSE) - expect_equal(object, 1577840400) - - object <- convert_to_seconds( - lubridate::as_datetime("2020-01-01 01:00:00"), ignore_date = TRUE) - expect_equal(object, 3600) - - object <- convert_to_seconds( - lubridate::as.interval(lubridate::dhours(), as.Date("2020-01-01"))) - expect_equal(object, 3600) + expect_equal(convert_to_seconds( as.Date("2000-01-01"), + ignore_date = FALSE), + 946684800) + expect_equal(convert_to_seconds( as.Date("2000-01-01"), ignore_date = TRUE), + 0) + expect_equal(convert_to_seconds( + lubridate::as_datetime("2020-01-01 01:00:00"), ignore_date = FALSE), + 1577840400) + expect_equal(convert_to_seconds( + lubridate::as_datetime("2020-01-01 01:00:00"), ignore_date = TRUE), + 3600) + expect_equal(convert_to_seconds( + lubridate::as.interval(lubridate::dhours(), as.Date("2020-01-01"))), + 3600) }) test_that("convert_to_seconds() | error test", { - x <- lubridate::dhours() - - # Invalid values for `x`, `input_unit`, `month_length`, `year_length`, - # `ignore_date`, and `quiet` - expect_error(convert_to_seconds(list())) - expect_error(convert_to_seconds(x, input_unit = "Z")) - expect_error(convert_to_seconds(x, month_length = "")) - expect_error(convert_to_seconds(x, month_length = -1)) - expect_error(convert_to_seconds(x, year_length = "")) - expect_error(convert_to_seconds(x, year_length = -1)) - expect_error(convert_to_seconds(x, ignore_date = "")) - expect_error(convert_to_seconds(x, quiet = "")) - - # !is_time(x) && is.null(input_unit) - expect_error(convert_to_seconds(1)) + expect_error(convert_to_seconds(list()), + "Assertion on 'x' failed") + expect_error(convert_to_seconds(lubridate::dhours(), input_unit = "Z"), + "Assertion on 'input_unit' failed") + expect_error(convert_to_seconds(lubridate::dhours(), month_length = ""), + "Assertion on 'month_length' failed") + expect_error(convert_to_seconds(lubridate::dhours(), month_length = -1), + "Assertion on 'month_length' failed") + expect_error(convert_to_seconds(lubridate::dhours(), year_length = ""), + "Assertion on 'year_length' failed") + expect_error(convert_to_seconds(lubridate::dhours(), year_length = -1), + "Assertion on 'year_length' failed") + expect_error(convert_to_seconds(lubridate::dhours(), ignore_date = ""), + "Assertion on 'ignore_date' failed") + expect_error(convert_to_seconds(lubridate::dhours(), quiet = ""), + "Assertion on 'quiet' failed") + + expect_error(convert_to_seconds(1), + "When 'x' is 'integer' or 'numeric', 'input_unit' ") }) test_that("convert_to_unit() | general test", { - x <- lubridate::dhours() - month_length <- 30 * 24 * 60 * 60 - year_length <- month_length * 12 - - expect_equal(convert_to_unit(x, output_unit = "S"), 3600) - expect_equal(convert_to_unit(x, output_unit = "M"), 60) - expect_equal(convert_to_unit(x, output_unit = "H"), 1) - expect_equal(convert_to_unit(x, output_unit = "d"), 1 / 24) - expect_equal(convert_to_unit(x, output_unit = "W"), 1 / (24 * 7)) - expect_equal(convert_to_unit(x, output_unit = "m", - month_length = month_length), 1 / (24 * 30)) - expect_equal(convert_to_unit(x, output_unit = "y", - year_length = year_length, - close_round = FALSE), 1 / (24 * 30 * 12)) - expect_equal(convert_to_unit(x, output_unit = "rad"), 0.2617994) - expect_equal(convert_to_unit(x, output_unit = "deg"), 15) - - x <- lubridate::dhours(1.999) - object <- convert_to_unit(x, output_unit = "H", close_round = FALSE) - expect_equal(object, 1.999) + expect_equal(convert_to_unit(lubridate::dhours(), output_unit = "S"), 3600) + expect_equal(convert_to_unit(lubridate::dhours(), output_unit = "M"), 60) + expect_equal(convert_to_unit(lubridate::dhours(), output_unit = "H"), 1) + expect_equal(convert_to_unit(lubridate::dhours(), output_unit = "d"), + 1 / 24) + expect_equal(convert_to_unit(lubridate::dhours(), output_unit = "W"), + 1 / (24 * 7)) + expect_equal(convert_to_unit(lubridate::dhours(), output_unit = "m", + month_length = 30 * 24 * 60 * 60), + 1 / (24 * 30)) + expect_equal(convert_to_unit(lubridate::dhours(), output_unit = "y", + year_length = 12 * 30 * 24 * 60 * 60, + close_round = FALSE), + 1 / (24 * 30 * 12)) + expect_equal(convert_to_unit(lubridate::dhours(), output_unit = "rad"), + 0.2617994) + expect_equal(convert_to_unit(lubridate::dhours(), output_unit = "deg"), 15) + expect_equal(convert_to_unit(lubridate::dhours(1.999), output_unit = "H", + close_round = FALSE), + 1.999) }) test_that("convert_to_unit() | error test", { - x <- lubridate::dhours() - - # Invalid values for `output_unit` and `close_round` - expect_error(convert_to_unit(x, output_unit = "Z", close_round = TRUE)) - expect_error(convert_to_unit(x, output_unit = "H", close_round = "")) + expect_error(convert_to_unit(lubridate::dhours(), output_unit = "Z", + close_round = TRUE), + "Assertion on 'output_unit' failed") + expect_error(convert_to_unit(lubridate::dhours(), output_unit = "H", + close_round = ""), + "Assertion on 'close_round' failed") }) test_that("convert_to_date_time() | general test", { - x <- 1 - object <- convert_to_date_time(x, "hms", input_unit = "H", quiet = TRUE) - expect_equal(object, hms::parse_hm("01:00:00")) - - x <- 3600 - object <- convert_to_date_time(x, "duration", input_unit = "S", - quiet = TRUE) - expect_equal(object, lubridate::dhours(1)) + expect_equal(convert_to_date_time(1, "hms", input_unit = "H", + quiet = TRUE), + hms::parse_hm("01:00:00")) + expect_equal(convert_to_date_time(3600, "duration", input_unit = "S", + quiet = TRUE), + lubridate::dhours(1)) }) test_that("convert_to_date_time() | error test", { - # Invalid value for `x` - expect_error(convert_to_date_time(lubridate::dhours(), "hms", "H")) + expect_error(convert_to_date_time(lubridate::dhours(), "hms", "H"), + "Assertion on 'x' failed") }) diff --git a/tests/testthat/test-fd.R b/tests/testthat/test-fd.R index a96b16f..1114742 100644 --- a/tests/testthat/test-fd.R +++ b/tests/testthat/test-fd.R @@ -7,6 +7,7 @@ test_that("fd() | scalar test", { expect_equal(fd(5), 2) expect_equal(fd(6), 1) expect_equal(fd(7), 0) + expect_equal(fd(as.numeric(NA)), as.integer(NA)) }) test_that("fd() | vector test", { @@ -16,12 +17,11 @@ test_that("fd() | vector test", { }) test_that("fd() | error test", { - # Invalid values for `wd` - expect_error(fd("test")) - expect_error(fd(1.5)) - expect_error(fd(10)) - expect_error(fd(-1)) - expect_error(fd(c(1, 10))) - expect_error(fd(lubridate::dhours(1))) - expect_error(fd(lubridate::minutes(1))) + expect_error(fd("test"), "Assertion on 'wd' failed") + expect_error(fd(1.5), "Assertion on 'wd' failed") + expect_error(fd(10), "Assertion on 'wd' failed") + expect_error(fd(-1), "Assertion on 'wd' failed") + expect_error(fd(c(1, 10)), "Assertion on 'wd' failed") + expect_error(fd(lubridate::dhours(1)), "Assertion on 'wd' failed") + expect_error(fd(lubridate::minutes(1)), "Assertion on 'wd' failed") }) diff --git a/tests/testthat/test-gu.R b/tests/testthat/test-gu.R index 5c2ee4e..a1d5112 100644 --- a/tests/testthat/test-gu.R +++ b/tests/testthat/test-gu.R @@ -1,37 +1,25 @@ test_that("gu() | scalar test", { - se <- hms::parse_hm("08:00") - si <- lubridate::dminutes(10) - object <- gu(se, si) - expected <- hms::parse_hm("08:10") - expect_equal(object, expected) - - se <- hms::parse_hm("23:30") - si <- lubridate::dminutes(90) - object <- gu(se, si) - expected <- hms::parse_hm("01:00") - expect_equal(object, expected) - - se <- hms::parse_hm("23:30") - si <- lubridate::as.duration(NA) - object <- gu(se, si) - expected <- hms::as_hms(NA) - expect_equal(object, expected) + expect_equal(gu(hms::parse_hm("08:00"), lubridate::dminutes(10)), + hms::parse_hm("08:10")) + expect_equal(gu(hms::parse_hm("23:30"), lubridate::dminutes(90)), + hms::parse_hm("01:00")) + expect_equal(gu(hms::parse_hm("23:30"), lubridate::as.duration(NA)), + hms::as_hms(NA)) }) test_that("gu() | vector test", { - se <- c(hms::parse_hm("12:30"), hms::parse_hm("23:45")) - si <- c(lubridate::dminutes(10), lubridate::dminutes(70)) - object <- gu(se, si) - expected <- c(hms::parse_hm("12:40"), hms::parse_hm("00:55")) - expect_equal(object, expected) + expect_equal(gu(c(hms::parse_hm("12:30"), hms::parse_hm("23:45")), + c(lubridate::dminutes(10), lubridate::dminutes(70))), + c(hms::parse_hm("12:40"), hms::parse_hm("00:55"))) }) test_that("gu() | error test", { - # Invalid values for `se` and `si` - expect_error(gu(1, lubridate::duration(1))) - expect_error(gu(hms::hms(1), 1)) + expect_error(gu(1, lubridate::duration(1)), + "Assertion on 'se' failed") + expect_error(gu(hms::hms(1), 1), + "Assertion on 'si' failed") - # `se` and `si` have different lengths expect_error(gu(hms::hms(1), c(lubridate::duration(1), - lubridate::duration(1)))) + lubridate::duration(1))), + "'se' and 'si' must have identical lengths.") }) diff --git a/tests/testthat/test-le_week.R b/tests/testthat/test-le_week.R index 99aed90..6fd07fd 100644 --- a/tests/testthat/test-le_week.R +++ b/tests/testthat/test-le_week.R @@ -1,60 +1,56 @@ test_that("le_week() | scalar test", { - le_w <- lubridate::dhours(2.3) - le_f <- lubridate::dhours(4.5) - wd <- 5 - object <- le_week(le_w, le_f, wd) - expected <- lubridate::as.duration( - stats::weighted.mean(c(le_w, le_f),c(wd, fd(wd)))) - expect_equal(object, expected) - - le_w <- lubridate::dhours(5.25) - le_f <- lubridate::dhours(1.25) - wd <- 3 - object <- le_week(le_w, le_f, wd) - expected <- lubridate::as.duration( - stats::weighted.mean(c(le_w, le_f),c(wd, fd(wd)))) - expect_equal(object, expected) - - le_w <- lubridate::as.duration(NA) - le_f <- lubridate::dhours(2.35) - wd <- 2 - object <- le_week(le_w, le_f, wd) - expected <- lubridate::as.duration(NA) - expect_equal(object, expected) + expect_equal(le_week(lubridate::dhours(2.3), lubridate::dhours(4.5), 5), + lubridate::as.duration( + stats::weighted.mean(c(lubridate::dhours(2.3), + lubridate::dhours(4.5)), + c(5, 2)))) + expect_equal(le_week(lubridate::dhours(5.25), lubridate::dhours(1.25), 3), + lubridate::as.duration( + stats::weighted.mean(c(lubridate::dhours(5.25), + lubridate::dhours(1.25)), + c(3, 4)))) + expect_equal(le_week(lubridate::as.duration(NA), + lubridate::dhours(2.35), 2), + lubridate::as.duration(NA)) }) test_that("le_week() | vector test", { - le_w <- c(lubridate::dhours(2.4), lubridate::dhours(0.5)) - le_f <- c(lubridate::dhours(2.4), lubridate::dhours(NA)) - wd <- c(3, 7) - object <- le_week(le_w, le_f, wd) - expected_1 <- stats::weighted.mean(c(le_w[1], le_f[1]), c(wd[1], fd(wd[1]))) - expected_2 <- lubridate::as.duration(NA) - expected <- c(lubridate::duration(expected_1), - lubridate::duration(expected_2)) - expect_equal(object, expected) - - le_w <- c(lubridate::dhours(1.8), lubridate::dhours(5.4)) - le_f <- c(lubridate::dhours(6.7), lubridate::dhours(1.2)) - wd <- c(5, 6) - object <- le_week(le_w, le_f, wd) - expected_1 <- stats::weighted.mean(c(le_w[1], le_f[1]), c(wd[1], fd(wd[1]))) - expected_2 <- stats::weighted.mean(c(le_w[2], le_f[2]), c(wd[2], fd(wd[2]))) - expected <- c(lubridate::duration(expected_1), - lubridate::duration(expected_2)) - expect_equal(object, expected) + expect_equal(le_week(c(lubridate::dhours(2.4), lubridate::dhours(0.5)), + c(lubridate::dhours(2.4), lubridate::dhours(NA)), + c(3, 7)), + c(lubridate::duration( + stats::weighted.mean(c(lubridate::dhours(2.4), + lubridate::dhours(2.4)), + c(3, 4))), + lubridate::as.duration(NA))) + expect_equal(le_week(c(lubridate::dhours(1.8), lubridate::dhours(5.4)), + c(lubridate::dhours(6.7), lubridate::dhours(1.2)), + c(5, 6)), + c(lubridate::duration( + stats::weighted.mean(c(lubridate::dhours(1.8), + lubridate::dhours(6.7)), + c(5, 2))), + lubridate::duration( + stats::weighted.mean(c(lubridate::dhours(5.4), + lubridate::dhours(1.2)), + c(6, 1))))) }) test_that("le_week() | error test", { - # Invalid values for `le_w`, `le_f`, and `wd` - expect_error(le_week(1, lubridate::duration(1), 1)) - expect_error(le_week(lubridate::duration(1), 1, 1)) - expect_error(le_week(lubridate::duration(1), lubridate::duration(1), "a")) - expect_error(le_week(lubridate::duration(1), lubridate::duration(1), 1.5)) - expect_error(le_week(lubridate::duration(1), lubridate::duration(1), -1)) - expect_error(le_week(lubridate::duration(1), lubridate::duration(1), 8)) + expect_error(le_week(1, lubridate::duration(1), 1), + "Assertion on 'le_w' failed") + expect_error(le_week(lubridate::duration(1), 1, 1), + "Assertion on 'le_f' failed") + expect_error(le_week(lubridate::duration(1), lubridate::duration(1), "a"), + "Assertion on 'wd' failed") + expect_error(le_week(lubridate::duration(1), lubridate::duration(1), 1.5), + "Assertion on 'wd' failed") + expect_error(le_week(lubridate::duration(1), lubridate::duration(1), -1), + "Assertion on 'wd' failed") + expect_error(le_week(lubridate::duration(1), lubridate::duration(1), 8), + "Assertion on 'wd' failed") - # `le_w`, `le_f`, and `wd` have different lengths expect_error(le_week(lubridate::duration(1), lubridate::duration(1), - c(1, 1))) + c(1, 1)), + "'le_w', 'le_f', and 'wd' must have identical lengths.") }) diff --git a/tests/testthat/test-ms.R b/tests/testthat/test-ms.R index afe884e..e6d2b87 100644 --- a/tests/testthat/test-ms.R +++ b/tests/testthat/test-ms.R @@ -1,43 +1,26 @@ test_that("ms() | scalar test", { - so <- hms::parse_hm("22:00") - sd <- lubridate::dhours(8) - object <- ms(so, sd) - expected <- hms::parse_hm("02:00") - expect_equal(object, expected) - - so <- hms::parse_hm("02:00") - sd <- lubridate::dhours(6) - object <- ms(so, sd) - expected <- hms::parse_hm("05:00") - expect_equal(object, expected) - - so <- hms::as_hms(NA) - sd <- lubridate::dhours(6) - object <- ms(so, sd) - expected <- hms::as_hms(NA) - expect_equal(object, expected) + expect_equal(ms(hms::parse_hm("22:00"), lubridate::dhours(8)), + hms::parse_hm("02:00")) + expect_equal(ms(hms::parse_hm("02:00"), lubridate::dhours(6)), + hms::parse_hm("05:00")) + expect_equal(ms(hms::as_hms(NA), lubridate::dhours(6)), hms::as_hms(NA)) }) test_that("ms() | vector test", { - so <- c(hms::parse_hm("23:30"), hms::parse_hm("03:30")) - sd <- c(lubridate::dhours(8), lubridate::dhours(10)) - object <- ms(so, sd) - expected <- c(hms::parse_hm("03:30"), hms::parse_hm("08:30")) - expect_equal(object, expected) - - so <- c(hms::parse_hm("04:15"), hms::parse_hm("21:00")) - sd <- c(lubridate::dhours(6.5), lubridate::as.duration(NA)) - object <- ms(so, sd) - expected <- c(hms::parse_hm("07:30"), hms::as_hms(NA)) - expect_equal(object, expected) + expect_equal(ms(c(hms::parse_hm("23:30"), hms::parse_hm("03:30")), + c(lubridate::dhours(8), lubridate::dhours(10))), + c(hms::parse_hm("03:30"), hms::parse_hm("08:30"))) + expect_equal(ms(c(hms::parse_hm("04:15"), hms::parse_hm("21:00")), + c(lubridate::dhours(6.5), lubridate::as.duration(NA))), + c(hms::parse_hm("07:30"), hms::as_hms(NA))) }) test_that("ms() | error test", { - # Invalid values for `so` and `sd` - expect_error(ms(1, lubridate::duration(1))) - expect_error(ms(hms::hms(1), 1)) - - # `so` and `sd` have different lengths + expect_error(ms(1, lubridate::duration(1)), + "Assertion on 'so' failed") + expect_error(ms(hms::hms(1), 1), + "Assertion on 'sd' failed") expect_error(ms(hms::hms(1), c(lubridate::duration(1), - lubridate::duration(1)))) + lubridate::duration(1))), + "'so' and 'sd' must have identical lengths.") }) diff --git a/tests/testthat/test-msf_sc.R b/tests/testthat/test-msf_sc.R index ec46402..451a7e1 100644 --- a/tests/testthat/test-msf_sc.R +++ b/tests/testthat/test-msf_sc.R @@ -1,124 +1,116 @@ test_that("msf_sc() | scalar test", { - msf <- hms::parse_hm("04:00") - sd_w <- lubridate::dhours(6) - sd_f <- lubridate::dhours(8) - sd_week <- sd_week(sd_w, sd_f, 5) - alarm_f <- FALSE - object <- msf_sc(msf, sd_w, sd_f, sd_week, alarm_f) - expected <- hms::parse_hms("03:17:08.571429") - expect_equal(object, expected) - - msf <- hms::parse_hm("23:30") - sd_w <- lubridate::dhours(7) - sd_f <- lubridate::dhours(9) - sd_week <- sd_week(sd_w, sd_f, 3) - alarm_f <- FALSE - object <- msf_sc(msf, sd_w, sd_f, sd_week, alarm_f) - expected <- hms::parse_hms("23:04:17.142857") - expect_equal(object, expected) - - msf <- hms::parse_hm("02:15") - sd_w <- lubridate::dhours(9) - sd_f <- lubridate::dhours(7) - sd_week <- sd_week(sd_w, sd_f, 5) - alarm_f <- FALSE - object <- msf_sc(msf, sd_w, sd_f, sd_week, alarm_f) - expected <- msf - expect_equal(object, expected) - - msf <- hms::parse_hm("00:00") - sd_w <- lubridate::dhours(6.15) - sd_f <- lubridate::dhours(8.25) - sd_week <- lubridate::as.duration(NA) - alarm_f <- FALSE - object <- msf_sc(msf, sd_w, sd_f, sd_week, alarm_f) - expected <- hms::as_hms(NA) - expect_equal(object, expected) - - msf <- hms::parse_hm("01:00") - sd_w <- lubridate::dhours(8) - sd_f <- lubridate::dhours(5.5) - sd_week <- lubridate::as.duration(NA) - alarm_f <- FALSE - object <- msf_sc(msf, sd_w, sd_f, sd_week, alarm_f) - expected <- msf - expect_equal(object, expected) - - msf <- hms::parse_hm("02:25") - sd_w <- lubridate::as.duration(NA) - sd_f <- lubridate::dhours(9.5) - sd_week <- sd_week(sd_w, sd_f, 5) - alarm_f <- FALSE - object <- msf_sc(msf, sd_w, sd_f, sd_week, alarm_f) - expected <- hms::as_hms(NA) - expect_equal(object, expected) - - msf <- hms::parse_hm("21:15") - sd_w <- lubridate::dhours(8) - sd_f <- lubridate::dhours(8) - sd_week <- sd_week(sd_w, sd_f, 6) - alarm_f <- TRUE - object <- msf_sc(msf, sd_w, sd_f, sd_week, alarm_f) - expected <- hms::as_hms(NA) - expect_equal(object, expected) + expect_equal(msf_sc(hms::parse_hm("04:00"), + lubridate::dhours(6), + lubridate::dhours(8), + sd_week(lubridate::dhours(6), + lubridate::dhours(8), + 5), + FALSE), + hms::parse_hms("03:17:08.571429")) + expect_equal(msf_sc(hms::parse_hm("23:30"), + lubridate::dhours(7), + lubridate::dhours(9), + sd_week(lubridate::dhours(7), + lubridate::dhours(9), + 3), + FALSE), + hms::parse_hms("23:04:17.142857")) + expect_equal(msf_sc(hms::parse_hm("02:15"), + lubridate::dhours(9), + lubridate::dhours(7), + sd_week(lubridate::dhours(9), + lubridate::dhours(7), + 5), + FALSE), + hms::parse_hm("02:15")) + expect_equal(msf_sc(hms::parse_hm("00:00"), + lubridate::dhours(6.15), + lubridate::dhours(8.25), + lubridate::as.duration(NA), + FALSE), + hms::as_hms(NA)) + expect_equal(msf_sc(hms::parse_hm("01:00"), + lubridate::dhours(8), + lubridate::dhours(5.5), + lubridate::as.duration(NA), + FALSE), + hms::parse_hm("01:00")) + expect_equal(msf_sc(hms::parse_hm("02:25"), + lubridate::as.duration(NA), + lubridate::dhours(9.5), + sd_week(lubridate::as.duration(NA), + lubridate::dhours(9.5), + 5), + FALSE), + hms::as_hms(NA)) + expect_equal(msf_sc(hms::parse_hm("21:15"), + lubridate::dhours(8), + lubridate::dhours(8), + sd_week(lubridate::dhours(8), + lubridate::dhours(8), + 6), + TRUE), + hms::as_hms(NA)) }) test_that("msf_sc() | vector test", { - msf <- c(hms::parse_hm("03:45"), hms::parse_hm("22:30")) - sd_w <- c(lubridate::dhours(6), lubridate::dhours(5.5)) - sd_f <- c(lubridate::dhours(7.5), lubridate::dhours(8)) - sd_week <- c(sd_week(sd_w[1], sd_f[1], 5), sd_week(sd_w[2], sd_f[2], 4)) - alarm_f <- c(FALSE, FALSE) - object <- msf_sc(msf, sd_w, sd_f, sd_week, alarm_f) - expected <- c(hms::parse_hms("03:12:51.428571"), - hms::parse_hms("21:47:08.571429")) - expect_equal(object, expected) - - msf <- c(hms::parse_hm("03:45"), hms::parse_hm("21:30")) - sd_w <- c(lubridate::dhours(7), lubridate::dhours(6.5)) - sd_f <- c(lubridate::dhours(7), lubridate::dhours(8)) - sd_week <- c(sd_week(sd_w[1], sd_f[1], 5), sd_week(sd_w[2], sd_f[2], 5)) - alarm_f <- c(FALSE, TRUE) - object <- msf_sc(msf, sd_w, sd_f, sd_week, alarm_f) - expected <- c(hms::parse_hm("03:45"), hms::as_hms(NA)) - expect_equal(object, expected) - - msf <- c(hms::parse_hm("01:20"), hms::as_hms(NA)) - sd_w <- c(lubridate::dhours(5), lubridate::dhours(7)) - sd_f <- c(lubridate::dhours(8.5), lubridate::dhours(9)) - sd_week <- c(lubridate::as.duration(NA), sd_week(sd_w[2], sd_f[2], 3)) - alarm_f <- c(FALSE, FALSE) - object <- msf_sc(msf, sd_w, sd_f, sd_week, alarm_f) - expected <- c(hms::as_hms(NA), hms::as_hms(NA)) - expect_equal(object, expected) + expect_equal(msf_sc(c(hms::parse_hm("03:45"), hms::parse_hm("22:30")), + c(lubridate::dhours(6), lubridate::dhours(5.5)), + c(lubridate::dhours(7.5), lubridate::dhours(8)), + c(sd_week(lubridate::dhours(6), + lubridate::dhours(7.5), + 5), + sd_week(lubridate::dhours(5.5), + lubridate::dhours(8), + 4)), + c(FALSE, FALSE)), + c(hms::parse_hms("03:12:51.428571"), + hms::parse_hms("21:47:08.571429"))) + expect_equal(msf_sc(c(hms::parse_hm("03:45"), hms::parse_hm("21:30")), + c(lubridate::dhours(7), lubridate::dhours(6.5)), + c(lubridate::dhours(7), lubridate::dhours(8)), + c(sd_week(lubridate::dhours(7), + lubridate::dhours(7), + 5), + sd_week(lubridate::dhours(7), + lubridate::dhours(8), + 5)), + c(FALSE, TRUE)), + c(hms::parse_hm("03:45"), hms::as_hms(NA))) + expect_equal(msf_sc(c(hms::parse_hm("01:20"), hms::as_hms(NA)), + c(lubridate::dhours(5), lubridate::dhours(7)), + c(lubridate::dhours(8.5), lubridate::dhours(9)), + c(lubridate::as.duration(NA), + sd_week(lubridate::dhours(7), + lubridate::dhours(9), + 3)), + c(FALSE, FALSE)), + c(hms::as_hms(NA), hms::as_hms(NA))) }) test_that("msf_sc() | error test", { - # Invalid values for `msf`, `sd_w`, `sd_f`, `sd_week`, and `alarm_f` expect_error(msf_sc(1, lubridate::duration(1), lubridate::duration(1), - lubridate::duration(1), TRUE)) + lubridate::duration(1), TRUE), + "Assertion on 'msf' failed") expect_error(msf_sc(hms::hms(1), 1, lubridate::duration(1), - lubridate::duration(1), TRUE)) + lubridate::duration(1), TRUE), + "Assertion on 'sd_w' failed") expect_error(msf_sc(hms::hms(1), lubridate::duration(1), 1, - lubridate::duration(1), TRUE)) + lubridate::duration(1), TRUE), + "Assertion on 'sd_f' failed") expect_error(msf_sc(hms::hms(1), lubridate::duration(1), - lubridate::duration(1), 1, TRUE)) + lubridate::duration(1), 1, TRUE), + "Assertion on 'sd_week' failed") expect_error(msf_sc(hms::hms(1), lubridate::duration(1), - lubridate::duration(1), lubridate::duration(1), 1)) + lubridate::duration(1), lubridate::duration(1), 1), + "Assertion on 'alarm_f' failed") - # `msf`, `sd_w`, `sd_f`, `sd_week`, and `alarm_f` have different lengths expect_error(msf_sc(hms::hms(1), lubridate::duration(1), lubridate::duration(1), lubridate::duration(1), - c(TRUE, FALSE))) + c(TRUE, FALSE)), + "'msf', 'sd_w', 'sd_f', 'sd_week', and 'alarm_f' must have ") }) test_that("msf_sc() | wrappers", { - msf <- hms::parse_hm("03:25") - sd_w <- lubridate::dhours(7) - sd_f <- lubridate::dhours(8) - sd_week <- sd_week(sd_w, sd_f, 2) - alarm_f <- FALSE - object <- chronotype(msf, sd_w, sd_f, sd_week, alarm_f) - expected <- hms::parse_hms("03:16:25.714286") - expect_equal(object, expected) + expect_equal(msf_sc, chronotype) }) diff --git a/tests/testthat/test-napd.R b/tests/testthat/test-napd.R index b50dab9..0e273a5 100644 --- a/tests/testthat/test-napd.R +++ b/tests/testthat/test-napd.R @@ -1,36 +1,22 @@ test_that("napd() | scalar test", { - napo <- hms::parse_hm("14:00") - nape <- hms::parse_hm("17:30") - object <- napd(napo, nape) - expected <- lubridate::dhours(3.5) - expect_equal(object, expected) - - napo <- hms::parse_hm("23:00") - nape <- hms::parse_hm("00:00") - object <- napd(napo, nape) - expected <- lubridate::dhours(1) - expect_equal(object, expected) - - napo <- hms::as_hms(NA) - nape <- hms::parse_hm("15:45") - object <- napd(napo, nape) - expected <- lubridate::as.duration(NA) - expect_equal(object, expected) + expect_equal(napd(hms::parse_hm("14:00"), hms::parse_hm("17:30")), + lubridate::dhours(3.5)) + expect_equal(napd(hms::parse_hm("23:00"), hms::parse_hm("00:00")), + lubridate::dhours(1)) + expect_equal(napd(hms::as_hms(NA), hms::parse_hm("15:45")), + lubridate::as.duration(NA)) }) test_that("napd() | vector test", { - napo <- c(hms::parse_hm("03:30"), hms::parse_hm("22:00")) - nape <- c(hms::parse_hm("04:00"), hms::parse_hm("01:00")) - object <- napd(napo, nape) - expected <- c(lubridate::dhours(0.5), lubridate::dhours(3)) - expect_equal(object, expected) + expect_equal(napd(c(hms::parse_hm("03:30"), hms::parse_hm("22:00")), + c(hms::parse_hm("04:00"), hms::parse_hm("01:00"))), + c(lubridate::dhours(0.5), lubridate::dhours(3))) }) test_that("napd() | error test", { - # Invalid values for `napo` and `nape` - expect_error(napd(1, hms::hms(1))) - expect_error(napd(hms::hms(1), 1)) + expect_error(napd(1, hms::hms(1)), "Assertion on 'napo' failed") + expect_error(napd(hms::hms(1), 1), "Assertion on 'nape' failed") - # `napo` and `nape` have different lengths - expect_error(napd(hms::hms(1), c(hms::hms(1), hms::hms(1)))) + expect_error(napd(hms::hms(1), c(hms::hms(1), hms::hms(1))), + "'napo' and 'nape' must have identical lengths.") }) diff --git a/tests/testthat/test-pretty_mctq.R b/tests/testthat/test-pretty_mctq.R index 0cfe39f..3c323a7 100644 --- a/tests/testthat/test-pretty_mctq.R +++ b/tests/testthat/test-pretty_mctq.R @@ -16,10 +16,9 @@ test_that("pretty_mctq() | general test", { }) test_that("pretty_mctq() | error test", { - data <- datasets::iris - - # Invalid values for `data`, `round`, and `hms` - expect_error(pretty_mctq(1, TRUE, TRUE)) - expect_error(pretty_mctq(data, "a", TRUE)) - expect_error(pretty_mctq(data, TRUE, "")) + expect_error(pretty_mctq(1, TRUE, TRUE), "Assertion on 'data' failed") + expect_error(pretty_mctq(datasets::iris, "a", TRUE), + "Assertion on 'round' failed") + expect_error(pretty_mctq(datasets::iris, TRUE, ""), + "Assertion on 'hms' failed") }) diff --git a/tests/testthat/test-qplot_walk.R b/tests/testthat/test-qplot_walk.R index 34984e8..6d353c4 100644 --- a/tests/testthat/test-qplot_walk.R +++ b/tests/testthat/test-qplot_walk.R @@ -1,9 +1,7 @@ -# Don't forget to run devtools::load_all(".") and uncomment the variables -# before trying to run the tests interactively. - test_that("qplot_walk() | general test", { - data <- utils::head(datasets::iris, 5) - + # ## Don't forget to run devtools::load_all(".") and uncomment the variables + # ## before trying to run the tests interactively. + # # is_interactive <- mctq:::is_interactive # require_namespace <- mctq:::require_namespace # dialog_line <- mctq:::dialog_line @@ -14,7 +12,7 @@ test_that("qplot_walk() | general test", { mockr::with_mock( is_interactive = function(...) TRUE, require_namespace = function(...) TRUE, - suppressWarnings(qplot_walk(data[[1]]))) + suppressWarnings(qplot_walk(utils::head(datasets::iris, 5)[[1]]))) } # x <- mock() @@ -25,7 +23,8 @@ test_that("qplot_walk() | general test", { mockr::with_mock( is_interactive = function(...) TRUE, require_namespace = function(...) TRUE, - suppressWarnings(qplot_walk(data[[1]], xlab = "test"))) + suppressWarnings(qplot_walk(utils::head(datasets::iris, 5)[[1]], + xlab = "test"))) } # x <- mock() @@ -37,7 +36,7 @@ test_that("qplot_walk() | general test", { is_interactive = function(...) TRUE, require_namespace = function(...) TRUE, dialog_line = function(...) TRUE, - qplot_walk(data)) + qplot_walk(utils::head(datasets::iris, 5))) } # x <- mock() @@ -47,7 +46,6 @@ test_that("qplot_walk() | general test", { # "x <- transform(data[[i]], midday_change)" # "if ("xlab" %in% names(list(...)))" data <- data.frame(a = hms::parse_hm("23:00"), b = lubridate::dhours(1)) - mock <- function(.parent = parent.frame(), .env = topenv(.parent)) { mockr::with_mock( is_interactive = function(...) TRUE, @@ -61,57 +59,55 @@ test_that("qplot_walk() | general test", { }) test_that("qplot_walk() | error test", { - data <- utils::head(datasets::iris, 5) - + # ## Don't forget to run devtools::load_all(".") and uncomment the variables + # ## before trying to run the tests interactively. + # # is_interactive <- mctq:::is_interactive # require_namespace <- mctq:::require_namespace # dialog_line <- mctq:::dialog_line # qplot_walk <- mctq::qplot_walk - # "This function can only be used in interactive mode" mock <- function(.parent = parent.frame(), .env = topenv(.parent)) { mockr::with_mock( is_interactive = function(...) FALSE, - qplot_walk(data)) + qplot_walk(utils::head(datasets::iris, 5))) } # mock() - expect_error(mock()) + expect_error(mock(), "This function can only be used in interactive mode.") # "This function requires the `grDevices` and `ggplot2` [...]" mock <- function(.parent = parent.frame(), .env = topenv(.parent)) { mockr::with_mock( is_interactive = function(...) TRUE, require_namespace = function(...) FALSE, - qplot_walk(data)) + qplot_walk(utils::head(datasets::iris, 5))) } # mock() expect_error(mock()) - # "`x`, `y` and `data` are reserved arguments for `qplot_walk()`" mock <- function(.parent = parent.frame(), .env = topenv(.parent)) { mockr::with_mock( is_interactive = function(...) TRUE, require_namespace = function(...) TRUE, - qplot_walk(data, x = 1)) + qplot_walk(utils::head(datasets::iris, 5), x = 1)) } # mock() - expect_error(mock()) + expect_error(mock(), "'x', 'y' and `data` are reserved arguments for .") - # "`cols` and `pattern` can't both have values [...]" mock <- function(.parent = parent.frame(), .env = topenv(.parent)) { mockr::with_mock( is_interactive = function(...) TRUE, require_namespace = function(...) TRUE, - qplot_walk(data, cols = "Sepal.Length", pattern = "\\.")) + qplot_walk(utils::head(datasets::iris, 5), cols = "Sepal.Length", + pattern = "\\.")) } # mock() - expect_error(mock()) + expect_error(mock(), "'cols' and 'pattern' can't both have values. ") - # "`cols` and `pattern` can't both have values [...]" mock <- function(.parent = parent.frame(), .env = topenv(.parent)) { mockr::with_mock( is_interactive = function(...) TRUE, @@ -120,61 +116,58 @@ test_that("qplot_walk() | error test", { } # mock() - expect_error(mock()) + expect_error(mock(), "'data' must be an 'atomic' object or a data frame.") - # "None match was found in `names(data)`" mock <- function(.parent = parent.frame(), .env = topenv(.parent)) { mockr::with_mock( is_interactive = function(...) TRUE, require_namespace = function(...) TRUE, - qplot_walk(data, pattern = "^999$")) + qplot_walk(utils::head(datasets::iris, 5), pattern = "^999$")) } # mock() - expect_error(mock()) - - # "You can't ignore all variables in `cols` or in `data` [...]" - ignore <- unique(vapply(data, function(x) class(x)[1], character(1))) + expect_error(mock(), "None match was found in 'names\\(data\\)'.") + ignore <- unique(vapply(utils::head(datasets::iris, 5), + function(x) class(x)[1], character(1))) mock <- function(.parent = parent.frame(), .env = topenv(.parent)) { mockr::with_mock( is_interactive = function(...) TRUE, require_namespace = function(...) TRUE, - qplot_walk(data, ignore = ignore)) + qplot_walk(utils::head(datasets::iris, 5), ignore = ignore)) } # mock() - expect_error(mock()) + expect_error(mock(), "You can't ignore all variables in 'cols' or in ") }) test_that("qplot_walk() | warning test", { - data <- utils::head(datasets::iris, 5) - + # ## Don't forget to run devtools::load_all(".") and uncomment the variables + # ## before trying to run the tests interactively. + # # is_interactive <- mctq:::is_interactive # require_namespace <- mctq:::require_namespace # dialog_line <- mctq:::dialog_line # qplot_walk <- mctq::qplot_walk - # "`data` is atomic. All other arguments, except `...` and [...]" mock <- function(.parent = parent.frame(), .env = topenv(.parent)) { mockr::with_mock( is_interactive = function(...) TRUE, require_namespace = function(...) TRUE, - qplot_walk(data[[1]])) + qplot_walk(utils::head(datasets::iris, 5)[[1]])) } # mock() - expect_warning(mock()) + expect_warning(mock(), "'data' is 'atomic'. All other arguments, ") - # "inline_collapse(match), " will be ignored due to the [...]" mock <- function(.parent = parent.frame(), .env = topenv(.parent)) { mockr::with_mock( is_interactive = function(...) TRUE, require_namespace = function(...) TRUE, dialog_line = function(...) TRUE, - qplot_walk(data, ignore = "factor")) + qplot_walk(utils::head(datasets::iris, 5), ignore = "factor")) } # mock() - expect_warning(mock()) + expect_warning(mock(), "'Species' will be ignored due to the settings ") }) diff --git a/tests/testthat/test-random_mctq.R b/tests/testthat/test-random_mctq.R index 218813a..b431733 100644 --- a/tests/testthat/test-random_mctq.R +++ b/tests/testthat/test-random_mctq.R @@ -1,6 +1,3 @@ -# Don't forget to run devtools::load_all(".") and uncomment the variables -# before trying to run the tests interactively. - test_that("random_mctq() | general test", { set.seed(1) checkmate::expect_list(shush(random_mctq(model = "standard"))) @@ -16,10 +13,12 @@ test_that("random_mctq() | general test", { }) test_that("random_mctq() | error test", { + # ## Don't forget to run devtools::load_all(".") and uncomment the variables + # ## before trying to run the tests interactively. + # # require_namespace <- mctq:::require_namespace # random_mctq <- mctq::random_mctq - # "This function requires the `stats` package to run [...]" mock <- function(.parent = parent.frame(), .env = topenv(.parent)) { mockr::with_mock( require_namespace = function(...) FALSE, @@ -27,22 +26,16 @@ test_that("random_mctq() | error test", { } # mock() - expect_error(mock()) + expect_error(mock(), "This function requires the 'stats' package to run. ") - # Invalid values for `model` and `quiet` - expect_error(random_mctq(model = 1)) - expect_error(random_mctq(quiet = 1)) + expect_error(random_mctq(model = 1), "Assertion on 'model' failed") + expect_error(random_mctq(quiet = 1), "Assertion on 'quiet' failed") }) test_that("random_mctq() | message test", { - # "\nModel: Standard MCTQ\n" - expect_message(random_mctq(model = "standard")) - - # "\nModel: Micro MCTQ\n" - expect_message(random_mctq(model = "micro")) - - "\nModel: MCTQ Shift\n" - expect_message(random_mctq(model = "shift")) + expect_message(random_mctq(model = "standard"), "\nModel: Standard MCTQ\n") + expect_message(random_mctq(model = "micro"), "\nModel: Micro MCTQ\n") + expect_message(random_mctq(model = "shift"), "\nModel: MCTQ Shift\n") }) test_that("random_std_mctq() | general test", { @@ -96,169 +89,258 @@ test_that("random_shift_mctq() | general test", { expect_false(x$nap_f_n) # Invalid values for `n_w` and `n_f` - expect_error(random_shift_mctq(n_w = "")) - expect_error(random_shift_mctq(n_w = c(1, 1))) - expect_error(random_shift_mctq(n_f = "")) - expect_error(random_shift_mctq(n_f = c(1, 1))) + expect_error(random_shift_mctq(n_w = ""), "Assertion on 'n_w' failed") + expect_error(random_shift_mctq(n_w = c(1, 1)), "Assertion on 'n_w' failed") + expect_error(random_shift_mctq(n_f = ""), "Assertion on 'n_f' failed") + expect_error(random_shift_mctq(n_f = c(1, 1)), "Assertion on 'n_f' failed") }) test_that("normalize() | general test", { # else if (check_2) - min <- hms::parse_hm("22:00") + lubridate::ddays(1) - max <- hms::parse_hm("05:00") - mean <- hms::parse_hm("02:00") - object <- normalize(min, max, mean) - expected <- hms::hms(as.numeric(hms::parse_hm("02:00") + - lubridate::ddays())) - expect_equal(object$mean, expected) + object <- normalize(hms::parse_hm("22:00") + lubridate::ddays(1), + hms::parse_hm("05:00"), + hms::parse_hm("02:00")) + expect_equal(object$mean, + hms::hms(as.numeric(hms::parse_hm("02:00") + + lubridate::ddays()))) # if (check_1) - min <- hms::parse_hm("01:00") - max <- hms::parse_hm("12:00") + lubridate::ddays(1) - mean <- hms::parse_hm("06:00") - object <- normalize(min, max, mean) - expected <- hms::parse_hm("12:00") - expect_equal(object$max, expected) - - # "'mean' can't be found within the interval between 'min' and 'max'" - min <- hms::parse_hm("12:00") - max <- hms::parse_hm("03:00") - mean <- hms::parse_hm("06:00") - expect_error(normalize(min, max, mean)) - - # Invalid values for `min`, `max`, `mean`, and `ambiguity` - test <- c(hms::hms(1), hms::hms(1)) - - expect_error(normalize("", hms::hms(1), hms::hms(1))) - expect_error(normalize(hms::hms(1), "", hms::hms(1))) - expect_error(normalize(hms::hms(1), hms::hms(1), "")) - expect_error(normalize(test, hms::hms(1), hms::hms(1))) - expect_error(normalize(hms::hms(1), test, hms::hms(1))) - expect_error(normalize(hms::hms(1), hms::hms(1), test)) - expect_error(normalize(hms::hms(1), hms::hms(1), hms::hms(1), 1)) + object <- normalize(hms::parse_hm("01:00"), + hms::parse_hm("12:00") + lubridate::ddays(1), + hms::parse_hm("06:00")) + expect_equal(object$max, hms::parse_hm("12:00")) + + expect_error(normalize(hms::parse_hm("12:00"), + hms::parse_hm("03:00"), + hms::parse_hm("06:00")), + "'mean' can't be found within the interval between 'min' ") + + expect_error(normalize("", hms::hms(1), hms::hms(1)), + "Assertion on 'min' failed") + expect_error(normalize(c(hms::hms(1), hms::hms(1)), hms::hms(1), + hms::hms(1)), + "Assertion on 'min' failed") + expect_error(normalize(hms::hms(1), "", hms::hms(1)), + "Assertion on 'max' failed") + expect_error(normalize(hms::hms(1), c(hms::hms(1), hms::hms(1)), + hms::hms(1)), + "Assertion on 'max' failed") + expect_error(normalize(hms::hms(1), hms::hms(1), ""), + "Assertion on 'mean' failed") + expect_error(normalize(hms::hms(1), hms::hms(1), + c(hms::hms(1), hms::hms(1))), + "Assertion on 'mean' failed") + expect_error(normalize(hms::hms(1), hms::hms(1), hms::hms(1), 1), + "Assertion on 'ambiguity' failed") }) test_that("sample_time() | general test", { - lower <- as.numeric(hms::parse_hms("00:00:00")) - max <- as.numeric(hms::parse_hms("23:59:59")) - object <- as.numeric(sample_time()) - checkmate::expect_numeric(object, lower = lower, max = max) + checkmate::expect_numeric(as.numeric(sample_time()), + lower = as.numeric(hms::parse_hms("00:00:00")), + max = as.numeric(hms::parse_hms("23:59:59"))) set.seed(1) expect_equal(sample_time(), hms::parse_hms("13:50:00")) - # "You cannot take a sample larger than the population [...]" - expect_error(sample_time( - min = lubridate::dseconds(1), - max = lubridate::dseconds(3), - by = lubridate::dseconds(1), - size = 100, - replace = FALSE)) - - # Invalid values for `class`, `min`, `max`, `by`, `size`, `replace` - # and `prob` - test <- c(hms::hms(1), hms::hms(1)) - - expect_error(sample_time(class = "")) - expect_error(sample_time(min = "")) - expect_error(sample_time(max = "")) - expect_error(sample_time(by = "")) - expect_error(sample_time(min = test)) - expect_error(sample_time(max = test)) - expect_error(sample_time(by = test)) - expect_error(sample_time(replace = "")) - expect_error(sample_time(size = "")) - expect_error(sample_time(size = - 1)) - expect_error(sample_time(prob = "")) + expect_error(sample_time(min = lubridate::dseconds(1), + max = lubridate::dseconds(3), + by = lubridate::dseconds(1), + size = 100, + replace = FALSE), + "You cannot take a sample larger than the population ") + + expect_error(sample_time(class = ""), + "Assertion on 'tolower\\(class\\)' failed") + expect_error(sample_time(min = ""), "Assertion on 'min' failed") + expect_error(sample_time(min = c(hms::hms(1), hms::hms(1))), + "Assertion on 'min' failed") + expect_error(sample_time(max = ""), "Assertion on 'max' failed") + expect_error(sample_time(max = c(hms::hms(1), hms::hms(1))), + "Assertion on 'max' failed") + expect_error(sample_time(by = ""), "Assertion on 'by' failed") + expect_error(sample_time(by = c(hms::hms(1), hms::hms(1))), + "Assertion on 'by' failed") + expect_error(sample_time(replace = ""), "Assertion on 'replace' failed") + expect_error(sample_time(size = ""), "Assertion on 'size' failed") + expect_error(sample_time(size = - 1), "Assertion on 'size' failed") + expect_error(sample_time(prob = ""), "Assertion on 'prob' failed") }) test_that("sampler_1() | general test", { set.seed(1) - x <- list(name = "a", min = hms::parse_hm("23:00"), - max = hms::parse_hm("16:00"), mean = hms::parse_hm("10:00"), - sd = hms::parse_hm("01:00")) - by <- hms::parse_hm("00:05") - envir <- new.env() - sampler_1(x, by, envir) + envir = new.env() + sampler_1(list(name = "a", + min = hms::parse_hm("23:00"), + max = hms::parse_hm("16:00"), + mean = hms::parse_hm("10:00"), + sd = hms::parse_hm("01:00")), + hms::parse_hm("00:05"), + envir) expect_equal(envir$a, hms::parse_hm("09:40")) - # Invalid values for `x`, `by`, and `envir` - test_1 <- list(a = 1, b = 2) - test_2 <- list(name = "", min = 1L, max = 1L, mean = 1L, sd = 1L) - - expect_error(sampler_1("", hms::hms(1), envir = environment())) - expect_error(sampler_1(test_1, hms::hms(1), envir = environment())) - expect_error(sampler_1(test_2, hms::hms(1), envir = environment())) - expect_error(sampler_1(x, "", envir = environment())) - expect_error(sampler_1(x, hms::hms(1), envir = "")) + expect_error(sampler_1("", hms::hms(1), envir = environment()), + "Assertion on 'x' failed") + expect_error(sampler_1(list(a = 1, b = 2), + hms::hms(1), + envir = environment()), + "Assertion on 'names\\(x\\)' failed") + expect_error(sampler_1(list(name = "", min = 1L, max = 1L, mean = 1L, + sd = 1L), + hms::hms(1), + envir = environment()), + "Assertion on 'X\\[\\[i\\]\\]' failed") + expect_error(sampler_1(list(name = "a", + min = hms::parse_hm("23:00"), + max = hms::parse_hm("16:00"), + mean = hms::parse_hm("10:00"), + sd = hms::parse_hm("01:00")), + "", + envir = environment()), + "Assertion on 'by' failed") + expect_error(sampler_1(list(name = "a", + min = hms::parse_hm("23:00"), + max = hms::parse_hm("16:00"), + mean = hms::parse_hm("10:00"), + sd = hms::parse_hm("01:00")), + hms::hms(1), + envir = ""), + "Assertion on 'envir' failed") }) test_that("sampler_2() | general test", { set.seed(1) - x <- list(name = "a_f", min = hms::parse_hm("23:00"), - max = hms::parse_hm("16:00"), mean = hms::parse_hm("10:00"), - sd = hms::parse_hm("01:00")) - by <- hms::parse_hm("00:05") envir <- new.env() envir$a_w <- hms::parse_hm("10:00") - sampler_2(x, by, envir) + sampler_2(list(name = "a_f", + min = hms::parse_hm("23:00"), + max = hms::parse_hm("16:00"), + mean = hms::parse_hm("10:00"), + sd = hms::parse_hm("01:00")), + hms::parse_hm("00:05"), + envir) expect_equal(envir$a_f, hms::parse_hm("08:20")) - # Invalid values for `x`, `by`, and `envir` - test_1 <- list(a = 1, b = 2) - test_2 <- list(name = "", min = 1L, max = 1L, mean = 1L, sd = 1L) - - expect_error(sampler_2("", hms::hms(1), envir = environment())) - expect_error(sampler_2(test_1, hms::hms(1), envir = environment())) - expect_error(sampler_2(test_2, hms::hms(1), envir = environment())) - expect_error(sampler_2(x, "", envir = environment())) - expect_error(sampler_2(x, hms::hms(1), envir = "")) + expect_error(sampler_2("", hms::hms(1), envir = environment()), + "Assertion on 'x' failed") + expect_error(sampler_2(list(a = 1, b = 2), hms::hms(1), + envir = environment()), + "Assertion on 'names\\(x\\)' failed") + expect_error(sampler_2(list(name = "", min = 1L, max = 1L, mean = 1L, + sd = 1L), + hms::hms(1), + envir = environment()), + "Assertion on 'X\\[\\[i\\]\\]' failed") + expect_error(sampler_2(list(name = "a_f", + min = hms::parse_hm("23:00"), + max = hms::parse_hm("16:00"), + mean = hms::parse_hm("10:00"), + sd = hms::parse_hm("01:00")), + "", + envir = environment()), + "Assertion on 'by' failed") + expect_error(sampler_2(list(name = "a_f", + min = hms::parse_hm("23:00"), + max = hms::parse_hm("16:00"), + mean = hms::parse_hm("10:00"), + sd = hms::parse_hm("01:00")), + hms::hms(1), + envir = ""), + "Assertion on 'envir' failed") }) test_that("sampler_3() | general test", { set.seed(1) - x <- list(name = "a_f", min = hms::parse_hm("23:00"), - max = hms::parse_hm("16:00"), mean = hms::parse_hm("10:00"), - sd = hms::parse_hm("01:00")) - y <- "b" - by <- hms::parse_hm("00:05") envir <- new.env() envir$a_w <- hms::parse_hm("10:00") envir$b_w <- hms::parse_hm("00:00") envir$b_f <- hms::parse_hm("11:00") - sampler_3(x, y, by, envir) + sampler_3(list(name = "a_f", + min = hms::parse_hm("23:00"), + max = hms::parse_hm("16:00"), + mean = hms::parse_hm("10:00"), + sd = hms::parse_hm("01:00")), + "b", + hms::parse_hm("00:05"), + envir) expect_equal(envir$a_f, hms::parse_hm("08:20")) - # Invalid values for `x`, `by`, and `envir` - test_1 <- list(a = 1, b = 2) - test_2 <- list(name = "", min = 1L, max = 1L, mean = 1L, sd = 1L) - - expect_error(sampler_3("", "1", hms::hms(1), envir = environment())) - expect_error(sampler_3(test_1, "1", hms::hms(1), envir = environment())) - expect_error(sampler_3(test_2, "1", hms::hms(1), envir = environment())) - expect_error(sampler_3(x, 1, hms::hms(1), envir = environment())) - expect_error(sampler_3(x, "", envir = environment())) - expect_error(sampler_3(x, hms::hms(1), envir = "")) + expect_error(sampler_3("", "1", hms::hms(1), envir = environment()), + "Assertion on 'x' failed") + expect_error(sampler_3(list(a = 1, b = 2), + "1", + hms::hms(1), + envir = environment()), + "Assertion on 'names\\(x\\)' failed") + expect_error(sampler_3(list(name = "", min = 1L, max = 1L, mean = 1L, + sd = 1L), "1", + hms::hms(1), + envir = environment()), + "Assertion on 'X\\[\\[i\\]\\]' failed") + expect_error(sampler_3(list(name = "a_f", + min = hms::parse_hm("23:00"), + max = hms::parse_hm("16:00"), + mean = hms::parse_hm("10:00"), + sd = hms::parse_hm("01:00")), + 1, + hms::hms(1), + envir = environment()), + "Assertion on 'y' failed") + expect_error(sampler_3(list(name = "a_f", + min = hms::parse_hm("23:00"), + max = hms::parse_hm("16:00"), + mean = hms::parse_hm("10:00"), + sd = hms::parse_hm("01:00")), + "", + envir = environment()), + "Assertion on 'y' failed") + expect_error(sampler_3(list(name = "a_f", + min = hms::parse_hm("23:00"), + max = hms::parse_hm("16:00"), + mean = hms::parse_hm("10:00"), + sd = hms::parse_hm("01:00")), + hms::hms(1), + envir = ""), + "Assertion on 'y' failed") }) test_that("sampler_4() | general test", { set.seed(1) - x <- list(name = "a_f", min = hms::parse_hm("00:00"), - max = hms::parse_hm("01:00"), mean = hms::parse_hm("00:30"), - sd = hms::parse_hm("00:15")) - by <- hms::parse_hm("00:05") envir <- new.env() envir$a_w <- lubridate::dhours(24) - sampler_4(x, by, envir) + sampler_4(list(name = "a_f", + min = hms::parse_hm("00:00"), + max = hms::parse_hm("01:00"), + mean = hms::parse_hm("00:30"), + sd = hms::parse_hm("00:15")), + hms::parse_hm("00:05"), + envir) expect_equal(envir$a_f, lubridate::duration(3300)) - # Invalid values for `x`, `by`, and `envir` - test_1 <- list(a = 1, b = 2) - test_2 <- list(name = "", min = 1L, max = 1L, mean = 1L, sd = 1L) - - expect_error(sampler_4("", hms::hms(1), envir = environment())) - expect_error(sampler_4(test_1, hms::hms(1), envir = environment())) - expect_error(sampler_4(test_2, hms::hms(1), envir = environment())) - expect_error(sampler_4(x, "", envir = environment())) - expect_error(sampler_4(x, hms::hms(1), envir = "")) + expect_error(sampler_4("", hms::hms(1), envir = environment()), + "Assertion on 'x' failed") + expect_error(sampler_4(list(a = 1, b = 2), + hms::hms(1), + envir = environment()), + "Assertion on 'names\\(x\\)' failed") + expect_error(sampler_4(list(name = "", min = 1L, max = 1L, mean = 1L, + sd = 1L), + hms::hms(1), + envir = environment()), + "Assertion on 'X\\[\\[i\\]\\]' failed") + expect_error(sampler_4(list(name = "a_f", + min = hms::parse_hm("00:00"), + max = hms::parse_hm("01:00"), + mean = hms::parse_hm("00:30"), + sd = hms::parse_hm("00:15")), + "", + envir = environment()), + "Assertion on 'by' failed") + expect_error(sampler_4(list(name = "a_f", + min = hms::parse_hm("00:00"), + max = hms::parse_hm("01:00"), + mean = hms::parse_hm("00:30"), + sd = hms::parse_hm("00:15")), + hms::hms(1), + envir = ""), + "Assertion on 'envir' failed") }) diff --git a/tests/testthat/test-raw_data.R b/tests/testthat/test-raw_data.R index 621e576..1b93794 100644 --- a/tests/testthat/test-raw_data.R +++ b/tests/testthat/test-raw_data.R @@ -5,6 +5,5 @@ test_that("raw_data() | general test", { }) test_that("raw_data() | error test", { - # Invalid value for `file` - expect_error(raW_data(file = 1)) + expect_error(raw_data(file = 1), "Assertion on 'file' failed") }) diff --git a/tests/testthat/test-round_time.R b/tests/testthat/test-round_time.R index 526bcfc..23d1a92 100644 --- a/tests/testthat/test-round_time.R +++ b/tests/testthat/test-round_time.R @@ -1,38 +1,23 @@ test_that("round_time() | scalar test", { - object <- round_time(lubridate::dmilliseconds(123456789)) - expected <- lubridate::duration(123457) - expect_equal(object, expected) - - object <- round_time(lubridate::microseconds(123456789)) - expected <- round(lubridate::microseconds(123456789)) - expect_equal(object, expected) - - object <- round_time(as.difftime(12345.6789, units = "secs")) - expected <- as.difftime(12346, units = "secs") - expect_equal(object, expected) - - object <- round_time(hms::as_hms(12345.6789)) - expected <- hms::hms(12346) - expect_equal(object, expected) - - object <- round_time(lubridate::as_datetime(12345.6789, tz = "EST")) - expected <- lubridate::as_datetime(12346, tz = "EST") - expect_equal(object, expected) - - object <- round_time(as.POSIXlt(lubridate::as_datetime(12345.6789, - tz = "EST"))) - expected <- as.POSIXlt(lubridate::as_datetime(12346, tz = "EST")) - expect_equal(object, expected) + expect_equal(round_time(lubridate::dmilliseconds(123456789)), + lubridate::duration(123457)) + expect_equal(round_time(lubridate::microseconds(123456789)), + round(lubridate::microseconds(123456789))) + expect_equal(round_time(as.difftime(12345.6789, units = "secs")), + as.difftime(12346, units = "secs")) + expect_equal(round_time(hms::as_hms(12345.6789)), hms::hms(12346)) + expect_equal(round_time(lubridate::as_datetime(12345.6789, tz = "EST")), + lubridate::as_datetime(12346, tz = "EST")) + expect_equal(round_time(as.POSIXlt(lubridate::as_datetime(12345.6789, + tz = "EST"))), + as.POSIXlt(lubridate::as_datetime(12346, tz = "EST"))) }) test_that("round_time() | vector test", { - x <- c(hms::hms(12345.6789), hms::as_hms(98765.4321)) - object <- round_time(x) - expected <- c(hms::hms(12346), hms::as_hms(98765)) - expect_equal(object, expected) + expect_equal(round_time(c(hms::hms(12345.6789), hms::as_hms(98765.4321))), + c(hms::hms(12346), hms::as_hms(98765))) }) test_that("round_time() | error test", { - # Invalid values for `x` - expect_error(round_time(1)) + expect_error(round_time(1), "Assertion on 'x' failed") }) diff --git a/tests/testthat/test-sd.R b/tests/testthat/test-sd.R index d8d0afc..fa5f413 100644 --- a/tests/testthat/test-sd.R +++ b/tests/testthat/test-sd.R @@ -1,36 +1,22 @@ test_that("sd() | scalar test", { - so <- hms::parse_hm("23:30") - se <- hms::parse_hm("07:30") - object <- sd(so, se) - expected <- lubridate::dhours(8) - expect_equal(object, expected) - - so <- hms::parse_hm("01:30") - se <- hms::parse_hm("10:00") - object <- sd(so, se) - expected <- lubridate::dhours(8.5) - expect_equal(object, expected) - - so <- hms::as_hms(NA) - se <- hms::parse_hm("08:00") - object <- sd(so, se) - expected <- lubridate::as.duration(NA) - expect_equal(object, expected) + expect_equal(sd(hms::parse_hm("23:30"), hms::parse_hm("07:30")), + lubridate::dhours(8)) + expect_equal(sd(hms::parse_hm("01:30"), hms::parse_hm("10:00")), + lubridate::dhours(8.5)) + expect_equal(sd(hms::as_hms(NA), hms::parse_hm("08:00")), + lubridate::as.duration(NA)) }) test_that("sd() | vector test", { - so <- c(hms::parse_hm("21:00"), hms::parse_hm("02:00")) - se <- c(hms::parse_hm("05:00"), hms::parse_hm("11:00")) - object <- sd(so, se) - expected <- c(lubridate::dhours(8), lubridate::dhours(9)) - expect_equal(object, expected) + expect_equal(sd(c(hms::parse_hm("21:00"), hms::parse_hm("02:00")), + c(hms::parse_hm("05:00"), hms::parse_hm("11:00"))), + c(lubridate::dhours(8), lubridate::dhours(9))) }) test_that("sd() | error test", { - # Invalid values for `so` and `se` - expect_error(sd(1, hms::hms(1))) - expect_error(sd(hms::hms(1), 1)) + expect_error(sd(1, hms::hms(1)), "Assertion on 'so' failed") + expect_error(sd(hms::hms(1), 1), "Assertion on 'se' failed") - # `so` and `se` have different lengths - expect_error(sd(hms::hms(1), c(hms::hms(1), hms::hms(1)))) + expect_error(sd(hms::hms(1), c(hms::hms(1), hms::hms(1))), + "'so' and 'se' must have identical lengths.") }) diff --git a/tests/testthat/test-sd24.R b/tests/testthat/test-sd24.R index 6c2b029..13c4ee9 100644 --- a/tests/testthat/test-sd24.R +++ b/tests/testthat/test-sd24.R @@ -1,50 +1,33 @@ test_that("sd24() | scalar test", { - sd <- lubridate::dhours(5.5) - napd <- lubridate::dhours(2) - nap <- TRUE - object <- sd24(sd, napd, nap) - expected <- lubridate::dhours(7.5) - expect_equal(object, expected) - - sd <- lubridate::dhours(7.5) - napd <- lubridate::dhours(0.5) - nap <- TRUE - object <- sd24(sd, napd, nap) - expected <- lubridate::dhours(8) - expect_equal(object, expected) - - sd <- lubridate::dhours(9) - napd <- lubridate::as.duration(NA) - nap <- FALSE - object <- sd24(sd, napd, nap) - expected <- lubridate::dhours(9) - expect_equal(object, expected) - - sd <- lubridate::as.duration(NA) - napd <- lubridate::dhours(1.45) - nap <- TRUE - object <- sd24(sd, napd, nap) - expected <- lubridate::as.duration(NA) - expect_equal(object, expected) + expect_equal(sd24(lubridate::dhours(5.5), lubridate::dhours(2), TRUE), + lubridate::dhours(7.5)) + expect_equal(sd24(lubridate::dhours(7.5), lubridate::dhours(0.5), TRUE), + lubridate::dhours(8)) + expect_equal(sd24(lubridate::dhours(9), lubridate::as.duration(NA), FALSE), + lubridate::dhours(9)) + expect_equal(sd24(lubridate::as.duration(NA), lubridate::dhours(1.45), + TRUE), + lubridate::as.duration(NA)) }) test_that("sd24() | vector test", { - sd <- c(lubridate::dhours(7.5), lubridate::dhours(3)) - napd <- c(lubridate::dhours(3.4), lubridate::dhours(2.5)) - nap <- c(FALSE, TRUE) - object <- sd24(sd, napd, nap) - expected <- c(lubridate::dhours(7.5), lubridate::dhours(5.5)) - expect_equal(object, expected) + expect_equal(sd24(c(lubridate::dhours(7.5), lubridate::dhours(3)), + c(lubridate::dhours(3.4), lubridate::dhours(2.5)), + c(FALSE, TRUE)), + c(lubridate::dhours(7.5), lubridate::dhours(5.5))) }) test_that("sd24() | error test", { - # Invalid values for `sd` and `napd` - expect_error(sd24(1, lubridate::as.duration(1), TRUE)) - expect_error(sd24(lubridate::as.duration(1), 1, TRUE)) - expect_error(sd24(lubridate::as.duration(1), lubridate::as.duration(1), "")) + expect_error(sd24(1, lubridate::as.duration(1), TRUE), + "Assertion on 'sd' failed") + expect_error(sd24(lubridate::as.duration(1), 1, TRUE), + "Assertion on 'napd' failed") + expect_error(sd24(lubridate::as.duration(1), lubridate::as.duration(1), + ""), + "Assertion on 'nap' failed") - # `sd` and `napd` have different lengths expect_error(sd24(lubridate::as.duration(1), c(lubridate::as.duration(1), lubridate::as.duration(1)), - TRUE)) + TRUE), + "'sd', 'napd', and 'nap' must have identical lengths.") }) diff --git a/tests/testthat/test-sd_overall.R b/tests/testthat/test-sd_overall.R index 09f9ac1..adfeb67 100644 --- a/tests/testthat/test-sd_overall.R +++ b/tests/testthat/test-sd_overall.R @@ -1,73 +1,70 @@ test_that("sd_overall() | scalar test", { - sd_w <- lubridate::dhours(6.5) - sd_f <- lubridate::dhours(11) - n_w <- 4 - n_f <- 2 - object <- sd_overall(sd_w, sd_f, n_w, n_f) - expected <- lubridate::as.duration( - stats::weighted.mean(c(sd_w, sd_f),c(n_w, n_f))) - expect_equal(object, expected) - - sd_w <- lubridate::dhours(8.5) - sd_f <- lubridate::dhours(6.5) - n_w <- 6 - n_f <- 1 - object <- sd_overall(sd_w, sd_f, n_w, n_f) - expected <- lubridate::as.duration( - stats::weighted.mean(c(sd_w, sd_f),c(n_w, fd(n_w)))) - expect_equal(object, expected) - - sd_w <- lubridate::as.duration(NA) - sd_f <- lubridate::dhours(7) - n_w <- 2 - n_f <- 2 - object <- sd_overall(sd_w, sd_f, n_w, n_f) - expected <- lubridate::as.duration(NA) - expect_equal(object, expected) + expect_equal(sd_overall(lubridate::dhours(6.5), lubridate::dhours(11), 4, + 2), + lubridate::as.duration( + stats::weighted.mean(c(lubridate::dhours(6.5), + lubridate::dhours(11)), + c(4, 2)))) + expect_equal(sd_overall(lubridate::dhours(8.5), lubridate::dhours(6.5), 6, + 1), + lubridate::as.duration( + stats::weighted.mean(c(lubridate::dhours(8.5), + lubridate::dhours(6.5)), + c(6, 1)))) + expect_equal(sd_overall(lubridate::as.duration(NA), lubridate::dhours(7), 2, + 2), + lubridate::as.duration(NA)) }) test_that("sd_overall() | vector test", { - sd_w <- c(lubridate::dhours(3.9), lubridate::dhours(5)) - sd_f <- c(lubridate::dhours(12), lubridate::dhours(NA)) - n_w <- c(6, 10) - n_f <- c(1, 7) - object <- sd_overall(sd_w, sd_f, n_w, n_f) - expected_1 <- stats::weighted.mean(c(sd_w[1], sd_f[1]), c(n_w[1], n_f[1])) - expected_2 <- lubridate::as.duration(NA) - expected <- c(lubridate::duration(expected_1), - lubridate::duration(expected_2)) - expect_equal(object, expected) - - sd_w <- c(lubridate::dhours(4.5), lubridate::dhours(7)) - sd_f <- c(lubridate::dhours(10.5), lubridate::dhours(3)) - n_w <- c(4, 5) - n_f <- c(1, 2) - object <- sd_overall(sd_w, sd_f, n_w, n_f) - expected_1 <- stats::weighted.mean(c(sd_w[1], sd_f[1]), c(n_w[1], n_f[1])) - expected_2 <- stats::weighted.mean(c(sd_w[2], sd_f[2]), c(n_w[2], n_f[2])) - expected <- c(lubridate::duration(expected_1), - lubridate::duration(expected_2)) - expect_equal(object, expected) + expect_equal(sd_overall(c(lubridate::dhours(3.9), lubridate::dhours(5)), + c(lubridate::dhours(12), lubridate::dhours(NA)), + c(6, 10), + c(1, 7)), + c(lubridate::duration( + stats::weighted.mean(c(lubridate::dhours(3.9), + lubridate::dhours(12)), + c(6, 1))), + lubridate::as.duration(NA))) + expect_equal(sd_overall(c(lubridate::dhours(4.5), lubridate::dhours(7)), + c(lubridate::dhours(10.5), lubridate::dhours(3)), + c(4, 5), + c(1, 2)), + c(lubridate::duration( + stats::weighted.mean(c(lubridate::dhours(4.5), + lubridate::dhours(10.5)), + c(4, 1))), + lubridate::duration( + stats::weighted.mean(c(lubridate::dhours(7), + lubridate::dhours(3)), + c(5, 2))))) }) test_that("sd_overall() | error test", { - # Invalid values for `sd_w`, `sd_f`, `n_w`, and `n_f` - expect_error(sd_overall(1, lubridate::duration(1), 1, 1)) - expect_error(sd_overall(lubridate::duration(1), 1, 1, 1)) + expect_error(sd_overall(1, lubridate::duration(1), 1, 1), + "Assertion on 'sd_w' failed") + expect_error(sd_overall(lubridate::duration(1), 1, 1, 1), + "Assertion on 'sd_f' failed") expect_error(sd_overall(lubridate::duration(1), lubridate::duration(1), - "a", 1)) + "a", 1), + "Assertion on 'n_w' failed") expect_error(sd_overall(lubridate::duration(1), lubridate::duration(1), - 1.5, 1)) + 1.5, 1), + "Assertion on 'n_w' failed") expect_error(sd_overall(lubridate::duration(1), lubridate::duration(1), - -1, 1)) + -1, 1), + "Assertion on 'n_w' failed") expect_error(sd_overall(lubridate::duration(1), lubridate::duration(1), - 1, "a")) + 1, "a"), + "Assertion on 'n_f' failed") expect_error(sd_overall(lubridate::duration(1), lubridate::duration(1), - 1, 1.5)) + 1, 1.5), + "Assertion on 'n_f' failed") expect_error(sd_overall(lubridate::duration(1), lubridate::duration(1), - 1, -1)) + 1, -1), + "Assertion on 'n_f' failed") - # `sd_w`, `sd_f`, `n_w`, and `n_f` have different lengths expect_error(sd_overall(lubridate::duration(1), lubridate::duration(1), - c(1, 1), 1)) + c(1, 1), 1), + "'sd_w', 'sd_f', 'n_w', and 'n_f' must have identical ") }) diff --git a/tests/testthat/test-sd_week.R b/tests/testthat/test-sd_week.R index d431d32..e6aaf15 100644 --- a/tests/testthat/test-sd_week.R +++ b/tests/testthat/test-sd_week.R @@ -1,60 +1,55 @@ test_that("sd_week() | scalar test", { - sd_w <- lubridate::dhours(6.5) - sd_f <- lubridate::dhours(9.5) - wd <- 5 - object <- sd_week(sd_w, sd_f, wd) - expected <- lubridate::as.duration( - stats::weighted.mean(c(sd_w, sd_f),c(wd, fd(wd)))) - expect_equal(object, expected) - - sd_w <- lubridate::dhours(6.5) - sd_f <- lubridate::dhours(5.5) - wd <- 4 - object <- sd_week(sd_w, sd_f, wd) - expected <- lubridate::as.duration( - stats::weighted.mean(c(sd_w, sd_f),c(wd, fd(wd)))) - expect_equal(object, expected) - - sd_w <- lubridate::as.duration(NA) - sd_f <- lubridate::dhours(7) - wd <- 5 - object <- sd_week(sd_w, sd_f, wd) - expected <- lubridate::as.duration(NA) - expect_equal(object, expected) + expect_equal(sd_week(lubridate::dhours(6.5), lubridate::dhours(9.5), 5), + lubridate::as.duration( + stats::weighted.mean(c(lubridate::dhours(6.5), + lubridate::dhours(9.5)), + c(5, 2)))) + expect_equal(sd_week(lubridate::dhours(6.5), lubridate::dhours(5.5), 4), + lubridate::as.duration( + stats::weighted.mean(c(lubridate::dhours(6.5), + lubridate::dhours(5.5)), + c(4, 3)))) + expect_equal(sd_week(lubridate::as.duration(NA), lubridate::dhours(7), 5), + lubridate::as.duration(NA)) }) test_that("sd_week() | vector test", { - sd_w <- c(lubridate::dhours(4.5), lubridate::dhours(6.5)) - sd_f <- c(lubridate::dhours(11.5), lubridate::dhours(NA)) - wd <- c(6, 1) - object <- sd_week(sd_w, sd_f, wd) - expected_1 <- stats::weighted.mean(c(sd_w[1], sd_f[1]), c(wd[1], fd(wd[1]))) - expected_2 <- lubridate::as.duration(NA) - expected <- c(lubridate::duration(expected_1), - lubridate::duration(expected_2)) - expect_equal(object, expected) - - sd_w <- c(lubridate::dhours(6.5), lubridate::dhours(8)) - sd_f <- c(lubridate::dhours(9), lubridate::dhours(5.5)) - wd <- c(5, 4) - object <- sd_week(sd_w, sd_f, wd) - expected_1 <- stats::weighted.mean(c(sd_w[1], sd_f[1]), c(wd[1], fd(wd[1]))) - expected_2 <- stats::weighted.mean(c(sd_w[2], sd_f[2]), c(wd[2], fd(wd[2]))) - expected <- c(lubridate::duration(expected_1), - lubridate::duration(expected_2)) - expect_equal(object, expected) + expect_equal(sd_week(c(lubridate::dhours(4.5), lubridate::dhours(6.5)), + c(lubridate::dhours(11.5), lubridate::dhours(NA)), + c(6, 1)), + c(lubridate::duration( + stats::weighted.mean(c(lubridate::dhours(4.5), + lubridate::dhours(11.5)), + c(6, 1))), + lubridate::duration(lubridate::as.duration(NA)))) + expect_equal(sd_week(c(lubridate::dhours(6.5), lubridate::dhours(8)), + c(lubridate::dhours(9), lubridate::dhours(5.5)), + c(5, 4)), + c(lubridate::duration( + stats::weighted.mean(c(lubridate::dhours(6.5), + lubridate::dhours(9)), + c(5, 2))), + lubridate::duration( + stats::weighted.mean(c(lubridate::dhours(8), + lubridate::dhours(5.5)), + c(4, 3))))) }) test_that("sd_week() | error test", { - # Invalid values for `sd_w`, `sd_f`, and `wd` - expect_error(sd_week(1, lubridate::duration(1), 1)) - expect_error(sd_week(lubridate::duration(1), 1, 1)) - expect_error(sd_week(lubridate::duration(1), lubridate::duration(1), "a")) - expect_error(sd_week(lubridate::duration(1), lubridate::duration(1), 1.5)) - expect_error(sd_week(lubridate::duration(1), lubridate::duration(1), -1)) - expect_error(sd_week(lubridate::duration(1), lubridate::duration(1), 8)) + expect_error(sd_week(1, lubridate::duration(1), 1), + "Assertion on 'sd_w' failed") + expect_error(sd_week(lubridate::duration(1), 1, 1), + "Assertion on 'sd_f' failed") + expect_error(sd_week(lubridate::duration(1), lubridate::duration(1), "a"), + "Assertion on 'wd' failed") + expect_error(sd_week(lubridate::duration(1), lubridate::duration(1), 1.5), + "Assertion on 'wd' failed") + expect_error(sd_week(lubridate::duration(1), lubridate::duration(1), -1), + "Assertion on 'wd' failed") + expect_error(sd_week(lubridate::duration(1), lubridate::duration(1), 8), + "Assertion on 'wd' failed") - # `sd_w`, `sd_f`, and `wd` have different lengths expect_error(sd_week(lubridate::duration(1), lubridate::duration(1), - c(1, 1))) + c(1, 1)), + "'sd_w', 'sd_f', and 'wd' must have identical lengths.") }) diff --git a/tests/testthat/test-shorter_interval.R b/tests/testthat/test-shorter_interval.R index 70479eb..192d939 100644 --- a/tests/testthat/test-shorter_interval.R +++ b/tests/testthat/test-shorter_interval.R @@ -1,85 +1,87 @@ test_that("shorter_interval() | scalar test", { - x <- hms::parse_hm("23:00") - y <- hms::parse_hm("01:00") - object <- shorter_interval(x, y) - expect_equal(object, hms::parse_hm("02:00")) + expect_equal(shorter_interval(hms::parse_hm("23:00"), + hms::parse_hm("01:00")), + hms::parse_hm("02:00")) # `x == y` - x <- lubridate::as_datetime("1985-01-15 12:00:00") - y <- lubridate::as_datetime("2020-09-10 12:00:00") - object <- shorter_interval(x, y) - expect_equal(object, hms::parse_hm("00:00")) + expect_equal(shorter_interval(lubridate::as_datetime("1985-01-15 12:00:00"), + lubridate::as_datetime( + "2020-09-10 12:00:00")), + hms::parse_hm("00:00")) # `inverse = TRUE` (longer interval) - x <- lubridate::as_datetime("1985-01-15 12:00:00") - y <- lubridate::as_datetime("2020-09-10 12:00:00") - object <- shorter_interval(x, y, inverse = TRUE) - expect_equal(object, hms::parse_hm("24:00")) + expect_equal(shorter_interval(lubridate::as_datetime("1985-01-15 12:00:00"), + lubridate::as_datetime("2020-09-10 12:00:00"), + inverse = TRUE), + hms::parse_hm("24:00")) # `NA` cases - x <- hms::parse_hm("23:00") - y <- hms::as_hms(NA) - object <- shorter_interval(x, y) - expect_equal(object, hms::as_hms(NA)) + expect_equal(shorter_interval(hms::parse_hm("23:00"), hms::as_hms(NA)), + hms::as_hms(NA)) }) test_that("shorter_interval() | vector test", { - x <- c(hms::parse_hm("22:45"), hms::parse_hm("12:00")) - y <- c(hms::parse_hm("04:15"), hms::parse_hm("09:00")) - object <- shorter_interval(x, y) - expected <- c(hms::parse_hm("05:30"), hms::parse_hm("03:00")) - expect_equal(object, expected) + expect_equal(shorter_interval(c(hms::parse_hm("22:45"), + hms::parse_hm("12:00")), + c(hms::parse_hm("04:15"), + hms::parse_hm("09:00"))), + c(hms::parse_hm("05:30"), hms::parse_hm("03:00"))) }) -test_that("shorter_interval() | `class` test", { - x <- as.POSIXct("1988-10-05 02:00:00") - y <- as.POSIXlt("2100-05-07 13:30:00") - - object <- longer_interval(x, y, "Duration") - expect_equal(object, lubridate::dhours(12.5)) - - object <- shorter_interval(x, y, "Period") - expect_equal(object, lubridate::hours(11) + lubridate::minutes(30)) - - object <- longer_interval(x, y, "difftime") - expect_equal(object, lubridate::as.difftime(lubridate::dhours(12.5))) - - object <- shorter_interval(x, y, "hms") - expect_equal(object, hms::parse_hm("11:30")) - - object <- longer_interval(x, y, "Interval") - expected <- lubridate::as.interval( - lubridate::ymd_hms("1970-01-01 13:30:00"), - lubridate::ymd_hms("1970-01-02 02:00:00")) - expect_equal(object, expected) +test_that("shorter_interval() | 'class' test", { + expect_equal(longer_interval(as.POSIXct("1988-10-05 02:00:00"), + as.POSIXlt("2100-05-07 13:30:00"), + "Duration"), + lubridate::dhours(12.5)) + expect_equal(shorter_interval(as.POSIXct("1988-10-05 02:00:00"), + as.POSIXlt("2100-05-07 13:30:00"), + "Period"), + lubridate::hours(11) + lubridate::minutes(30)) + expect_equal(longer_interval(as.POSIXct("1988-10-05 02:00:00"), + as.POSIXlt("2100-05-07 13:30:00"), + "difftime"), + lubridate::as.difftime(lubridate::dhours(12.5))) + expect_equal(shorter_interval(as.POSIXct("1988-10-05 02:00:00"), + as.POSIXlt("2100-05-07 13:30:00"), + "hms"), + hms::parse_hm("11:30")) + expect_equal(longer_interval(as.POSIXct("1988-10-05 02:00:00"), + as.POSIXlt("2100-05-07 13:30:00"), + "Interval"), + lubridate::as.interval( + lubridate::ymd_hms("1970-01-01 13:30:00"), + lubridate::ymd_hms("1970-01-02 02:00:00"))) }) test_that("shorter_interval() | warning test", { - expect_warning(shorter_interval( - hms::parse_hm("00:00"), hms::parse_hm("12:00"), "Interval", - quiet = FALSE)) + expect_warning(shorter_interval(hms::parse_hm("00:00"), + hms::parse_hm("12:00"), "Interval", + quiet = FALSE), + "Element\\(s\\) '1' of 'x' and 'y' have intervals equal to ") }) test_that("shorter_interval() | error test", { - # Invalid values for `x`, `y`, `class`, and `inverse` - expect_error(shorter_interval(1, hms::hms(1), "hms", TRUE)) - expect_error(shorter_interval(hms::hms(1), 1, "hms", TRUE)) - expect_error(shorter_interval(hms::hms(1), hms::hms(1), "", TRUE)) - expect_error(shorter_interval(hms::hms(1), hms::hms(1), "hms", 1)) + expect_error(shorter_interval(1, hms::hms(1), "hms", TRUE), + "Assertion on 'x' failed") + expect_error(shorter_interval(hms::hms(1), 1, "hms", TRUE), + "Assertion on 'y' failed") + expect_error(shorter_interval(hms::hms(1), hms::hms(1), "", TRUE), + "Assertion on 'tolower\\(class\\)' failed") + expect_error(shorter_interval(hms::hms(1), hms::hms(1), "hms", 1), + "Assertion on 'inverse' failed") - # `x` and `y` have different lengths - expect_error(shorter_interval(hms::hms(1), c(hms::hms(1), hms::hms(1)))) + expect_error(shorter_interval(hms::hms(1), c(hms::hms(1), hms::hms(1))), + "'x' and 'y' must have identical lengths.") }) test_that("shorter_interval() | wrappers", { - x <- lubridate::parse_date_time("01:10:00", "HMS") - y <- lubridate::parse_date_time("11:45:00", "HMS") - object <- longer_interval(x, y, "hms") - expect_equal(object, hms::parse_hm("13:25")) + expect_equal(longer_interval(lubridate::parse_date_time("01:10:00", "HMS"), + lubridate::parse_date_time("11:45:00", "HMS"), + "hms"), + hms::parse_hm("13:25")) # `x == y` - x <- lubridate::as_datetime("1915-02-14 05:00:00") - y <- lubridate::as_datetime("1970-07-01 05:00:00") - object <- longer_interval(x, y) - expect_equal(object, hms::parse_hm("24:00")) + expect_equal(longer_interval(lubridate::as_datetime("1915-02-14 05:00:00"), + lubridate::as_datetime("1970-07-01 05:00:00")), + hms::parse_hm("24:00")) }) diff --git a/tests/testthat/test-sjl.R b/tests/testthat/test-sjl.R index e4bf0ec..b5f225f 100644 --- a/tests/testthat/test-sjl.R +++ b/tests/testthat/test-sjl.R @@ -1,145 +1,121 @@ test_that("sjl() | scalar test", { - msw <- hms::parse_hm("02:30") - msf <- hms::parse_hm("04:30") - abs <- TRUE - method <- "shorter" - object <- sjl(msw, msf, abs, method) - expected <- lubridate::dhours(2) - expect_equal(object, expected) - - msw <- hms::parse_hm("23:00") - msf <- hms::parse_hm("02:00") - abs <- TRUE - method <- "shorter" - object <- sjl(msw, msf, abs, method) - expected <- lubridate::dhours(3) - expect_equal(object, expected) - - msw <- hms::parse_hm("05:00") - msf <- hms::parse_hm("03:00") - abs <- FALSE - method <- "shorter" - object <- sjl(msw, msf, abs, method) - expected <- lubridate::dhours(-2) - expect_equal(object, expected) - - msw <- hms::as_hms(NA) - msf <- hms::parse_hm("00:00") - abs <- FALSE - method <- "shorter" - object <- sjl(msw, msf, abs, method) - expected <- lubridate::as.duration(NA) - expect_equal(object, expected) + expect_equal(sjl(hms::parse_hm("02:30"), + hms::parse_hm("04:30"), + TRUE, + "shorter"), + lubridate::dhours(2)) + expect_equal(sjl(hms::parse_hm("23:00"), + hms::parse_hm("02:00"), + TRUE, + "shorter"), + lubridate::dhours(3)) + expect_equal(sjl(hms::parse_hm("05:00"), + hms::parse_hm("03:00"), + FALSE, + "shorter"), + lubridate::dhours(-2)) + expect_equal(sjl(hms::as_hms(NA), + hms::parse_hm("00:00"), + FALSE, + "shorter"), + lubridate::as.duration(NA)) }) test_that("sjl() | vector test", { - msw <- c(hms::parse_hm("11:00"), hms::parse_hm("22:00")) - msf <- c(hms::parse_hm("18:30"), hms::parse_hm("17:30")) - abs <- FALSE - method <- "shorter" - object <- sjl(msw, msf, abs, method) - expected <- c(lubridate::dhours(7.5), lubridate::dhours(-4.5)) - expect_equal(object, expected) + expect_equal(sjl(c(hms::parse_hm("11:00"), hms::parse_hm("22:00")), + c(hms::parse_hm("18:30"), hms::parse_hm("17:30")), + FALSE, + "shorter"), + c(lubridate::dhours(7.5), lubridate::dhours(-4.5))) }) test_that("sjl() | `method` test", { - msw <- hms::parse_hm("08:00") - msf <- hms::parse_hm("12:00") - abs <- FALSE - method <- "difference" - object <- sjl(msw, msf, abs, method) - expected <- lubridate::dhours(4) - expect_equal(object, expected) - - method <- "shorter" - object <- sjl(msw, msf, abs, method) - expected <- lubridate::dhours(4) - expect_equal(object, expected) - - method <- "longer" - object <- sjl(msw, msf, abs, method) - expected <- lubridate::dhours(-20) - expect_equal(object, expected) - - msw <- hms::parse_hm("12:00") - msf <- hms::parse_hm("08:00") - abs <- FALSE - method <- "difference" - object <- sjl(msw, msf, abs, method) - expected <- lubridate::dhours(-4) - expect_equal(object, expected) - - method <- "shorter" - object <- sjl(msw, msf, abs, method) - expected <- lubridate::dhours(-4) - expect_equal(object, expected) - - method <- "longer" - object <- sjl(msw, msf, abs, method) - expected <- lubridate::dhours(20) - expect_equal(object, expected) - - - msw <- hms::parse_hm("23:00") - msf <- hms::parse_hm("01:00") - abs <- FALSE - method <- "difference" - object <- sjl(msw, msf, abs, method) - expected <- lubridate::dhours(-22) - expect_equal(object, expected) - - method <- "shorter" - object <- sjl(msw, msf, abs, method) - expected <- lubridate::dhours(2) - expect_equal(object, expected) - - method <- "longer" - object <- sjl(msw, msf, abs, method) - expected <- lubridate::dhours(-22) - expect_equal(object, expected) - - msw <- hms::parse_hm("01:00") - msf <- hms::parse_hm("23:00") - abs <- FALSE - method <- "difference" - object <- sjl(msw, msf, abs, method) - expected <- lubridate::dhours(22) - expect_equal(object, expected) - - method <- "shorter" - object <- sjl(msw, msf, abs, method) - expected <- lubridate::dhours(-2) - expect_equal(object, expected) - - method <- "longer" - object <- sjl(msw, msf, abs, method) - expected <- lubridate::dhours(22) - expect_equal(object, expected) + expect_equal(sjl(hms::parse_hm("08:00"), + hms::parse_hm("12:00"), + FALSE, + "difference"), + lubridate::dhours(4)) + expect_equal(sjl(hms::parse_hm("08:00"), + hms::parse_hm("12:00"), + FALSE, + "shorter"), + lubridate::dhours(4)) + expect_equal(sjl(hms::parse_hm("08:00"), + hms::parse_hm("12:00"), + FALSE, + "longer"), + lubridate::dhours(-20)) + + expect_equal(sjl(hms::parse_hm("12:00"), + hms::parse_hm("08:00"), + FALSE, + "difference"), + lubridate::dhours(-4)) + expect_equal(sjl(hms::parse_hm("12:00"), + hms::parse_hm("08:00"), + FALSE, + "shorter"), + lubridate::dhours(-4)) + expect_equal(sjl(hms::parse_hm("12:00"), + hms::parse_hm("08:00"), + FALSE, + "longer"), + lubridate::dhours(20)) + + expect_equal(sjl(hms::parse_hm("23:00"), + hms::parse_hm("01:00"), + FALSE, + "difference"), + lubridate::dhours(-22)) + expect_equal(sjl(hms::parse_hm("23:00"), + hms::parse_hm("01:00"), + FALSE, + "shorter"), + lubridate::dhours(2)) + expect_equal(sjl(hms::parse_hm("23:00"), + hms::parse_hm("01:00"), + FALSE, + "longer"), + lubridate::dhours(-22)) + + expect_equal(sjl(hms::parse_hm("01:00"), + hms::parse_hm("23:00"), + FALSE, + "difference"), + lubridate::dhours(22)) + expect_equal(sjl(hms::parse_hm("01:00"), + hms::parse_hm("23:00"), + FALSE, + "shorter"), + lubridate::dhours(-2)) + expect_equal(sjl(hms::parse_hm("01:00"), + hms::parse_hm("23:00"), + FALSE, + "longer"), + lubridate::dhours(22)) }) test_that("sjl() | error test", { - # Invalid values for `msw`, `msf`, `abs`, and `method` - expect_error(sjl(1, hms::hms(1), TRUE, "shorter")) - expect_error(sjl(hms::hms(1), 1, TRUE, "shorter")) - expect_error(sjl(hms::hms(1), hms::hms(1), "", "shorter")) - expect_error(sjl(hms::hms(1), hms::hms(1), TRUE, 1)) - - # `msw` and `msf` have different lengths - expect_error(sjl(hms::hms(1), c(hms::hms(1), hms::hms(1)))) + expect_error(sjl(1, hms::hms(1), TRUE, "shorter"), + "Assertion on 'msw' failed") + expect_error(sjl(hms::hms(1), 1, TRUE, "shorter"), + "Assertion on 'msf' failed") + expect_error(sjl(hms::hms(1), hms::hms(1), "", "shorter"), + "Assertion on 'abs' failed") + expect_error(sjl(hms::hms(1), hms::hms(1), TRUE, 1), + "Assertion on 'method' failed") + + expect_error(sjl(hms::hms(1), c(hms::hms(1), hms::hms(1))), + "'msw' and 'msf' must have identical lengths.") }) test_that("sjl() | wrappers", { - msw <- hms::parse_hm("10:00") - msf <- hms::parse_hm("12:00") - method <- "shorter" - object <- sjl_rel(msw, msf, method) - expected <- lubridate::dhours(2) - expect_equal(object, expected) - - msw <- hms::parse_hm("03:30") - msf <- hms::parse_hm("03:00") - method <- "shorter" - object <- sjl_rel(msw, msf, method) - expected <- lubridate::dhours(-0.5) - expect_equal(object, expected) + expect_equal(sjl_rel(hms::parse_hm("10:00"), + hms::parse_hm("12:00"), + "shorter"), + lubridate::dhours(2)) + expect_equal(sjl_rel(hms::parse_hm("03:30"), + hms::parse_hm("03:00"), + "shorter"), + lubridate::dhours(-0.5)) }) diff --git a/tests/testthat/test-sjl_weighted.R b/tests/testthat/test-sjl_weighted.R index 226ad49..ca8167e 100644 --- a/tests/testthat/test-sjl_weighted.R +++ b/tests/testthat/test-sjl_weighted.R @@ -1,57 +1,57 @@ test_that("sjl_weighted() | scalar test", { - sjl <- list(sjl_m = lubridate::dhours(0.5), - sjl_e = lubridate::dhours(4), - sjl_n = lubridate::dhours(2)) - n_w <- list(n_w_m = 5, n_w_e = 1, n_w_n = 2) - object <- sjl_weighted(sjl, n_w) - x <- c(sjl[["sjl_m"]][1], sjl[["sjl_e"]][1], sjl[["sjl_n"]][1]) - w <- c(n_w[["n_w_m"]][1], n_w[["n_w_e"]][1], n_w[["n_w_n"]][1]) - expected <- lubridate::as.duration(stats::weighted.mean(x, w)) - expect_equal(object, expected) - - sjl <- list(sjl_m = lubridate::as.duration(NA), - sjl_e = lubridate::dhours(1), - sjl_n = lubridate::dhours(3)) - n_w <- list(n_w_m = 4, n_w_e = 3, n_w_n = 2) - object <- sjl_weighted(sjl, n_w) - x <- c(sjl[["sjl_m"]][1], sjl[["sjl_e"]][1], sjl[["sjl_n"]][1]) - w <- c(n_w[["n_w_m"]][1], n_w[["n_w_e"]][1], n_w[["n_w_n"]][1]) - expected <- lubridate::as.duration(stats::weighted.mean(x, w)) - expect_equal(object, expected) + expect_equal(sjl_weighted(list(sjl_m = lubridate::dhours(0.5), + sjl_e = lubridate::dhours(4), + sjl_n = lubridate::dhours(2)), + list(n_w_m = 5, n_w_e = 1, n_w_n = 2)), + lubridate::as.duration(stats::weighted.mean( + c(lubridate::dhours(0.5), + lubridate::dhours(4), + lubridate::dhours(2)), + c(5, 1, 2)))) + expect_equal(sjl_weighted(list(sjl_m = lubridate::as.duration(NA), + sjl_e = lubridate::dhours(1), + sjl_n = lubridate::dhours(3)), + list(n_w_m = 4, n_w_e = 3, n_w_n = 2)), + lubridate::as.duration(stats::weighted.mean( + c(lubridate::as.duration(NA), + lubridate::dhours(1), + lubridate::dhours(3)), + c(4, 3, 2)))) }) test_that("sjl_weighted() | vector test", { - sjl <- list(sjl_m = c(lubridate::dhours(8), lubridate::dhours(1.78)), - sjl_e = c(lubridate::dhours(5.5), lubridate::as.duration(NA)), - sjl_n = c(lubridate::dhours(3.2), lubridate::dhours(5.45))) - n_w <- list(n_w_m = c(2, 4), n_w_e = c(1, 2), n_w_n = c(7, 2)) - object <- sjl_weighted(sjl, n_w) - i <- 1 - x <- c(sjl[["sjl_m"]][i], sjl[["sjl_e"]][i], sjl[["sjl_n"]][i]) - w <- c(n_w[["n_w_m"]][i], n_w[["n_w_e"]][i], n_w[["n_w_n"]][i]) - expected_1 <- lubridate::as.duration(stats::weighted.mean(x, w)) - i <- 2 - x <- c(sjl[["sjl_m"]][i], sjl[["sjl_e"]][i], sjl[["sjl_n"]][i]) - w <- c(n_w[["n_w_m"]][i], n_w[["n_w_e"]][i], n_w[["n_w_n"]][i]) - expected_2 <- lubridate::as.duration(stats::weighted.mean(x, w)) - expected <- c(expected_1, expected_2) - expect_equal(object, expected) + expect_equal(sjl_weighted( + list(sjl_m = c(lubridate::dhours(8), lubridate::dhours(1.78)), + sjl_e = c(lubridate::dhours(5.5), lubridate::as.duration(NA)), + sjl_n = c(lubridate::dhours(3.2), lubridate::dhours(5.45))), + list(n_w_m = c(2, 4), n_w_e = c(1, 2), n_w_n = c(7, 2))), + c(lubridate::as.duration(stats::weighted.mean( + c(lubridate::dhours(8), + lubridate::dhours(5.5), + lubridate::dhours(3.2)), + c(2, 1, 7))), + lubridate::as.duration(NA))) }) test_that("sjl_weighted() | error test", { - # Invalid values for `sjl`, and `n_w` - expect_error(sjl_weighted(1, list(n_w_m = 1))) - expect_error(sjl_weighted(list(sjl_m = lubridate::duration(1)), 1.5)) + expect_error(sjl_weighted(1, list(n_w_m = 1)), + "Assertion on 'sjl' failed") + expect_error(sjl_weighted(list(sjl_m = lubridate::duration(1)), 1.5), + "Assertion on 'n_w' failed") expect_error(sjl_weighted(list(sjl_m = lubridate::duration(1)), - list(n_w_m = ""))) + list(n_w_m = "")), + "Assertion on 'X\\[\\[i\\]\\]' failed") expect_error(sjl_weighted(list(sjl_m = lubridate::duration(1)), - list(n_w_m = 1.5))) + list(n_w_m = 1.5)), + "Assertion on 'X\\[\\[i\\]\\]' failed") # `sjl` and `n_w` have different element lengths expect_error(sjl_weighted(list(sjl_m = lubridate::duration(1)), - list(n_w_m = 1, n_w_e = 1))) + list(n_w_m = 1, n_w_e = 1)), + "Assertion on 'sjl' failed") # `sjl` and `n_w` have different object lengths inside elements expect_error(sjl_weighted(list(sjl_m = lubridate::duration(1)), - list(n_w_m = c(1, 1)))) + list(n_w_m = c(1, 1))), + "'dots\\[\\[1L\\]\\]\\[\\[1L\\]\\]' and 'dots\\[\\[2L\\]\\]") }) diff --git a/tests/testthat/test-sloss_week.R b/tests/testthat/test-sloss_week.R index 7a7bb75..ad4035f 100644 --- a/tests/testthat/test-sloss_week.R +++ b/tests/testthat/test-sloss_week.R @@ -1,57 +1,44 @@ test_that("sloss_week() | scalar test", { - sd_w <- lubridate::dhours(5.5) - sd_f <- lubridate::dhours(9) - wd <- 5 - object <- sloss_week(sd_w, sd_f, wd) - expected <- lubridate::duration(18000) - expect_equal(object, expected) - - sd_w <- lubridate::dhours(8) - sd_f <- lubridate::dhours(6.5) - wd <- 4 - object <- sloss_week(sd_w, sd_f, wd) - expected <- lubridate::duration(9257.14285714286) - expect_equal(object, expected) - - sd_w <- lubridate::as.duration(7) - sd_f <- lubridate::dhours(7) - wd <- as.numeric(NA) - object <- sloss_week(sd_w, sd_f, wd) - expected <- lubridate::as.duration(NA) - expect_equal(object, expected) + expect_equal(sloss_week(lubridate::dhours(5.5), lubridate::dhours(9), 5), + lubridate::duration(18000)) + expect_equal(sloss_week(lubridate::dhours(8), lubridate::dhours(6.5), 4), + lubridate::duration(9257.14285714286)) + expect_equal(sloss_week(lubridate::as.duration(7), lubridate::dhours(7), + as.numeric(NA)), + lubridate::as.duration(NA)) }) test_that("sloss_week() | vector test", { - sd_w <- c(lubridate::dhours(9), lubridate::dhours(10.5)) - sd_f <- c(lubridate::dhours(12), lubridate::dhours(8.5)) - wd <- c(4, 5) - object <- sloss_week(sd_w, sd_f, wd) - expected <- c(lubridate::duration(18514.2857142857), - lubridate::duration(10285.7142857143)) - expect_equal(object, expected) - - sd_w <- c(lubridate::dhours(NA), lubridate::dhours(8.7)) - sd_f <- c(lubridate::dhours(7.5), lubridate::dhours(9.2)) - wd <- c(5, 6) - object <- sloss_week(sd_w, sd_f, wd) - expected <- c(lubridate::as.duration(NA), - lubridate::duration(1542.85714285713)) - expect_equal(object, expected) + expect_equal(sloss_week(c(lubridate::dhours(9), lubridate::dhours(10.5)), + c(lubridate::dhours(12), lubridate::dhours(8.5)), + c(4, 5)), + c(lubridate::duration(18514.2857142857), + lubridate::duration(10285.7142857143))) + expect_equal(sloss_week(c(lubridate::dhours(NA), lubridate::dhours(8.7)), + c(lubridate::dhours(7.5), lubridate::dhours(9.2)), + c(5, 6)), + c(lubridate::as.duration(NA), + lubridate::duration(1542.85714285713))) }) test_that("sloss_week() | error test", { - # Invalid values for `sd_w`, `sd_f`, and `wd` - expect_error(sloss_week(1, lubridate::duration(1), 1)) - expect_error(sloss_week(lubridate::duration(1), 1, 1)) + expect_error(sloss_week(1, lubridate::duration(1), 1), + "Assertion on 'sd_w' failed") + expect_error(sloss_week(lubridate::duration(1), 1, 1), + "Assertion on 'sd_f' failed") expect_error(sloss_week(lubridate::duration(1), lubridate::duration(1), - "a")) + "a"), + "Assertion on 'wd' failed") expect_error(sloss_week(lubridate::duration(1), lubridate::duration(1), - 1.5)) + 1.5), + "Assertion on 'wd' failed") expect_error(sloss_week(lubridate::duration(1), lubridate::duration(1), - -1)) - expect_error(sloss_week(lubridate::duration(1), lubridate::duration(1), 8)) + -1), + "Assertion on 'wd' failed") + expect_error(sloss_week(lubridate::duration(1), lubridate::duration(1), 8), + "Assertion on 'wd' failed") - # `sd_w`, `sd_f`, and `wd` have different lengths expect_error(sloss_week(lubridate::duration(1), lubridate::duration(1), - c(1, 1))) + c(1, 1)), + "'sd_w', 'sd_f', and 'wd' must have identical lengths.") }) diff --git a/tests/testthat/test-so.R b/tests/testthat/test-so.R index 05499f9..7acea6b 100644 --- a/tests/testthat/test-so.R +++ b/tests/testthat/test-so.R @@ -1,37 +1,25 @@ test_that("so() | scalar test", { - sprep <- hms::parse_hm("23:15") - slat <- lubridate::dminutes(30) - object <- so(sprep, slat) - expected <- hms::parse_hm("23:45") - expect_equal(object, expected) - - sprep <- hms::parse_hm("02:45") - slat <- lubridate::dminutes(60) - object <- so(sprep, slat) - expected <- hms::parse_hm("03:45") - expect_equal(object, expected) - - sprep <- hms::parse_hm("00:00") - slat <- lubridate::as.duration(NA) - object <- so(sprep, slat) - expected <- hms::as_hms(NA) - expect_equal(object, expected) + expect_equal(so(hms::parse_hm("23:15"), lubridate::dminutes(30)), + hms::parse_hm("23:45")) + expect_equal(so(hms::parse_hm("02:45"), lubridate::dminutes(60)), + hms::parse_hm("03:45")) + expect_equal(so(hms::parse_hm("00:00"), lubridate::as.duration(NA)), + hms::as_hms(NA)) }) test_that("so() | vector test", { - sprep <- c(hms::parse_hm("21:45"), hms::parse_hm("01:30")) - slat <- c(lubridate::dminutes(20), lubridate::dminutes(50)) - object <- so(sprep, slat) - expected <- c(hms::parse_hm("22:05"), hms::parse_hm("02:20")) - expect_equal(object, expected) + expect_equal(so(c(hms::parse_hm("21:45"), hms::parse_hm("01:30")), + c(lubridate::dminutes(20), lubridate::dminutes(50))), + c(hms::parse_hm("22:05"), hms::parse_hm("02:20"))) }) test_that("so() | error test", { - # Invalid values for `sprep` and `slat` - expect_error(so(1, lubridate::duration(1))) - expect_error(so(hms::hms(1), 1)) + expect_error(so(1, lubridate::duration(1)), + "Assertion on 'sprep' failed") + expect_error(so(hms::hms(1), 1), + "Assertion on 'slat' failed") - # `sprep` and `slat` have different lengths expect_error(so(hms::hms(1), c(lubridate::duration(1), - lubridate::duration(1)))) + lubridate::duration(1))), + "Assertion failed: 'sprep' and 'slat' must have identical ") }) diff --git a/tests/testthat/test-sum_time.R b/tests/testthat/test-sum_time.R index e1ce13e..da3fa33 100644 --- a/tests/testthat/test-sum_time.R +++ b/tests/testthat/test-sum_time.R @@ -1,146 +1,208 @@ test_that("sum_time() | non-vectorized test", { - t <- c(lubridate::dhours(1), lubridate::dminutes(30)) - u <- lubridate::hours(1) - v <- c(as.difftime(1, units = "hours"), as.difftime(30, units = "mins")) - w <- c(hms::parse_hm("02:00"), hms::parse_hm("02:00")) - x <- lubridate::as_datetime("1970-01-01 20:00:00") - y <- as.POSIXlt(lubridate::as_datetime("1970-01-01 01:00:00")) - z <- lubridate::as.interval(lubridate::dhours(1), as.Date("1970-01-01")) - - class <- "duration" - circular <- FALSE - vectorize <- FALSE - na.rm <- FALSE - object <- sum_time(t, u, v, w, x, y, z, class = class, circular = circular, - vectorize = vectorize, na.rm = na.rm) - expected <- lubridate::dhours(30) - expect_equal(object, expected) # 30:00:00 - - class <- "hms" - circular <- TRUE - vectorize <- FALSE - na.rm <- FALSE - object <- sum_time(t, u, v, w, x, y, z, class = class, circular = circular, - vectorize = vectorize, na.rm = na.rm) - expected <- hms::parse_hm("06:00") - expect_equal(object, expected) # 06:00 | 30 - 24 - - i <- hms::as_hms(NA) - class <- "period" - circular <- FALSE - vectorize <- FALSE - na.rm <- FALSE - object <- sum_time(i, t, u, v, w, x, y, z, class = class, - circular = circular, vectorize = vectorize, - na.rm = na.rm) - expected <- lubridate::as.period(NA) - expect_equal(object, expected) - - i <- hms::as_hms(NA) - class <- "period" - circular <- FALSE - vectorize <- FALSE - na.rm <- TRUE - object <- sum_time(i, t, u, v, w, x, y, z, class = class, - circular = circular, vectorize = vectorize, - na.rm = na.rm) - expected <- lubridate::as.period(hms::hms(108000)) - expect_equal(object, expected) # 30:00:00 - - i <- hms::as_hms(NA) - class <- "difftime" - circular <- TRUE - vectorize <- FALSE - na.rm <- TRUE - object <- sum_time(i, t, u, v, w, x, y, z, class = class, - circular = circular, vectorize = vectorize, - na.rm = na.rm) - expected <- lubridate::as.difftime(21600, units = "secs") - expect_equal(object, expected) + expect_equal(sum_time(c(lubridate::dhours(1), lubridate::dminutes(30)), + lubridate::hours(1), + c(as.difftime(1, units = "hours"), + as.difftime(30, units = "mins")), + c(hms::parse_hm("02:00"), hms::parse_hm("02:00")), + lubridate::as_datetime("1970-01-01 20:00:00"), + as.POSIXlt(lubridate::as_datetime( + "1970-01-01 01:00:00")), + lubridate::as.interval(lubridate::dhours(1), + as.Date("1970-01-01")), + class = "duration", + circular = FALSE, + vectorize = FALSE, + na.rm = FALSE), + lubridate::dhours(30)) # 30:00:00 + expect_equal(sum_time(c(lubridate::dhours(1), lubridate::dminutes(30)), + lubridate::hours(1), + c(as.difftime(1, units = "hours"), + as.difftime(30, units = "mins")), + c(hms::parse_hm("02:00"), hms::parse_hm("02:00")), + lubridate::as_datetime("1970-01-01 20:00:00"), + as.POSIXlt(lubridate::as_datetime( + "1970-01-01 01:00:00")), + lubridate::as.interval(lubridate::dhours(1), + as.Date("1970-01-01")), + class = "hms", + circular = TRUE, # ! + vectorize = FALSE, + na.rm = FALSE), + hms::parse_hm("06:00")) # 06:00 | 30 - 24 + expect_equal(sum_time(hms::as_hms(NA), # ! + c(lubridate::dhours(1), lubridate::dminutes(30)), + lubridate::hours(1), + c(as.difftime(1, units = "hours"), + as.difftime(30, units = "mins")), + c(hms::parse_hm("02:00"), hms::parse_hm("02:00")), + lubridate::as_datetime("1970-01-01 20:00:00"), + as.POSIXlt(lubridate::as_datetime( + "1970-01-01 01:00:00")), + lubridate::as.interval(lubridate::dhours(1), + as.Date("1970-01-01")), + class = "period", + circular = FALSE, + vectorize = FALSE, + na.rm = FALSE), # ! + lubridate::as.period(NA)) + expect_equal(sum_time(hms::as_hms(NA), # ! + c(lubridate::dhours(1), lubridate::dminutes(30)), + lubridate::hours(1), + c(as.difftime(1, units = "hours"), + as.difftime(30, units = "mins")), + c(hms::parse_hm("02:00"), hms::parse_hm("02:00")), + lubridate::as_datetime("1970-01-01 20:00:00"), + as.POSIXlt(lubridate::as_datetime( + "1970-01-01 01:00:00")), + lubridate::as.interval(lubridate::dhours(1), + as.Date("1970-01-01")), + class = "period", + circular = FALSE, + vectorize = FALSE, + na.rm = TRUE), # ! + lubridate::as.period(hms::hms(108000))) # 30:00:00 + expect_equal(sum_time(hms::as_hms(NA), + c(lubridate::dhours(1), lubridate::dminutes(30)), + lubridate::hours(1), + c(as.difftime(1, units = "hours"), + as.difftime(30, units = "mins")), + c(hms::parse_hm("02:00"), hms::parse_hm("02:00")), + lubridate::as_datetime("1970-01-01 20:00:00"), + as.POSIXlt(lubridate::as_datetime( + "1970-01-01 01:00:00")), + lubridate::as.interval(lubridate::dhours(1), + as.Date("1970-01-01")), + class = "difftime", + circular = TRUE, # ! + vectorize = FALSE, + na.rm = TRUE), + lubridate::as.difftime(21600, units = "secs")) }) test_that("sum_time()| vectorized test", { - t <- c(lubridate::dhours(1), lubridate::dminutes(30)) - u <- c(lubridate::hours(1), lubridate::hours(1)) - v <- c(as.difftime(1, units = "hours"), as.difftime(30, units = "mins")) - w <- c(hms::parse_hm("02:00"), hms::parse_hm("02:00")) - x <- c(lubridate::as_datetime("1970-01-01 20:00:00"), - lubridate::as_datetime("1970-01-01 10:00:00")) - y <- c(lubridate::as_datetime("1970-01-01 01:00:00"), - lubridate::as_datetime("1970-01-01 02:00:00")) - y <- as.POSIXlt(y) - z <- c(lubridate::as.interval(lubridate::dhours(4), as.Date("1970-01-01")), - lubridate::as.interval(lubridate::dhours(1), as.Date("1970-01-01"))) - - class <- "duration" - circular <- FALSE - vectorize <- TRUE - na.rm <- FALSE - object <- sum_time(t, u, v, w, x, y, z, class = class, circular = circular, - vectorize = vectorize, na.rm = na.rm) - expected <- c(lubridate::dhours(30), lubridate::dhours(17)) - expect_equal(object, expected) # 30:00:00 | 17:00:00 - - class <- "hms" - circular <- TRUE - vectorize <- TRUE - na.rm <- FALSE - object <- sum_time(t, u, v, w, x, y, z, class = class, - circular = circular, vectorize = vectorize, - na.rm = na.rm) - expected <- c(hms::parse_hm("06:00"), hms::parse_hm("17:00")) - expect_equal(object, expected) # 06:00:00 | 17:00:00 - - i <- c(hms::as_hms(NA), hms::as_hms(NA)) - class <- "period" - circular <- FALSE - vectorize <- TRUE - na.rm <- FALSE - object <- sum_time(i, t, u, v, w, x, y, z, class = class, - circular = circular, vectorize = vectorize, - na.rm = na.rm) - expected <- c(lubridate::as.period(NA), lubridate::as.period(NA)) - expect_equal(object, expected) - - i <- c(hms::as_hms(NA), hms::as_hms(NA)) - class <- "period" - circular <- FALSE - vectorize <- TRUE - na.rm <- TRUE - object <- sum_time(i, t, u, v, w, x, y, z, class = class, - circular = circular, vectorize = vectorize, - na.rm = na.rm) - expected <- c(lubridate::as.period(hms::hms(108000)), - lubridate::as.period(hms::hms(61200))) - expect_equal(object, expected) # 30:00:00 | 17:00:00 - - i <- c(hms::as_hms(NA), hms::as_hms(NA)) - class <- "difftime" - circular <- TRUE - vectorize <- TRUE - na.rm <- TRUE - object <- sum_time(i, t, u, v, w, x, y, z, class = class, - circular = circular, vectorize = vectorize, - na.rm = na.rm) - expected <- c(lubridate::as.difftime(21600, units = "secs"), - lubridate::as.difftime(61200, units = "secs")) - expect_equal(object, expected) + expect_equal(sum_time(c(lubridate::dhours(1), lubridate::dminutes(30)), + c(lubridate::hours(1), lubridate::hours(1)), + c(as.difftime(1, units = "hours"), + as.difftime(30, units = "mins")), + c(hms::parse_hm("02:00"), hms::parse_hm("02:00")), + c(lubridate::as_datetime("1970-01-01 20:00:00"), + lubridate::as_datetime("1970-01-01 10:00:00")), + as.POSIXlt( + c(lubridate::as_datetime("1970-01-01 01:00:00"), + lubridate::as_datetime("1970-01-01 02:00:00"))), + c(lubridate::as.interval(lubridate::dhours(4), + as.Date("1970-01-01")), + lubridate::as.interval(lubridate::dhours(1), + as.Date("1970-01-01"))), + class = "duration", + circular = FALSE, + vectorize = TRUE, + na.rm = FALSE), + c(lubridate::dhours(30), + lubridate::dhours(17))) # 30:00:00 | 17:00:00 + expect_equal(sum_time(c(lubridate::dhours(1), lubridate::dminutes(30)), + c(lubridate::hours(1), lubridate::hours(1)), + c(as.difftime(1, units = "hours"), + as.difftime(30, units = "mins")), + c(hms::parse_hm("02:00"), hms::parse_hm("02:00")), + c(lubridate::as_datetime("1970-01-01 20:00:00"), + lubridate::as_datetime("1970-01-01 10:00:00")), + as.POSIXlt( + c(lubridate::as_datetime("1970-01-01 01:00:00"), + lubridate::as_datetime("1970-01-01 02:00:00"))), + c(lubridate::as.interval(lubridate::dhours(4), + as.Date("1970-01-01")), + lubridate::as.interval(lubridate::dhours(1), + as.Date("1970-01-01"))), + class = "hms", + circular = TRUE, # ! + vectorize = TRUE, + na.rm = FALSE), + c(hms::parse_hm("06:00"), + hms::parse_hm("17:00"))) # 06:00:00 | 17:00:00 + expect_equal(sum_time(c(hms::as_hms(NA), hms::as_hms(NA)), # ! + c(lubridate::dhours(1), lubridate::dminutes(30)), + c(lubridate::hours(1), lubridate::hours(1)), + c(as.difftime(1, units = "hours"), + as.difftime(30, units = "mins")), + c(hms::parse_hm("02:00"), hms::parse_hm("02:00")), + c(lubridate::as_datetime("1970-01-01 20:00:00"), + lubridate::as_datetime("1970-01-01 10:00:00")), + as.POSIXlt( + c(lubridate::as_datetime("1970-01-01 01:00:00"), + lubridate::as_datetime("1970-01-01 02:00:00"))), + c(lubridate::as.interval(lubridate::dhours(4), + as.Date("1970-01-01")), + lubridate::as.interval(lubridate::dhours(1), + as.Date("1970-01-01"))), + class = "period", + circular = FALSE, + vectorize = TRUE, + na.rm = FALSE), # ! + c(lubridate::as.period(NA), + lubridate::as.period(NA))) + expect_equal(sum_time(c(hms::as_hms(NA), hms::as_hms(NA)), # ! + c(lubridate::dhours(1), lubridate::dminutes(30)), + c(lubridate::hours(1), lubridate::hours(1)), + c(as.difftime(1, units = "hours"), + as.difftime(30, units = "mins")), + c(hms::parse_hm("02:00"), hms::parse_hm("02:00")), + c(lubridate::as_datetime("1970-01-01 20:00:00"), + lubridate::as_datetime("1970-01-01 10:00:00")), + as.POSIXlt( + c(lubridate::as_datetime("1970-01-01 01:00:00"), + lubridate::as_datetime("1970-01-01 02:00:00"))), + c(lubridate::as.interval(lubridate::dhours(4), + as.Date("1970-01-01")), + lubridate::as.interval(lubridate::dhours(1), + as.Date("1970-01-01"))), + class = "period", + circular = FALSE, + vectorize = TRUE, + na.rm = TRUE), # ! + c(lubridate::as.period(hms::hms(108000)), + lubridate::as.period(hms::hms(61200)))) # 30:00:00 | 17:00:00 + expect_equal(sum_time(c(hms::as_hms(NA), hms::as_hms(NA)), + c(lubridate::dhours(1), lubridate::dminutes(30)), + c(lubridate::hours(1), lubridate::hours(1)), + c(as.difftime(1, units = "hours"), + as.difftime(30, units = "mins")), + c(hms::parse_hm("02:00"), hms::parse_hm("02:00")), + c(lubridate::as_datetime("1970-01-01 20:00:00"), + lubridate::as_datetime("1970-01-01 10:00:00")), + as.POSIXlt( + c(lubridate::as_datetime("1970-01-01 01:00:00"), + lubridate::as_datetime("1970-01-01 02:00:00"))), + c(lubridate::as.interval(lubridate::dhours(4), + as.Date("1970-01-01")), + lubridate::as.interval(lubridate::dhours(1), + as.Date("1970-01-01"))), + class = "difftime", + circular = TRUE, # ! + vectorize = TRUE, + na.rm = TRUE), + c(lubridate::as.difftime(21600, units = "secs"), + lubridate::as.difftime(61200, units = "secs"))) }) test_that("sum_time() | error test", { - # Invalid values for `...`, `class`, `circular`, `vectorize` and `na.rm` - expect_error(sum_time(1, class = "", circular = TRUE, - vectorize = TRUE, na.rm = TRUE)) + expect_error(sum_time(1, class = "hms", circular = TRUE, + vectorize = TRUE, na.rm = TRUE), + "Assertion on 'x' failed") expect_error(sum_time(hms::hms(1), class = 1, circular = TRUE, - vectorize = TRUE, na.rm = TRUE)) - expect_error(sum_time(hms::hms(1), class = "", circular = "", - vectorize = TRUE, na.rm = TRUE)) - expect_error(sum_time(hms::hms(1), class = "", circular = TRUE, - vectorize = "", na.rm = TRUE)) - expect_error(sum_time(hms::hms(1), class = "", circular = TRUE, - vectorize = TRUE, na.rm = "")) + vectorize = TRUE, na.rm = TRUE), + "Assertion on 'tolower\\(class\\)' failed") + expect_error(sum_time(hms::hms(1), class = "hms", circular = "", + vectorize = TRUE, na.rm = TRUE), + "Assertion on 'circular' failed") + expect_error(sum_time(hms::hms(1), class = "hms", circular = TRUE, + vectorize = "", na.rm = TRUE), + "Assertion on 'vectorize' failed") + expect_error(sum_time(hms::hms(1), class = "hms", circular = TRUE, + vectorize = TRUE, na.rm = ""), + "Assertion on 'na.rm' failed") - # "When `vectorize` is `TRUE`, all values in `...` must have [...]" expect_error(sum_time(hms::hms(1), c(hms::hms(1), hms::hms(1)), - vectorize = TRUE)) + vectorize = TRUE), + "When 'vectorize' is 'TRUE', all values in '...' must ") }) diff --git a/tests/testthat/test-tbt.R b/tests/testthat/test-tbt.R index 3e3a23a..5af6f58 100644 --- a/tests/testthat/test-tbt.R +++ b/tests/testthat/test-tbt.R @@ -1,36 +1,24 @@ test_that("tbt() | scalar test", { - bt <- hms::parse_hm("22:00") - gu <- hms::parse_hm("07:00") - object <- tbt(bt, gu) - expected <- lubridate::dhours(9) - expect_equal(object, expected) - - bt <- hms::parse_hm("02:00") - gu <- hms::parse_hm("10:00") - object <- tbt(bt, gu) - expected <- lubridate::dhours(8) - expect_equal(object, expected) - - bt <- hms::as_hms(NA) - gu <- hms::parse_hm("00:00") - object <- tbt(bt, gu) - expected <- lubridate::as.duration(NA) - expect_equal(object, expected) + expect_equal(tbt(hms::parse_hm("22:00"), hms::parse_hm("07:00")), + lubridate::dhours(9)) + expect_equal(tbt(hms::parse_hm("02:00"), hms::parse_hm("10:00")), + lubridate::dhours(8)) + expect_equal(tbt(hms::as_hms(NA), hms::parse_hm("00:00")), + lubridate::as.duration(NA)) }) test_that("tbt() | vector test", { - bt <- c(hms::parse_hm("23:30"), hms::parse_hm("03:15")) - gu <- c(hms::parse_hm("12:00"), hms::parse_hm("10:45")) - object <- tbt(bt, gu) - expected <- c(lubridate::duration(45000), lubridate::duration(27000)) - expect_equal(object, expected) + expect_equal(tbt(c(hms::parse_hm("23:30"), hms::parse_hm("03:15")), + c(hms::parse_hm("12:00"), hms::parse_hm("10:45"))), + c(lubridate::duration(45000), lubridate::duration(27000))) }) test_that("tbt() | error test", { - # Invalid values for `bt` and `gu` - expect_error(tbt(1, hms::hms(1))) - expect_error(tbt(hms::hms(1), 1)) + expect_error(tbt(1, hms::hms(1)), + "Assertion on 'bt' failed") + expect_error(tbt(hms::hms(1), 1), + "Assertion on 'gu' failed") - # `bt` and `gu` have different lengths - expect_error(tbt(hms::hms(1), c(hms::hms(1), hms::hms(1)))) + expect_error(tbt(hms::hms(1), c(hms::hms(1), hms::hms(1))), + "'bt' and 'gu' must have identical lengths.") }) diff --git a/tests/testthat/test-utils-checks.R b/tests/testthat/test-utils-checks.R index 79ca3bc..c8a3e4b 100644 --- a/tests/testthat/test-utils-checks.R +++ b/tests/testthat/test-utils-checks.R @@ -1,138 +1,235 @@ -test_that("check_any_na() and assert_any_na() | general test", { - checkmate::expect_string(check_any_na(c(NA, 1))) - expect_true(check_any_na(c(1, 1))) - expect_equal(assert_any_na(c(1, 1)), c(1, 1)) - expect_error(assert_any_na(c(NA, 1))) -}) - -test_that("check_not_all_na() and assert_not_all_na() | general test", { - checkmate::expect_string(check_not_all_na(c(NA, NA))) - expect_true(check_not_all_na(c(1, 1))) - expect_equal(assert_not_all_na(c(1, 1)), c(1, 1)) - expect_error(assert_not_all_na(c(NA, NA))) -}) - -test_that("check_length_one() and assert_length_one() | general test", { - checkmate::expect_string(check_length_one(c(1, 1))) - checkmate::expect_string(check_length_one(c(1, NA), any.missing = FALSE)) +test_that("*_length_one() | general test", { + expect_true(test_length_one(NA)) + expect_false(test_length_one(NULL)) + checkmate::expect_string(check_length_one(c(1, 1)), + pattern = "'c\\(1, 1\\)' must have length 1, ") expect_true(check_length_one(1)) + expect_equal(assert_length_one(1), 1) - expect_error(assert_length_one(c(1, 1))) + expect_error(assert_length_one(c(1, 1)), + "Assertion on 'c\\(1, 1\\)' failed") }) -test_that("check_has_length() and assert_has_length() | general test", { - checkmate::expect_string(check_has_length(numeric())) - checkmate::expect_string(check_has_length(c(1, NA), any.missing = FALSE)) +test_that("*_has_length() | general test", { + expect_true(test_has_length(c(1, 2))) + expect_false(test_has_length(NULL)) + checkmate::expect_string(check_has_length(numeric()), + pattern = "'numeric\\(\\)' must have length ") + checkmate::expect_string(check_has_length(c(1, NA), any.missing = FALSE), + pattern = "'c\\(1, NA\\)' cannot have missing ") expect_true(check_has_length(1)) + expect_equal(assert_has_length(1), 1) - expect_error(assert_has_length(numeric())) + expect_error(assert_has_length(numeric()), + "Assertion on 'numeric\\(\\)' failed") }) -test_that("check_whole_number() and assert_whole_number() | general test", { - checkmate::expect_string(check_whole_number(c(1, 1.5))) - checkmate::expect_string(check_whole_number(c(1, NA), any.missing = FALSE)) - checkmate::expect_string(check_whole_number(NULL, null.ok = FALSE)) - +test_that("*_whole_number() | general test", { + expect_true(test_whole_number(0)) + expect_true(test_whole_number(as.integer(1))) + expect_true(test_whole_number(as.double(11))) + expect_true(test_whole_number(as.numeric(475))) + expect_true(test_whole_number(c(1, NA), any.missing = TRUE)) + expect_true(test_whole_number(NULL, null.ok = TRUE)) + expect_false(test_whole_number(-1L)) + expect_false(test_whole_number(-55)) + expect_false(test_whole_number(1.58)) + expect_false(test_whole_number(lubridate::dhours())) + expect_false(test_whole_number(letters)) + expect_false(test_whole_number(datasets::iris)) + expect_false(test_whole_number(c(1, NA), any.missing = FALSE)) + expect_false(test_whole_number(NULL, null.ok = FALSE)) + + checkmate::expect_string(check_whole_number(c(1, 1.5)), + pattern = "'c\\(1, 1.5\\)' must consist of whole ") + checkmate::expect_string(check_whole_number(c(1, NA), any.missing = FALSE), + pattern = "'c\\(1, NA\\)' cannot have missing ") + checkmate::expect_string(check_whole_number(NULL, null.ok = FALSE), + "'NULL' cannot have 'NULL' values") expect_true(check_whole_number(c(1, 1))) + expect_true(check_whole_number(c(1, NA), any.missing = TRUE)) expect_true(check_whole_number(NULL, null.ok = TRUE)) expect_equal(assert_whole_number(c(1, 1)), c(1, 1)) - expect_error(assert_whole_number(c(1, 1.5))) + expect_error(assert_whole_number(c(1, 1.5)), + "Assertion on 'c\\(1, 1.5\\)' failed") }) -test_that("check_numeric_() and assert_numeric_() | general test", { - checkmate::expect_string(check_numeric_(c("a", "b"))) - checkmate::expect_string(check_numeric_(c(1, NA), any.missing = FALSE)) - checkmate::expect_string(check_numeric_(NULL, null.ok = FALSE)) - +test_that("*_numeric_() | general test", { + expect_true(test_numeric_(as.integer(1))) + expect_true(test_numeric_(as.double(1))) + expect_true(test_numeric_(as.numeric(1))) + expect_true(test_numeric_(c(1, NA), any.missing = TRUE)) + expect_true(test_numeric_(NULL, null.ok = TRUE)) + expect_false(test_numeric_(lubridate::dhours())) + expect_false(test_numeric_(letters)) + expect_false(test_numeric_(datasets::iris)) + expect_false(test_numeric_(c(1, NA), any.missing = FALSE)) + expect_false(test_numeric_(NULL, null.ok = FALSE)) + + checkmate::expect_string(check_numeric_(c("a", "b")), + pattern = "Must be of type 'numeric', ") + checkmate::expect_string(check_numeric_(c(1, NA), any.missing = FALSE), + "'c\\(1, NA\\)' cannot have missing values") + checkmate::expect_string(check_numeric_(NULL, null.ok = FALSE), + "'NULL' cannot have 'NULL' values") expect_true(check_numeric_(c(1, 1))) expect_true(check_numeric_(NULL, null.ok = TRUE)) expect_equal(assert_numeric_(c(1, 1)), c(1, 1)) - expect_error(assert_numeric_(c("a", "b"))) + expect_error(assert_numeric_(c("a", "b")), + "Assertion on 'c\\(\"a\", \"b\"\\)' failed") }) -test_that("check_duration() and assert_duration() | general test", { - object <- c(lubridate::dhours(1), lubridate::dhours(1)) - - checkmate::expect_string(check_duration(c(1, 1))) - checkmate::expect_string(check_duration(c(1, NA), any.missing = FALSE)) - checkmate::expect_string(check_duration(NULL, null.ok = FALSE)) - - expect_true(check_duration(object)) +test_that("*_duration() | general test", { + expect_true(test_duration(lubridate::dhours(1))) + expect_true(test_duration(c(lubridate::dhours(1), NA), any.missing = TRUE)) + expect_true(test_duration(NULL, null.ok = TRUE)) + expect_false(test_duration("a")) + expect_false(test_duration(1)) + expect_false(test_duration(lubridate::hours())) + expect_false(test_duration(hms::hms(1))) + expect_false(test_duration(datasets::iris)) + expect_false(test_duration(c(lubridate::dhours(1), NA), + any.missing = FALSE)) + expect_false(test_duration(NULL, null.ok = FALSE)) + + checkmate::expect_string(check_duration(c(1, 1)), + "Must be of type 'Duration', not 'numeric'") + checkmate::expect_string(check_duration(c(1, NA), any.missing = FALSE), + "'c\\(1, NA\\)' cannot have missing values") + checkmate::expect_string(check_duration(NULL, null.ok = FALSE), + "'NULL' cannot have 'NULL' values") + expect_true(check_duration(c(lubridate::dhours(1), + lubridate::dhours(1)))) expect_true(check_duration(NULL, null.ok = TRUE)) - expect_equal(assert_duration(object), object) - expect_error(assert_duration(c(1, 1))) + expect_equal(assert_duration(c(lubridate::dhours(1), + lubridate::dhours(1))), + c(lubridate::dhours(1), lubridate::dhours(1))) + expect_error(assert_duration(c(1, 1)), + "Assertion on 'c\\(1, 1\\)' failed") }) -test_that("check_posixt() and assert_posixt() | general test", { - object <- c(lubridate::as_datetime(1), lubridate::as_datetime(1)) - - checkmate::expect_string(check_posixt(c(1, 1))) - checkmate::expect_string(check_posixt(c(1, NA), any.missing = FALSE)) - checkmate::expect_string(check_posixt(NULL, null.ok = FALSE)) - - expect_true(check_posixt(object)) +test_that("*_posixt() | general test", { + expect_true(test_posixt(lubridate::as_datetime(1))) + expect_true(test_posixt(as.POSIXlt(lubridate::as_datetime(1)))) + expect_true(test_posixt(c(lubridate::as_datetime(1), NA), + any.missing = TRUE)) + expect_true(test_posixt(NULL, null.ok = TRUE)) + expect_false(test_posixt("a")) + expect_false(test_posixt(1)) + expect_false(test_posixt(lubridate::hours())) + expect_false(test_posixt(hms::hms(1))) + expect_false(test_posixt(datasets::iris)) + expect_false(test_posixt(c(lubridate::as_datetime(1), NA), + any.missing = FALSE)) + expect_false(test_posixt(NULL, null.ok = FALSE)) + + checkmate::expect_string(check_posixt(c(1, 1)), + "Must be of type 'POSIXct' or 'POSIXlt', ") + checkmate::expect_string(check_posixt(c(1, NA), any.missing = FALSE), + "'c\\(1, NA\\)' cannot have missing values") + checkmate::expect_string(check_posixt(NULL, null.ok = FALSE), + "'NULL' cannot have 'NULL' values") + expect_true(check_posixt(c(lubridate::as_datetime(1), + lubridate::as_datetime(1)))) expect_true(check_posixt(NULL, null.ok = TRUE)) - expect_equal(assert_posixt(object), object) - expect_error(assert_posixt(c(1, 1))) + expect_equal(assert_posixt(c(lubridate::as_datetime(1), + lubridate::as_datetime(1))), + c(lubridate::as_datetime(1), lubridate::as_datetime(1))) + expect_error(assert_posixt(c(1, 1)), + "Assertion on 'c\\(1, 1\\)' failed") }) -test_that("test_time(), check_time() and assert_time() | general test", { - object <- c(lubridate::hours(1), lubridate::hours(1)) - - expect_false(test_time(c(1, 1))) - expect_false(test_time(c(1, NA), any.missing = FALSE)) - expect_false(test_time(NULL, null.ok = FALSE)) - - checkmate::expect_string(check_time(c(1, 1))) - checkmate::expect_string(check_time(c(1, NA), any.missing = FALSE)) - checkmate::expect_string(check_time(NULL, null.ok = FALSE)) - - expect_true(test_time(object)) - expect_true(test_time(NULL, null.ok = TRUE)) - expect_true(check_time(object)) - expect_true(check_time(NULL, null.ok = TRUE)) - - expect_equal(assert_time(object), object) - expect_error(assert_time(c(1, 1))) +test_that("*_temporal() | general test", { + expect_true(test_temporal(lubridate::dhours())) + expect_true(test_temporal(lubridate::hours())) + expect_true(test_temporal(as.difftime(1, units = "secs"))) + expect_true(test_temporal(hms::hms(1))) + expect_true(test_temporal(as.Date("2000-01-01"))) + expect_true(test_temporal(lubridate::as_datetime(1))) + expect_true(test_temporal(as.POSIXlt(lubridate::as_datetime(1)))) + expect_true(test_temporal(lubridate::as.interval( + lubridate::dhours(), lubridate::as_datetime(0)))) + expect_true(test_temporal(NULL, null.ok = TRUE)) + expect_false(test_temporal(1)) + expect_false(test_temporal(letters)) + expect_false(test_temporal(datasets::iris)) + expect_false(test_temporal(lubridate::dhours(), rm = "Duration")) + expect_false(test_temporal(lubridate::hours(), rm = "Period")) + expect_false(test_temporal(as.difftime(1, units = "secs"), rm = "difftime")) + expect_false(test_temporal(hms::hms(1), rm = "hms")) + expect_false(test_temporal(as.Date("2000-01-01"), rm = "Date")) + expect_false(test_temporal(lubridate::as_datetime(1), rm = "POSIXct")) + expect_false(test_temporal(as.POSIXlt(lubridate::as_datetime(1)), + rm = "POSIXlt")) + expect_false(test_temporal(lubridate::as.interval( + lubridate::dhours(), lubridate::as_datetime(0)), rm = "Interval")) + expect_false(test_temporal(c(1, NA), any.missing = FALSE)) + expect_false(test_temporal(NULL, null.ok = FALSE)) + + checkmate::expect_string(check_temporal(c(1, 1)), + pattern = "Must be a temporal object ") + checkmate::expect_string(check_temporal(c(1, NA), any.missing = FALSE), + pattern = "'c\\(1, NA\\)' cannot have missing ") + checkmate::expect_string(check_temporal(NULL, null.ok = FALSE), + pattern = "'NULL' cannot have 'NULL' values") + expect_true(check_temporal(c(lubridate::hours(1), lubridate::hours(1)))) + expect_true(check_temporal(NULL, null.ok = TRUE)) + + expect_equal(assert_temporal(c(lubridate::hours(1), lubridate::hours(1))), + c(lubridate::hours(1), lubridate::hours(1))) + expect_error(assert_temporal(c(1, 1)), "Assertion on 'c\\(1, 1\\)' failed") }) test_that("assert_identical() | general test", { - expect_error(assert_identical(1)) - expect_error(assert_identical(1, type = "a")) - - expect_error(assert_identical(1, c(1, 1), type = "value")) + expect_error(assert_identical(1), + "'...' must have 2 or more elements.") + expect_error(assert_identical(1, c(1, 1), type = "value"), + "Assertion failed: '1' and 'c\\(1, 1\\)' must be identical.") expect_true(assert_identical(1, 1, type = "value")) - expect_error(assert_identical(1, c(2, 2), type = "length")) + expect_error(assert_identical(1, c(2, 2), type = "length"), + "Assertion failed: '1' and 'c\\(2, 2\\)' must have identical ") expect_true(assert_identical(1, 2, type = "length")) - expect_error(assert_identical(1, "a", type = "class")) + expect_error(assert_identical(1, "a", type = "class"), + "Assertion failed: '1' and 'a' must have identical classes.") expect_true(assert_identical(1, 3, type = "class")) expect_true(assert_identical(NULL, NULL, null.ok = TRUE)) - expect_error(assert_identical(1, NA, any.missing = FALSE)) - expect_error(assert_identical(NULL, NULL, null.ok = FALSE)) + expect_error(assert_identical(1, NA, any.missing = FALSE), + "'1' and 'NA' cannot have missing values.") + expect_error(assert_identical(NULL, NULL, null.ok = FALSE), + "'NULL' and 'NULL' cannot have 'NULL' values.") }) -test_that("check_custom_1() and assert_custom_1() | general test", { - object <- c(lubridate::dminutes(1), lubridate::dminutes(1)) - - checkmate::expect_string(check_custom_1(object)) - checkmate::expect_string(check_custom_1(c(1, NA), any.missing = FALSE)) - checkmate::expect_string(check_custom_1(NULL, null.ok = FALSE)) - +test_that("*_custom_1() | general test", { + expect_true(test_custom_1(c("a", "b"))) + expect_true(test_custom_1(c(1, 2))) + expect_true(test_custom_1(c(1, NA), any.missing = TRUE)) + expect_true(test_custom_1(NULL, null.ok = TRUE)) + expect_false(test_custom_1(datasets::iris)) + expect_false(test_custom_1(lubridate::dhours())) + expect_false(test_custom_1(c(1, NA), any.missing = FALSE)) + expect_false(test_custom_1(NULL, null.ok = FALSE)) + + checkmate::expect_string(check_custom_1(lubridate::dminutes(1)), + pattern = "'lubridate::dminutes\\(1\\)' must ") + checkmate::expect_string(check_custom_1(c(1, NA), any.missing = FALSE), + pattern = "'c\\(1, NA\\)' cannot have missing ") + checkmate::expect_string(check_custom_1(NULL, null.ok = FALSE), + "'NULL' cannot have 'NULL' values") expect_true(check_custom_1(c(1, 1))) expect_true(check_custom_1(c("a", "a"))) expect_true(check_custom_1(NULL, null.ok = TRUE)) expect_equal(assert_custom_1(c(1, 1)), c(1, 1)) expect_equal(assert_custom_1(c("a", "a")), c("a", "a")) - - expect_error(assert_custom_1(object)) + expect_error(assert_custom_1(lubridate::dminutes(1)), + "Assertion on 'lubridate::dminutes\\(1\\)' failed") }) diff --git a/tests/testthat/test-utils-clock_roll.R b/tests/testthat/test-utils-clock_roll.R index 782717c..7b306dd 100644 --- a/tests/testthat/test-utils-clock_roll.R +++ b/tests/testthat/test-utils-clock_roll.R @@ -1,45 +1,54 @@ test_that("clock_roll() | general test", { - # Nonexistent method error + ## Nonexistent method error + ## The error message may change depending on the user's 'locale' settings. expect_error(clock_roll(list())) }) -test_that("clock_roll.Duration() | general test", { +test_that("clock_roll.Duration() | scalar test", { expect_equal(clock_roll(lubridate::dhours(6)), lubridate::dhours(6)) expect_equal(clock_roll(lubridate::dhours(24)), lubridate::dhours(0)) expect_equal(clock_roll(lubridate::dhours(36)), lubridate::dhours(12)) +}) +test_that("clock_roll.Duration() | vector test", { expect_equal(clock_roll(c(lubridate::dhours(1), lubridate::dhours(48))), c(lubridate::dhours(1), lubridate::dhours(0))) }) -test_that("clock_roll.Period() | general test", { +test_that("clock_roll.Period() | scalar test", { expect_equal(clock_roll(lubridate::hours(6)), lubridate::hours(6)) expect_equal(clock_roll(lubridate::hours(24)), lubridate::hours(0)) expect_equal(clock_roll(lubridate::hours(36)), lubridate::hours(12)) +}) +test_that("clock_roll.Period() | vector test", { expect_equal(clock_roll(c(lubridate::hours(1), lubridate::hours(48))), c(lubridate::hours(1), lubridate::hours(0))) }) -test_that("clock_roll.difftime() | general test", { +test_that("clock_roll.difftime() | scalar test", { expect_equal(clock_roll(as.difftime(6, units = "mins")), as.difftime(6, units = "mins")) expect_equal(clock_roll(as.difftime(24, units = "hours")), as.difftime(0, units = "hours")) expect_equal(clock_roll(as.difftime(36, units = "hours")), as.difftime(12, units = "hours")) +}) +test_that("clock_roll.difftime() | vector test", { expect_equal(clock_roll(c(as.difftime(1, units = "hours"), as.difftime(48, units = "hours"))), c(as.difftime(1, units = "hours"), as.difftime(0, units = "hours"))) }) -test_that("clock_roll.hms() | general test", { +test_that("clock_roll.hms() | scalar test", { expect_equal(clock_roll(hms::parse_hm("06:00")), hms::parse_hm("06:00")) expect_equal(clock_roll(hms::parse_hm("24:00")), hms::parse_hm("00:00")) expect_equal(clock_roll(hms::hms(129600)), hms::parse_hm("12:00")) +}) +test_that("clock_roll.hms() | vector test", { expect_equal(clock_roll(c(hms::parse_hm("01:00"), hms::hms(172800))), c(hms::parse_hm("01:00"), hms::parse_hm("00:00"))) }) diff --git a/tests/testthat/test-utils-dialogs.R b/tests/testthat/test-utils-dialogs.R index 32cf82c..76aa2c2 100644 --- a/tests/testthat/test-utils-dialogs.R +++ b/tests/testthat/test-utils-dialogs.R @@ -1,7 +1,7 @@ -# Don't forget to run devtools::load_all(".") and uncomment the variables -# before trying to run the tests interactively. - test_that("dialog_line() | general test", { + # ## Don't forget to run devtools::load_all(".") and uncomment the variables + # ## before trying to run the tests interactively. + # # is_interactive <- mctq:::is_interactive # require_namespace <- mctq:::require_namespace # read_line <- mctq:::read_line @@ -38,22 +38,28 @@ test_that("dialog_line() | general test", { }) test_that("dialog_line() | error test", { - # Invalid values for `...`, `combined_styles`, `space_above`, - # `space_below`, and `abort` - expect_error(dialog_line()) - expect_error(dialog_line(1, combined_styles = "")) - expect_error(dialog_line(1, space_above = "")) - expect_error(dialog_line(1, space_below = "")) - expect_error(dialog_line(1, abort = "")) + expect_error(dialog_line(), "Assertion on 'list\\(...\\)' failed") + expect_error(dialog_line(1, combined_styles = ""), + "Assertion on 'combined_styles' failed") + expect_error(dialog_line(1, space_above = ""), + "Assertion on 'space_above' failed") + expect_error(dialog_line(1, space_below = ""), + "Assertion on 'space_below' failed") + expect_error(dialog_line(1, abort = ""), + "Assertion on 'abort' failed") }) test_that("alert() | general test", { - # require_namespace <- mctq:::require_namespace - expect_equal(alert(1, abort = TRUE), NULL) - expect_message(alert(1)) - expect_message(alert(c(1, 2))) - expect_message(alert(1, 2)) + + expect_message(alert(1), "1") + expect_message(alert(c(1, 2)), "12") + expect_message(alert(1, 2), "12") + + # ## Don't forget to run devtools::load_all(".") and uncomment the variables + # ## before trying to run the tests interactively. + # + # require_namespace <- mctq:::require_namespace mock <- function(.parent = parent.frame(), .env = topenv(.parent)) { mockr::with_mock( @@ -66,8 +72,9 @@ test_that("alert() | general test", { }) test_that("alert() | error test", { - # Invalid values for `...`, `combined_styles`, and `abort` - expect_error(alert()) - expect_error(alert(1, combined_styles = "")) - expect_error(alert(1, abort = "")) + expect_error(alert(), "Assertion on 'list\\(...\\)' failed") + expect_error(alert(1, combined_styles = ""), + "Assertion on 'combined_styles' failed") + expect_error(alert(1, abort = ""), + "Assertion on 'abort' failed") }) diff --git a/tests/testthat/test-utils-na_as.R b/tests/testthat/test-utils-na_as.R index 179c3ef..d906d95 100644 --- a/tests/testthat/test-utils-na_as.R +++ b/tests/testthat/test-utils-na_as.R @@ -1,5 +1,6 @@ test_that("na_as() | general test", { - # Nonexistent method error + ## Nonexistent method error + ## The error message may change depending on the user's 'locale' settings. expect_error(na_as(list(NA))) }) @@ -41,10 +42,10 @@ test_that("na_as.Date() | general test", { }) test_that("na_as.POSIXct() | general test", { - expect_equal(na_as(lubridate::as_datetime(0)), lubridate::as_datetime(NA)) + expect_equal(na_as(lubridate::as_datetime(1)), lubridate::as_datetime(NA)) }) test_that("na_as.POSIXlt() | general test", { - expect_equal(na_as(as.POSIXlt(lubridate::as_datetime(0))), + expect_equal(na_as(as.POSIXlt(lubridate::as_datetime(1))), as.POSIXlt(lubridate::as_datetime(NA))) }) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 7c2a91b..df09d74 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -1,26 +1,26 @@ test_that("flat_posixct() | general test", { - x <- lubridate::dmy_hms("17/04/1995 12:00:00") - force_utc <- TRUE - base <- "1970-01-01" - object <- flat_posixt(x, force_utc = force_utc, base = base) - expect_equal(object, lubridate::ymd_hms("1970-01-01 12:00:00")) - - x <- lubridate::dmy_hms("17/04/1995 12:00:00", tz = "EST") - force_utc <- FALSE - base <- "1970-01-01" - object <- flat_posixt(x, force_utc = force_utc, base = base) - expect_equal(object, lubridate::ymd_hms("1970-01-01 12:00:00", tz = "EST")) - - x <- lubridate::dmy_hms("17/04/1995 12:00:00", tz = "EST") - force_utc <- TRUE - base <- "2000-01-01" - object <- flat_posixt(x, force_utc = force_utc, base = base) - expect_equal(object, lubridate::ymd_hms("2000-01-01 12:00:00")) - - # Error test - expect_error(flat_posixt(1, TRUE, "")) - expect_error(flat_posixt(lubridate::as_datetime(1), "", "")) - expect_error(flat_posixt(lubridate::as_datetime(1), "", 1)) + expect_equal(flat_posixt(lubridate::dmy_hms("17/04/1995 12:00:00"), + TRUE, + "1970-01-01"), + lubridate::ymd_hms("1970-01-01 12:00:00")) + expect_equal(flat_posixt(lubridate::dmy_hms("17/04/1995 12:00:00", + tz = "EST"), + FALSE, + "1970-01-01"), + lubridate::ymd_hms("1970-01-01 12:00:00", tz = "EST")) + expect_equal(flat_posixt(lubridate::dmy_hms("17/04/1995 12:00:00", + tz = "EST"), + TRUE, + "2000-01-01"), + lubridate::ymd_hms("2000-01-01 12:00:00")) +}) + +test_that("flat_posixct() | error test", { + expect_error(flat_posixt(1, TRUE, ""), "Assertion on 'posixt' failed") + expect_error(flat_posixt(lubridate::as_datetime(1), "", ""), + "Assertion on 'force_utc' failed") + expect_error(flat_posixt(lubridate::as_datetime(1), TRUE, 1), + "Assertion on 'base' failed") }) test_that("midday_change() | general test", { @@ -32,187 +32,120 @@ test_that("midday_change() | general test", { lubridate::ymd_hms("2020-01-01 06:00:00"))), c(lubridate::ymd_hms("1970-01-01 18:00:00"), lubridate::ymd_hms("1970-01-02 06:00:00"))) - - # Assert error test - expect_error(midday_change(1), "but has class 'numeric'") }) -test_that("change_date() | general test", { - x <- as.Date("1970-01-01") - date <- "2000-01-01" - object <- change_date(x, date) - expect_equal(object, as.Date("2000-01-01")) - - x <- lubridate::as_datetime(0) - date <- as.Date("1990-01-01") - object <- change_date(x, date) - expect_equal(object, lubridate::ymd_hms("1990-01-01 00:00:00")) - - # Error test - expect_error(change_date(1, "")) - expect_error(change_date(as.Date("1970-01-01"), 1)) +test_that("midday_change() | error test", { + expect_error(midday_change(1), "Assertion on 'time' failed") }) -test_that("change_day() | general test", { - x <- as.Date("1970-01-01") - day <- 10 - object <- change_day(x, day) - expect_equal(object, as.Date("1970-01-10")) - - x <- lubridate::as_datetime(0) - day <- 25 - object <- change_day(x, day) - expect_equal(object, lubridate::ymd_hms("1970-01-25 00:00:00")) - - # Error test - expect_error(change_day(1, 1)) - expect_error(change_day(as.Date("1970-01-01"), "")) - - # "You can't assign more than 30 days to April, June, [...]" - expect_error(change_day(as.Date("1970-04-01"), 31)) - - # "You can't assign more than 28 days to February in [...]" - expect_error(change_day(as.Date("1970-02-01"), 31)) - - # "You can't assign more than 29 days to February in a leap year." - expect_error(change_day(as.Date("1972-02-01"), 31)) -}) - -test_that("is_time() | general test", { - expect_false(is_time(1)) - expect_false(is_time(letters)) - expect_false(is_time(datasets::iris)) - - test <- list( - "Duration" = lubridate::dhours(), - "Period" = lubridate::hours(), - "difftime" = as.difftime(1, units = "secs"), - "hms" = hms::hms(1), - "Date" = as.Date("2000-01-01"), - "POSIXct" = lubridate::as_datetime(1), - "POSIXlt" = as.POSIXlt(lubridate::as_datetime(1)), - "Interval" = lubridate::as.interval(lubridate::dhours(), - lubridate::as_datetime(0)) - ) - - for (i in names(test)) { - x <- test[[i]] - rm <- i - expect_true(is_time(x)) - expect_false(is_time(x, rm = rm)) - } - - # Error test - expect_error(is_time(1, rm = 1)) +test_that("interval_mean() | general test", { + expect_equal(interval_mean(hms::parse_hm("22:00"), hms::parse_hm("06:00")), + hms::hms(26 * 3600)) + expect_equal(interval_mean(hms::parse_hm("22:00"), hms::parse_hm("06:00"), + class = "Duration"), + lubridate::dhours(26)) + expect_equal(interval_mean(hms::parse_hm("22:00"), hms::parse_hm("06:00"), + circular = TRUE), + hms::parse_hm("02:00")) + expect_equal(interval_mean(hms::parse_hm("00:00"), hms::parse_hm("10:00")), + hms::parse_hm("05:00")) }) -test_that("is_numeric_() | general test", { - expect_false(is_numeric_(lubridate::dhours())) - expect_false(is_numeric_(letters)) - expect_false(is_numeric_(datasets::iris)) +test_that("interval_mean() | error test", { + expect_error(interval_mean(1, hms::hms(1)), "Assertion on 'start' failed") + expect_error(interval_mean(hms::hms(1), 1), "Assertion on 'end' failed") + expect_error(interval_mean(hms::hms(1), hms::hms(1), class = 1), + "Assertion on 'tolower\\(class\\)' failed") + expect_error(interval_mean(hms::hms(1), hms::hms(1), ambiguity = 1), + "Assertion on 'ambiguity' failed") + expect_error(interval_mean(hms::hms(1), hms::hms(1), circular = ""), + "Assertion on 'circular' failed") +}) - expect_true(is_numeric_(as.integer(1))) - expect_true(is_numeric_(as.double(1))) - expect_true(is_numeric_(as.numeric(1))) +test_that("change_date() | general test", { + expect_equal(change_date(as.Date("1970-01-01"), "2000-01-01"), + as.Date("2000-01-01")) + expect_equal(change_date(lubridate::as_datetime(0), as.Date("1990-01-01")), + lubridate::ymd_hms("1990-01-01 00:00:00")) }) -test_that("is_whole_number() | general test", { - expect_false(is_whole_number(lubridate::dhours())) - expect_false(is_whole_number(letters)) - expect_false(is_whole_number(datasets::iris)) +test_that("change_date() | error test", { + expect_error(change_date(1, ""), "Assertion on 'x' failed") + expect_error(change_date(as.Date("1970-01-01"), 1), + "Assertion on 'date' failed") +}) - expect_false(is_whole_number(-1L)) - expect_false(is_whole_number(-55)) - expect_false(is_whole_number(1.58)) +test_that("change_day() | general test", { + expect_equal(change_day(as.Date("1970-01-01"), 10), as.Date("1970-01-10")) + expect_equal(change_day(lubridate::as_datetime(0), 25), + lubridate::ymd_hms("1970-01-25 00:00:00")) +}) - expect_true(is_whole_number(0)) - expect_true(is_whole_number(as.integer(1))) - expect_true(is_whole_number(as.double(11))) - expect_true(is_whole_number(as.numeric(475))) +test_that("change_day() | general test", { + expect_error(change_day(1, 1), "Assertion on 'x' failed") + expect_error(change_day(as.Date("1970-01-01"), ""), + "Assertion on 'day' failed") + + expect_error(change_day(as.Date("1970-04-01"), 31), + "You can't assign more than 30 days to April, June, ") + expect_error(change_day(as.Date("1970-02-01"), 31), + "You can't assign more than 28 days to February in non-leap ") + expect_error(change_day(as.Date("1972-02-01"), 31), + "You can't assign more than 29 days to February in a leap ") }) test_that("single_quote_() | general test", { - test <- list("test", 1, lubridate::dhours()) - - for (i in test) { - checkmate::expect_character(single_quote_(i)) - expect_equal(single_quote_(i), paste0("'", i, "'")) - } + expect_equal(single_quote_("test"), paste0("'", "test", "'")) + expect_equal(single_quote_(1), paste0("'", 1, "'")) + expect_equal(single_quote_(lubridate::dhours()), + paste0("'", lubridate::dhours(), "'")) }) test_that("backtick_() | general test", { - test <- list("test", 1, lubridate::dhours()) - - for (i in test) { - checkmate::expect_character(backtick_(i)) - expect_equal(backtick_(i), paste0("`", i, "`")) - } + expect_equal(backtick_("test"), paste0("`", "test", "`")) + expect_equal(backtick_(1), paste0("`", 1, "`")) + expect_equal(backtick_(lubridate::dhours()), + paste0("`", lubridate::dhours(), "`")) }) test_that("class_collapse() | general test", { - test <- list("test", 1, lubridate::dhours()) - - for (i in test) { - checkmate::expect_character(class_collapse(i)) - expect_equal(class_collapse(i), - single_quote_(paste0(class(i), collapse = "/"))) - } + expect_equal(class_collapse("test"), + single_quote_(paste0(class("test"), collapse = "/"))) + expect_equal(class_collapse(1), + single_quote_(paste0(class(1), collapse = "/"))) + expect_equal(class_collapse(lubridate::dhours()), + single_quote_(paste0(class(lubridate::dhours()), + collapse = "/"))) }) test_that("paste_collapse() | general test", { - x <- "test" - expect_equal(paste_collapse(x), x) - - x <- c(1, 2, 3) - sep <- ", " - last <- ", and " - object <- paste_collapse(x, sep = sep, last = last) - expect_equal(object, "1, 2, and 3") + expect_equal(paste_collapse("test"), "test") + expect_equal(paste_collapse(c(1, 2, 3), sep = ", ", last = ", and "), + "1, 2, and 3") +}) - # Error test - expect_error(paste_collapse("", 1, "")) - expect_error(paste_collapse("", "", 1)) +test_that("paste_collapse() | error test", { + expect_error(paste_collapse("", 1, ""), "Assertion on 'sep' failed") + expect_error(paste_collapse("", "", 1), "Assertion on 'last' failed") }) test_that("inline_collapse() | general test", { - x <- "test" - single_quote <- FALSE - serial_comma <- FALSE - object <- inline_collapse(x, single_quote = single_quote, - serial_comma = serial_comma) - expect_equal(object, x) - - x <- "test" - single_quote <- TRUE - serial_comma <- FALSE - object <- inline_collapse(x, single_quote = single_quote, - serial_comma = serial_comma) - expect_equal(object, paste0("'", x, "'")) - - x <- c(1, 2) - single_quote <- FALSE - serial_comma <- FALSE - object <- inline_collapse(x, single_quote = single_quote, - serial_comma = serial_comma) - expect_equal(object, paste0(1, " and ", 2)) - - x <- c(1, 2) - single_quote <- TRUE - serial_comma <- FALSE - object <- inline_collapse(x, single_quote = single_quote, - serial_comma = serial_comma) - expect_equal(object, paste0("'1'", " and ", "'2'")) - - x <- c(1, 2, 3) - single_quote <- TRUE - serial_comma <- TRUE - object <- inline_collapse(x, single_quote = single_quote, - serial_comma = serial_comma) - expect_equal(object, paste0("'1'", ", ", "'2'", ", and ", "'3'")) - - # Error test - expect_error(inline_collapse("", "", TRUE)) - expect_error(inline_collapse("", TRUE, "")) + expect_equal(inline_collapse("test", FALSE, FALSE), "test") + expect_equal(inline_collapse("test", TRUE, FALSE), + paste0("'", "test", "'")) + expect_equal(inline_collapse(c(1, 2), FALSE, FALSE), + paste0(1, " and ", 2)) + expect_equal(inline_collapse(c(1, 2), TRUE, FALSE), + paste0("'1'", " and ", "'2'")) + expect_equal(inline_collapse(c(1, 2, 3), TRUE, TRUE), + paste0("'1'", ", ", "'2'", ", and ", "'3'")) +}) + +test_that("inline_collapse() | error test", { + expect_error(inline_collapse("", "", TRUE), + "Assertion on 'single_quote' failed") + expect_error(inline_collapse("", TRUE, ""), + "Assertion on 'serial_comma' failed") }) test_that("shush() | general test", { @@ -224,158 +157,113 @@ test_that("shush() | general test", { } expect_equal(shush(test(), quiet = TRUE), "test") - expect_warning(shush(test(), quiet = FALSE)) + expect_warning(shush(test(), quiet = FALSE), "test") }) test_that("close_round() | general test", { - x <- 1.999999 - digits <- 5 - expect_equal(close_round(x, digits = digits), 2) - - x <- 1.000001 - digits <- 5 - expect_equal(close_round(x, digits = digits), 1) - - x <- 1.001 - digits <- 2 - expect_equal(close_round(x, digits = digits), 1) - - x <- c(1.000001, 1.999999) - digits <- 5 - expect_equal(close_round(x, digits = digits), c(1, 2)) + expect_equal(close_round(1.999999, 5), 2) + expect_equal(close_round(1.000001, 5), 1) + expect_equal(close_round(1.001, 2), 1) + expect_equal(close_round(1.0001, 5), 1.0001) + expect_equal(close_round(c(1.000001, 1.999999, 1.11), 5), + c(1, 2, 1.11)) +}) - # Error test - expect_error(close_round("", 1)) - expect_error(close_round(1, "")) +test_that("close_round() | error test", { + expect_error(close_round("", 1), "Assertion on 'x' failed") + expect_error(close_round(1, ""), "Assertion on 'digits' failed") }) test_that("swap() | general test", { expect_equal(swap(5, 1), list(x = 1, y = 5)) expect_equal(swap(1, 5, 1 > 5), list(x = 1, y = 5)) expect_equal(swap(5, 1, 2 > 1), list(x = 1, y = 5)) +}) - # Assert condition error - expect_error(swap(1, 1, 1), "not 'double'") +test_that("swap() | error test", { + expect_error(swap(1, 1, 1), "Assertion on 'condition' failed") }) test_that("count_na() | general test", { - x <- c(1, NA, 1, NA) - expect_equal(count_na(x), 2) + expect_equal(count_na(c(1, NA, 1, NA)), 2) }) test_that("escape_regex() | general test", { - x <- "test.test" - expect_equal(escape_regex(x), "test\\.test") + expect_equal(escape_regex("test.test"), "test\\.test") }) test_that("get_names() | general test", { - object <- get_names(x, y, z) - expect_equal(object, noquote(c("x", "y", "z"))) + expect_equal(get_names(x, y, z), noquote(c("x", "y", "z"))) }) test_that("get_class() | general test", { - test <- function(x) class(x)[1] - expect_equal(get_class(1), "numeric") expect_equal(get_class(datasets::iris), - vapply(datasets::iris, test, character(1))) + vapply(datasets::iris, function(x) class(x)[1], character(1))) expect_equal(get_class(list(a = 1, b = 1)), - vapply(list(a = 1, b = 1), test, character(1))) + vapply(list(a = 1, b = 1), function(x) class(x)[1], + character(1))) }) test_that("fix_character() | general test", { - x <- c("1 ", " 1", "", "NA") - expect_equal(fix_character(x), c("1", "1", NA, NA)) + expect_equal(fix_character(c("1 ", " 1", "", "NA")), + c("1", "1", NA, NA)) +}) - # Error test - expect_error(fix_character(1)) +test_that("fix_character() | error test", { + expect_error(fix_character(1), "Assertion on 'x' failed") }) test_that("str_extract_() | general test", { - string <- "test123" - pattern <- "\\d+$" - perl <- TRUE - object <- str_extract_(string, pattern, perl = perl) - expected <- regmatches(string, regexpr(pattern, string, perl = TRUE)) - expect_equal(object, expected) - - string <- "test123" - pattern <- "^0$" - perl <- TRUE - object <- str_extract_(string, pattern, perl = perl) - expected <- as.character(NA) - expect_equal(object, expected) - - # Error test (argument check) - expect_error(str_extract_(1, 1, TRUE, TRUE, TRUE, TRUE, TRUE)) - expect_error(str_extract_(1, TRUE, "", TRUE, TRUE, TRUE, TRUE)) - expect_error(str_extract_(1, TRUE, TRUE, "", TRUE, TRUE, TRUE)) - expect_error(str_extract_(1, TRUE, TRUE, TRUE, "", TRUE, TRUE)) - expect_error(str_extract_(1, TRUE, TRUE, TRUE, TRUE, "", TRUE)) - expect_error(str_extract_(1, TRUE, TRUE, TRUE, TRUE, TRUE, "")) + expect_equal(str_extract_("test123", "\\d+$", TRUE), + regmatches("test123", regexpr("\\d+$", "test123", + perl = TRUE))) + expect_equal(str_extract_("test123", "^0$", TRUE), as.character(NA)) }) -test_that("str_subset_() | general test", { - string <- month.name - pattern <- "^J.+" - perl <- TRUE - negate <- FALSE - object <- str_subset_(string, pattern, perl = perl, negate = negate) - expected <- subset(string, grepl(pattern, string, perl = perl)) - expect_equal(object, expected) - - string <- month.name - pattern <- "^J.+" - perl <- TRUE - negate <- TRUE - object <- str_subset_(string, pattern, perl = perl, negate = negate) - expected <- subset(string, !grepl(pattern, string, perl = perl)) - expect_equal(object, expected) - - string <- month.name - pattern <- "^z$" - perl <- TRUE - negate <- FALSE - object <- str_subset_(string, pattern, perl = perl, negate = negate) - expected <- as.character(NA) - expect_equal(object, expected) - - # Error test - expect_error(str_subset_(1, 1, TRUE, TRUE, TRUE, TRUE, TRUE)) - expect_error(str_subset_(1, TRUE, "", TRUE, TRUE, TRUE, TRUE)) - expect_error(str_subset_(1, TRUE, TRUE, "", TRUE, TRUE, TRUE)) - expect_error(str_subset_(1, TRUE, TRUE, TRUE, "", TRUE, TRUE)) - expect_error(str_subset_(1, TRUE, TRUE, TRUE, TRUE, "", TRUE)) - expect_error(str_subset_(1, TRUE, TRUE, TRUE, TRUE, TRUE, "")) +test_that("str_extract_() | error test", { + expect_error(str_extract_(1, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE), + "Assertion on 'pattern' failed") + expect_error(str_extract_(1, "a", "", TRUE, TRUE, TRUE, TRUE), + "Assertion on 'ignore_case' failed") + expect_error(str_extract_(1, "a", TRUE, "", TRUE, TRUE, TRUE), + "Assertion on 'perl' failed") + expect_error(str_extract_(1, "a", TRUE, TRUE, "", TRUE, TRUE), + "Assertion on 'fixed' failed") + expect_error(str_extract_(1, "a", TRUE, TRUE, TRUE, "", TRUE), + "Assertion on 'use_bytes' failed") + expect_error(str_extract_(1, "a", TRUE, TRUE, TRUE, TRUE, ""), + "Assertion on 'invert' failed") }) -test_that("interval_mean() | general test", { - start <- hms::parse_hm("22:00") - end <- hms::parse_hm("06:00") - - object <- interval_mean(start, end) - expect_equal(object, hms::hms(26 * 3600)) - - object <- interval_mean(start, end, class = "Duration") - expect_equal(object, lubridate::dhours(26)) - - object <- interval_mean(start, end, circular = TRUE) - expect_equal(object, hms::parse_hm("02:00")) - - start <- hms::parse_hm("00:00") - end <- hms::parse_hm("10:00") - object <- interval_mean(start, end) - expect_equal(object, hms::parse_hm("05:00")) +test_that("str_subset_() | general test", { + expect_equal(str_subset_(month.name, "^J.+", perl = TRUE, negate = FALSE), + subset(month.name, grepl("^J.+", month.name, perl = TRUE))) + expect_equal(str_subset_(month.name, "^J.+", perl = TRUE, negate = TRUE), + subset(month.name, !grepl("^J.+", month.name, perl = TRUE))) + expect_equal(str_subset_(month.name, "^z$", perl = TRUE, negate = FALSE), + as.character(NA)) +}) - # Error test - expect_error(interval_mean(1, hms::hms(1))) - expect_error(interval_mean(hms::hms(1), 1)) - expect_error(interval_mean(hms::hms(1), hms::hms(1), class = 1)) - expect_error(interval_mean(hms::hms(1), hms::hms(1), ambiguity = 1)) - expect_error(interval_mean(hms::hms(1), hms::hms(1), circular = "")) +test_that("str_subset_() | error test", { + expect_error(str_subset_(1, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE), + "Assertion on 'pattern' failed") + expect_error(str_subset_(1, "a", "", TRUE, TRUE, TRUE, TRUE), + "Assertion on 'negate' failed") + expect_error(str_subset_(1, "a", TRUE, "", TRUE, TRUE, TRUE), + "Assertion on 'ignore_case' failed") + expect_error(str_subset_(1, "a", TRUE, TRUE, "", TRUE, TRUE), + "Assertion on 'perl' failed") + expect_error(str_subset_(1, "a", TRUE, TRUE, TRUE, "", TRUE), + "Assertion on 'fixed' failed") + expect_error(str_subset_(1, "a", TRUE, TRUE, TRUE, TRUE, ""), + "Assertion on 'use_bytes' failed") }) test_that("package_startup_message() | general test", { + # ## Don't forget to run devtools::load_all(".") and uncomment the variables + # ## before trying to run the tests interactively. + # # is_interactive <- mctq:::is_interactive mock <- function(.parent = parent.frame(), .env = topenv(.parent)) {