Add format_ISO8601 with methods

DESCRIPTION

@@ -81,6 +81,7 @@ Collate:
     'data.r'
     'decimal-dates.r'
     'deprecated.r'
+    'format_ISO8601.r'
     'guess.r'
     'hidden.r'
     'instants.r'

NAMESPACE

@@ -127,6 +127,7 @@ export(fit_to_timeline)
 export(floor_date)
 export(force_tz)
 export(force_tzs)
+export(format_ISO8601)
 export(guess_formats)
 export(here)
 export(hm)
@@ -257,6 +258,7 @@ exportMethods(as.numeric)
 exportMethods(as_date)
 exportMethods(as_datetime)
 exportMethods(c)
+exportMethods(format_ISO8601)
 exportMethods(intersect)
 exportMethods(reclass_timespan)
 exportMethods(rep)

NEWS.md

@@ -3,9 +3,10 @@ Version 1.7.4.9000
 
 ### NEW FEATURES
 
-* [#695](https://github.com/tidyverse/lubridate/issues/695) Durations can now be compared with numeric vectors. 
+* [#695](https://github.com/tidyverse/lubridate/issues/695) Durations can now be compared with numeric vectors.
 * [#681](https://github.com/tidyverse/lubridate/issues/681) New constants `NA_Date_` and `NA_POSIXct_` which parallel built-in primitive constants.
 * [#681](https://github.com/tidyverse/lubridate/issues/681) New constructors `Date()` and `POSIXct()` which parallel built-in primitive constructors.
+* [#629](https://github.com/tidyverse/lubridate/issues/629) Added `format_ISO8601()` methods.
 
 
 ### BUG FIXES

R/format_ISO8601.r

@@ -0,0 +1,146 @@
+#' Format in ISO8601 character format
+#'
+#' @param x An object to convert to ISO8601 character format.
+#' @param usetz Include the time zone in the formatting (of outputs including
+#'   time; date outputs never include time zone information).
+#' @param precision The amount of precision to represent with substrings of
+#'   "ymdhms", as "y"ear, "m"onth, "d"ay, "h"our, "m"inute, and "s"econd. (e.g.
+#'   "ymdhm" would show precision through minutes.  When \code{NULL}, full
+#'   precision for the object is shown.
+#' @param ... Additional arguments to methods.
+#' @return A character vector of ISO8601-formatted text.
+#' @references \url{https://en.wikipedia.org/wiki/ISO_8601}
+#' @examples
+#' format_ISO8601(as.Date("02-01-2018", format="%m-%d-%Y"))
+#' format_ISO8601(as.POSIXct("2018-02-01 03:04:05", tz="EST"), usetz=TRUE)
+#' format_ISO8601(as.POSIXct("2018-02-01 03:04:05", tz="EST"), precision="ymdhm")
+#' @aliases format_ISO8601,Date-method
+#' format_ISO8601,POSIXt-method
+#' format_ISO8601,Interval-method
+#' format_ISO8601,Duration-method
+#' format_ISO8601,Period-method
+#' @export
+setGeneric(name = "format_ISO8601",
+           def = function(x, usetz=FALSE, precision=NULL, ...) standardGeneric("format_ISO8601"))
+
+#' @rdname format_ISO86901
+#' @export
+setMethod("format_ISO8601", signature="Date",
+          function(x, usetz=FALSE, precision=NULL, ...) {
+            precision_format <-
+              format_ISO8601_precision_check(precision=precision, max_precision="ymd", usetz=FALSE)
+            as.character(x, format=precision_format, usetz=FALSE)
+          })
+
+#' @rdname format_ISO86901
+#' @export
+setMethod("format_ISO8601", signature="POSIXt",
+          function(x, usetz=FALSE, precision=NULL, ...) {
+            precision_format <-
+              format_ISO8601_precision_check(precision=precision, max_precision="ymdhms", usetz=usetz)
+            # Note that the usetz argument to as.character is always FALSE because the time zone is handled in the precision argument.
+            as.character(x, format=precision_format, usetz=FALSE)
+          })
+
+#' @rdname format_ISO86901
+#' @export
+setMethod("format_ISO8601", signature="Interval",
+          function(x, usetz=FALSE, precision=NULL, ...) {
+            precision_format <-
+              format_ISO8601_precision_check(precision=precision, max_precision="ymdhms", usetz=usetz)
+            # Note that the usetz argument to as.character is always FALSE because the time zone is handled in the precision argument.
+            sprintf("%s/%s",
+                    as.character(x@start, format=precision_format, usetz=FALSE),
+                    as.character(x@start + [email protected], format=precision_format, usetz=FALSE))
+          })
+
+#' @rdname format_ISO86901
+#' @export
+setMethod("format_ISO8601", signature="Duration",
+          function(x, usetz=FALSE, precision=NULL, ...) {
+            if (!is.null(precision)) {
+              warning("precision is not used for Duration objects")
+            }
+            sprintf("PT%sS", format([email protected]))
+          })
+
+#' @rdname format_ISO86901
+#' @export
+setMethod("format_ISO8601", signature="Period",
+          function(x, usetz=FALSE, precision=NULL, ...) {
+            if (!is.null(precision)) {
+              warning("precision is not used for Period objects")
+            }
+            date_part <-
+              paste0(
+                ifelse(x@year != 0,
+                       paste0(x@year, "Y"),
+                       ""),
+                ifelse(x@month != 0,
+                       paste0(x@month, "M"),
+                       ""),
+                ifelse(x@day != 0,
+                       paste0(x@day, "D"),
+                       ""))
+            time_part <-
+              paste0(
+                ifelse(x@hour != 0,
+                       paste0(x@hour, "H"),
+                       ""),
+                ifelse(x@minute != 0,
+                       paste0(x@minute, "M"),
+                       ""),
+                ifelse([email protected] != 0,
+                       paste0([email protected], "S"),
+                       ""))
+            mask_neither <- (nchar(date_part) == 0) & (nchar(time_part) == 0)
+            time_part[mask_neither] <- "0S"
+            ifelse(nchar(time_part),
+                   paste0("P", date_part, "T", time_part),
+                   paste0("P", date_part))
+          })
+
+ISO8601_precision_map <-
+  list(y="%Y",
+       ym="%Y-%m",
+       ymd="%Y-%m-%d",
+       ymdh="%Y-%m-%dT%H",
+       ymdhm="%Y-%m-%dT%H:%M",
+       ymdhms="%Y-%m-%dT%H:%M:%S")
+
+#' Provide a format for ISO8601 dates and times with the requested precision.
+#'
+#' @param precision The amount of precision to represent with substrings of
+#'   "ymdhms", as "y"ear, "m"onth, "d"ay, "h"our, "m"inute, and "s"econd. (e.g.
+#'   "ymdhm" would show precision through minutes.
+#' @param max_precision The maximum precision allowed to be output.
+#' @param usetz Include the timezone in the output format
+#' @return A format string ready for \code{as.character} methods.
+#' @details
+#' When \code{NULL}, \code{max_precision} is returned.  When \code{precision} is
+#' more precise than \code{max_precision}, a warning is given and
+#' \code{max_precision} is returned.
+format_ISO8601_precision_check <- function(precision, max_precision, usetz=FALSE) {
+  if (!(max_precision %in% names(ISO8601_precision_map))) {
+    stop("Invalid value for max_precision provided: ", max_precision)
+  }
+  if (is.null(precision)) {
+    precision <- max_precision
+  }
+  if (nchar(precision) > nchar(max_precision)) {
+    warning("More precision requested (", precision, ") ",
+            "than allowed (", max_precision, ") for this format.  ",
+            "Using maximum allowed precision.")
+    precision <- max_precision
+  }
+  if (length(precision) != 1) {
+    stop("precision must be a scalar")
+  }
+  if (is.null(ret <- ISO8601_precision_map[[precision]])) {
+    stop("Invalid value for precision provided: ", precision)
+  }
+  if (usetz) {
+    ret <- paste0(ret, "%z")
+  }
+  ret
+}

tests/testthat/test-format_ISO8601.R

@@ -0,0 +1,137 @@
+context("format_ISO8601")
+
+test_that("Formatting a date works", {
+  expect_equal(format_ISO8601(as.Date("02-01-2018", format="%m-%d-%Y")),
+               "2018-02-01",
+               info="Standard date formatting works")
+  expect_equal(format_ISO8601(as.Date("02-01-2018", format="%m-%d-%Y"), usetz=TRUE),
+               "2018-02-01",
+               info="usetz is ignored with dates")
+  expect_equal(format_ISO8601(as.Date("02-01-2018", format="%m-%d-%Y"), precision="y"),
+               "2018",
+               info="precision is respected (y)")
+  expect_equal(format_ISO8601(as.Date("02-01-2018", format="%m-%d-%Y"), precision="ym"),
+               "2018-02",
+               info="precision is respected (ym)")
+  expect_equal(format_ISO8601(as.Date("02-01-2018", format="%m-%d-%Y"), precision="ymd"),
+               "2018-02-01",
+               info="precision is respected (ymd)")
+  expect_warning(
+    expect_equal(format_ISO8601(as.Date("02-01-2018", format="%m-%d-%Y"), precision="ymdh"),
+                 "2018-02-01",
+                 info="precision is respected (ymdh)"),
+    info="Requesting too much precision gives a warning and the maximum precision.")
+})
+
+test_that("Formatting a datetime works", {
+  expect_equal(format_ISO8601(as.POSIXct("2018-02-01 03:04:05", tz="EST")),
+               "2018-02-01T03:04:05",
+               info="Standard datetime formatting works")
+  expect_equal(format_ISO8601(as.POSIXct("2018-02-01 03:04:05", tz="EST"), usetz=TRUE),
+               "2018-02-01T03:04:05-0500",
+               info="usetz is respected with datetimes")
+  expect_equal(format_ISO8601(as.POSIXct("2018-02-01 03:04:05", tz="EST"), precision="y"),
+               "2018",
+               info="precision is respected (y)")
+  # Uncertain if this is the best result; including a test so that if it changes
+  # the change is caught.
+  expect_equal(format_ISO8601(as.POSIXct("2018-02-01 03:04:05", tz="EST"), precision="y", usetz=TRUE),
+               "2018-0500",
+               info="precision is respected (y) with timezone")
+  expect_equal(format_ISO8601(as.POSIXct("2018-02-01 03:04:05", tz="EST"), precision="ymdhm"),
+               "2018-02-01T03:04",
+               info="precision is respected (ymdhm)")
+})
+
+test_that("Formatting a Duration works", {
+  expect_equal(format_ISO8601(duration(20, units="seconds")),
+               "PT20S",
+               info="Standard duration formatting works")
+  expect_equal(format_ISO8601(duration(20, units="minutes")),
+               paste0("PT", 20*60,"S"),
+               info="Duration always formats as seconds to ensure precision.")
+  expect_warning(format_ISO8601(duration(20, units="minutes"), precision="y"),
+                 regexp="precision is not used for Duration objects",
+                 fixed=TRUE)
+})
+
+test_that("Formatting a Period works", {
+  expect_equal(format_ISO8601(period(1, units="seconds")),
+               "PT1S",
+               info="A period of 1 second works")
+  expect_equal(format_ISO8601(period(1, units="minute")),
+               "PT1M",
+               info="A period of 1 minute works")
+  expect_equal(format_ISO8601(period(1, units="hour")),
+               "PT1H",
+               info="A period of 1 hour works")
+  expect_equal(format_ISO8601(period(1, units="day")),
+               "P1D",
+               info="A period of 1 day works")
+  expect_equal(format_ISO8601(period(1, units="month")),
+               "P1M",
+               info="A period of 1 month works")
+  expect_equal(format_ISO8601(period(1, units="year")),
+               "P1Y",
+               info="A period of 1 year works")
+
+  expect_equal(format_ISO8601(period(1, units="seconds") + period(1, units="year")),
+               "P1YT1S",
+               info="More than one unit works")
+
+  expect_equal(format_ISO8601(period(0, units="seconds")),
+               "PT0S",
+               info="zero-length period (seconds specified)")
+
+  expect_equal(format_ISO8601(period(0, units="year")),
+               "PT0S",
+               info="zero-length period (years specified)")
+})
+
+test_that("Formatting an Interval works", {
+  expect_equal(format_ISO8601(interval(start="2018-02-01", end="2018-03-04")),
+               "2018-02-01T00:00:00/2018-03-04T00:00:00",
+               info="Standard interval formatting works")
+  expect_equal(format_ISO8601(interval(start="2018-02-01", end="2018-03-04"), precision="ymd"),
+               "2018-02-01/2018-03-04",
+               info="interval formatting respects precision (ymd)")
+  expect_equal(format_ISO8601(interval(start="2018-02-01", end="2018-03-04", tzone="EST"), usetz=TRUE),
+               "2018-02-01T00:00:00-0500/2018-03-04T00:00:00-0500",
+               info="interval formatting respects timezone")
+})
+
+test_that("formatting precision provides accurate format strings", {
+  expect_equal(format_ISO8601_precision_check(precision="y", max_precision="ymd", usetz=FALSE),
+               "%Y",
+               info="simple formatting works")
+  expect_equal(format_ISO8601_precision_check(precision="y", max_precision="ymd", usetz=TRUE),
+               "%Y%z",
+               info="timezone formatting works")
+  expect_equal(format_ISO8601_precision_check(precision=NULL, max_precision="ymd", usetz=FALSE),
+               "%Y-%m-%d",
+               info="NULL yields max_precision")
+  expect_error(format_ISO8601_precision_check(precision="foo", max_precision="ymd", usetz=FALSE),
+               regexp="Invalid value for precision provided: foo",
+               fixed=TRUE,
+               info="invalid precision is an error")
+  expect_error(format_ISO8601_precision_check(precision=NULL, max_precision="foo", usetz=FALSE),
+               regexp="Invalid value for max_precision provided: foo",
+               fixed=TRUE,
+               info="invalid max_precision is an error")
+  expect_error(format_ISO8601_precision_check(precision="ymd", max_precision="foo", usetz=FALSE),
+               regexp="Invalid value for max_precision provided: foo",
+               fixed=TRUE,
+               info="invalid max_precision is an error (even if it's not used)")
+  expect_warning( # additional warnings are generated about comparison of length > 1
+    expect_error(format_ISO8601_precision_check(precision=c("ymd", "ymdh"), max_precision="ymdh", usetz=FALSE),
+                 regexp="precision must be a scalar",
+                 info="Vector precision is an error.")
+  )
+  expect_warning(
+    expect_equal(format_ISO8601_precision_check(precision="ymdh", max_precision="ymd", usetz=FALSE),
+                 "%Y-%m-%d",
+                 info="max_precision is respected"),
+    regexp="More precision requested (ymdh) than allowed (ymd) for this format.  Using maximum allowed precision.",
+    fixed=TRUE,
+    info="max_precision is warned")
+})