Skip to content

Commit

Permalink
Change 'assign_date()' to output only 'Interval' objects
Browse files Browse the repository at this point in the history
  • Loading branch information
@danielvartan
danielvartan committed Oct 4, 2021
1 parent f66cab4 commit 4dc4a11
Show file tree
Hide file tree
Showing 3 changed files with 33 additions and 209 deletions.
105 changes: 18 additions & 87 deletions R/assign_date.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@
#' `r lifecycle::badge("maturing")`
#'
#' `assign_date()` assign dates to two sequential hours. It can facilitate
#' time arithmetic by locating time values without date reference on a
#' time arithmetic by locating time values without a date reference on a
#' timeline.
#'
#' @details
Expand Down Expand Up @@ -44,52 +44,35 @@
#' hours, i.e., `start` and `end` distance themselves by one day.
#' * `ambiguity = NA`: to disregard these cases, assigning `NA` as value.
#'
#' ## `return` argument
#' ## Base date and timezone
#'
#' `assign_date()` can return different outputs:
#' `assign_date()` uses the
#' [Unix epoch](https://en.wikipedia.org/wiki/Unix_time) (1970-01-01) date as
#' the start date for creating intervals.
#'
#' * `return = "Interval"`: returns a `start`--`end` `Interval` object.
#' * `return = "list"`: returns a `list` object with two named elements
#' corresponding to `start` and `end` output.
#' * `return = "start"`: returns only the `start` output.
#' * `return = "end"`: returns only the `end` output.
#'
#' ## `start_name` and `end_name` arguments
#'
#' These arguments serve to instruct `assign_date()` on how to name the
#' list elements when `return = "list"`. By default, the function will name
#' these elements with the names of the variables assigned to `start` and `end`
#' arguments.
#'
#' If the number of characters (`nchar()`) of `start_name` or `end_name` are
#' equal or greater than 30, `assign_date()` will name the list elements as
#' `"start"` and `"end"`.
#' The output will always have `"UTC"` set as timezone. Learn more about
#' time zones in [base::timezone].
#'
#' ## `POSIXt` objects
#'
#' `POSIXt` values passed as argument to `start` or `end` will be stripped of
#' `POSIXt` objects passed as argument to `start` or `end` will be stripped of
#' their dates. Only the time will be considered.
#'
#' Both `POSIXct` and `POSIXlt` are objects that inherits the class `POSIXt`.
#' Learn more about it in [base::DateTimeClasses].
#'
#' ## `NA` values
#'
#' `assign_date()` will return `NA` if `start` or `end` are `NA`.
#' `assign_date()` will return an `Interval` `NA`-`NA` if `start` or `end` are
#' `NA`.
#'
#' @param start,end A `hms` or `POSIXt` object indicating the start or end
#' hour.
#' @param ambiguity (optional) a `numeric` or `NA` value to instruct
#' `assign_date()` on how to deal with ambiguities (see Details) (default:
#' `0`).
#' @param return (optional) a string indicating the type of the output (see
#' Details) (default: `"Interval"`).
#' @param start_name,end_name (optional) a string indicating a name associated
#' with the `start` and `end` argument.
#'
#' @return
#'
#' * If `return = "Interval"`, a `start`--`end` `Interval` object.
#' * If `return = "list"`, a named list with `start` and `end` as elements.
#' * If `return = "start`, only the `start` output.
#' * If `return = "end"`, only the `end` output.
#' @return A `start`--`end` `Interval` object.
#'
#' @family utility functions
#' @export
Expand Down Expand Up @@ -120,58 +103,21 @@
#' #> [1] 1970-01-01 09:45:00 UTC--1970-01-01 21:15:00 UTC # Expected
#' #> [2] 1970-01-01 20:30:00 UTC--1970-01-02 04:30:00 UTC # Expected
#'
#' ## To return `start` and `end` as interval (default)
#'
#' start <- hms::parse_hm("12:34")
#' end <- hms::parse_hm("01:25")
#' assign_date(start, end)
#' #> [1] 1970-01-01 12:34:00 UTC--1970-01-02 01:25:00 UTC # Expected
#'
#' ## To return `start` and `end` as list
#'
#' start <- hms::parse_hm("22:15")
#' end <- hms::parse_hm("00:01")
#' assign_date(start, end, return = "list")
#' #> $start # Expected
#' #> [1] "1970-01-01 22:15:00 UTC" # Expected
#' #> # Expected
#' #> $end # Expected
#' #> [1] "1970-01-02 00:01:00 UTC" # Expected
#'
#' ## To return only `start` or `end`
#'
#' start <- lubridate::parse_date_time("01:10:00", "HMS")
#' end <- lubridate::parse_date_time("11:45:00", "HMS")
#' assign_date(start, end, return = "start")
#' #> [1] "1970-01-01 01:10:00 UTC" # Expected
#' assign_date(start, end, return = "end")
#' #> [1] "1970-01-01 11:45:00 UTC" # Expected
#'
#' ## To assign a 24 hours interval to ambiguities
#'
#' start <- lubridate::as_datetime("1985-01-15 12:00:00")
#' end <- lubridate::as_datetime("2020-09-10 12:00:00")
#' assign_date(start, end, ambiguity = 24)
#' #> [1] 1970-01-01 12:00:00 UTC--1970-01-02 12:00:00 UTC # Expected
assign_date <- function(start, end, return = "Interval", ambiguity = 0,
start_name = deparse(substitute(start)),
end_name = deparse(substitute(end))) {
checkmate::assert_multi_class(start, c("hms", "POSIXct", "POSIXlt"))
checkmate::assert_multi_class(end, c("hms", "POSIXct", "POSIXlt"))
assign_date <- function(start, end, ambiguity = 0) {
checkmate::assert_multi_class(start, c("hms", "POSIXt"))
checkmate::assert_multi_class(end, c("hms", "POSIXt"))
assert_identical(start, end, type = "length")
checkmate::assert_numeric(as.numeric(hms::as_hms(start)),
lower = 0, upper = 86400)
checkmate::assert_numeric(as.numeric(hms::as_hms(end)),
lower = 0, upper = 86400)
checkmate::assert_choice(tolower(return),
c("list", "interval", "start", "end"))
checkmate::assert_choice(ambiguity, c(0, 24 , NA))
checkmate::assert_string(start_name)
checkmate::assert_string(end_name)

return <- tolower(return)
start_name <- start_name[1]
end_name <- end_name[1]

start <- flat_posixt(convert(start, "posixct", quiet = TRUE))
end <- flat_posixt(convert(end, "posixct", quiet = TRUE))
Expand All @@ -184,20 +130,5 @@ assign_date <- function(start, end, return = "Interval", ambiguity = 0,
TRUE ~ lubridate::as.interval(lubridate::hours(ambiguity), start)
)

if (return == "interval") {
out
} else if (return == "start") {
lubridate::int_start(out)
} else if (return == "end") {
lubridate::int_end(out)
} else {
out <- list(start = lubridate::int_start(out),
end = lubridate::int_end(out))

if (nchar(start_name) < 30 && nchar(end_name) < 30) {
names(out) <- c(start_name, end_name)
}

out
}
out
}
85 changes: 15 additions & 70 deletions man/assign_date.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

52 changes: 0 additions & 52 deletions tests/testthat/test-assign_date.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -37,62 +37,10 @@ test_that("assign_date() | `ambiguity` test", {
lubridate::as.interval(NA))
})

test_that("assign_date() | `return` test", {
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")))

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")))

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"))

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"))

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"))

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", {
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", {
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))))
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")
})

0 comments on commit 4dc4a11

Please sign in to comment.