Fix #212

NAMESPACE

@@ -41,6 +41,7 @@ export(boxcox_trans)
 export(breaks_extended)
 export(breaks_log)
 export(breaks_pretty)
+export(breaks_timespan)
 export(breaks_width)
 export(brewer_pal)
 export(cbreaks)
@@ -66,6 +67,7 @@ export(demo_datetime)
 export(demo_discrete)
 export(demo_log10)
 export(demo_time)
+export(demo_timespan)
 export(dichromat_pal)
 export(discard)
 export(div_gradient_pal)
@@ -101,6 +103,7 @@ export(label_percent)
 export(label_pvalue)
 export(label_scientific)
 export(label_time)
+export(label_timespan)
 export(label_wrap)
 export(linetype_pal)
 export(log10_trans)
@@ -158,6 +161,7 @@ export(squish)
 export(squish_infinite)
 export(time_format)
 export(time_trans)
+export(timespan_trans)
 export(train_continuous)
 export(train_discrete)
 export(trans_breaks)

NEWS.md

@@ -13,6 +13,11 @@
 * `label_dollar()` has been superseeded by `label_currency()` for clarity (#344)
 * `sqrt_trans()` no longer returns an inverse for values outside of its domain 
   (#214)
+* Add better support for `difftime` objects. `label_timespan()` adds 
+  functionality for adding correct unit suffix to timespan data, 
+  `breaks_timespan()` adds functionality for finding pleasant breakpoints across
+  the various bases in time units, while `timespan_trans()` wraps it all 
+  together and provides an alternative to `hms_trans()` (#212)
 
 # scales 1.2.1
 

R/breaks.R

@@ -140,3 +140,45 @@ breaks_pretty <- function(n = 5, ...) {
 #' @export
 #' @inheritParams breaks_pretty
 pretty_breaks <- breaks_pretty
+
+#' Breaks for timespan data
+#'
+#' As timespan units span a variety of bases (1000 below seconds, 60 for second
+#' and minutes, 24 for hours, and 7 for days), the range of the input data
+#' determines the base used for calculating breaks
+#'
+#' @param unit The unit used to interpret numeric data input
+#' @inheritParams breaks_extended
+#' @export
+#' @examples
+#' demo_timespan(seq(0, 100), breaks = breaks_timespan())
+#'
+breaks_timespan <- function(unit = c("secs", "mins", "hours", "days", "weeks"), n = 5) {
+  unit <- arg_match(unit)
+  force(n)
+  function(x) {
+    x <- as.numeric(as.difftime(x, units = unit), units = "secs")
+    rng <- range(x)
+    diff <- rng[2] - rng[1]
+
+    if (diff <= 2 * 60) {
+      scale <- 1
+    } else if (diff <= 2 * 3600) {
+      scale <- 60
+    } else if (diff <= 2 * 86400) {
+      scale <- 3600
+    } else if (diff <= 2 * 604800) {
+      scale <- 86400
+    } else {
+      scale <- 604800
+    }
+
+    rng <- rng / scale
+    breaks <- labeling::extended(
+      rng[1], rng[2], n,
+      Q = c(1, 2, 1.5, 4, 3),
+      only.loose = FALSE
+    )
+    as.difftime(breaks * scale, units = "secs")
+  }
+}

R/label-date.R

@@ -7,6 +7,8 @@
 #' but uses a slightly different approach: `ConciseDateFormatter` formats
 #' "firsts" (e.g. first day of month, first day of day) specially;
 #' `date_short()` formats changes (e.g. new month, new year) specially.
+#' `label_timespan()` is intended to show time passed and adds common time units
+#' suffix to the input (ns, µs, ms, s, m, h, d, w).
 #'
 #' @inherit label_number return
 #' @param format For `date_format()` and `time_format()` a date/time format
@@ -114,6 +116,34 @@ label_time <- function(format = "%H:%M:%S", tz = "UTC", locale = NULL) {
   }
 }
 
+#' @export
+#' @rdname label_date
+#' @param unit The unit used to interpret numeric input
+#' @inheritDotParams number accuracy scale prefix suffix big.mark decimal.mark style_positive style_negative trim
+label_timespan <- function(unit = c("secs", "mins", "hours", "days", "weeks"),
+                           ...) {
+  unit <- arg_match(unit)
+  force_all(...)
+  function(x) {
+    x <- as.numeric(as.difftime(x, units = unit), units = "secs")
+    number(
+      x,
+      scale_cut = c(
+        0,
+        "ns" = 1e-9,
+        "µs" = 1e-6,
+        "ms" = 1e-3,
+        "s" = 1,
+        "m" = 60,
+        "h" = 3600,
+        "d" = 24 * 3600,
+        "w" = 7 * 24 * 3600
+      ),
+      ...
+    )
+  }
+}
+
 format_dt <- function(x, format, tz = "UTC", locale = NULL) {
   if (is.null(locale)) {
     format(x, format = format, tz = tz)

R/trans-date.R

@@ -61,48 +61,63 @@ time_trans <- function(tz = NULL) {
 
 #' Transformation for times (class hms)
 #'
+#' `timespan_trans()` provides transformations for data encoding time passed
+#' along with breaks and label formatting showing standard unit of time fitting
+#' the range of the data. `hms_trans()` provides the same but using standard hms
+#' idioms and formatting.
+#'
 #' @export
 #' @examples
+#' # timespan_trans allows you to specify the time unit numeric data is
+#' # interpreted in
+#' min_trans <- timespan_trans("mins")
+#' demo_timespan(seq(0, 100), trans = min_trans)
+#' # Input already in difftime format is interpreted correctly
+#' demo_timespan(as.difftime(seq(0, 100), units = "secs"), trans = min_trans)
+#'
 #' if (require("hms")) {
+#'   # hms_trans always assumes seconds
 #'   hms <- round(runif(10) * 86400)
 #'   t <- hms_trans()
 #'   t$transform(hms)
 #'   t$inverse(t$transform(hms))
 #'   t$breaks(hms)
+#'   # The break labels also follow the hms format
+#'   demo_timespan(hms, trans = t)
 #' }
+#'
+timespan_trans <- function(unit = c("secs", "mins", "hours", "days", "weeks")) {
+  unit <- arg_match(unit)
+  trans_new(
+    "timespan",
+    transform = function(x) {
+      structure(as.numeric(as.difftime(x, units = unit), units = "secs"), names = names(x))
+    },
+    inverse = function(x) {
+      x <- as.difftime(x, units = "secs")
+      units(x) <- unit
+      x
+    },
+    breaks = breaks_timespan(unit),
+    format = label_timespan(unit)
+  )
+}
+#' @rdname timespan_trans
+#' @export
 hms_trans <- function() {
   trans_new(
     "hms",
     transform = function(x) {
       structure(as.numeric(x), names = names(x))
     },
     inverse = hms::as_hms,
-    breaks = time_breaks()
+    breaks = breaks_hms()
   )
 }
 
-time_breaks <- function(n = 5) {
-  force(n)
+breaks_hms <- function(n = 5) {
+  base_breaks <- breaks_timespan("secs", n)
   function(x) {
-    rng <- as.numeric(range(x))
-    diff <- rng[2] - rng[1]
-
-    if (diff <= 2 * 60) {
-      scale <- 1
-    } else if (diff <= 2 * 3600) {
-      scale <- 60
-    } else if (diff <= 2 * 86400) {
-      scale <- 3600
-    } else {
-      scale <- 86400
-    }
-
-    rng <- rng / scale
-    breaks <- labeling::extended(
-      rng[1], rng[2], n,
-      Q = c(1, 2, 1.5, 4, 3),
-      only.loose = FALSE
-    )
-    hms::as_hms(breaks * scale)
+    hms::as_hms(base_breaks(x))
   }
 }

R/utils.R

@@ -55,3 +55,9 @@ demo_datetime <- function(x, ...) {
 demo_time <- function(x, ...) {
   demo_ggplot(x, "scale_x_time", ...)
 }
+
+#' @rdname demo_continuous
+#' @export
+demo_timespan <- function(x, ...) {
+  demo_ggplot(x, "scale_x_continuous", ...)
+}