Warn if periodicity() called on < 2 observations

It can be confusing when periodicity() throws an error when called
with an object that only has one observation, because the root cause
of the error is usually not clear to the end user.

Throw a warning and return a periodicity object with zero time
difference and frequency.

Fixes #230.

R/periodicity.R

@@ -35,9 +35,28 @@ periodicity <- function(x, ...) {
   if( timeBased(x) || !is.xts(x) )
     x <- try.xts(x, error='\'x\' needs to be timeBased or xtsible')
 
-  p <- median(diff( .index(x) ))
+  n <- length(.index(x))
+  if( n < 2 ) {
+    res <- list(difftime = structure(0, units='secs', class='difftime'),
+                frequency = 0,
+                start = NA,
+                end = NA,
+                units = 'secs',
+                scale = 'seconds',
+                label = 'second')
+    res <- structure(res, class='periodicity')
 
-  if( is.na(p) ) stop("can not calculate periodicity of 1 observation")
+    if( n == 0 ) {
+      warning("can not calculate periodicity of empty object")
+    } else {
+      warning("can not calculate periodicity of 1 observation")
+      res$start <- start(x)
+      res$end <- end(x)
+    }
+    return(res)
+  } else {
+    p <- median(diff( .index(x) ))
+  }
 
   units <- 'days' # the default if p > hourly
   scale <- 'yearly'# the default for p > quarterly

inst/unitTests/runit.periodicity.R

@@ -0,0 +1,32 @@
+P <- structure(
+  list(difftime = structure(0, units = "secs", class = "difftime"),
+       frequency = 0,
+       start = structure(.POSIXct(1, "UTC"), tclass = c("POSIXct", "POSIXt")),
+       end = structure(.POSIXct(1, "UTC"), tclass = c("POSIXct", "POSIXt")),
+       units = "secs",
+       scale = "seconds",
+       label = "second"),
+  class = "periodicity")
+
+test.periodicity_on_one_observation_warns <- function() {
+  x <- xts(1, .POSIXct(1, "UTC"))
+  p <- periodicity(x)
+  checkIdentical(p, P)
+
+  opt <- options(warn = 2)
+  on.exit(options(warn = opt$warn))
+
+  checkException(p <- periodicity(x))
+}
+test.periodicity_on_zero_observations_warns <- function() {
+  x <- xts(, .POSIXct(numeric(0), "UTC"))
+  p <- periodicity(x)
+  P$start <- NA
+  P$end <- NA
+  checkIdentical(p, P)
+
+  opt <- options(warn = 2)
+  on.exit(options(warn = opt$warn))
+
+  checkException(p <- periodicity(x))
+}