If you reallllllllly want to....
It's kind of annoying that most forecast
package functions are not generics. This makes it difficult for us to extend the package to data.frames and other new objects.
library(tibbletime)
library(dplyr)
library(forecast)
# as.ts() is generic, let's go ahead and make a tbl_time method
as.ts.tbl_time <- function(x, ...) {
index_quo <- tibbletime::get_index_quo(x)
index_col <- tibbletime::get_index_col(x)
x_no_index <- dplyr::select(x, - !! index_quo)
start <- dplyr::first(index_col)
end <- dplyr::last(index_col)
ts(data = x_no_index, start = start, end = end, ...)
}
# Every forecast package function is not a generic for some reason :(
# Force it to be one anyways for the sake of the example
ets <- function(y, model = "ZZZ", damped = NULL, alpha = NULL, beta = NULL,
gamma = NULL, phi = NULL, additive.only = FALSE, lambda = NULL,
biasadj = FALSE, lower = c(rep(1e-04, 3), 0.8), upper = c(rep(0.9999, 3), 0.98),
opt.crit = c("lik", "amse", "mse", "sigma", "mae"), nmse = 3,
bounds = c("both", "usual", "admissible"), ic = c("aicc", "aic", "bic"),
restrict = TRUE, allow.multiplicative.trend = FALSE,
use.initial.values = FALSE, ...) {
UseMethod("ets")
}
# The default just calls the forecast version directly
ets.default <- function(y, model = "ZZZ", damped = NULL, alpha = NULL, beta = NULL,
gamma = NULL, phi = NULL, additive.only = FALSE, lambda = NULL,
biasadj = FALSE, lower = c(rep(1e-04, 3), 0.8), upper = c(rep(0.9999, 3), 0.98),
opt.crit = c("lik", "amse", "mse", "sigma", "mae"), nmse = 3,
bounds = c("both", "usual", "admissible"), ic = c("aicc", "aic", "bic"),
restrict = TRUE, allow.multiplicative.trend = FALSE,
use.initial.values = FALSE, ...) {
forecast::ets(y, model = "ZZZ", damped = NULL, alpha = NULL, beta = NULL,
gamma = NULL, phi = NULL, additive.only = FALSE, lambda = NULL,
biasadj = FALSE, lower = c(rep(1e-04, 3), 0.8), upper = c(rep(0.9999, 3), 0.98),
opt.crit = c("lik", "amse", "mse", "sigma", "mae"), nmse = 3,
bounds = c("both", "usual", "admissible"), ic = c("aicc", "aic", "bic"),
restrict = TRUE, allow.multiplicative.trend = FALSE,
use.initial.values = FALSE, ...)
}
# The method for tbl_time first coerces to ts
ets.tbl_time <- function(y, model = "ZZZ", damped = NULL, alpha = NULL, beta = NULL,
gamma = NULL, phi = NULL, additive.only = FALSE, lambda = NULL,
biasadj = FALSE, lower = c(rep(1e-04, 3), 0.8), upper = c(rep(0.9999, 3), 0.98),
opt.crit = c("lik", "amse", "mse", "sigma", "mae"), nmse = 3,
bounds = c("both", "usual", "admissible"), ic = c("aicc", "aic", "bic"),
restrict = TRUE, allow.multiplicative.trend = FALSE,
use.initial.values = FALSE, ...) {
# Pass ... to as.ts() so you can control frequency
# May or may not work / be useful
y <- as.ts(y, ...)
forecast::ets(y, model = "ZZZ", damped = NULL, alpha = NULL, beta = NULL,
gamma = NULL, phi = NULL, additive.only = FALSE, lambda = NULL,
biasadj = FALSE, lower = c(rep(1e-04, 3), 0.8), upper = c(rep(0.9999, 3), 0.98),
opt.crit = c("lik", "amse", "mse", "sigma", "mae"), nmse = 3,
bounds = c("both", "usual", "admissible"), ic = c("aicc", "aic", "bic"),
restrict = TRUE, allow.multiplicative.trend = FALSE,
use.initial.values = FALSE)
}
# Let's try it out
data(FB)
FB %>%
select(date, adjusted) %>%
as_tbl_time(date) %>%
ets()
#> ETS(M,A,N)
#>
#> Call:
#> forecast::ets(y = y, model = "ZZZ", damped = NULL, alpha = NULL,
#>
#> Call:
#> beta = NULL, gamma = NULL, phi = NULL, additive.only = FALSE,
#>
#> Call:
#> lambda = NULL, biasadj = FALSE, lower = c(rep(1e-04, 3),
#>
#> Call:
#> 0.8), upper = c(rep(0.9999, 3), 0.98), opt.crit = c("lik",
#>
#> Call:
#> "amse", "mse", "sigma", "mae"), nmse = 3, bounds = c("both",
#>
#> Call:
#> "usual", "admissible"), ic = c("aicc", "aic", "bic"),
#>
#> Call:
#> restrict = TRUE, allow.multiplicative.trend = FALSE, use.initial.values = FALSE)
#>
#> Smoothing parameters:
#> alpha = 0.9999
#> beta = 1e-04
#>
#> Initial states:
#> l = 28.0112
#> b = 0.0932
#>
#> sigma: 0.0307
#>
#> AIC AICc BIC
#> 12491.56 12491.60 12517.99
Created on 2018-01-18 by the reprex package (v0.1.1.9000).