Nothing
#' Convert time-series-like to data.frame
#'
#' @param model time-series-like instance
#' @inheritParams fortify_base
#' @param columns character vector specifies target column name(s)
#' @param is.date logical frag indicates whether the \code{stats::ts} is date or not
#' If not provided, regard the input as date when the frequency is 4 or 12
#' @param index.name specify column name for time series index
#' @param data.name specify column name for univariate time series data. Ignored in multivariate time series.
#' @param scale logical flag indicating whether to perform scaling each timeseries
#' @param melt logical flag indicating whether to melt each timeseries as variable
#' @return data.frame
#' @examples
#' \dontrun{
#' fortify(AirPassengers)
#' fortify(timeSeries::as.timeSeries(AirPassengers))
#' fortify(tseries::irts(cumsum(rexp(10, rate = 0.1)), matrix(rnorm(20), ncol=2)))
#' fortify(stats::stl(UKgas, s.window = 'periodic'))
#' fortify(stats::decompose(UKgas))
#' }
#' @export
fortify.ts <- function(model, data = NULL, columns = NULL, is.date = NULL,
index.name = 'Index', data.name = 'Data',
scale = FALSE, melt = FALSE, ...) {
# no need to define `fortify.xts` because zoo package has `fortify.zoo`
if (is(model, 'timeSeries')) {
d <- as.data.frame(model)
dtindex <- as.POSIXct(rownames(d))
} else if (is(model, 'irts')) {
d <- as.data.frame(model$value)
dtindex <- model$time
} else if (is(model, 'ts')) {
d <- as.data.frame(as.matrix(model))
dtindex <- get.dtindex(model, is.date = is.date)
} else if (is(model, 'stl')) {
# stl allows only univariate series
ts.data <- model$time.series
orig <- drop(ts.data %*% rep(1, ncol(ts.data)))
dtindex <- get.dtindex(ts.data, is.date = is.date)
d <- cbind(data.frame(Data = orig),
data.frame(model$time.series))
} else if (is(model, 'decomposed.ts')) {
dtindex <- get.dtindex(model$x, is.date = is.date)
dtframe <- ggplot2::fortify(model$x)
# for tbl_df
dtframe <- data.frame(Data = dtframe[['Data']])
# trend and random can be multivariate
rndframe <- model$random
colnames(rndframe) <- NULL
dcframe <- data.frame(seasonal = model$seasonal,
trend = model$trend,
remainder = rndframe)
d <- cbind(dtframe, dcframe)
} else {
stop(paste0('Unsupported class for fortify.ts: ', class(model)))
}
dtframe <- data.frame(Index = dtindex)
colnames(dtframe) <- index.name
if (ncol(d) == 1) {
colnames(d) <- data.name
}
d <- cbind(dtframe, d)
# filtering columns
if (is.null(columns)) {
data.names <- names(d)
columns <- data.names[data.names != index.name]
} else {
d <- dplyr::select_(d, .dots = c(index.name, columns))
}
# scaling
if (scale) {
for (col in columns) {
d[[col]] <- base::scale(d[[col]], center = TRUE, scale = TRUE)
}
}
# unpivot
if (melt) {
d <- tidyr::gather(d, 'variable', 'value', columns)
}
post_fortify(d)
}
#' @export
fortify.timeSeries <- fortify.ts
#' @export
fortify.irts <- fortify.ts
#' Autoplot time-series-like
#'
#' @param object time-series-like instance
#' @param columns Character vector specifies target column name(s)
#' @param group Character vector specifies grouping
#' @param is.date Logical frag indicates whether the \code{stats::ts} is date or not
#' If not provided, regard the input as date when the frequency is 4 or 12
#' @param index.name Specify column name for time series index when passing \code{data.frame} via data.
#' @param p \code{ggplot2::ggplot} instance
#' @param ts.scale Logical flag indicating whether to perform scaling each timeseries
#' @param stacked Logical flag indicating whether to stack multivariate timeseries
#' @inheritParams apply_facets
#' @param ts.geom geometric string for time-series. 'line', 'bar', 'ribbon', or 'point'
#' @param ts.colour line colour for time-series
#' @param ts.size point size for time-series
#' @param ts.linetype line type for time-series
#' @param ts.alpha alpha for time-series
#' @param ts.fill fill colour for time-series
#' @param ts.shape point shape for time-series
#' @param geom same as ts.geom
#' @param colour same as ts.colour
#' @param size same as ts.size
#' @param linetype same as ts.linetype
#' @param alpha same as ts.alpha
#' @param fill same as ts.fill
#' @param shape same as ts.shape
#' @inheritParams post_autoplot
#' @param ... other arguments passed to methods
#' @return ggplot
#' @aliases autoplot.xts autoplot.timeSeries autoplot.irts autoplot.stl autoplot.decomposed.ts
#' @examples
#' \dontrun{
#' data(Canada, package = 'vars')
#' autoplot(AirPassengers)
#' autoplot(UKgas, ts.geom = 'bar')
#' autoplot(Canada)
#' autoplot(Canada, facets = FALSE)
#'
#' library(zoo)
#' autoplot(xts::as.xts(AirPassengers))
#' autoplot(timeSeries::as.timeSeries(AirPassengers))
#' its <- tseries::irts(cumsum(rexp(10, rate = 0.1)), matrix(rnorm(20), ncol=2))
#' autoplot(its)
#'
#' autoplot(stats::stl(UKgas, s.window = 'periodic'))
#' autoplot(stats::decompose(UKgas))
#' }
#' @export
autoplot.ts <- function(object, columns = NULL, group = NULL,
is.date = NULL, index.name = 'Index',
p = NULL, ts.scale = FALSE, stacked = FALSE,
facets = TRUE, nrow = NULL, ncol = 1, scales = 'free_y',
ts.geom = 'line', ts.colour = NULL, ts.size = NULL, ts.linetype = NULL,
ts.alpha = NULL, ts.fill = NULL, ts.shape = NULL,
geom = ts.geom, colour = ts.colour, size = ts.size, linetype = ts.linetype,
alpha = ts.alpha, fill = ts.fill, shape = ts.shape,
xlim = c(NA, NA), ylim = c(NA, NA), log = "",
main = NULL, xlab = '', ylab = '', asp = NULL,
...) {
geomfunc <- get_geom_function(geom, allowed = c('line', 'bar', 'point', 'ribbon'))
# fortify data
if (is.data.frame(object)) {
plot.data <- object
} else {
plot.data <- ggplot2::fortify(object, scale = ts.scale,
is.date = is.date, index.name = index.name)
}
if (is.null(columns)) {
if (is(object, 'bats') || is(object, 'ets')) {
# for forecast::bats and forecast::ets
columns <- c('Data', 'Level', 'Slope', 'Season')
# Slope and Season can be optionals
columns <- columns[columns %in% names(plot.data)]
} else {
data.names <- names(plot.data)
columns <- data.names[data.names != index.name]
}
}
if (is.null(colour) && !is.null(fill)) {
colour <- fill
} else if (!is.null(colour) && is.null(fill)) {
if (geom %in% c('bar', 'ribbon')) {
# do not set for line / point to handle as NULL in geom_factory
fill <- colour
}
}
if (length(columns) > 1) {
.is.univariate <- FALSE
} else {
.is.univariate <- TRUE
facets <- FALSE
stacked <- FALSE
}
# required for shift op
tslen <- nrow(plot.data)
if (!facets && stacked && geom != 'bar') {
for (i in seq_len(length(columns) - 1)) {
plot.data[columns[i + 1]] <- plot.data[columns[i + 1]] + plot.data[columns[i]]
}
}
# must be done here, because fortify.zoo is defined in zoo package
ts.column <- plot.data[[index.name]]
if (is(ts.column, 'yearmon') || is(ts.column, 'yearqtr')) {
plot.data[[index.name]] <- zoo::as.Date(plot.data[[index.name]])
}
group_key <- 'plot_group' # gets used later. Don't know why its defined here.
plot.data <- tidyr::pivot_longer(plot.data, names_to=group_key, values_to='value', columns) %>%
arrange(plot_group) # somewhere later the sort order matters.
# create ggplot instance if not passed
if (is.null(p)) {
null.p <- TRUE
mapping <- ggplot2::aes_string(x = index.name)
p <- ggplot2::ggplot(data = plot.data, mapping = mapping)
} else {
null.p <- FALSE
}
if (!facets && stacked) {
# using dplyr::lag may be easier, but it likely to
# cause a trouble in CMD check
value <- plot.data$value
shifted <- c(rep(0, times = tslen), value[1:(length(value) - tslen)])
plot.data[['base']] <- shifted
} else {
plot.data[['base']] <- 0
}
args <- list(geomfunc, plot.data, colour = colour, size = size,
linetype = linetype, alpha = alpha, fill = fill,
shape = shape, stat = 'identity')
if (geom == 'ribbon') {
args['ymin'] <- 'base'
args['ymax'] <- 'value'
} else {
args['y'] <- 'value'
}
if (facets) {
args['group'] <- group_key
p <- p + do.call(geom_factory, args)
p <- apply_facets(p, ~ plot_group, nrow = nrow, ncol = ncol, scales = scales)
} else {
if (!.is.univariate) {
# ts.colour cannot be used
if (!is.null(colour)) {
warning('multivariate timeseries with facets=FALSE are colorized by variable, colour is ignored')
}
args['colour'] <- group_key
if (geom %in% c('bar', 'ribbon')) {
args['fill'] <- group_key
}
if (geom == 'ribbon' && !stacked && is.null(alpha)) {
args['alpha'] <- 0.5
}
if (geom == 'bar' && !stacked) {
args['position'] <- 'dodge'
}
}
p <- p + do.call(geom_factory, args)
}
if (null.p) {
p <- p + ggplot2::scale_y_continuous()
}
p <- post_autoplot(p = p, xlim = xlim, ylim = ylim, log = log,
main = main, xlab = xlab, ylab = ylab, asp = asp)
p
}
#' @export
autoplot.zooreg <- autoplot.ts
#' @export
autoplot.xts <- autoplot.ts
#' @export
autoplot.timeSeries <- autoplot.ts
#' @export
autoplot.irts <- autoplot.ts
#' Convert time series models (like AR, ARIMA) to \code{data.frame}
#'
#' @param model Time series model instance
#' @param data original dataset, needed for \code{stats::ar}, \code{stats::Arima}
#' @inheritParams fortify_base
#' @param predict Predicted \code{stats::ts}
#' If not provided, try to retrieve from current environment using variable name.
#' @param is.date Logical frag indicates whether the \code{stats::ts} is date or not.
#' If not provided, regard the input as date when the frequency is 4 or 12.
#' @param ts.connect Logical frag indicates whether connects original time-series and predicted values
#' @return data.frame
#' @aliases fortify.ar fortify.Arima fortify.fracdiff
#' fortify.nnetar fortify.HoltWinters fortify.fGARCH
#' @examples
#' \dontrun{
#' fortify(stats::ar(AirPassengers))
#' fortify(stats::arima(UKgas))
#' fortify(stats::arima(UKgas), data = UKgas, is.date = TRUE)
#' fortify(forecast::auto.arima(austres))
#' fortify(forecast::arfima(AirPassengers))
#' fortify(forecast::nnetar(UKgas))
#' fortify(stats::HoltWinters(USAccDeaths))
#'
#' data(LPP2005REC, package = 'timeSeries')
#' x = timeSeries::as.timeSeries(LPP2005REC)
#' d.Garch = fGarch::garchFit(LPP40 ~ garch(1, 1), data = 100 * x, trace = FALSE)
#' fortify(d.Garch)
#' }
fortify.tsmodel <- function(model, data = NULL,
predict = NULL,
is.date = NULL,
ts.connect = TRUE, ...) {
if (is(model, 'Arima') || is(model, 'ar')) {
if (is.null(data)) {
data <- forecast::getResponse(model)
fit <- stats::fitted(model)
} else {
fit <- data - stats::residuals(model)
}
d <- ggplot2::fortify(data, is.date = is.date)
fit <- ggplot2::fortify(fit, data.name = 'Fitted', is.date = is.date)
resid <- ggplot2::fortify(stats::residuals(model), data.name = 'Residuals', is.date = is.date)
if (!is.null(predict)) {
pred <- ggplot2::fortify(predict$pred, data.name = 'Predicted')
se <- as.vector(predict$se)
pred$lower <- pred$Predicted - se
pred$upper <- pred$Predicted + se
}
} else if (is(model, 'HoltWinters')) {
# same as fracdiff and nnetar
d <- ggplot2::fortify(model$x, is.date = is.date)
fit <- ggplot2::fortify(stats::fitted(model), data.name = 'Fitted', is.date = is.date)
resid <- ggplot2::fortify(stats::residuals(model), data.name = 'Residuals', is.date = is.date)
if (!is.null(predict)) {
pred <- ggplot2::fortify(predict)
if (! 'upr' %in% names(pred)) {
pred$upr <- pred$Data
pred$lwr <- pred$Data
}
colnames(pred) <- c('Index', 'Predicted', 'upper', 'lower')
}
} else if (is(model, 'fracdiff') || is(model, 'nnetar')) {
d <- ggplot2::fortify(model$x, is.date = is.date)
fit <- ggplot2::fortify(stats::fitted(model), data.name = 'Fitted', is.date = is.date)
resid <- ggplot2::fortify(stats::residuals(model), data.name = 'Residuals', is.date = is.date)
} else if (is(model, 'fGARCH')) {
index <- attr(model@data, 'names')
index <- as.vector(index)
d <- data.frame(Index = index, Data = model@data)
fit <- data.frame(Index = index, Fitted = model@fitted)
resid <- data.frame(Index = index, Residuals = model@residuals)
if (!is.null(predict)) {
pred <- data.frame(Predicted = predict$meanForecast)
pred$lower <- pred$Predicted - predict$meanError
pred$upper <- pred$Predicted + predict$meanError
}
} else if (is(model, 'KFS')) {
d <- ggplot2::fortify(model$model$y, is.date = is.date)
m <- model$alphahat
if (is.null(m)) {
m <- model$m
if (is.null(m)) {
stop('Object does not contain smoothed estimates of states.')
}
m[1] <- model$model$y[1]
}
fit <- ggplot2::fortify(m, data.name = 'Fitted', is.date = is.date)
resid <- ggplot2::fortify(model$model$y - m,
data.name = 'Residuals', is.date = is.date)
} else {
stop(paste0('Unsupported class for fortify.Arima: ', class(model)))
}
d <- dplyr::left_join(d, fit, by = 'Index')
d <- dplyr::left_join(d, resid, by = 'Index')
if (!is.null(predict)) {
d <- rbind_ts(pred, d, ts.connect = ts.connect)
}
post_fortify(d)
}
#' @export
fortify.ar <- fortify.tsmodel
#' @export
fortify.Arima <- fortify.tsmodel
#' @export
fortify.tsmodel <- fortify.tsmodel
#' @export
fortify.HoltWinters <- fortify.tsmodel
#' @export
fortify.fracdiff <- fortify.tsmodel
#' @export
fortify.nnetar <- fortify.tsmodel
#' @export
fortify.fGARCH <- fortify.tsmodel
#' @export
fortify.dlmFiltered <- fortify.tsmodel
#' @export
fortify.KFS <- fortify.tsmodel
#' Autoplot time series models (like AR, ARIMA)
#'
#' @param object Time series model instance
#' @param data original dataset, needed for \code{stats::ar}, \code{stats::Arima}
#' @param predict Predicted \code{stats::ts}
#' If not provided, try to retrieve from current environment using variable name.
#' @param is.date Logical frag indicates whether the \code{stats::ts} is date or not.
#' If not provided, regard the input as date when the frequency is 4 or 12
#' @param ts.connect Logical frag indicates whether connects original time-series and predicted values
#' @param fitted.geom geometric string for fitted time-series
#' @param fitted.colour line colour for fitted time-series
#' @param fitted.size point size for fitted time-series
#' @param fitted.linetype line type for fitted time-series
#' @param fitted.alpha alpha for fitted time-series
#' @param fitted.fill fill colour for fitted time-series
#' @param fitted.shape point shape for fitted time-series
#' @param predict.geom geometric string for predicted time-series
#' @param predict.colour line colour for predicted time-series
#' @param predict.size point size for predicted time-series
#' @param predict.linetype line type for predicted time-series
#' @param predict.alpha alpha for predicted time-series
#' @param predict.fill fill colour for predicted time-series
#' @param predict.shape point shape for predicted time-series
#' @inheritParams plot_confint
#' @param ... Keywords passed to \code{autoplot.ts}
#' @return ggplot
#' @aliases autoplot.ar autoplot.fracdiff autoplot.nnetar autoplot.HoltWinters autoplot.fGARCH
#' @examples
#' \dontrun{
#' d.ar <- stats::ar(AirPassengers)
#' autoplot(d.ar)
#' autoplot(d.ar, predict = predict(d.ar, n.ahead = 5))
#' autoplot(stats::arima(UKgas), data = UKgas)
#' autoplot(forecast::arfima(AirPassengers))
#' autoplot(forecast::nnetar(UKgas), is.date = FALSE)
#'
#' d.holt <- stats::HoltWinters(USAccDeaths)
#' autoplot(d.holt)
#' autoplot(d.holt, predict = predict(d.holt, n.ahead = 5))
#' autoplot(d.holt, predict = predict(d.holt, n.ahead = 5, prediction.interval = TRUE))
#' }
#' @export
autoplot.tsmodel <- function(object, data = NULL,
predict = NULL,
is.date = NULL, ts.connect = TRUE,
fitted.geom = 'line',
fitted.colour = '#FF0000', fitted.size = NULL,
fitted.linetype = NULL, fitted.alpha = NULL,
fitted.fill = NULL, fitted.shape = NULL,
predict.geom = 'line',
predict.colour = '#0000FF', predict.size = NULL,
predict.linetype = NULL, predict.alpha = NULL,
predict.fill = NULL, predict.shape = NULL,
conf.int = TRUE,
conf.int.colour = '#0000FF', conf.int.linetype = 'none',
conf.int.fill = '#000000', conf.int.alpha = 0.3,
...) {
fcol <- ifelse(is(object, 'HoltWinters'), 'xhat', 'Fitted')
plot.data <- ggplot2::fortify(object, predict = predict,
data = data, is.date = is.date)
p <- autoplot.ts(plot.data, columns = 'Data', ...)
# must be passed by ts.<option>
p <- autoplot.ts(plot.data, columns = fcol, p = p,
ts.geom = fitted.geom,
ts.colour = fitted.colour, ts.size = fitted.size,
ts.linetype = fitted.linetype, ts.alpha = fitted.alpha,
ts.fill = fitted.fill, ts.shape = fitted.shape)
if (!is.null(predict)) {
predict.data <- dplyr::filter_(plot.data, '!is.na(Predicted)')
p <- autoplot.ts(predict.data, columns = 'Predicted', p = p,
ts.geom = predict.geom,
ts.colour = predict.colour, ts.size = predict.size,
ts.linetype = predict.linetype, ts.alpha = predict.alpha,
ts.fill = predict.fill, ts.shape = predict.shape)
p <- plot_confint(p = p, data = predict.data, conf.int = conf.int,
conf.int.colour = conf.int.colour,
conf.int.linetype = conf.int.linetype,
conf.int.fill = conf.int.fill, conf.int.alpha = conf.int.alpha)
}
p
}
#' @export
autoplot.ar <- autoplot.tsmodel
#' @export
autoplot.Arima <- autoplot.tsmodel
#' @export
autoplot.HoltWinters <- autoplot.tsmodel
#' @export
autoplot.fracdiff <- autoplot.tsmodel
#' @export
autoplot.nnetar <- autoplot.tsmodel
#' @export
autoplot.fGARCH <- autoplot.tsmodel
#' @export
autoplot.dlmFiltered <- autoplot.tsmodel
#' @export
autoplot.KFS <- autoplot.tsmodel
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.