[med-svn] [r-cran-hms] 01/02: New upstream version 0.3
Andreas Tille
tille at debian.org
Mon Oct 2 06:11:31 UTC 2017
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-cran-hms.
commit 988fc4675ff09c18f90da79d5049b2cf2b986aa5
Author: Andreas Tille <tille at debian.org>
Date: Mon Oct 2 08:10:45 2017 +0200
New upstream version 0.3
---
DESCRIPTION | 25 ++++++
MD5 | 18 +++++
NAMESPACE | 19 +++++
NEWS.md | 41 ++++++++++
R/aaa-tools.R | 18 +++++
R/arith.R | 42 ++++++++++
R/format.R | 11 +++
R/hms.R | 174 ++++++++++++++++++++++++++++++++++++++++
README.md | 36 +++++++++
man/hms.Rd | 96 ++++++++++++++++++++++
tests/testthat.R | 4 +
tests/testthat/helper-compare.R | 11 +++
tests/testthat/test-arith.R | 33 ++++++++
tests/testthat/test-coercion.R | 29 +++++++
tests/testthat/test-construct.R | 24 ++++++
tests/testthat/test-lubridate.R | 20 +++++
tests/testthat/test-output.R | 56 +++++++++++++
tests/testthat/test-subset.R | 25 ++++++
tests/testthat/test-update.R | 10 +++
19 files changed, 692 insertions(+)
diff --git a/DESCRIPTION b/DESCRIPTION
new file mode 100644
index 0000000..dcd8e54
--- /dev/null
+++ b/DESCRIPTION
@@ -0,0 +1,25 @@
+Package: hms
+Title: Pretty Time of Day
+Date: 2016-11-22
+Version: 0.3
+Authors at R: c(
+ person("Kirill", "Müller", role = c("aut", "cre"), email = "krlmlr+r at mailbox.org"),
+ person("The R Consortium", role = "cph")
+ )
+Description: Implements an S3 class for storing and formatting time-of-day
+ values, based on the 'difftime' class.
+Imports: methods
+Suggests: testthat, lubridate
+License: GPL-3
+Encoding: UTF-8
+LazyData: true
+URL: https://github.com/rstats-db/hms
+BugReports: https://github.com/rstats-db/hms/issues
+RoxygenNote: 5.0.1.9000
+NeedsCompilation: no
+Packaged: 2016-11-22 14:45:31 UTC; muelleki
+Author: Kirill Müller [aut, cre],
+ The R Consortium [cph]
+Maintainer: Kirill Müller <krlmlr+r at mailbox.org>
+Repository: CRAN
+Date/Publication: 2016-11-22 17:08:01
diff --git a/MD5 b/MD5
new file mode 100644
index 0000000..2bf6d5c
--- /dev/null
+++ b/MD5
@@ -0,0 +1,18 @@
+71887e025bbc9f8d685076ba4ffd93bf *DESCRIPTION
+6fc52dc59347352469b948db5793ffd3 *NAMESPACE
+d0bf58dc51571b1764786f0337936a56 *NEWS.md
+fcdf13180407d2fdf40bd661731c2c17 *R/aaa-tools.R
+2b89e2462be5b7d72097c68a4b6c654a *R/arith.R
+8b37fabf6c7f076a6353dc7c260a3d31 *R/format.R
+6f9bba739966b4e509beaa502bce509a *R/hms.R
+86bc8de6929f0043166a736a3fdf1af9 *README.md
+4fedd87423f6f51ccf2aca9558a07e60 *man/hms.Rd
+929afdb21c50685048246bdc5d82207d *tests/testthat.R
+fc7098abdba1003efcde210eced441ac *tests/testthat/helper-compare.R
+baa00de5b6dad9da9a13212b4dfa0da0 *tests/testthat/test-arith.R
+6c97d9c126f0a3f9ecefe6934e0a6fac *tests/testthat/test-coercion.R
+86ca91c46da5d129c7585c3917826596 *tests/testthat/test-construct.R
+8a0858c5e546d54f7719e77a7940b62a *tests/testthat/test-lubridate.R
+f1bd1c27b9e372c1cb13d9abac4ea102 *tests/testthat/test-output.R
+765c3591c7471688d7b53a8fa47bdddc *tests/testthat/test-subset.R
+36082171f366b616c4004a919542871c *tests/testthat/test-update.R
diff --git a/NAMESPACE b/NAMESPACE
new file mode 100644
index 0000000..8a18c6c
--- /dev/null
+++ b/NAMESPACE
@@ -0,0 +1,19 @@
+# Generated by roxygen2: do not edit by hand
+
+S3method("[[",hms)
+S3method("units<-",hms)
+S3method(as.POSIXct,hms)
+S3method(as.POSIXlt,hms)
+S3method(as.character,hms)
+S3method(as.data.frame,hms)
+S3method(as.hms,POSIXt)
+S3method(as.hms,character)
+S3method(as.hms,default)
+S3method(as.hms,difftime)
+S3method(as.hms,numeric)
+S3method(format,hms)
+S3method(print,hms)
+export(as.hms)
+export(hms)
+export(is.hms)
+importFrom(methods,setOldClass)
diff --git a/NEWS.md b/NEWS.md
new file mode 100644
index 0000000..eb899b3
--- /dev/null
+++ b/NEWS.md
@@ -0,0 +1,41 @@
+# hms 0.3 (2016-11-22)
+
+- Fix `lubridate` test for compatibility with 1.6.0 (#23, @vspinu).
+- NA values are formatted as `NA` (#22).
+
+
+# hms 0.2 (2016-06-17)
+
+Minor fixes and improvements.
+
+- Subsetting keeps `hms` class (#16).
+- `format.hms()` right-justifies the output by padding with spaces from the left, `as.character.hms()` remains unchanged.
+- Times larger than 24 hours or with split seconds are now formatted correctly (#12, #13).
+- Sub-second part is printed with up to six digits, for even smaller values trailing zeros are shown (#17).
+
+
+# hms 0.1 (2016-04-30)
+
+First CRAN release.
+
+- Values are stored as a numeric vector that contains the number of seconds
+ since midnight.
+ - Inherits from `difftime` class.
+ - Updating units is a no-op, anything different from `"secs"` issues a warning.
+- Supports construction from time values, coercion to and from various data
+ types, and formatting.
+ - Conversion from numeric treats input as seconds.
+ - Negative times are formatted with a leading `-`.
+- Can be used as a regular column in a data frame.
+- Full test coverage.
+ - Test for arithmetic with `Date`, `POSIXt` and `hms` classes.
+ - Test basic compatibility with `lubridate` package (#5).
+- Interface:
+ - `hms()` (with rigorous argument checks)
+ - `as.hms()` for `character`, `numeric`, `POSIXct` and `POSIXlt`
+ - `as.xxx.hms()` for `character`, `numeric` (implicitly), `POSIXct` and
+ `POSIXlt`
+ - `is.hms()`
+ - `as.data.frame.hms()` (forwards to `as.data.frame.difftime()`)
+ - `format.hms()`
+ - `print.hms()` (returns unchanged input invisibly)
diff --git a/R/aaa-tools.R b/R/aaa-tools.R
new file mode 100644
index 0000000..8bad767
--- /dev/null
+++ b/R/aaa-tools.R
@@ -0,0 +1,18 @@
+# nocov start
+forward_to <- function(f, envir = parent.frame()) {
+ f_fmls <- formals(f)
+ f_called_fmls <- stats::setNames(lapply(names(f_fmls), as.symbol), names(f_fmls))
+
+ f_call <- as.call(c(substitute(f), f_called_fmls))
+
+ f_ret <- eval(bquote(
+ function() {
+ .(f_call)
+ }
+ ))
+
+ formals(f_ret) <- f_fmls
+ environment(f_ret) <- envir
+ f_ret
+}
+# nocov end
diff --git a/R/arith.R b/R/arith.R
new file mode 100644
index 0000000..93f3cd7
--- /dev/null
+++ b/R/arith.R
@@ -0,0 +1,42 @@
+SECONDS_PER_MINUTE <- 60
+MINUTES_PER_HOUR <- 60
+HOURS_PER_DAY <- 24
+
+SECONDS_PER_HOUR <- MINUTES_PER_HOUR * SECONDS_PER_MINUTE
+SECONDS_PER_DAY <- HOURS_PER_DAY * SECONDS_PER_HOUR
+
+days <- function(x) {
+ trunc(as.numeric(x) / SECONDS_PER_DAY)
+}
+
+hours <- function(x) {
+ trunc(as.numeric(x) / SECONDS_PER_HOUR)
+}
+
+hour_of_day <- function(x) {
+ abs(hours(x) - days(x) * HOURS_PER_DAY)
+}
+
+minutes <- function(x) {
+ trunc(as.numeric(x) / SECONDS_PER_MINUTE)
+}
+
+minute_of_hour <- function(x) {
+ abs(minutes(x) - hours(x) * MINUTES_PER_HOUR)
+}
+
+seconds <- function(x) {
+ trunc(as.numeric(x))
+}
+
+second_of_minute <- function(x) {
+ abs(seconds(x) - minutes(x) * SECONDS_PER_MINUTE)
+}
+
+split_seconds <- function(x) {
+ as.numeric(x)
+}
+
+split_second_of_second <- function(x) {
+ abs(split_seconds(x) - seconds(x))
+}
diff --git a/R/format.R b/R/format.R
new file mode 100644
index 0000000..028ca6b
--- /dev/null
+++ b/R/format.R
@@ -0,0 +1,11 @@
+format_two_digits <- function(x) {
+ formatC(x, width = 2, flag = "0")
+}
+
+format_split_seconds <- function(x) {
+ split_second <- split_second_of_second(x)
+ out <- format(split_second, scientific = FALSE)
+ digits <- max(min(max(nchar(out) - 2), 6), 0)
+ out <- formatC(split_second, format = "f", digits = digits)
+ gsub("^0", "", out)
+}
diff --git a/R/hms.R b/R/hms.R
new file mode 100644
index 0000000..1565025
--- /dev/null
+++ b/R/hms.R
@@ -0,0 +1,174 @@
+#' @importFrom methods setOldClass
+setOldClass(c("hms", "difftime"))
+
+#' A simple class for storing time-of-day values
+#'
+#' The values are stored as a \code{\link{difftime}} vector with a custom class,
+#' and always with "seconds" as unit for robust coercion to numeric.
+#' Supports construction from time values, coercion to and from
+#' various data types, and formatting. Can be used as a regular column in a
+#' data frame.
+#'
+#' @name hms
+#' @examples
+#' hms(56, 34, 12)
+#' as.hms(1)
+#' as.hms("12:34:56")
+#' as.hms(Sys.time())
+#' as.POSIXct(hms(1))
+#' \dontrun{
+#' # Will raise an error
+#' data.frame(a = hms(1))
+#' }
+#' d <- data.frame(hours = 1:3)
+#' d$hours <- hms(hours = d$hours)
+#' d
+NULL
+
+# Construction ------------------------------------------------------------
+
+#' @rdname hms
+#' @details For \code{hms}, all arguments must have the same length or be
+#' \code{NULL}. Odd combinations (e.g., passing only \code{seconds} and
+#' \code{hours} but not \code{minutes}) are rejected.
+#' @param seconds,minutes,hours,days Time since midnight. No bounds checking is
+#' performed.
+#' @export
+hms <- function(seconds = NULL, minutes = NULL, hours = NULL, days = NULL) {
+ args <- list(seconds = seconds, minutes = minutes, hours = hours, days = days)
+ check_args(args)
+ arg_secs <- mapply(`*`, args, c(1, 60, 3600, 86400))
+ secs <- Reduce(`+`, arg_secs[vapply(arg_secs, length, integer(1L)) > 0L])
+
+ as.hms(as.difftime(secs, units = "secs"))
+}
+
+check_args <- function(args) {
+ lengths <- vapply(args, length, integer(1L))
+ if (all(lengths == 0L)) {
+ stop("Need to pass at least one entry for seconds, minutes, hours, or days to hms().",
+ call. = FALSE)
+ }
+
+ if (!all(diff(which(lengths != 0L)) == 1L)) {
+ stop("Can't pass only ", paste(names(lengths)[lengths != 0L], collapse = ", "),
+ " to hms().", call. = FALSE)
+ }
+
+ lengths <- lengths[lengths != 0]
+ if (length(unique(lengths)) > 1L) {
+ stop("All arguments to hms() must have the same length or be NULL. Found ",
+ paste0("length(", names(lengths), ") = ", lengths, collapse = ", "), ".",
+ call. = FALSE)
+ }
+}
+
+#' @rdname hms
+#' @export
+is.hms <- function(x) inherits(x, "hms")
+
+# Coercion in -------------------------------------------------------------
+
+#' @rdname hms
+#' @param x An object.
+#' @param ... Arguments passed on to further methods.
+#' @export
+as.hms <- function(x, ...) UseMethod("as.hms", x)
+
+#' @rdname hms
+#' @export
+as.hms.default <- function(x, ...) {
+ stop("Can't convert object of class ", paste(class(x), collapse = ", "),
+ " to hms.", call. = FALSE)
+}
+
+#' @rdname hms
+#' @export
+as.hms.difftime <- function(x, ...) {
+ units(x) <- "secs"
+ structure(x, class = unique(c("hms", class(x))))
+}
+
+#' @rdname hms
+#' @export
+as.hms.numeric <- function(x, ...) hms(seconds = x)
+
+#' @rdname hms
+#' @export
+as.hms.character <- function(x, ...) {
+ as.hms(as.difftime(x))
+}
+
+#' @rdname hms
+#' @export
+as.hms.POSIXt <- function(x, ...) {
+ seconds <- as.numeric(as.POSIXct(x)) %% 86400
+ hms(seconds = seconds)
+}
+
+
+# Coercion out ------------------------------------------------------------
+
+#' @rdname hms
+#' @export
+as.POSIXct.hms <- function(x, ...) {
+ structure(as.numeric(x), tzone = "UTC", class = c("POSIXct", "POSIXt"))
+}
+
+#' @rdname hms
+#' @export
+as.POSIXlt.hms <- function(x, ...) {
+ as.POSIXlt(as.POSIXct(x, ...), ...)
+}
+
+#' @rdname hms
+#' @export
+as.character.hms <- function(x, ...) {
+ ifelse(is.na(x), "NA", paste0(
+ ifelse(x < 0, "-", ""),
+ format_two_digits(abs(hours(x))), ":",
+ format_two_digits(minute_of_hour(x)), ":",
+ format_two_digits(second_of_minute(x)),
+ format_split_seconds(x)))
+}
+
+#' @rdname hms
+#' @inheritParams base::as.data.frame
+#' @param nm Name of column in new data frame
+#' @export
+as.data.frame.hms <- forward_to(as.data.frame.difftime)
+
+
+# Subsetting --------------------------------------------------------------
+
+#' @export
+`[[.hms` <- function(x, ...) {
+ hms(NextMethod())
+}
+
+
+# Updating ----------------------------------------------------------------
+
+#' @export
+`units<-.hms` <- function(x, value) {
+ if (!identical(value, "secs")) {
+ warning("hms always uses seconds as unit.", call. = FALSE)
+ }
+ x
+}
+
+
+# Output ------------------------------------------------------------------
+
+#' @rdname hms
+#' @export
+format.hms <- function(x, ...) {
+ format(as.character(x), justify = "right")
+}
+
+#' @rdname hms
+#' @export
+print.hms <- function(x, ...) {
+ cat(format(x), sep = "\n")
+ invisible(x)
+}
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..22b8e1f
--- /dev/null
+++ b/README.md
@@ -0,0 +1,36 @@
+
+hms [](https://travis-ci.org/rstats-db/hms) [](https://ci.appveyor.com/project/rstats-db/hms) [](https://codecov.io/github/rstats-db/hms?branch=master) [
+hms(56, 34, 12)
+#> 12:34:56
+as.hms(1)
+#> 00:00:01
+as.hms("12:34:56")
+#> 12:34:56
+as.hms(Sys.time())
+#> 14:41:28.004544
+as.POSIXct(hms(1))
+#> [1] "1970-01-01 00:00:01 UTC"
+
+data.frame(hours = 1:3, hms = hms(hours = 1:3))
+#> hours hms
+#> 1 1 01:00:00
+#> 2 2 02:00:00
+#> 3 3 03:00:00
+```
+
+Install the package from GitHub:
+
+``` r
+# install.packages("devtools")
+devtools::install_github("rstats-db/hms")
+```
diff --git a/man/hms.Rd b/man/hms.Rd
new file mode 100644
index 0000000..cdccbef
--- /dev/null
+++ b/man/hms.Rd
@@ -0,0 +1,96 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/hms.R
+\name{hms}
+\alias{hms}
+\alias{hms}
+\alias{is.hms}
+\alias{as.hms}
+\alias{as.hms.default}
+\alias{as.hms.difftime}
+\alias{as.hms.numeric}
+\alias{as.hms.character}
+\alias{as.hms.POSIXt}
+\alias{as.POSIXct.hms}
+\alias{as.POSIXlt.hms}
+\alias{as.character.hms}
+\alias{as.data.frame.hms}
+\alias{format.hms}
+\alias{print.hms}
+\title{A simple class for storing time-of-day values}
+\usage{
+hms(seconds = NULL, minutes = NULL, hours = NULL, days = NULL)
+
+is.hms(x)
+
+as.hms(x, ...)
+
+\method{as.hms}{default}(x, ...)
+
+\method{as.hms}{difftime}(x, ...)
+
+\method{as.hms}{numeric}(x, ...)
+
+\method{as.hms}{character}(x, ...)
+
+\method{as.hms}{POSIXt}(x, ...)
+
+\method{as.POSIXct}{hms}(x, ...)
+
+\method{as.POSIXlt}{hms}(x, ...)
+
+\method{as.character}{hms}(x, ...)
+
+\method{as.data.frame}{hms}(x, row.names = NULL, optional = FALSE, ...,
+ nm = paste(deparse(substitute(x), width.cutoff = 500L), collapse = " "))
+
+\method{format}{hms}(x, ...)
+
+\method{print}{hms}(x, ...)
+}
+\arguments{
+\item{seconds, minutes, hours, days}{Time since midnight. No bounds checking is
+performed.}
+
+\item{x}{An object.}
+
+\item{...}{Arguments passed on to further methods.}
+
+\item{row.names}{\code{NULL} or a character vector giving the row
+ names for the data frame. Missing values are not allowed.}
+
+\item{optional}{logical. If \code{TRUE}, setting row names and
+ converting column names (to syntactic names: see
+ \code{\link{make.names}}) is optional. Note that all of \R's
+ \pkg{base} package \code{as.data.frame()} methods use
+ \code{optional} only for column names treatment, basically with the
+ meaning of \code{\link{data.frame}(*, check.names = !optional)}.}
+
+\item{nm}{Name of column in new data frame}
+}
+\description{
+The values are stored as a \code{\link{difftime}} vector with a custom class,
+and always with "seconds" as unit for robust coercion to numeric.
+Supports construction from time values, coercion to and from
+various data types, and formatting. Can be used as a regular column in a
+data frame.
+}
+\details{
+For \code{hms}, all arguments must have the same length or be
+ \code{NULL}. Odd combinations (e.g., passing only \code{seconds} and
+ \code{hours} but not \code{minutes}) are rejected.
+}
+\examples{
+hms(56, 34, 12)
+as.hms(1)
+as.hms("12:34:56")
+as.hms(Sys.time())
+as.POSIXct(hms(1))
+\dontrun{
+ # Will raise an error
+ data.frame(a = hms(1))
+}
+d <- data.frame(hours = 1:3)
+d$hours <- hms(hours = d$hours)
+d
+}
+
diff --git a/tests/testthat.R b/tests/testthat.R
new file mode 100644
index 0000000..0235aba
--- /dev/null
+++ b/tests/testthat.R
@@ -0,0 +1,4 @@
+library(testthat)
+library(hms)
+
+test_check("hms")
diff --git a/tests/testthat/helper-compare.R b/tests/testthat/helper-compare.R
new file mode 100644
index 0000000..b35c216
--- /dev/null
+++ b/tests/testthat/helper-compare.R
@@ -0,0 +1,11 @@
+expect_hms_equal <- function(x, y) {
+ expect_is(x, "hms")
+ expect_is(y, "hms")
+ expect_equal(as.numeric(x), as.numeric(y))
+}
+
+expect_difftime_equal <- function(x, y) {
+ expect_is(x, "difftime")
+ expect_is(y, "difftime")
+ expect_equal(as.numeric(as.hms(x)), as.numeric(as.hms(y)))
+}
diff --git a/tests/testthat/test-arith.R b/tests/testthat/test-arith.R
new file mode 100644
index 0000000..39db185
--- /dev/null
+++ b/tests/testthat/test-arith.R
@@ -0,0 +1,33 @@
+context("arith")
+
+test_that("arithmetics work", {
+ expect_equal(as.Date("2016-03-31") + hms(hours = 1), as.Date("2016-03-31"))
+ expect_equal(as.Date("2016-03-31") + hms(days = -1), as.Date("2016-03-30"))
+ expect_equal(as.POSIXct("2016-03-31") + hms(1), as.POSIXct("2016-03-31 00:00:01"))
+ expect_equal(hms(hours = 1) + as.Date("2016-03-31"), as.Date("2016-03-31"))
+ expect_equal(hms(days = 1) + as.Date("2016-03-31"), as.Date("2016-04-01"))
+ expect_equal(hms(hours = 1) + as.POSIXct("2016-03-31"), as.POSIXct("2016-03-31 01:00:00"))
+
+ expect_difftime_equal(hms(1) + hms(2), hms(3))
+ expect_difftime_equal(hms(1) - hms(2), hms(-1))
+ expect_difftime_equal(2 * hms(1), hms(2))
+ expect_difftime_equal(hms(hours = 1) / 2, hms(minutes = 30))
+})
+
+test_that("component extraction work", {
+ x <- hms(12.3, 45, 23, 1)
+ expect_equal(split_second_of_second(x), 0.3)
+ expect_equal(second_of_minute(x), 12)
+ expect_equal(minute_of_hour(x), 45)
+ expect_equal(hour_of_day(x), 23)
+ expect_equal(days(x), 1)
+})
+
+test_that("component extraction work for negative times", {
+ x <- -hms(12.3, 45, 23, 1)
+ expect_equal(split_second_of_second(x), 0.3)
+ expect_equal(second_of_minute(x), 12)
+ expect_equal(minute_of_hour(x), 45)
+ expect_equal(hour_of_day(x), 23)
+ expect_equal(days(x), -1)
+})
diff --git a/tests/testthat/test-coercion.R b/tests/testthat/test-coercion.R
new file mode 100644
index 0000000..90292a1
--- /dev/null
+++ b/tests/testthat/test-coercion.R
@@ -0,0 +1,29 @@
+context("coercion")
+
+test_that("coercion in", {
+ expect_identical(as.hms(0.5 * 86400), hms(hours = 12))
+ expect_identical(as.hms(-0.25 * 86400), hms(hours = -6))
+ expect_hms_equal(as.hms("12:34:56"), hms(56, 34, 12))
+ expect_hms_equal(as.hms(strptime("12:34:56", format = "%H:%M:%S", tz = "UTC")),
+ hms(56, 34, 12))
+ expect_hms_equal(as.hms(strptime("12:34:56", format = "%H:%M:%S", tz = "CEST")),
+ hms(56, 34, 12))
+ expect_hms_equal(as.hms(strptime("12:34:56", format = "%H:%M:%S", tz = "PST")),
+ hms(56, 34, 12))
+
+ expect_error(as.hms(FALSE))
+})
+
+test_that("coercion out", {
+ expect_identical(as.character(hms(56, 34, 12)), "12:34:56")
+ expect_identical(as.POSIXlt(hms(hours = 6)),
+ strptime("1970-01-01 06:00:00",
+ format = "%Y-%m-%d %H:%M:%S", tz = "UTC"))
+ expect_identical(as.POSIXct(hms(hours = -6)),
+ strptime("1970-01-01 18:00:00",
+ format = "%Y-%m-%d %H:%M:%S", tz = "UTC") - 86400)
+
+ df <- data.frame(a = 1:3)
+ df$b <- hms(hours = df$a)
+ expect_identical(df, data.frame(a = 1:3, b = hms(hours = 1:3)))
+})
diff --git a/tests/testthat/test-construct.R b/tests/testthat/test-construct.R
new file mode 100644
index 0000000..2875898
--- /dev/null
+++ b/tests/testthat/test-construct.R
@@ -0,0 +1,24 @@
+context("construct")
+
+test_that("constructor", {
+ expect_identical(hms(1:3, 2:4, 3:5),
+ hms(seconds = 1:3 + 2:4 * 60 + 3:5 * 3600))
+ expect_identical(hms(-1, 1), hms(59))
+ expect_identical(hms(3600), hms(hours = 1))
+
+ expect_true(is.hms(hms(1)))
+ expect_is(hms(1), "difftime")
+ expect_identical(as.numeric(hms(1)), 1)
+ expect_identical(as.difftime(hms(1)), hms(1))
+
+ expect_identical(units(as.hms(as.difftime(1, units = "mins"))), "secs")
+ expect_identical(as.hms(hms(1)), hms(1))
+})
+
+test_that("bad input", {
+ expect_error(hms(), "seconds")
+ expect_error(hms(hours = 1, seconds = 3), "only")
+ expect_error(hms(minutes = 1, days = 3), "only")
+ expect_error(hms(minutes = 1, hours = 2:3), "same length or be NULL")
+ expect_error(hms(seconds = 1:5, minutes = 6:10, hours = 11:17), "same length or be NULL")
+})
diff --git a/tests/testthat/test-lubridate.R b/tests/testthat/test-lubridate.R
new file mode 100644
index 0000000..5b6d8db
--- /dev/null
+++ b/tests/testthat/test-lubridate.R
@@ -0,0 +1,20 @@
+context("lubridate")
+
+test_that("duration", {
+ skip_if_not_installed("lubridate")
+ expect_identical(lubridate::as.duration(hms(minutes = 1:3)),
+ lubridate::duration(minutes = 1:3))
+})
+
+test_that("interval", {
+ skip_if_not_installed("lubridate")
+ timestamp <- Sys.time()
+ expect_identical(lubridate::as.interval(hms(seconds = 2), timestamp),
+ lubridate::interval(timestamp, timestamp + 2))
+})
+
+test_that("period", {
+ skip_if_not_installed("lubridate")
+ expect_identical(lubridate::as.period(hms(hours = -1)),
+ lubridate::period(hours = -1))
+})
diff --git a/tests/testthat/test-output.R b/tests/testthat/test-output.R
new file mode 100644
index 0000000..73d57bc
--- /dev/null
+++ b/tests/testthat/test-output.R
@@ -0,0 +1,56 @@
+context("output")
+
+test_that("output", {
+ expect_identical(format(hms(1:2, minutes = c(0, 0), hours = 3:4)),
+ c("03:00:01", "04:00:02"))
+ expect_identical(format(hms(minutes = 1:-1)),
+ c(" 00:01:00", " 00:00:00", "-00:01:00"))
+ expect_output(
+ expect_identical(print(hms(minutes = 1:2, hours = 3:4)),
+ hms(minutes = 1:2, hours = 3:4)),
+ "03:01:00\n04:02:00", fixed = TRUE)
+})
+
+test_that("beyond 24 hours (#12)", {
+ expect_identical(format(hms(hours = 23:25)),
+ c("23:00:00", "24:00:00", "25:00:00"))
+ expect_identical(format(hms(hours = 99:101)),
+ c(" 99:00:00", "100:00:00", "101:00:00"))
+ expect_identical(format(hms(hours = c(-99, 100))),
+ c("-99:00:00", "100:00:00"))
+ expect_identical(format(hms(hours = c(-100, 99))),
+ c("-100:00:00", " 99:00:00"))
+})
+
+test_that("fractional seconds (#13)", {
+ expect_identical(format(hms(0.1)),
+ c("00:00:00.1"))
+ expect_identical(format(hms(c(12, 0.3))),
+ c("00:00:12.0", "00:00:00.3"))
+ expect_identical(format(hms(c(0.1, 0.01))),
+ c("00:00:00.10", "00:00:00.01"))
+ expect_identical(format(hms(c(12, 0.3), minutes = c(0, 0), hours = c(345, 6))),
+ c("345:00:12.0", " 06:00:00.3"))
+ expect_identical(format(hms(c(-0.1, 0.1))),
+ c("-00:00:00.1", " 00:00:00.1"))
+})
+
+test_that("picoseconds (#17)", {
+ expect_identical(format(hms(1e-6)),
+ c("00:00:00.000001"))
+ expect_identical(format(hms(9e-7)),
+ c("00:00:00.000001"))
+ expect_identical(format(hms(4e-7)),
+ c("00:00:00.000000"))
+ expect_identical(format(hms(1e-10)),
+ c("00:00:00.000000"))
+ expect_identical(format(hms(1e-20)),
+ c("00:00:00.000000"))
+ expect_identical(format(hms(c(1, 1e-20))),
+ c("00:00:01.000000", "00:00:00.000000"))
+})
+
+test_that("NA", {
+ expect_identical(format(hms(NA)),
+ c("NA"))
+})
diff --git a/tests/testthat/test-subset.R b/tests/testthat/test-subset.R
new file mode 100644
index 0000000..2ed1bb7
--- /dev/null
+++ b/tests/testthat/test-subset.R
@@ -0,0 +1,25 @@
+context("subset")
+
+test_that("range subsetting keeps class", {
+ expect_identical(hms(1:3)[2], hms(2))
+ expect_identical(hms(1:3)[2:3], hms(2:3))
+})
+
+test_that("range updating keeps class", {
+ x <- hms(1:3)
+ x[2] <- 4
+ expect_identical(x, hms(c(1,4,3)))
+ x <- hms(1:4)
+ x[2:3] <- 5:6
+ expect_identical(x, hms(c(1,5,6,4)))
+})
+
+test_that("index subsetting keeps class", {
+ expect_identical(hms(1:3)[[2]], hms(2))
+})
+
+test_that("index updating keeps class", {
+ x <- hms(1:3)
+ x[[2]] <- 4
+ expect_identical(x, hms(c(1,4,3)))
+})
diff --git a/tests/testthat/test-update.R b/tests/testthat/test-update.R
new file mode 100644
index 0000000..9d176de
--- /dev/null
+++ b/tests/testthat/test-update.R
@@ -0,0 +1,10 @@
+context("update")
+
+test_that("Can't update units", {
+ x <- hms(minutes = 3)
+ expect_equal(units(x), "secs")
+ expect_warning(units(x) <- "mins", "always uses seconds")
+ expect_equal(units(x), "secs")
+ expect_warning(units(x) <- "secs", NA)
+ expect_equal(units(x), "secs")
+})
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/r-cran-hms.git
More information about the debian-med-commit
mailing list