From ba2766e23dd7a171fc61922b9e61e8356e5120a3 Mon Sep 17 00:00:00 2001 From: Joshua Ulrich Date: Sat, 14 Jul 2018 09:23:10 -0500 Subject: [PATCH] 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 | 23 +++++++++++++++++++-- inst/unitTests/runit.periodicity.R | 32 ++++++++++++++++++++++++++++++ 2 files changed, 53 insertions(+), 2 deletions(-) create mode 100644 inst/unitTests/runit.periodicity.R diff --git a/R/periodicity.R b/R/periodicity.R index 0085ab28..e825fe04 100644 --- a/R/periodicity.R +++ b/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 diff --git a/inst/unitTests/runit.periodicity.R b/inst/unitTests/runit.periodicity.R new file mode 100644 index 00000000..8935eb67 --- /dev/null +++ b/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)) +}