Merge branch 'master' of github.com:robjhyndman/forecast

NAMESPACE

@@ -77,6 +77,10 @@ S3method(getResponse,fracdiff)
 S3method(getResponse,lm)
 S3method(getResponse,mforecast)
 S3method(getResponse,tbats)
+S3method(gglagplot,ts)
+S3method(ggseasonplot,ts)
+S3method(ggsubseriesplot,ts)
+S3method(ggtsdisplay,ts)
 S3method(head,ts)
 S3method(logLik,ets)
 S3method(nobs,ets)

R/attach.R

@@ -42,14 +42,29 @@ register_s3_method <- function(pkg, generic, class, fun = NULL) {
 }
 
 .onLoad <- function(...) {
-  ns <- getNamespace("ggplot2")
-  if (exists("autolayer", ns)) {
-    autolayer <<- ns$autolayer
+  if (tryCatch(exists("autolayer", getNamespace("ggplot2")), error = function(e) FALSE)) {
+    autolayer <<- getNamespace("ggplot2")$autolayer
     register_s3_method("ggplot2", "autolayer", "ts")
     register_s3_method("ggplot2", "autolayer", "mts")
     register_s3_method("ggplot2", "autolayer", "msts")
     register_s3_method("ggplot2", "autolayer", "forecast")
     register_s3_method("ggplot2", "autolayer", "mforecast")
   }
+  if (tryCatch(exists("ggseasonplot", getNamespace("feasts")), error = function(e) FALSE)) {
+    ggseasonplot <<- getNamespace("feasts")$ggseasonplot
+    register_s3_method("feasts", "ggseasonplot", "ts")
+  }
+  if (tryCatch(exists("ggsubseriesplot", getNamespace("feasts")), error = function(e) FALSE)) {
+    ggsubseriesplot <<- getNamespace("feasts")$ggsubseriesplot
+    register_s3_method("feasts", "ggsubseriesplot", "ts")
+  }
+  if (tryCatch(exists("gglagplot", getNamespace("feasts")), error = function(e) FALSE)) {
+    gglagplot <<- getNamespace("feasts")$gglagplot
+    register_s3_method("feasts", "gglagplot", "ts")
+  }
+  if (tryCatch(exists("ggtsdisplay", getNamespace("feasts")), error = function(e) FALSE)) {
+    ggtsdisplay <<- getNamespace("feasts")$ggtsdisplay
+    register_s3_method("feasts", "ggtsdisplay", "ts")
+  }
   invisible()
 }

R/ggplot.R

@@ -126,7 +126,7 @@ autoplot.acf <- function(object, ci=0.95, ...) {
     p <- p + ggplot2::geom_hline(yintercept = 0)
 
     # Add data
-    p <- p + ggplot2::geom_segment(lineend = "butt")
+    p <- p + ggplot2::geom_segment(lineend = "butt", ...)
 
     # Add ci lines (assuming white noise input)
     ci <- qnorm((1 + ci) / 2) / sqrt(object$n.used)
@@ -688,7 +688,12 @@ autoplot.forecast <- function(object, include, PI=TRUE, shadecols=c("#596DD5", "
     }
     else {
       # Time series objects (assumed)
-
+      if(!missing(shadecols)){
+        warning(
+"The `schadecols` argument is deprecated for time series forecasts. 
+Interval shading is now done automatically based on the level and `fcol`.", 
+          call. = FALSE)
+      }
       # Data points
       if (!is.null(time(object$x))) {
         timex <- time(object$x)
@@ -705,30 +710,33 @@ autoplot.forecast <- function(object, include, PI=TRUE, shadecols=c("#596DD5", "
         ggplot2::labs(y = vars["yvar"], x = "Time")
 
       # Forecasted intervals
-      predicted <- data.frame(xvar = time(object$mean), yvar = object$mean)
-      colnames(predicted) <- c("datetime", "ypred")
-      if (PI) {
-        levels <- NROW(object$level)
-        interval <- data.frame(datetime = rep(predicted$datetime, levels), lower = c(object$lower), upper = c(object$upper), level = rep(object$level, each = NROW(object$mean)))
-        interval <- interval[order(interval$level, decreasing = TRUE), ] # Must be ordered for gg z-index
-        p <- p + ggplot2::geom_ribbon(ggplot2::aes_(x = ~datetime, ymin = ~lower, ymax = ~upper, group = ~-level, fill = ~level), data = interval)
-        if (min(object$level) < 50) {
-          scalelimit <- c(1, 99)
-        }
-        else {
-          scalelimit <- c(50, 99)
-        }
-        if (length(object$level) <= 5) {
-          p <- p + ggplot2::scale_fill_gradientn(breaks = object$level, colours = shadecols, limit = scalelimit, guide = "legend")
-        }
-        else {
-          p <- p + ggplot2::scale_fill_gradientn(colours = shadecols, limit = scalelimit)
-        }
-        # Negative group is a work around for missing z-index
-      }
-
-      # Forecasted points
-      p <- p + ggplot2::geom_line(ggplot2::aes_(x = ~datetime, y = ~ypred), data = predicted, color = fcol, size = flwd)
+      p <- p + autolayer(object, colour = fcol)
+
+      # predicted <- data.frame(xvar = time(object$mean), yvar = object$mean)
+      # colnames(predicted) <- c("datetime", "ypred")
+      # if (PI) {
+      #   levels <- NROW(object$level)
+      #   interval <- data.frame(datetime = rep(predicted$datetime, levels), lower = c(object$lower), upper = c(object$upper), level = rep(object$level, each = NROW(object$mean)))
+      #   interval <- interval[order(interval$level, decreasing = TRUE), ] # Must be ordered for gg z-index
+      #   p <- p + ggplot2::geom_ribbon(ggplot2::aes_(x = ~datetime, ymin = ~lower, ymax = ~upper, group = ~-level, fill = ~level), data = interval)
+      #   if (min(object$level) < 50) {
+      #     scalelimit <- c(1, 99)
+      #   }
+      #   else {
+      #     scalelimit <- c(50, 99)
+      #   }
+      #   if (length(object$level) <= 5) {
+      #     p <- p + ggplot2::scale_fill_gradientn(breaks = object$level, colours = shadecols, limit = scalelimit, guide = "legend")
+      #   }
+      #   else {
+      #     p <- p + ggplot2::scale_fill_gradientn(colours = shadecols, limit = scalelimit)
+      #   }
+      #   # Negative group is a work around for missing z-index
+      # }
+
+
+      # # Forecasted points
+      # p <- p + ggplot2::geom_line(ggplot2::aes_(x = ~datetime, y = ~ypred), data = predicted, color = fcol, size = flwd)
     }
 
     p <- p + ggAddExtras(main = paste("Forecasts from ", object$method, sep = ""))
@@ -817,7 +825,13 @@ autoplot.mforecast <- function(object, PI = TRUE, facets = TRUE, colour = FALSE,
 #' ggtsdisplay(USAccDeaths, plot.type="scatter", theme=theme_bw())
 #'
 #' @export
-ggtsdisplay <- function(x, plot.type=c("partial", "histogram", "scatter", "spectrum"),
+ggtsdisplay <- function(x, ...){
+  UseMethod("ggtsdisplay")
+}
+
+#' @rdname tsdisplay
+#' @export
+ggtsdisplay.ts <- function(x, plot.type=c("partial", "histogram", "scatter", "spectrum"),
                         points=TRUE, smooth=FALSE,
                         lag.max, na.action=na.contiguous, theme=NULL, ...) {
   if (!requireNamespace("ggplot2", quietly = TRUE)) {
@@ -972,8 +986,15 @@ ggtsdisplay <- function(x, plot.type=c("partial", "histogram", "scatter", "spect
 #' gglagplot(lungDeaths, lags=2)
 #' gglagchull(lungDeaths, lags=6)
 #'
+#' @rdname gglagplot
 #' @export
-gglagplot <- function(x, lags=ifelse(frequency(x) > 9, 16, 9),
+gglagplot <- function(x, ...){
+  UseMethod("gglagplot")
+}
+
+#' @rdname gglagplot
+#' @export
+gglagplot.ts  <- function(x, lags=ifelse(frequency(x) > 9, 16, 9),
                       set.lags = 1:lags, diag=TRUE, diag.col="gray", do.lines = TRUE, colour = TRUE,
                       continuous = frequency(x) > 12, labels = FALSE, seasonal = TRUE, ...) {
   if (!requireNamespace("ggplot2", quietly = TRUE)) {
@@ -1177,19 +1198,26 @@ gglagchull <- function(x,
 #' @return Returns an object of class \code{ggplot}.
 #' @author Mitchell O'Hara-Wild
 #' @seealso \code{\link[stats]{monthplot}}
+#'
+#' @export
+ggmonthplot <- function(x, labels = NULL, times = time(x), phase = cycle(x), ...) {
+  ggsubseriesplot(x, labels, times, phase, ...)
+}
+
 #' @examples
 #'
 #' ggsubseriesplot(AirPassengers)
 #' ggsubseriesplot(woolyrnq)
-#'
+#' 
+#' @rdname ggmonthplot
 #' @export
-ggmonthplot <- function(x, labels = NULL, times = time(x), phase = cycle(x), ...) {
-  ggsubseriesplot(x, labels, times, phase, ...)
+ggsubseriesplot <- function(x, ...){
+  UseMethod("ggsubseriesplot")
 }
 
 #' @rdname ggmonthplot
 #' @export
-ggsubseriesplot <- function(x, labels = NULL, times = time(x), phase = cycle(x), ...) {
+ggsubseriesplot.ts <- function(x, labels = NULL, times = time(x), phase = cycle(x), ...) {
   if (!requireNamespace("ggplot2", quietly = TRUE)) {
     stop("ggplot2 is needed for this function to work. Install it via install.packages(\"ggplot2\")", call. = FALSE)
   }
@@ -1272,7 +1300,16 @@ ggsubseriesplot <- function(x, labels = NULL, times = time(x), phase = cycle(x),
 #' ggseasonplot(AirPassengers, year.labels=TRUE, continuous=TRUE)
 #'
 #' @export
-ggseasonplot <- function(x, season.labels=NULL, year.labels=FALSE, year.labels.left=FALSE, type=NULL, col=NULL, continuous=FALSE, polar=FALSE, labelgap=0.04, ...) {
+ggseasonplot <- function(x, ...){
+  UseMethod("ggseasonplot")
+}
+
+#' @rdname seasonplot
+#' @param continuous Should the colour scheme for years be continuous or
+#' discrete?
+#' @param polar Plot the graph on seasonal coordinates
+#' @export
+ggseasonplot.ts <- function(x, season.labels=NULL, year.labels=FALSE, year.labels.left=FALSE, type=NULL, col=NULL, continuous=FALSE, polar=FALSE, labelgap=0.04, ...) {
   if (!requireNamespace("ggplot2", quietly = TRUE)) {
     stop("ggplot2 is needed for this function to work. Install it via install.packages(\"ggplot2\")", call. = FALSE)
   }

R/graph.R

@@ -120,9 +120,6 @@ tsdisplay <- function(x, plot.type=c("partial", "histogram", "scatter", "spectru
 #' @param xlab X-axis label.
 #' @param ylab Y-axis label.
 #' @param col Colour
-#' @param continuous Should the colour scheme for years be continuous or
-#' discrete?
-#' @param polar Plot the graph on seasonal coordinates
 #' @param labelgap Distance between year labels and plotted lines
 #' @param \dots additional arguments to \code{\link[graphics]{plot}}.
 #' @return None.

R/newarima2.R

@@ -18,7 +18,7 @@
 #' @inheritParams stats::arima
 #' @param y a univariate time series
 #' @param d Order of first-differencing. If missing, will choose a value based
-#' on KPSS test.
+#' on \code{test}.
 #' @param D Order of seasonal-differencing. If missing, will choose a value
 #' based on \code{season.test}.
 #' @param max.p Maximum value of p

R/unitRoot.R

@@ -84,7 +84,12 @@ ndiffs <- function(x,alpha=0.05,test=c("kpss","adf","pp"), type=c("level", "tren
       diff
       },
       error = function(e){
-        warning("The chosen test encountered an error, so no differencing is selected. Check the time series data.")
+        warning(
+          sprintf(
+            "The chosen unit root test encountered an error when testing for the %s difference. %i differences will be used. Consider using a different unit root test.",
+            switch(as.character(d), `0` = "first", `1` = "second", `2` = "third", paste0(d+1, "th")), d
+          )
+        )
         FALSE
       }
     )
@@ -206,6 +211,9 @@ nsdiffs <- function(x, alpha = 0.05, m=frequency(x), test=c("seas", "ocsb", "heg
     return(0)
   }
 
+  if(frequency(x) >= length(x))
+    return(0) # Can't take differences
+
   runTests <- function(x, test, alpha){
     tryCatch(
       {suppressWarnings(
@@ -219,7 +227,12 @@ nsdiffs <- function(x, alpha = 0.05, m=frequency(x), test=c("seas", "ocsb", "heg
         diff
       },
       error = function(e){
-        warning("The chosen test encountered an error, so no seasonal differencing is selected. Check the time series data.")
+        warning(
+          sprintf(
+            "The chosen seasonal unit root test encountered an error when testing for the %s difference. %i seasonal differences will be used. Consider using a different unit root test.",
+            switch(as.character(D), `0` = "first", `1` = "second", `2` = "third", paste0(D+1, "th")), D
+          )
+        )
         0
       }
     )

README.md

@@ -3,6 +3,7 @@ forecast <img src="man/figures/logo.png" align="right" />
 
 [![Travis-CI Build Status](https://travis-ci.org/robjhyndman/forecast.svg?branch=master)](https://travis-ci.org/robjhyndman/forecast)
 [![CRAN_Status_Badge](https://www.r-pkg.org/badges/version/forecast)](https://cran.r-project.org/package=forecast)
+[![lifecycle](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://www.tidyverse.org/lifecycle/#stable)
 [![Downloads](https://cranlogs.r-pkg.org/badges/forecast)](https://cran.r-project.org/package=forecast)
 [![Licence](https://img.shields.io/badge/licence-GPL--3-blue.svg)](https://www.gnu.org/licenses/gpl-3.0.en.html)