A Primer on Time Series Modelling using Reproducible R Software
Abdisalam Hassan Muse (PhD)
2023-06-30
Amoud University
Abstract
This primer provides a comprehensive overview of 15 different time series models, including ARIMA, SARIMA, WARIMA, ARFIMA, ARIMAX, TAR, ARCH, GARCH, SETAR, THETA, ETS, BATS, TBATS, ANN, and ARNA models. For each model, we present a definition, formulation, model assumptions, application, fitting, evaluation, interpretation, and R code to reproduce the results.
First, we introduce the basic concepts of time series analysis and provide an overview of the R software environment. Then, we discuss the most widely used time series models, starting with the ARIMA family of models, which includes the SARIMA and WARIMA models. We also cover the ARFIMA model, which is used for long-memory time series, and the ARIMAX model, which incorporates exogenous variables.
In addition to these linear models, we also present several nonlinear models, such as the TAR, ARCH, GARCH, and SETAR models, which are used to capture nonlinearities and volatility clustering in time series data. We also discuss the THETA model, which is used for seasonal time series, and the ETS, BATS, and TBATS models, which are used for forecasting.
Finally, we present two advanced models: the ANN model, which is a neural network-based model, and the ARNA model, which is a nonparametric model that uses a nearest-neighbour approach.
Throughout the primer, we provide R code examples to illustrate the model fitting and evaluation process, as well as the interpretation of the results. We also emphasize the importance of reproducibility in time series analysis, and demonstrate how to achieve this using R.
Overall, this primer provides a comprehensive and practical guide to time series modelling using R, and is suitable for both beginners and intermediate-level users.
Module I: ARIMA Model
Introduction
- The ARIMA model is a time series forecasting model that is used to model stationary time series data.
- It is a flexible model that can capture non-linear relationships in the data.
- The ARIMA model is useful when the data exhibits autocorrelation and/or seasonality.
Model Formulation
The mathematical formula for an ARIMA model with parameters p, d, and q can be written in LaTeX as:
\[(1 - \phi_1 B - \phi_2 B^2 - \dots - \phi_p B^p)(1 - B)^d(Y_t - \mu) = (1 + \theta_1 B + \theta_2 B^2 + \dots + \theta_q B^q)e_t\]
where \(Y_t\) is the value of the time series at time \(t\), \(B\) is the backshift operator (\(B^kY_t = Y_{t-k}\)), \(\mu\) is the mean of the time series, \(\phi_1, \phi_2, \dots, \phi_p\) are the autoregressive coefficients, \(\theta_1, \theta_2, \dots, \theta_q\) are the moving average coefficients, \(d\) is the degree of differencing, and \(e_t\) is the error term.
The first part of the equation \((1 - \phi_1 B - \phi_2 B^2 - \dots - \phi_p B^p)(1 - B)^d(Y_t - \mu)\) represents the autoregressive integrated component of the ARIMA model, which models the relationship between an observation and a certain number of lagged observations, after differencing to make the series stationary.
The second part of the equation \((1 + \theta_1 B + \theta_2 B^2 + \dots + \theta_q B^q)e_t\) represents the moving average component of the ARIMA model, which models the errors or residuals of the series.
The autoregressive and moving average coefficients represent the strength of the relationship between past observations and future predictions. The degree of differencing \(d\) represents the number of times the series needs to be differenced to make it stationary, and the error term \(e_t\) represents the error or residual term that is not accounted for by the autoregressive and moving average components.
Model Assumptions
The ARIMA model makes several assumptions about the underlying time series data, including:
Stationarity: The time series should be stationary, meaning that the statistical properties of the series (such as the mean and variance) do not depend on time. If the series is non-stationary, it may need to be differenced to make it stationary before using the ARIMA model.
Linearity: The relationship between past observations and future predictions should be linear. Nonlinear relationships may require a different type of model.
Independence: The error terms in the ARIMA model should be independent and identically distributed (IID), meaning that each error term should be unrelated to previous error terms and should have the same distribution. If the error terms are not IID, it may indicate that the model is misspecified.
Normality: The error terms should be normally distributed, with a mean of zero and constant variance. If the error terms are not normally distributed, it may indicate that the model is misspecified.
Adequate Sample Size: The ARIMA model assumes that the time series has a sufficient number of observations to estimate the model parameters with reasonable accuracy. A general guideline is to have at least 50 observations in the time series.
These assumptions are important to keep in mind when using the ARIMA model, as violations of these assumptions can lead to inaccurate predictions and biased parameter estimates. It is important to check these assumptions before fitting an ARIMA model to a time series and to take appropriate steps to address any violations.
Alternative Models
If the assumptions of the ARIMA model are violated, there are several alternative time series models that may be more appropriate, including:
SARIMA: SARIMA models are a natural alternative to ARIMA when the data exhibits seasonal patterns. SARIMA models become a viable alternative to ARIMA when the data exhibits clear seasonal patterns that cannot be captured by a non-seasonal ARIMA model.
ETS: ETS models can be used as an alternative to ARIMA when the data exhibits non-constant variance or non-stationary trends. ETS models become a viable alternative to ARIMA when the data exhibits clear trends that cannot be captured by a non-seasonal ARIMA model.
BATS and TBATS: BATS and TBATS models are a class of time series models that can handle multiple seasonalities and are useful when the data exhibits multiple seasonal patterns. BATS and TBATS models become a viable alternative to ARIMA when the data exhibits multiple seasonal patterns that cannot be captured by a seasonal ARIMA model.
ARFIMA and WARIMA: ARFIMA and WARIMA models are a class of time series models that can handle long-range dependencies and non-stationary trends in the data. ARFIMA and WARIMA models become a viable alternative to ARIMA when the data exhibits long-range dependencies or non-stationary trends that cannot be captured by a non-seasonal ARIMA model.
ARIMAX: ARIMAX models are a class of time series models that incorporate exogenous variables into the modeling process. ARIMAX models become a viable alternative to ARIMA when the data exhibits clear relationships between the time series and one or more exogenous variables.
TAR: TAR models are a class of time series models that can capture non-linear relationships between the time series and past observations. TAR models become a viable alternative to ARIMA when the data exhibits non-linear relationships that cannot be captured by a linear ARIMA model.
ARCH and GARCH: ARCH and GARCH models are a class of time series models that can handle time-varying volatility in the data. ARCH and GARCH models become a viable alternative to ARIMA when the data exhibits time-varying volatility that cannot be captured by a constant variance ARIMA model.
SETAR: SETAR models are a class of time series models that can capture non-linear relationships between the time series and past observations, similar to TAR models. SETAR models become a viable alternative to ARIMA when the data exhibits non-linear relationships that cannot be captured by a linear ARIMA model.
THETA: THETA models are a class of time series models that are useful for forecasting short-term time series data. THETA models become a viable alternative to ARIMA when the data exhibits short-term patterns that can be captured by a simple smoothing method.
ANN and ARNN: ANN and ARNN models are a class of time series models that use artificial neural networks to capture complex relationships between the time series and past observations. ANN and ARNN models become a viable alternative to ARIMA when the data exhibits complex relationships that cannot be captured by a linear ARIMA model.
DLM: DLM models are a class of time series models that can handle non-linear and non-stationary trends in the data. DLM models become a viable alternative to ARIMA when the data exhibits complex patterns or trends that cannot be captured by a linear ARIMA model.
VAR and ARDL: VAR and ARDL models are a class of time series models that are useful when there are multiple time series that are related to each other, rather than a single time series. VAR and ARDL models become a viable alternative to ARIMA when the data exhibits clear relationships between multiple time series.
Model Fitting
To fit an ARIMA model to a time series, the following steps can be followed:
Visualize the data: Plot the time series and examine its characteristics, including any trends, seasonality, or other patterns.
Stationarity testing: Check whether the time series is stationary or not. If the series is non-stationary, it needs to be differenced to make it stationary. The augmented Dickey-Fuller (ADF) test or the Kwiatkowski-Phillips-Schmidt-Shin (KPSS) test can be used to test for stationarity.
Determine the order of differencing: Determine the minimum number of times the series needs to be differenced to make it stationary. This can be done by looking at the autocorrelation function (ACF) and partial autocorrelation function (PACF) plots of the differenced series.
Determine the order of the AR and MA components: Determine the order of the autoregressive (AR) and moving average (MA) components by examining the ACF and PACF plots of the stationary series.
Fit the ARIMA model: Use the determined values of the AR, MA, and differencing orders to fit the ARIMA model to the time series. This can be done using software packages such as R or Python, which have built-in functions for fitting ARIMA models.
Evaluate the model: Evaluate the performance of the ARIMA model by comparing its predicted values to the actual values of the time series. Various metrics such as mean absolute error (MAE), mean squared error (MSE), root mean squared error (RMSE), and mean absolute percentage error (MAPE) can be used to evaluate the model’s performance.
Refit the model: If the model’s performance is not satisfactory, refine the model by adjusting the AR, MA, and differencing orders, or by trying alternative models, such as SARIMA or ETS models.
Forecast using the model: Once the model has been fitted and evaluated, it can be used to make forecasts of future values of the time series.
Overall, fitting an ARIMA model involves a combination of visual inspection, statistical testing, and model selection techniques to determine the appropriate order of the AR, MA, and differencing components. The model is then evaluated and refined as necessary to produce accurate forecasts of the time series.
Model Evaluation
After fitting an ARIMA model to a time series, it is important to evaluate the model’s performance to determine its accuracy in forecasting future values. There are several techniques that can be used to evaluate the performance of an ARIMA model, including:
Residual analysis: Examine the residuals (the difference between the actual values and the predicted values) to check for patterns or trends that may indicate that the model is misspecified. Ideally, the residuals should be normally distributed with a mean of zero and constant variance.
Mean Absolute Percentage Error (MAPE): MAPE measures the average percentage difference between the predicted and actual values of the time series. A lower MAPE indicates better model performance.
Mean Absolute Error (MAE): MAE measures the average absolute difference between the predicted and actual values of the time series. A lower MAE indicates better model performance.
Mean Squared Error (MSE) and Root Mean Squared Error (RMSE): MSE and RMSE measure the average squared and square root of the difference between the predicted and actual values of the time series, respectively. A lower MSE or RMSE indicates better model performance.
Forecast accuracy: Evaluate the accuracy of the model’s forecasts by comparing its predicted values to the actual values of the time series over a specific period of time. This can be done by calculating the difference between the predicted and actual values, and examining metrics such as MAE, MSE, and RMSE.
Visual inspection: Plot the predicted values of the time series against the actual values to visually examine the accuracy of the model’s forecasts.
Overall, ARIMA model evaluation involves a combination of quantitative and qualitative techniques to assess the model’s accuracy and determine whether it is suitable for forecasting future values of the time series. It is important to evaluate the model carefully and refine it as necessary to produce accurate and reliable forecasts.
Conclusion
- The ARIMA model is a useful model for forecasting time series data that exhibit autocorrelation and/or seasonality.
- It is important to carefully consider the assumptions of the model and to evaluate its performance to ensure that the results are valid and reliable.
- The ARIMA model can be a useful tool for making informed decisions about forecasting and planning in various fields such as finance, economics, and weather forecasting.
Worked Example
Suppose we have a dataset of annual \(CO_2\) emissions of Somalia from 1950 to 2020. We want to build an ARIMA model to forecast the emissions for the next 10 years.
Solution
First, let’s load the dataset into R:
emissions <- read.csv("COSOM.csv")
head(emissions)## No Year Cumulative.CO2.emissions
## 1 1 1950 47632
## 2 2 1951 95264
## 3 3 1952 142896
## 4 4 1953 190528
## 5 5 1954 238160
## 6 6 1955 304112Next, we can use the ts function in R to convert the data into a time series object:
emissions_ts <- ts(emissions$Cumulative.CO2.emissions, start = 1950, frequency = 1)After converting the data into a time series object, we can fit an ARIMA model using the forecast package in R:
library(forecast)## Warning: package 'forecast' was built under R version 4.1.3## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zooarima_model <- auto.arima(emissions_ts)
summary(arima_model)## Series: emissions_ts
## ARIMA(0,2,2)
##
## Coefficients:
## ma1 ma2
## -0.5680 0.3345
## s.e. 0.1108 0.1166
##
## sigma^2 = 1.116e+10: log likelihood = -895.28
## AIC=1796.57 AICc=1796.94 BIC=1803.27
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 9997.113 102614.3 55881.75 0.5788606 1.125933 0.1191065
## ACF1
## Training set -0.004377921Plot the Residuals
plot.ts(arima_model$residuals)
In this example, we are using the auto.arima function to fit an ARIMA model to the \(CO_2\) emissions data. The function automatically selects the best order of the autoregressive and moving average components based on the AIC (Akaike Information Criterion) value. We can then use the forecast function to generate forecasts for the next 10 years:
forecast_values <- forecast(arima_model, h = 10)
forecast_values## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 2021 33510828 33375454 33646202 33303791 33717865
## 2022 34102465 33866022 34338908 33740857 34464073
## 2023 34694103 34314002 35074203 34112789 35275416
## 2024 35285740 34732956 35838524 34440330 36131150
## 2025 35877378 35128568 36626188 34732172 37022584
## 2026 36469015 35503901 37434130 34993000 37945031
## 2027 37060653 35860948 38260357 35225863 38895443
## 2028 37652290 36201160 39103421 35432978 39871603
## 2029 38243928 36525661 39962195 35616065 40871791
## 2030 38835566 36835363 40835769 35776519 41894612The forecast_values variable will show us the forecasted emissions for the next 10 years, along with the upper and lower bounds of the prediction intervals.
We can also visualize the results of the ARIMA model using the autoplot function in R:
autoplot(forecast_values)
This will produce a plot of the actual sales and the forecasted sales from the ARIMA model:
The plot shows us how the ARIMA model has made forecasts that are close to the actual emissions data. We can use the forecasted values to make informed decisions about environmental and climate change planning. However, it is important to note that the ARIMA model may not perform well for all types of data and that careful analysis and evaluation of the model is necessary before making any decisions based on the forecasts.
Model II: SARIMA Model
Introduction
- The SARIMA model is a time series forecasting model that is an extension of the ARIMA model.
- It is used to model time series data that exhibit both trend and seasonal components.
- The acronym SARIMA stands for Seasonal Autoregressive Integrated Moving Average.
Model Formulation
- The SARIMA model can be written as:
\[y(t) = c + \sum_{i=1}^{p} \phi(i)y(t-i) + \sum_{i=1}^{P}\Phi(i)y(t-i\cdot s) + \varepsilon(t) - \sum_{i=1}^{q}\theta(i)\varepsilon(t-i) - \sum_{i=1}^{Q}\Theta(i)\varepsilon(t-i\cdot s) \]
where:
\(y(t)\) is the value of the time series at time \(t\). \(c\) is a constant term. \(\phi(1), ..., \phi(p)\) are the autoregressive parameters of the non-seasonal component. \(\Phi(1), ..., \Phi(P)\) are the autoregressive parameters of the seasonal component. \(\varepsilon(t)\) is the error term at time \(t\). \(\theta(1), ..., \theta(q)\) are the moving average parameters of the non-seasonal component. \(\Theta(1), ..., \Theta(Q)\) are the moving average parameters of the seasonal component. \(d\) is the degree of differencing required to make the time series stationary. \(D\) is the degree of seasonal differencing required to make the time series stationary. \(s\) is the seasonal period. The formula represents the SARIMA model as a linear combination of lagged values of the time series and error terms. The model can be used to forecast future values of the time series by estimating the parameters using historical data.
It is important to note that this formula assumes that the time series is stationary after differencing, and that the residual errors have no autocorrelation or seasonality. Violations of these assumptions can lead to biased or inaccurate forecasts, so it is important to carefully evaluate the assumptions before fitting a SARIMA model.
Model Assumptions
The Seasonal Autoregressive Integrated Moving Average (SARIMA) model is a time series forecasting model that extends the Autoregressive Integrated Moving Average (ARIMA) model to account for seasonality. Like ARIMA, SARIMA also has certain assumptions that must be met for the model to work properly.
The assumptions of SARIMA are as follows:
Stationarity: The time series should be stationary, which means that the statistical properties of the series should be constant over time. This can be checked using statistical tests such as the Augmented Dickey-Fuller (ADF) test.
Seasonality: If the time series exhibits seasonality, then the SARIMA model should be used instead of the ARIMA model.
No outliers: The time series should not have any outliers, as they can affect the model’s accuracy. Outliers can be detected using techniques such as boxplots and scatterplots.
No autocorrelation of residuals: The residuals (the difference between the predicted and actual values) of the model should not exhibit autocorrelation, as this indicates that the model has not captured all the information in the data. Autocorrelation can be checked using the Ljung-Box test.
Normality of residuals: The residuals should be normally distributed with a mean of zero and constant variance, as this ensures that the model is unbiased and has accurate confidence intervals. Normality can be checked using a histogram or a normal probability plot.
It is important to note that these assumptions are not always strictly required, and some violations can be tolerated depending on the specific circumstances. However, violating one or more of these assumptions can lead to biased or inaccurate forecasts, so it is recommended to check and address them as much as possible before using SARIMA for time series forecasting.
Model Fitting
- The goal of the SARIMA model is to find the parameters that minimize the sum of squared errors between the predicted values and the actual values.
- This is typically done using a method called maximum likelihood estimation (MLE).
- MLE involves finding the values of the parameters that maximize the likelihood function, which is a measure of how well the model fits the data.
Model Evaluation
- Once the SARIMA model has been fitted, it is important to evaluate its performance.
- One way to do this is to calculate the mean absolute percentage error (MAPE), which measures the accuracy of the forecasts.
- Another way to evaluate the model is to examine the residual plot to assess whether the assumptions of the model have been met.
Conclusion
- The SARIMA model is a powerful tool for forecasting time series data that exhibit both trend and seasonal components.
- It is important to carefully consider the assumptions of the model and to evaluate its performance to ensure that the results are valid and reliable.
- The SARIMA model has proven to be a popular choice for forecasting time series data in many different industries and applications.
Worked Example
You are given monthly inflation rate data for Somaliland from December 2014 to March 2023. Your task is to select the most appropriate time series model from a set of models.
Solution
# Modelling and Forecasting Inflation Rate Data
# 1. Loading data
inflation<-read.csv("~/INFRSOM.csv")
# 2.Selection of the variable interest
rate<-inflation$Rate
#3. Descriptive Statistics
summary(rate)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 97.59 103.46 111.39 114.03 122.15 137.29library(AdequacyModel)
descriptive(rate)
## $mean
## [1] 114.0277
##
## $median
## [1] 111.39
##
## $mode
## [1] 102.5
##
## $variance
## [1] 137.6631
##
## $Skewness
## [1] 0.43464
##
## $Kurtosis
## [1] -1.02065
##
## $minimum
## [1] 97.59
##
## $maximum
## [1] 137.29
##
## $n
## [1] 100#4. Checking missing values
any(is.na(rate))## [1] FALSE#5. Checking whether its time series data or NOT
is.ts(rate)## [1] FALSEclass(rate)## [1] "numeric"#6. Converting into time series data
ratets<-ts(rate,frequency = 12,start =c(2014,12) )
ratets## Jan Feb Mar Apr May Jun Jul Aug Sep Oct
## 2014
## 2015 97.59 98.43 99.75 100.35 99.98 100.02 103.98 105.29 105.33 100.13
## 2016 99.78 99.70 100.01 100.56 100.74 100.91 101.26 101.21 101.11 100.82
## 2017 102.31 101.64 101.52 102.89 104.56 105.58 105.66 105.75 106.67 107.34
## 2018 106.26 107.43 107.39 108.73 110.32 109.76 108.94 109.09 110.36 111.62
## 2019 109.62 110.75 110.79 114.89 116.81 117.01 116.36 115.41 116.07 116.25
## 2020 113.14 114.13 116.55 119.80 121.76 122.04 121.13 120.08 120.63 120.61
## 2021 118.80 119.88 122.47 124.85 126.42 125.97 126.89 125.26 126.17 126.46
## 2022 126.92 127.61 129.92 132.90 134.89 134.77 136.71 134.74 135.28 135.20
## 2023 133.99 134.54 137.29
## Nov Dec
## 2014 100.00
## 2015 100.13 100.29
## 2016 103.65 101.51
## 2017 107.55 107.69
## 2018 111.85 111.16
## 2019 116.10 114.64
## 2020 121.18 120.18
## 2021 127.27 126.99
## 2022 135.37 134.68
## 2023start(ratets)## [1] 2014 12end(ratets)## [1] 2023 3frequency(ratets)## [1] 12#7. Plotting
plot.ts(ratets, xlab="Months",ylab="Inflation rates",
main="Inflation rate data for Somalia", col="red")
library(TSstudio)
# Plot the series
ts_plot(ratets,
title = "Inflation rate data for Somalia",
Ytitle = "Inflation Rate",
Xtitle = "Source: Somalia National Bureau of Statistics",
slider = TRUE)#8. Decomposition
windows()
plot(decompose(ratets))
windows()
plot(decompose(ratets,type="multiplicative"))
ts_decompose(ratets)#Seasonal analysis
ts_seasonal(ratets, type = "normal")ts_seasonal(ratets, type = "cycle")ts_seasonal(ratets, type = "box")ts_seasonal(ratets, type = "all") ts_seasonal(ratets - decompose(ratets)$trend,
type = "all",
title = "Seasonal Plot - Inflationrate (Detrend)")## Warning: Can't display both discrete & non-discrete data on same axis## Warning: Ignoring 2 observations
## Warning: Ignoring 2 observations
## Warning: Ignoring 2 observations## Warning: Ignoring 1 observations
## Warning: Ignoring 1 observations
## Warning: Ignoring 1 observations
## Warning: Ignoring 1 observations## Warning: Ignoring 2 observations
## Warning: Can't display both discrete & non-discrete data on same axis# Heatmap
ts_heatmap(ratets)# Surface Plot
ts_surface(ratets)#Polar plot
ts_polar(ratets)## Warning: 'layout' objects don't have these attributes: 'orientation'
## Valid attributes include:
## '_deprecated', 'activeshape', 'annotations', 'autosize', 'autotypenumbers', 'calendar', 'clickmode', 'coloraxis', 'colorscale', 'colorway', 'computed', 'datarevision', 'dragmode', 'editrevision', 'editType', 'font', 'geo', 'grid', 'height', 'hidesources', 'hoverdistance', 'hoverlabel', 'hovermode', 'images', 'legend', 'mapbox', 'margin', 'meta', 'metasrc', 'modebar', 'newshape', 'paper_bgcolor', 'plot_bgcolor', 'polar', 'scene', 'selectdirection', 'selectionrevision', 'separators', 'shapes', 'showlegend', 'sliders', 'spikedistance', 'template', 'ternary', 'title', 'transition', 'uirevision', 'uniformtext', 'updatemenus', 'width', 'xaxis', 'yaxis', 'barmode', 'bargap', 'mapType'## Warning: 'barpolar' objects don't have these attributes: 't'
## Valid attributes include:
## 'base', 'basesrc', 'customdata', 'customdatasrc', 'dr', 'dtheta', 'hoverinfo', 'hoverinfosrc', 'hoverlabel', 'hovertemplate', 'hovertemplatesrc', 'hovertext', 'hovertextsrc', 'ids', 'idssrc', 'legendgroup', 'legendgrouptitle', 'legendrank', 'marker', 'meta', 'metasrc', 'name', 'offset', 'offsetsrc', 'opacity', 'r', 'r0', 'rsrc', 'selected', 'selectedpoints', 'showlegend', 'stream', 'subplot', 'text', 'textsrc', 'theta', 'theta0', 'thetasrc', 'thetaunit', 'transforms', 'type', 'uid', 'uirevision', 'unselected', 'visible', 'width', 'widthsrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'
## Warning: 'barpolar' objects don't have these attributes: 't'
## Valid attributes include:
## 'base', 'basesrc', 'customdata', 'customdatasrc', 'dr', 'dtheta', 'hoverinfo', 'hoverinfosrc', 'hoverlabel', 'hovertemplate', 'hovertemplatesrc', 'hovertext', 'hovertextsrc', 'ids', 'idssrc', 'legendgroup', 'legendgrouptitle', 'legendrank', 'marker', 'meta', 'metasrc', 'name', 'offset', 'offsetsrc', 'opacity', 'r', 'r0', 'rsrc', 'selected', 'selectedpoints', 'showlegend', 'stream', 'subplot', 'text', 'textsrc', 'theta', 'theta0', 'thetasrc', 'thetaunit', 'transforms', 'type', 'uid', 'uirevision', 'unselected', 'visible', 'width', 'widthsrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'
## Warning: 'barpolar' objects don't have these attributes: 't'
## Valid attributes include:
## 'base', 'basesrc', 'customdata', 'customdatasrc', 'dr', 'dtheta', 'hoverinfo', 'hoverinfosrc', 'hoverlabel', 'hovertemplate', 'hovertemplatesrc', 'hovertext', 'hovertextsrc', 'ids', 'idssrc', 'legendgroup', 'legendgrouptitle', 'legendrank', 'marker', 'meta', 'metasrc', 'name', 'offset', 'offsetsrc', 'opacity', 'r', 'r0', 'rsrc', 'selected', 'selectedpoints', 'showlegend', 'stream', 'subplot', 'text', 'textsrc', 'theta', 'theta0', 'thetasrc', 'thetaunit', 'transforms', 'type', 'uid', 'uirevision', 'unselected', 'visible', 'width', 'widthsrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'
## Warning: 'barpolar' objects don't have these attributes: 't'
## Valid attributes include:
## 'base', 'basesrc', 'customdata', 'customdatasrc', 'dr', 'dtheta', 'hoverinfo', 'hoverinfosrc', 'hoverlabel', 'hovertemplate', 'hovertemplatesrc', 'hovertext', 'hovertextsrc', 'ids', 'idssrc', 'legendgroup', 'legendgrouptitle', 'legendrank', 'marker', 'meta', 'metasrc', 'name', 'offset', 'offsetsrc', 'opacity', 'r', 'r0', 'rsrc', 'selected', 'selectedpoints', 'showlegend', 'stream', 'subplot', 'text', 'textsrc', 'theta', 'theta0', 'thetasrc', 'thetaunit', 'transforms', 'type', 'uid', 'uirevision', 'unselected', 'visible', 'width', 'widthsrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'
## Warning: 'barpolar' objects don't have these attributes: 't'
## Valid attributes include:
## 'base', 'basesrc', 'customdata', 'customdatasrc', 'dr', 'dtheta', 'hoverinfo', 'hoverinfosrc', 'hoverlabel', 'hovertemplate', 'hovertemplatesrc', 'hovertext', 'hovertextsrc', 'ids', 'idssrc', 'legendgroup', 'legendgrouptitle', 'legendrank', 'marker', 'meta', 'metasrc', 'name', 'offset', 'offsetsrc', 'opacity', 'r', 'r0', 'rsrc', 'selected', 'selectedpoints', 'showlegend', 'stream', 'subplot', 'text', 'textsrc', 'theta', 'theta0', 'thetasrc', 'thetaunit', 'transforms', 'type', 'uid', 'uirevision', 'unselected', 'visible', 'width', 'widthsrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'
## Warning: 'barpolar' objects don't have these attributes: 't'
## Valid attributes include:
## 'base', 'basesrc', 'customdata', 'customdatasrc', 'dr', 'dtheta', 'hoverinfo', 'hoverinfosrc', 'hoverlabel', 'hovertemplate', 'hovertemplatesrc', 'hovertext', 'hovertextsrc', 'ids', 'idssrc', 'legendgroup', 'legendgrouptitle', 'legendrank', 'marker', 'meta', 'metasrc', 'name', 'offset', 'offsetsrc', 'opacity', 'r', 'r0', 'rsrc', 'selected', 'selectedpoints', 'showlegend', 'stream', 'subplot', 'text', 'textsrc', 'theta', 'theta0', 'thetasrc', 'thetaunit', 'transforms', 'type', 'uid', 'uirevision', 'unselected', 'visible', 'width', 'widthsrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'
## Warning: 'barpolar' objects don't have these attributes: 't'
## Valid attributes include:
## 'base', 'basesrc', 'customdata', 'customdatasrc', 'dr', 'dtheta', 'hoverinfo', 'hoverinfosrc', 'hoverlabel', 'hovertemplate', 'hovertemplatesrc', 'hovertext', 'hovertextsrc', 'ids', 'idssrc', 'legendgroup', 'legendgrouptitle', 'legendrank', 'marker', 'meta', 'metasrc', 'name', 'offset', 'offsetsrc', 'opacity', 'r', 'r0', 'rsrc', 'selected', 'selectedpoints', 'showlegend', 'stream', 'subplot', 'text', 'textsrc', 'theta', 'theta0', 'thetasrc', 'thetaunit', 'transforms', 'type', 'uid', 'uirevision', 'unselected', 'visible', 'width', 'widthsrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'
## Warning: 'barpolar' objects don't have these attributes: 't'
## Valid attributes include:
## 'base', 'basesrc', 'customdata', 'customdatasrc', 'dr', 'dtheta', 'hoverinfo', 'hoverinfosrc', 'hoverlabel', 'hovertemplate', 'hovertemplatesrc', 'hovertext', 'hovertextsrc', 'ids', 'idssrc', 'legendgroup', 'legendgrouptitle', 'legendrank', 'marker', 'meta', 'metasrc', 'name', 'offset', 'offsetsrc', 'opacity', 'r', 'r0', 'rsrc', 'selected', 'selectedpoints', 'showlegend', 'stream', 'subplot', 'text', 'textsrc', 'theta', 'theta0', 'thetasrc', 'thetaunit', 'transforms', 'type', 'uid', 'uirevision', 'unselected', 'visible', 'width', 'widthsrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'
## Warning: 'barpolar' objects don't have these attributes: 't'
## Valid attributes include:
## 'base', 'basesrc', 'customdata', 'customdatasrc', 'dr', 'dtheta', 'hoverinfo', 'hoverinfosrc', 'hoverlabel', 'hovertemplate', 'hovertemplatesrc', 'hovertext', 'hovertextsrc', 'ids', 'idssrc', 'legendgroup', 'legendgrouptitle', 'legendrank', 'marker', 'meta', 'metasrc', 'name', 'offset', 'offsetsrc', 'opacity', 'r', 'r0', 'rsrc', 'selected', 'selectedpoints', 'showlegend', 'stream', 'subplot', 'text', 'textsrc', 'theta', 'theta0', 'thetasrc', 'thetaunit', 'transforms', 'type', 'uid', 'uirevision', 'unselected', 'visible', 'width', 'widthsrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'
## Warning: 'barpolar' objects don't have these attributes: 't'
## Valid attributes include:
## 'base', 'basesrc', 'customdata', 'customdatasrc', 'dr', 'dtheta', 'hoverinfo', 'hoverinfosrc', 'hoverlabel', 'hovertemplate', 'hovertemplatesrc', 'hovertext', 'hovertextsrc', 'ids', 'idssrc', 'legendgroup', 'legendgrouptitle', 'legendrank', 'marker', 'meta', 'metasrc', 'name', 'offset', 'offsetsrc', 'opacity', 'r', 'r0', 'rsrc', 'selected', 'selectedpoints', 'showlegend', 'stream', 'subplot', 'text', 'textsrc', 'theta', 'theta0', 'thetasrc', 'thetaunit', 'transforms', 'type', 'uid', 'uirevision', 'unselected', 'visible', 'width', 'widthsrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'# Correlation Analysis
#ts_acf(ratets, lag.max = 36)
ts_lags(ratets)ts_lags(ratets, lags = c(12, 24, 36, 48))#9. Stationarity Testing
library(tseries)## Warning: package 'tseries' was built under R version 4.1.3adf.test(ratets)##
## Augmented Dickey-Fuller Test
##
## data: ratets
## Dickey-Fuller = -2.2012, Lag order = 4, p-value = 0.4933
## alternative hypothesis: stationarypp.test(ratets)##
## Phillips-Perron Unit Root Test
##
## data: ratets
## Dickey-Fuller Z(alpha) = -15.501, Truncation lag parameter = 3, p-value
## = 0.2155
## alternative hypothesis: stationary#10. Differencing
library(forecast)
ratedf<-diff(ratets,differences = 1)
adf.test(ratedf)## Warning in adf.test(ratedf): p-value smaller than printed p-value##
## Augmented Dickey-Fuller Test
##
## data: ratedf
## Dickey-Fuller = -5.0176, Lag order = 4, p-value = 0.01
## alternative hypothesis: stationarypp.test(ratedf)## Warning in pp.test(ratedf): p-value smaller than printed p-value##
## Phillips-Perron Unit Root Test
##
## data: ratedf
## Dickey-Fuller Z(alpha) = -74.471, Truncation lag parameter = 3, p-value
## = 0.01
## alternative hypothesis: stationary#11. Modelling
acf(ratets)
pacf(ratets)
modelling<-auto.arima(ratets)
modelling## Series: ratets
## ARIMA(0,1,0)(0,1,0)[12]
##
## sigma^2 = 1.395: log likelihood = -137.88
## AIC=277.75 AICc=277.8 BIC=280.22#12. Forecating
forecasting<-forecast(auto.arima(ratets),h=21)
forecasting## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Apr 2023 140.27 138.7564 141.7836 137.9552 142.5848
## May 2023 142.26 140.1195 144.4005 138.9864 145.5336
## Jun 2023 142.14 139.5184 144.7616 138.1306 146.1494
## Jul 2023 144.08 141.0529 147.1071 139.4504 148.7096
## Aug 2023 142.11 138.7256 145.4944 136.9339 147.2861
## Sep 2023 142.65 138.9425 146.3575 136.9799 148.3201
## Oct 2023 142.57 138.5655 146.5745 136.4456 148.6944
## Nov 2023 142.74 138.4590 147.0210 136.1927 149.2873
## Dec 2023 142.05 137.5093 146.5907 135.1056 148.9944
## Jan 2024 141.36 136.5737 146.1463 134.0399 148.6801
## Feb 2024 141.91 136.8901 146.9299 134.2327 149.5873
## Mar 2024 144.66 139.4168 149.9032 136.6413 152.6787
## Apr 2024 147.64 141.5857 153.6943 138.3808 156.8992
## May 2024 149.63 142.8611 156.3989 139.2779 159.9821
## Jun 2024 149.51 142.0950 156.9250 138.1698 160.8502
## Jul 2024 151.45 143.4409 159.4591 139.2012 163.6988
## Aug 2024 149.48 140.9179 158.0421 136.3855 162.5745
## Sep 2024 150.02 140.9386 159.1014 136.1312 163.9088
## Oct 2024 149.94 140.3673 159.5127 135.2999 164.5801
## Nov 2024 150.11 140.0701 160.1499 134.7553 165.4647
## Dec 2024 149.42 138.9337 159.9063 133.3825 165.4575windows()
plot(forecasting)
Model III: WARIMA Model
Introduction
- The WARIMA model is a time series forecasting model that is used to model non-stationary time series data with time-varying volatility.
- It is a flexible model that can capture non-linear relationships in the data.
- The WARIMA model is useful when the data exhibits different trends or behaviors at different scales.
Model Formulation
- The WARIMA model can be written as: Yt = μ + φ1(Yt-1 - μ) + … + φp(Yt-p - μ) + γDαt + θ1εt-1 + … + θqεt-q
- Yt is the observed value of the time series at time t, μ is the mean value, φ1 to φp are the autoregressive coefficients, D is the wavelet transform operator, αt is the wavelet coefficients, γ is the scaling parameter, θ1 to θq are the moving average coefficients, and εt is the error term.
- The WARIMA model includes both the autoregressive and moving average components, as well as the wavelet transform operator to capture the time-varying volatility in the data.
Model Assumptions
- The assumptions of the WARIMA model include:
- Stationarity: the time series is stationary.
- Independence: the observations are independent of each other.
- Homoscedasticity: the variance of the errors is constant across all time periods.
- Normality: the errors are normally distributed.
Model fitting
- The parameters of the WARIMA model can be estimated using a method called maximum likelihood estimation (MLE).
- MLE involves finding the values of the parameters that maximize the likelihood function, which is a measure of how well the model fits the data.
Model Evaluation
- Once the WARIMA model has been fitted, it is important to evaluate its performance.
- One way to do this is to calculate the mean absolute percentage error (MAPE), which measures the accuracy of the forecasts.
- Another way to evaluate the model is to examine the residual plot to assess whether the assumptions of the model have been met.
Conclusion
- The WARIMA model is a useful model for forecasting time series data that exhibit non-stationarity and time-varying volatility.
- It is important to carefully consider the assumptions of the model and to evaluate its performance to ensure that the results are valid and reliable.
- The WARIMA model can be a useful tool for making informed decisions about forecasting and planning in various fields such as finance, economics, and weather forecasting.
Model IV: ARFIMA Model
Introduction
- The ARFIMA model is a time series forecasting model that is used to model non-stationary time series data with long term memory.
- It is a flexible model that can capture non-linear relationships in the data.
- The ARFIMA model is useful when the data exhibits long-term dependence and has a fractional difference component.
Model Formulation
- The ARFIMA model can be written as: (1-B)^d(Yt - μ) = φ1(1-B)D1(1-L)d1εt + … + φp(1-B)Dp(1-L)dpεt-p
- Yt is the observed value of the time series at time t, μ is the mean value, B is the backshift operator, d is the differencing parameter which captures the long-term dependence, φ1 to φp are the autoregressive coefficients, L is the lag operator, D1 to Dp and d1 to dp are the fractional difference parameters, and εt is the error term.
- The ARFIMA model includes both the autoregressive and moving average components, as well as the fractional difference component to capture the long-term dependence in the data.
Model Assumptions
- The assumptions of the ARFIMA model include:
- Stationarity: the time series is stationary.
- Independence: the observations are independent of each other.
- Homoscedasticity: the variance of the errors is constant across all time periods.
- Normality: the errors are normally distributed.
Model Fitting
- The parameters of the ARFIMA model can be estimated using a method called maximum likelihood estimation (MLE).
- MLE involves finding the values of the parameters that maximize the likelihood function, which is a measure of how well the model fits the data.
Model Evaluation
- Once the ARFIMA model has been fitted, it is important to evaluate its performance.
- One way to do this is to calculate the mean absolute percentage error (MAPE), which measures the accuracy of the forecasts.
- Another way to evaluate the model is to examine the residual plot to assess whether the assumptions of the model have been met.
Conclusion
- The ARFIMA model is a useful model for forecasting time series data that exhibit long-term dependence and have a fractional difference component.
- It is important to carefully consider the assumptions of the model and to evaluate its performance to ensure that the results are valid and reliable.
- The ARFIMA model can be a useful tool for making informed decisions about forecasting and planning in various fields such as finance, economics, and weather forecasting.
Model V: ETS Model
Introduction
- The ETS model is a time series forecasting model that is used to model time series data that exhibit both trend and seasonality.
- The acronym ETS stands for Error, Trend, Seasonality.
Model Formulation
- The ETS model can be written as: Yt = μt + αTt + βBt + St + εt
- Yt is the observed value of the time series at time t, μt is the level component, Tt is the trend component, Bt is the seasonal component, St is the error component, α is the smoothing parameter for the trend, β is the smoothing parameter for the seasonal component, and εt is the error term.
- The level component μt represents the long-term average of the time series.
- The trend component Tt represents the direction and rate of change of the time series.
- The seasonal component Bt captures the periodic fluctuations in the time series.
- The error component St represents the random fluctuations in the time series.
Model Assumptions
- The assumptions of the ETS model include:
- Stationarity: the time series is stationary after being transformed using the appropriate transformation.
- Independence: the observations are independent of each other.
- Homoscedasticity: the variance of the errors is constant across all time periods.
- Normality: the errors are normally distributed.
Model Fitting
- The goal of the ETS model is to find the parameters that minimize the sum of squared errors between the predicted values and the actual values.
- This is typically done using a method called maximum likelihood estimation (MLE).
- MLE involves finding the values of the parameters that maximize the likelihood function, which is a measure of how well the model fits the data.
Model Evaluation
- Once the ETS model has been fitted, it is important to evaluate its performance.
- One way to do this is to calculate the mean absolute percentage error (MAPE), which measures the accuracy of the forecasts.
- Another way to evaluate the model is to examine the residual plot to assess whether the assumptions of the model have been met.
Conclusion
- The ETS model is a powerful tool for forecasting time series data that exhibit both trend and seasonality.
- It is important to carefully consider the assumptions of the model and to evaluate its performance to ensure that the results are valid and reliable.
- The ETS model has proven to be a popular choice for forecasting time series data in many different industries and applications.
Model VI: BATS Model
Introduction
- BATS model is a time series forecasting model that was developed to handle complex time series data that exhibit both trend and seasonal components.
- The acronym stands for Box-Cox transformation, ARMA errors, Trend and Seasonal components.
- The BATS model is an extension of the well-known ARIMA model and has proven to be a popular choice for forecasting time series data.
Model Formulation
- The BATS model can be written as: Yt = μt + St + Tt + εt
- Yt is the observed value of the time series at time t, μt is the level component, St is the seasonal component, Tt is the trend component, and εt is the error term.
- The Box-Cox transformation is applied to the observed values Yt to stabilize the variance of the time series.
- The ARMA errors component is added to capture any autocorrelation in the residuals.
Model Assumptions
- The assumptions of the BATS model include:
- Stationarity: the time series is stationary after being transformed using the Box-Cox transformation.
- Independence: the observations are independent of each other.
- Homoscedasticity: the variance of the errors is constant across all time periods.
- Normality: the errors are normally distributed.
Model Fitting
- The goal of the BATS model is to find the parameters that minimize the sum of squared errors between the predicted values and the actual values.
- This is typically done using a method called maximum likelihood estimation (MLE).
- MLE involves finding the values of the parameters that maximize the likelihood function, which is a measure of how well the model fits the data.
Model Evaluation
- Once the BATS model has been fitted, it is important to evaluate its performance.
- One way to do this is to calculate the mean absolute percentage error (MAPE), which measures the accuracy of the forecasts.
- Another way to evaluate the model is to examine the residual plot to assess whether the assumptions of the model have been met.
Conclusion
- The BATS model is a powerful tool for forecasting time series data that exhibit both trend and seasonal components.
- It is important to carefully consider the assumptions of the model and to evaluate its performance to ensure that the results are valid and reliable.
- The BATS model has proven to be a popular choice for forecasting time series data in many different industries and applications.
Worked Example
Suppose we have a dataset of monthly airline passenger numbers from January 1949 to December 1960. We want to build a BATS model to forecast the passenger numbers for the next 12 months.
Solution
First, let’s load the dataset into R:
library(datasets)
passengers <- AirPassengers
head(passengers)## Jan Feb Mar Apr May Jun
## 1949 112 118 132 129 121 135Next, we can use the ts function in R to convert the data into a time series object:
passengers_ts <- ts(passengers, start = c(1949, 1), frequency = 12)After converting the data into a time series object, we can fit a BATS model using the bats function in the forecast package in R:
library(forecast)
bats_model <- bats(passengers_ts)
summary(bats_model)## Length Class Mode
## lambda 1 -none- numeric
## alpha 1 -none- numeric
## beta 0 -none- NULL
## damping.parameter 0 -none- NULL
## gamma.values 1 -none- numeric
## ar.coefficients 0 -none- NULL
## ma.coefficients 0 -none- NULL
## likelihood 1 -none- numeric
## optim.return.code 1 -none- numeric
## variance 1 -none- numeric
## AIC 1 -none- numeric
## parameters 2 -none- list
## seed.states 13 -none- numeric
## fitted.values 144 ts numeric
## errors 144 ts numeric
## x 1872 -none- numeric
## seasonal.periods 1 -none- numeric
## y 144 ts numeric
## call 2 -none- call
## series 1 -none- character
## method 1 -none- characterIn this example, we are using the bats function to fit a BATS model to the passenger data. We are using the default settings for the model, which includes a Box-Cox transformation, an ARMA error component, and separate components for the trend and seasonal components.
We can then use the forecast function to generate forecasts for the next 12 months:
forecast_values <- forecast(bats_model, h = 12)
forecast_values## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jan 1961 432.9933 412.8137 454.1581 402.5143 465.7771
## Feb 1961 424.6770 398.4422 452.6367 385.2161 468.1743
## Mar 1961 488.8715 452.8673 527.7340 434.8927 549.5403
## Apr 1961 473.6276 433.9853 516.8859 414.3596 541.3605
## May 1961 472.3200 428.6136 520.4768 407.1366 547.9237
## Jun 1961 532.3190 478.8328 591.7712 452.7273 625.8821
## Jul 1961 592.3424 528.5203 663.8601 497.5642 705.1465
## Aug 1961 586.9803 519.7778 662.8587 487.3721 706.9144
## Sep 1961 508.6374 447.1896 578.5161 417.7221 619.3087
## Oct 1961 447.8296 391.0647 512.8220 363.9852 550.9570
## Nov 1961 386.7702 335.5665 445.7753 311.2616 480.5669
## Dec 1961 432.8531 373.2485 501.9617 345.0899 542.9000The output of the forecast_values variable will show us the forecasted passenger numbers for the next 12 months, along with the upper and lower bounds of the 80% and 95% prediction intervals.
We can also visualize the results of the BATS model using the autoplot function in R:
autoplot(forecast_values)
The plot shows us how the BATS model has made forecasts that are close to the actual passenger number data. We can also see that the model has captured the trend and seasonal components of the data, as the forecasts follow the patterns of the historical data. We can use the forecasted values to make informed decisions about future airline capacity and demand.
Model VII: TBATS Model
Introduction
- The TBATS model is a time series forecasting model that was developed to handle complex time series data that exhibit both trend and seasonal components, as well as multiple seasonalities.
- The acronym stands for Trigonometric Seasonality, Box-Cox Transformation, ARMA errors, Trend, and Seasonality.
- The TBATS model is an extension of the BATS model and has proven to be a powerful tool for forecasting time series data in many different industries and applications.
Model Formulation
- The TBATS model can be written as: Yt = μt + St + Tt + Σj=1p/2 (sj1sin(2πjt/p) + sj2cos(2πjt/p)) + εt
- Yt is the observed value of the time series at time t, μt is the level component, St is the seasonal component, Tt is the trend component, sj1 and sj2 are the coefficients for the seasonal components, and εt is the error term.
- The Trigonometric Seasonality component captures multiple seasonalities in the data by adding sine and cosine functions with frequencies j/p for p seasonal periods.
- The Box-Cox transformation is applied to the observed values Yt to stabilize the variance of the time series.
- The ARMA errors component is added to capture any autocorrelation in the residuals.
Model Assumptions
- The assumptions of the TBATS model include:
- Stationarity: the time series is stationary after being transformed using the Box-Cox transformation.
- Independence: the observations are independent of each other.
- Homoscedasticity: the variance of the errors is constant across all time periods.
- Normality: the errors are normally distributed.
Model Fitting
- The goal of the TBATS model is to find the parameters that minimize the sum of squared errors between the predicted values and the actual values.
- This is typically done using a method called maximum likelihood estimation (MLE).
- MLE involves finding the values of the parameters that maximize the likelihood function, which is a measure of how well the model fits the data.
Model Evaluation
- Once the TBATS model has been fitted, it is important to evaluate its performance.
- One way to do this is to calculate the mean absolute percentage error (MAPE), which measures the accuracy of the forecasts.
- Another way to evaluate the model is to examine the residual plot to assess whether the assumptions of the model have been met.
Conclusion
- The TBATS model is a powerful tool for forecasting time series data that exhibit both trend and seasonal components, as well as multiple seasonalities.
- It is important to carefully consider the assumptions of the model and to evaluate its performance to ensure that the results are valid and reliable.
- The TBATS model has proven to be a popular choice for forecasting time series data in many different industries and applications.
Worked Example
Suppose we have a dataset of Average hourly wages in the apparel industry, from 07/1981 - 06/1987 available in the TSA package in R. We want to build a TBATS model to forecast the hourly wages in the apparel industry for the next 24 hours.
Solution
First, let’s load the dataset into R:
library(TSA)## Warning: package 'TSA' was built under R version 4.1.3## Registered S3 methods overwritten by 'TSA':
## method from
## fitted.Arima forecast
## plot.Arima forecast##
## Attaching package: 'TSA'## The following objects are masked from 'package:stats':
##
## acf, arima## The following object is masked from 'package:utils':
##
## tardata("wages")
wages<-wages
head(wages)## Jul Aug Sep Oct Nov Dec
## 1981 7.75 7.74 7.87 7.89 7.94 8.00Next, we can use the ts function in R to convert the data into a time series object:
wages_ts <- ts(wages, start = c(1981, 7), frequency = 24)After converting the data into a time series object, we can fit a TBATS model using the tbats function in the forecast package in R:
library(forecast)
tbats_model <- tbats(wages_ts)
summary(tbats_model)## Length Class Mode
## lambda 0 -none- NULL
## alpha 1 -none- numeric
## beta 1 -none- numeric
## damping.parameter 1 -none- numeric
## gamma.one.values 1 -none- numeric
## gamma.two.values 1 -none- numeric
## ar.coefficients 0 -none- NULL
## ma.coefficients 0 -none- NULL
## likelihood 1 -none- numeric
## optim.return.code 1 -none- numeric
## variance 1 -none- numeric
## AIC 1 -none- numeric
## parameters 2 -none- list
## seed.states 10 -none- numeric
## fitted.values 72 ts numeric
## errors 72 ts numeric
## x 720 -none- numeric
## seasonal.periods 1 -none- numeric
## k.vector 1 -none- numeric
## y 72 ts numeric
## p 1 -none- numeric
## q 1 -none- numeric
## call 2 -none- call
## series 1 -none- character
## method 1 -none- characterIn this example, we are using the tbats function to fit a TBATS model to the average hourly wages data. We are using the default settings for the model, which includes a Box-Cox transformation, an ARMA error component, and separate components for the trend and seasonal components. We are also including the Trigonometric Seasonality component to capture multiple seasonalities in the data.
We can then use the forecast function to generate forecasts for the next 24 hours:
forecast_values <- forecast(tbats_model, h = 24)
forecast_values## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 1984.250 9.424643 9.386692 9.462594 9.366602 9.482684
## 1984.292 9.398934 9.360456 9.437412 9.340087 9.457781
## 1984.333 9.396138 9.357110 9.435165 9.336450 9.455825
## 1984.375 9.427672 9.388091 9.467252 9.367139 9.488205
## 1984.417 9.481389 9.441259 9.521519 9.420016 9.542762
## 1984.458 9.529721 9.489048 9.570393 9.467518 9.591924
## 1984.500 9.551349 9.510166 9.592533 9.488364 9.614335
## 1984.542 9.546921 9.505301 9.588542 9.483268 9.610574
## 1984.583 9.534895 9.492938 9.576851 9.470727 9.599062
## 1984.625 9.532452 9.490237 9.574666 9.467890 9.597013
## 1984.667 9.540195 9.497752 9.582638 9.475285 9.605105
## 1984.708 9.544830 9.502143 9.587517 9.479545 9.610114
## 1984.750 9.535948 9.492991 9.578904 9.470252 9.601644
## 1984.792 9.519330 9.476119 9.562541 9.453245 9.585415
## 1984.833 9.513185 9.469782 9.556588 9.446805 9.579565
## 1984.875 9.531093 9.487561 9.574624 9.464517 9.597668
## 1984.917 9.568665 9.525035 9.612296 9.501938 9.635392
## 1984.958 9.607011 9.563271 9.650751 9.540116 9.673905
## 1985.000 9.629233 9.585352 9.673113 9.562123 9.696342
## 1985.042 9.633512 9.589479 9.677545 9.566170 9.700854
## 1985.083 9.630413 9.586266 9.674560 9.562896 9.697930
## 1985.125 9.628484 9.584280 9.672687 9.560881 9.696087
## 1985.167 9.624120 9.579896 9.668343 9.556486 9.691753
## 1985.208 9.606863 9.562630 9.651096 9.539215 9.674511The forecast_values variable will show us the forecasted average hourly wages for the next 24 hours, along with the upper and lower bounds of the 80% and 95% prediction intervals.
We can also visualize the results of the TBATS model using the autoplot function in R:
autoplot(forecast_values)
The plot shows us how the TBATS model has made forecasts that are close to the actual average hourly wages data. We can also see that the model has captured the trend and multiple seasonal components of the data, as the forecasts follow the patterns of the historical data. We can use the forecasted values to make informed decisions about future hourly wages.
Model VIII: Theta Model
Introduction
- The Theta model is a time series forecasting model that is used to model time series data that exhibit no trend or seasonality.
- It is a simple model that is easy to implement and interpret.
- The Theta model is also known as the random walk model or the naïve model.
Model Formulation
- The Theta model can be written as: Yt+1 = Yt + θεt
- Yt is the observed value of the time series at time t, Yt+1 is the forecasted value at time t+1, εt is the error term, and θ is the parameter that estimates the average change in the time series.
- The Theta model assumes that the expected change in the time series is equal to the average change in the time series over time.
Model Assumptions
- The assumptions of the Theta model include:
- Stationarity: the time series is stationary.
- Independence: the observations are independent of each other.
- Homoscedasticity: the variance of the errors is constant across all time periods.
- Normality: the errors are normally distributed.
Model Fitting
- The parameter θ can be estimated using the following formula: θ = (Yt - Yt-1) / εt-1
- This formula estimates the average change in the time series based on the difference between the current and previous observations, divided by the previous error term.
- The parameter θ can also be estimated using a method called maximum likelihood estimation (MLE).
Model Evaluation
- Once the Theta model has been fitted, it is important to evaluate its performance.
- One way to do this is to calculate the mean absolute percentage error (MAPE), which measures the accuracy of the forecasts.
- Another way to evaluate the model is to examine the residual plot to assess whether the assumptions of the model have been met.
Conclusion
- The Theta model is a simple and basic model for forecasting time series data that exhibit no trend or seasonality.
- It is important to carefully consider the assumptions of the model and to evaluate its performance to ensure that the results are valid and reliable.
- The Theta model can be a useful starting point for time series forecasting, but more complex models may be necessary for more accurate forecasting in practical applications.
Model IX: SETAR Model
Introduction
- The SETAR model is a time series forecasting model that is used to model non-linear relationships in time series data.
- It is a flexible model that can capture changes in the data that are not linear.
- The SETAR model is useful when the data exhibits different trends or behaviors in different regions of the data.
Model Formulation
- The SETAR model can be written as: Yt = f1(Yt-1, Yt-2, …, Yt-p) + εt, if Yt-1 <= c Yt = f2(Yt-1, Yt-2, …, Yt-p) + εt, if Yt-1 > c
- Yt is the observed value of the time series at time t, Yt-1 is the lagged value of the time series at time t-1, εt is the error term, c is the threshold value, and f1 and f2 are the regression functions for the two regions of the data.
- The SETAR model assumes that there are two linear regions in the data, each with its own regression function.
Model Assumptions
- The assumptions of the SETAR model include:
- Stationarity: the time series is stationary.
- Independence: the observations are independent of each other.
- Homoscedasticity: the variance of the errors is constant across all time periods.
- Normality: the errors are normally distributed.
Model Fitting
- The parameters of the SETAR model can be estimated using a method called maximum likelihood estimation (MLE).
- MLE involves finding the values of the parameters that maximize the likelihood function, which is a measure of how well the model fits the data.
Model Evaluation
- Once the SETAR model has been fitted, it is important to evaluate its performance.
- One way to do this is to calculate the mean absolute percentage error (MAPE), which measures the accuracy of the forecasts.
- Another way to evaluate the model is to examine the residual plot to assess whether the assumptions of the model have been met.
Conclusion
- The SETAR model is a useful model for forecasting time series data that exhibit non-linear relationships.
- It is important to carefully consider the assumptions of the model and to evaluate its performance to ensure that the results are valid and reliable.
- The SETAR model can be a useful tool for identifying different regions in the data and for making informed decisions about forecasting and planning.
Model X: ARIMAX Model
Model XI: TAR Model
Model XII: ARCH Model
Model XIII: GARCH Model
Module XIV: ANN Model
Model XV: ARNN Model
Model XVI: Research Paper
Suppose we have a time series data for the monthly sales of a retail store over a 13-year period. We want to estimate an ARMA model for this data and use it to make forecasts for the next year. The data is stored in a CSV file called “sales.csv” and has two columns: “month” and “sales”. We want to build a time series forecasting model to forecast the stock price for the next 30 days. We are interested in comparing the performance of different models, including SARIMA, BATS, TBATS, ETS, SETAR, Theta, ARFIMA, and WARIMA.
Solution
Data Loading
First, let’s load the dataset into R:
library(tseries)
sales<-read.csv("~/sales.csv")
head(sales)## Month.Year sales
## 1 01/01/2008 200.1
## 2 01/02/2008 199.5
## 3 01/03/2008 199.4
## 4 01/04/2008 198.9
## 5 01/05/2008 199.0
## 6 01/06/2008 200.2Data Partition
Next, we can split the data into a training set and a test set:
salests<-ts(sales$sales,frequency = 12,start=c(2008,1))
library(TSstudio)
splitdata<-ts_split(salests,sample.out = 24)
train_data <- splitdata$train
test_data <- splitdata$testModelling and Forecasting
We can then use the forecast package in R to fit different models and generate forecasts:
library(forecast)# SARIMA model
sarima_model <- auto.arima(train_data)
sarima_forecast <- forecast(sarima_model, h = 24)# BATS model
bats_model <- bats(train_data)
bats_forecast <- forecast(bats_model, h = 24)# TBATS model
tbats_model <- tbats(train_data)
tbats_forecast <- forecast(tbats_model, h = 24)# ETS model
ets_model <- ets(train_data)
ets_forecast <- forecast(ets_model, h = 24)# SETAR model
library(tsDyn)## Warning: package 'tsDyn' was built under R version 4.1.3setar_model <- setar(train_data, m=2)
setar_forecast <- predict(setar_model, n.ahead = 24)# Theta model
library(tsutils)## Warning: package 'tsutils' was built under R version 4.1.3theta_model <- theta(train_data)
theta_forecast <- predict(theta_model, h = 24)# ARFIMA model
library(forecast)
arfima_model <- arfima(train_data)
predARFIMA <-forecast(arfima_model,h=24)
arfima_forecast <- predARFIMA$mean# WARIMA model
library(WaveletArima)## Warning: package 'WaveletArima' was built under R version 4.1.3warima_model <- WaveletFittingarma(train_data,Waveletlevels = floor(log(length(train_data))), FastFlag =TRUE,MaxARParam = 5,MaxMAParam = 5, NForecast = 24)
warima_forecast <- warima_model$FinalforecastIn this example, we are using different functions from the forecast package to fit different models and generate forecasts. For example, auto.arima is used to fit a SARIMA model, bats is used to fit a BATS model, tbats is used to fit a TBATS model, ets is used to fit an ETS model, setar is used to fit a SETAR model, theta is used to fit a Theta model, arfima is used to fit an ARFIMA model, and warima is used to fit a WARIMA model.
Model Performance
We can then evaluate the performance of the models using various metrics, such as mean absolute percentage error (MAPE), mean squared error (MSE), and root mean squared error (RMSE):
# SARIMA model evaluation
sarima_mape <- accuracy(sarima_forecast, test_data)[2]
sarima_mse <- accuracy(sarima_forecast, test_data)[3]
sarima_rmse <- accuracy(sarima_forecast, test_data)[4]# BATS model evaluation
bats_mape <- accuracy(bats_forecast, test_data)[2]
bats_mse <- accuracy(bats_forecast, test_data)[3]
bats_rmse <- accuracy(bats_forecast, test_data)[4]# TBATS model evaluation
tbats_mape <- accuracy(tbats_forecast, test_data)[2]
tbats_mse <- accuracy(tbats_forecast, test_data)[3]
tbats_rmse <- accuracy(tbats_forecast, test_data)[4]# ETS model evaluation
ets_mape <- accuracy(ets_forecast, test_data)[2]
ets_mse <- accuracy(ets_forecast, test_data)[3]
ets_rmse <- accuracy(ets_forecast, test_data)[4]# SETAR model evaluation
setar_mape <- accuracy(setar_forecast, test_data)[2]
setar_mse <- accuracy(setar_forecast, test_data)[3]
setar_rmse <- accuracy(setar_forecast, test_data)[4]# Theta model evaluation
theta_mape <- accuracy(theta_forecast, test_data)[2]
theta_mse <- accuracy(theta_forecast, test_data)[3]
theta_rmse <- accuracy(theta_forecast, test_data)[4]# ARFIMA model evaluation
arfima_mape <- accuracy(arfima_forecast, test_data)[2]
arfima_mse <- accuracy(arfima_forecast, test_data)[3]
arfima_rmse <- accuracy(arfima_forecast, test_data)[4]# WARIMA model evaluation
warima_mape <- accuracy(warima_forecast, test_data[1:24])[2]
warima_mse <- accuracy(warima_forecast, test_data[1:24])[3]
warima_rmse <- accuracy(warima_forecast, test_data[1:24])[4]In this example, we are using the accuracy function to calculate the MAPE, MSE, and RMSE for each model’s forecast.
Model Comparison
We can then compare the performance of the different models based on these metrics:
results <- data.frame(Model = c("SARIMA", "BATS", "TBATS", "ETS", "SETAR", "Theta", "ARFIMA", "WARIMA"),
MAPE = c(sarima_mape, bats_mape, tbats_mape, ets_mape, setar_mape, theta_mape, arfima_mape, warima_mape),
MSE = c(sarima_mse, bats_mse, tbats_mse, ets_mse, setar_mse, theta_mse, arfima_mse, warima_mse),
RMSE = c(sarima_rmse, bats_rmse, tbats_rmse, ets_rmse, setar_rmse, theta_rmse, arfima_rmse, warima_rmse))
results## Model MAPE MSE RMSE
## 1 SARIMA 4.836369 1.392133 5.6267768
## 2 BATS 4.823426 1.431900 5.6837280
## 3 TBATS 4.823426 1.431900 5.6837280
## 4 ETS 4.898058 1.398364 5.7589725
## 5 SETAR 2.895693 1.879681 0.6967836
## 6 Theta -1.112072 1.544686 1.8299309
## 7 ARFIMA 4.446078 3.673583 1.4100138
## 8 WARIMA 6.046004 5.300114 -2.0429898In this example, we are creating a data frame that shows the MAPE, MSE, and RMSE for each model’s forecast. We can then use this data frame to compare the performance of the different models.
Based on the results, we can conclude that the Theta model has the lowest MAPE and RMSE and is therefore the best model for forecasting stock prices in this example. However, it is important to note that the performance of the models may vary depending on the data and the forecasting horizon, and that careful analysis and evaluation of the models is necessary before making any decisions based on the forecasts.
methods <- list(ets1 = list(method = "ets",
method_arg = list(opt.crit = "lik"),
notes = "ETS model with opt.crit = lik"),
ets2 = list(method = "ets",
method_arg = list(opt.crit = "amse"),
notes = "ETS model with opt.crit = amse"),
arima1 = list(method = "arima",
method_arg = list(order = c(2,1,0)),
notes = "ARIMA(2,1,0)"),
arima2 = list(method = "arima",
method_arg = list(order = c(2,1,2),
seasonal = list(order = c(1,1,1))),
notes = "SARIMA(2,1,2)(1,1,1)"),
hw = list(method = "HoltWinters",
method_arg = NULL,
notes = "HoltWinters Model"),
tslm = list(method = "tslm",
method_arg = list(formula = input ~ trend + season),
notes = "tslm model with trend and seasonal components"))
train_method = list(partitions = 6,
sample.out = 12,
space = 3)
md<- train_model(input = train_data,
methods = methods,
train_method = train_method,
horizon = 12,
error = "MAPE")## # A tibble: 6 x 7
## model_id model notes avg_mape avg_rmse `avg_coverage_80%` `avg_coverage_95%`
## <chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 ets1 ets ETS ~ 0.0109 3.27 0.944 0.972
## 2 ets2 ets ETS ~ 0.0115 3.42 0.861 0.972
## 3 arima1 arima ARIM~ 0.0126 3.80 0.944 0.972
## 4 arima2 arima SARI~ 0.0126 3.74 0.875 0.958
## 5 hw HoltWi~ Holt~ 0.0227 6.53 0.708 0.931
## 6 tslm tslm tslm~ 0.0670 17.2 0.0972 0.889md## $train
## $train$partition_1
## $train$partition_1$ets1
## $train$partition_1$ets1$model
## ETS(M,Ad,N)
##
## Call:
## (function (y, model = "ZZZ", damped = NULL, alpha = NULL, beta = NULL,
##
## Call:
## gamma = NULL, phi = NULL, additive.only = FALSE, lambda = NULL,
##
## Call:
## biasadj = FALSE, lower = c(rep(1e-04, 3), 0.8), upper = c(rep(0.9999,
##
## Call:
## 3), 0.98), opt.crit = c("lik", "amse", "mse", "sigma",
##
## Call:
## "mae"), nmse = 3, bounds = c("both", "usual", "admissible"),
##
## Call:
## ic = c("aicc", "aic", "bic"), restrict = TRUE, allow.multiplicative.trend = FALSE,
##
## Call:
## use.initial.values = FALSE, na.action = c("na.contiguous",
##
## Call:
## "na.interp", "na.fail"), ...)
##
## Call:
## {
##
## Call:
## opt.crit <- match.arg(opt.crit)
##
## Call:
## bounds <- match.arg(bounds)
##
## Call:
## ic <- match.arg(ic)
##
## Call:
## if (!is.function(na.action)) {
##
## Call:
## na.fn_name <- match.arg(na.action)
##
## Call:
## na.action <- get(na.fn_name)
##
## Call:
## }
##
## Call:
## seriesname <- deparse(substitute(y))
##
## Call:
## if (any(class(y) %in% c("data.frame", "list", "matrix", "mts"))) {
##
## Call:
## stop("y should be a univariate time series")
##
## Call:
## }
##
## Call:
## y <- as.ts(y)
##
## Call:
## if (missing(model) && is.constant(y)) {
##
## Call:
## return(ses(y, alpha = 0.99999, initial = "simple")$model)
##
## Call:
## }
##
## Call:
## ny <- length(y)
##
## Call:
## y <- na.action(y)
##
## Call:
## if (ny != length(y) && na.fn_name == "na.contiguous") {
##
## Call:
## warning("Missing values encountered. Using longest contiguous portion of time series")
##
## Call:
## ny <- length(y)
##
## Call:
## }
##
## Call:
## orig.y <- y
##
## Call:
## if (identical(class(model), "ets") && is.null(lambda)) {
##
## Call:
## lambda <- model$lambda
##
## Call:
## }
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## y <- BoxCox(y, lambda)
##
## Call:
## lambda <- attr(y, "lambda")
##
## Call:
## additive.only <- TRUE
##
## Call:
## }
##
## Call:
## if (nmse < 1 || nmse > 30) {
##
## Call:
## stop("nmse out of range")
##
## Call:
## }
##
## Call:
## m <- frequency(y)
##
## Call:
## if (any(upper < lower)) {
##
## Call:
## stop("Lower limits must be less than upper limits")
##
## Call:
## }
##
## Call:
## if (class(model) == "ets") {
##
## Call:
## alpha <- max(model$par["alpha"], 1e-10)
##
## Call:
## beta <- model$par["beta"]
##
## Call:
## if (is.na(beta)) {
##
## Call:
## beta <- NULL
##
## Call:
## }
##
## Call:
## gamma <- model$par["gamma"]
##
## Call:
## if (is.na(gamma)) {
##
## Call:
## gamma <- NULL
##
## Call:
## }
##
## Call:
## phi <- model$par["phi"]
##
## Call:
## if (is.na(phi)) {
##
## Call:
## phi <- NULL
##
## Call:
## }
##
## Call:
## modelcomponents <- paste(model$components[1], model$components[2],
##
## Call:
## model$components[3], sep = "")
##
## Call:
## damped <- (model$components[4] == "TRUE")
##
## Call:
## if (use.initial.values) {
##
## Call:
## errortype <- substr(modelcomponents, 1, 1)
##
## Call:
## trendtype <- substr(modelcomponents, 2, 2)
##
## Call:
## seasontype <- substr(modelcomponents, 3, 3)
##
## Call:
## e <- pegelsresid.C(y, m, model$initstate, errortype,
##
## Call:
## trendtype, seasontype, damped, alpha, beta, gamma,
##
## Call:
## phi, nmse)
##
## Call:
## np <- length(model$par) + 1
##
## Call:
## model$loglik <- -0.5 * e$lik
##
## Call:
## model$aic <- e$lik + 2 * np
##
## Call:
## model$bic <- e$lik + log(ny) * np
##
## Call:
## model$aicc <- model$aic + 2 * np * (np + 1)/(ny -
##
## Call:
## np - 1)
##
## Call:
## model$mse <- e$amse[1]
##
## Call:
## model$amse <- mean(e$amse)
##
## Call:
## tsp.y <- tsp(y)
##
## Call:
## model$states <- ts(e$states, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1] - 1/tsp.y[3])
##
## Call:
## colnames(model$states)[1] <- "l"
##
## Call:
## if (trendtype != "N") {
##
## Call:
## colnames(model$states)[2] <- "b"
##
## Call:
## }
##
## Call:
## if (seasontype != "N") {
##
## Call:
## colnames(model$states)[(2 + (trendtype != "N")):ncol(model$states)] <- paste("s",
##
## Call:
## 1:m, sep = "")
##
## Call:
## }
##
## Call:
## if (errortype == "A") {
##
## Call:
## model$fitted <- ts(y - e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model$fitted <- ts(y/(1 + e$e), frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## model$residuals <- ts(e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## model$series <- seriesname
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda,
##
## Call:
## biasadj, var(model$residuals))
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(model)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model <- modelcomponents
##
## Call:
## if (missing(use.initial.values)) {
##
## Call:
## message("Model is being refit with current smoothing parameters but initial states are being re-estimated.\nSet 'use.initial.values=TRUE' if you want to re-use existing initial values.")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## errortype <- substr(model, 1, 1)
##
## Call:
## trendtype <- substr(model, 2, 2)
##
## Call:
## seasontype <- substr(model, 3, 3)
##
## Call:
## if (!is.element(errortype, c("M", "A", "Z"))) {
##
## Call:
## stop("Invalid error type")
##
## Call:
## }
##
## Call:
## if (!is.element(trendtype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid trend type")
##
## Call:
## }
##
## Call:
## if (!is.element(seasontype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid season type")
##
## Call:
## }
##
## Call:
## if (m < 1 || length(y) <= m) {
##
## Call:
## seasontype <- "N"
##
## Call:
## }
##
## Call:
## if (m == 1) {
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## stop("Nonseasonal data")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (m > 24) {
##
## Call:
## if (is.element(seasontype, c("A", "M"))) {
##
## Call:
## stop("Frequency too high")
##
## Call:
## }
##
## Call:
## else if (seasontype == "Z") {
##
## Call:
## warning("I can't handle data with frequency greater than 24. Seasonality will be ignored. Try stlf() if you need seasonal forecasts.")
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if ((errortype == "A" && (trendtype == "M" || seasontype ==
##
## Call:
## "M")) | (errortype == "M" && trendtype == "M" &&
##
## Call:
## seasontype == "A") || (additive.only && (errortype ==
##
## Call:
## "M" || trendtype == "M" || seasontype == "M"))) {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## data.positive <- (min(y) > 0)
##
## Call:
## if (!data.positive && errortype == "M") {
##
## Call:
## stop("Inappropriate model for data with negative or zero values")
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped && trendtype == "N") {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## n <- length(y)
##
## Call:
## npars <- 2L
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## npars <- npars + 2L
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## npars <- npars + m
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## npars <- npars + as.numeric(damped)
##
## Call:
## }
##
## Call:
## if (n <= npars + 4L) {
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped) {
##
## Call:
## warning("Not enough data to use damping")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = gamma, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), seasonal = ifelse(seasontype != "A",
##
## Call:
## "multiplicative", "additive"), lambda = lambda,
##
## Call:
## biasadj = biasadj, warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Seasonal component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Trend component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "N" && seasontype == "N") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, lambda = lambda, biasadj = biasadj,
##
## Call:
## warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## }
##
## Call:
## fit1 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## fit2 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if ("try-error" %in% class(fit1)) {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## else if (fit1$sigma2 < fit2$sigma2) {
##
## Call:
## fit <- fit1
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## if ("try-error" %in% class(fit))
##
## Call:
## stop("Unable to estimate a model.")
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## if (errortype == "Z") {
##
## Call:
## errortype <- c("A", "M")
##
## Call:
## }
##
## Call:
## if (trendtype == "Z") {
##
## Call:
## if (allow.multiplicative.trend) {
##
## Call:
## trendtype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## trendtype <- c("N", "A")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "Z") {
##
## Call:
## seasontype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## if (is.null(damped)) {
##
## Call:
## damped <- c(TRUE, FALSE)
##
## Call:
## }
##
## Call:
## best.ic <- Inf
##
## Call:
## for (i in 1:length(errortype)) {
##
## Call:
## for (j in 1:length(trendtype)) {
##
## Call:
## for (k in 1:length(seasontype)) {
##
## Call:
## for (l in 1:length(damped)) {
##
## Call:
## if (trendtype[j] == "N" && damped[l]) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if (errortype[i] == "A" && (trendtype[j] ==
##
## Call:
## "M" || seasontype[k] == "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (errortype[i] == "M" && trendtype[j] ==
##
## Call:
## "M" && seasontype[k] == "A") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (additive.only && (errortype[i] == "M" ||
##
## Call:
## trendtype[j] == "M" || seasontype[k] ==
##
## Call:
## "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (!data.positive && errortype[i] == "M") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## fit <- try(etsmodel(y, errortype[i], trendtype[j],
##
## Call:
## seasontype[k], damped[l], alpha, beta, gamma,
##
## Call:
## phi, lower = lower, upper = upper, opt.crit = opt.crit,
##
## Call:
## nmse = nmse, bounds = bounds, ...), silent = TRUE)
##
## Call:
## if (is.element("try-error", class(fit)))
##
## Call:
## fit.ic <- Inf
##
## Call:
## else fit.ic <- switch(ic, aic = fit$aic, bic = fit$bic,
##
## Call:
## aicc = fit$aicc)
##
## Call:
## if (!is.na(fit.ic)) {
##
## Call:
## if (fit.ic < best.ic) {
##
## Call:
## model <- fit
##
## Call:
## best.ic <- fit.ic
##
## Call:
## best.e <- errortype[i]
##
## Call:
## best.t <- trendtype[j]
##
## Call:
## best.s <- seasontype[k]
##
## Call:
## best.d <- damped[l]
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (best.ic == Inf) {
##
## Call:
## stop("No model able to be fitted")
##
## Call:
## }
##
## Call:
## model$m <- m
##
## Call:
## model$method <- paste("ETS(", best.e, ",", best.t, ifelse(best.d,
##
## Call:
## "d", ""), ",", best.s, ")", sep = "")
##
## Call:
## model$series <- seriesname
##
## Call:
## model$components <- c(best.e, best.t, best.s, best.d)
##
## Call:
## model$call <- match.call()
##
## Call:
## model$initstate <- model$states[1, ]
##
## Call:
## np <- length(model$par)
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda, biasadj,
##
## Call:
## model$sigma2)
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(structure(model, class = "ets"))
##
## Call:
## })(y = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6,
##
## Call:
## 200, 200.3, 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1,
##
## Call:
## 210.5, 210.5, 209.8, 208.8, 209.5, 213.2, 213.7, 215.1, 218.7,
##
## Call:
## 219.8, 220.5, 223.8, 222.8, 223.8, 221.7, 222.3, 220.8, 219.4,
##
## Call:
## 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7,
##
## Call:
## 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7,
##
## Call:
## 217, 215.9, 215.8, 214.1, 212.3, 213.9, 214.6, 213.6, 212.1,
##
## Call:
## 211.4, 213.1, 212.9, 213.3, 211.5, 212.3, 213, 211, 210.7, 210.1,
##
## Call:
## 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6, 211.9, 212.8,
##
## Call:
## 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4,
##
## Call:
## 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7,
##
## Call:
## 247.6), .Tsp = c(2008, 2016.16666666667, 12), class = "ts"),
##
## Call:
## opt.crit = "lik")
##
## Smoothing parameters:
## alpha = 0.9679
## beta = 0.3025
## phi = 0.892
##
## Initial states:
## l = 200.4285
## b = -0.3917
##
## sigma: 0.0068
##
## AIC AICc BIC
## 537.1874 538.1004 552.7581
##
## $train$partition_1$ets1$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Apr 2016 248.1715 246.0142 250.3288 244.8722 251.4709
## May 2016 248.6530 245.2176 252.0883 243.3991 253.9068
## Jun 2016 249.0824 244.3902 253.7746 241.9063 256.2585
## Jul 2016 249.4655 243.5126 255.4183 240.3614 258.5695
## Aug 2016 249.8071 242.5899 257.0243 238.7694 260.8448
## Sep 2016 250.1119 241.6311 258.5927 237.1416 263.0821
## Oct 2016 250.3837 240.6450 260.1224 235.4896 265.2778
## Nov 2016 250.6262 239.6395 261.6128 233.8236 267.4288
## Dec 2016 250.8424 238.6214 263.0635 232.1520 269.5329
## Jan 2017 251.0353 237.5961 264.4745 230.4818 271.5888
## Feb 2017 251.2074 236.5683 265.8465 228.8188 273.5960
## Mar 2017 251.3609 235.5417 267.1801 227.1675 275.5542
##
## $train$partition_1$ets1$parameters
## $train$partition_1$ets1$parameters$type
## [1] "train"
##
## $train$partition_1$ets1$parameters$model_id
## [1] "ets1"
##
## $train$partition_1$ets1$parameters$method
## [1] "ets"
##
## $train$partition_1$ets1$parameters$horizon
## [1] 12
##
## $train$partition_1$ets1$parameters$partition
## [1] "partition_1"
##
##
##
## $train$partition_1$ets2
## $train$partition_1$ets2$model
## ETS(M,Ad,N)
##
## Call:
## (function (y, model = "ZZZ", damped = NULL, alpha = NULL, beta = NULL,
##
## Call:
## gamma = NULL, phi = NULL, additive.only = FALSE, lambda = NULL,
##
## Call:
## biasadj = FALSE, lower = c(rep(1e-04, 3), 0.8), upper = c(rep(0.9999,
##
## Call:
## 3), 0.98), opt.crit = c("lik", "amse", "mse", "sigma",
##
## Call:
## "mae"), nmse = 3, bounds = c("both", "usual", "admissible"),
##
## Call:
## ic = c("aicc", "aic", "bic"), restrict = TRUE, allow.multiplicative.trend = FALSE,
##
## Call:
## use.initial.values = FALSE, na.action = c("na.contiguous",
##
## Call:
## "na.interp", "na.fail"), ...)
##
## Call:
## {
##
## Call:
## opt.crit <- match.arg(opt.crit)
##
## Call:
## bounds <- match.arg(bounds)
##
## Call:
## ic <- match.arg(ic)
##
## Call:
## if (!is.function(na.action)) {
##
## Call:
## na.fn_name <- match.arg(na.action)
##
## Call:
## na.action <- get(na.fn_name)
##
## Call:
## }
##
## Call:
## seriesname <- deparse(substitute(y))
##
## Call:
## if (any(class(y) %in% c("data.frame", "list", "matrix", "mts"))) {
##
## Call:
## stop("y should be a univariate time series")
##
## Call:
## }
##
## Call:
## y <- as.ts(y)
##
## Call:
## if (missing(model) && is.constant(y)) {
##
## Call:
## return(ses(y, alpha = 0.99999, initial = "simple")$model)
##
## Call:
## }
##
## Call:
## ny <- length(y)
##
## Call:
## y <- na.action(y)
##
## Call:
## if (ny != length(y) && na.fn_name == "na.contiguous") {
##
## Call:
## warning("Missing values encountered. Using longest contiguous portion of time series")
##
## Call:
## ny <- length(y)
##
## Call:
## }
##
## Call:
## orig.y <- y
##
## Call:
## if (identical(class(model), "ets") && is.null(lambda)) {
##
## Call:
## lambda <- model$lambda
##
## Call:
## }
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## y <- BoxCox(y, lambda)
##
## Call:
## lambda <- attr(y, "lambda")
##
## Call:
## additive.only <- TRUE
##
## Call:
## }
##
## Call:
## if (nmse < 1 || nmse > 30) {
##
## Call:
## stop("nmse out of range")
##
## Call:
## }
##
## Call:
## m <- frequency(y)
##
## Call:
## if (any(upper < lower)) {
##
## Call:
## stop("Lower limits must be less than upper limits")
##
## Call:
## }
##
## Call:
## if (class(model) == "ets") {
##
## Call:
## alpha <- max(model$par["alpha"], 1e-10)
##
## Call:
## beta <- model$par["beta"]
##
## Call:
## if (is.na(beta)) {
##
## Call:
## beta <- NULL
##
## Call:
## }
##
## Call:
## gamma <- model$par["gamma"]
##
## Call:
## if (is.na(gamma)) {
##
## Call:
## gamma <- NULL
##
## Call:
## }
##
## Call:
## phi <- model$par["phi"]
##
## Call:
## if (is.na(phi)) {
##
## Call:
## phi <- NULL
##
## Call:
## }
##
## Call:
## modelcomponents <- paste(model$components[1], model$components[2],
##
## Call:
## model$components[3], sep = "")
##
## Call:
## damped <- (model$components[4] == "TRUE")
##
## Call:
## if (use.initial.values) {
##
## Call:
## errortype <- substr(modelcomponents, 1, 1)
##
## Call:
## trendtype <- substr(modelcomponents, 2, 2)
##
## Call:
## seasontype <- substr(modelcomponents, 3, 3)
##
## Call:
## e <- pegelsresid.C(y, m, model$initstate, errortype,
##
## Call:
## trendtype, seasontype, damped, alpha, beta, gamma,
##
## Call:
## phi, nmse)
##
## Call:
## np <- length(model$par) + 1
##
## Call:
## model$loglik <- -0.5 * e$lik
##
## Call:
## model$aic <- e$lik + 2 * np
##
## Call:
## model$bic <- e$lik + log(ny) * np
##
## Call:
## model$aicc <- model$aic + 2 * np * (np + 1)/(ny -
##
## Call:
## np - 1)
##
## Call:
## model$mse <- e$amse[1]
##
## Call:
## model$amse <- mean(e$amse)
##
## Call:
## tsp.y <- tsp(y)
##
## Call:
## model$states <- ts(e$states, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1] - 1/tsp.y[3])
##
## Call:
## colnames(model$states)[1] <- "l"
##
## Call:
## if (trendtype != "N") {
##
## Call:
## colnames(model$states)[2] <- "b"
##
## Call:
## }
##
## Call:
## if (seasontype != "N") {
##
## Call:
## colnames(model$states)[(2 + (trendtype != "N")):ncol(model$states)] <- paste("s",
##
## Call:
## 1:m, sep = "")
##
## Call:
## }
##
## Call:
## if (errortype == "A") {
##
## Call:
## model$fitted <- ts(y - e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model$fitted <- ts(y/(1 + e$e), frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## model$residuals <- ts(e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## model$series <- seriesname
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda,
##
## Call:
## biasadj, var(model$residuals))
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(model)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model <- modelcomponents
##
## Call:
## if (missing(use.initial.values)) {
##
## Call:
## message("Model is being refit with current smoothing parameters but initial states are being re-estimated.\nSet 'use.initial.values=TRUE' if you want to re-use existing initial values.")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## errortype <- substr(model, 1, 1)
##
## Call:
## trendtype <- substr(model, 2, 2)
##
## Call:
## seasontype <- substr(model, 3, 3)
##
## Call:
## if (!is.element(errortype, c("M", "A", "Z"))) {
##
## Call:
## stop("Invalid error type")
##
## Call:
## }
##
## Call:
## if (!is.element(trendtype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid trend type")
##
## Call:
## }
##
## Call:
## if (!is.element(seasontype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid season type")
##
## Call:
## }
##
## Call:
## if (m < 1 || length(y) <= m) {
##
## Call:
## seasontype <- "N"
##
## Call:
## }
##
## Call:
## if (m == 1) {
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## stop("Nonseasonal data")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (m > 24) {
##
## Call:
## if (is.element(seasontype, c("A", "M"))) {
##
## Call:
## stop("Frequency too high")
##
## Call:
## }
##
## Call:
## else if (seasontype == "Z") {
##
## Call:
## warning("I can't handle data with frequency greater than 24. Seasonality will be ignored. Try stlf() if you need seasonal forecasts.")
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if ((errortype == "A" && (trendtype == "M" || seasontype ==
##
## Call:
## "M")) | (errortype == "M" && trendtype == "M" &&
##
## Call:
## seasontype == "A") || (additive.only && (errortype ==
##
## Call:
## "M" || trendtype == "M" || seasontype == "M"))) {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## data.positive <- (min(y) > 0)
##
## Call:
## if (!data.positive && errortype == "M") {
##
## Call:
## stop("Inappropriate model for data with negative or zero values")
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped && trendtype == "N") {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## n <- length(y)
##
## Call:
## npars <- 2L
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## npars <- npars + 2L
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## npars <- npars + m
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## npars <- npars + as.numeric(damped)
##
## Call:
## }
##
## Call:
## if (n <= npars + 4L) {
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped) {
##
## Call:
## warning("Not enough data to use damping")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = gamma, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), seasonal = ifelse(seasontype != "A",
##
## Call:
## "multiplicative", "additive"), lambda = lambda,
##
## Call:
## biasadj = biasadj, warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Seasonal component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Trend component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "N" && seasontype == "N") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, lambda = lambda, biasadj = biasadj,
##
## Call:
## warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## }
##
## Call:
## fit1 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## fit2 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if ("try-error" %in% class(fit1)) {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## else if (fit1$sigma2 < fit2$sigma2) {
##
## Call:
## fit <- fit1
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## if ("try-error" %in% class(fit))
##
## Call:
## stop("Unable to estimate a model.")
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## if (errortype == "Z") {
##
## Call:
## errortype <- c("A", "M")
##
## Call:
## }
##
## Call:
## if (trendtype == "Z") {
##
## Call:
## if (allow.multiplicative.trend) {
##
## Call:
## trendtype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## trendtype <- c("N", "A")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "Z") {
##
## Call:
## seasontype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## if (is.null(damped)) {
##
## Call:
## damped <- c(TRUE, FALSE)
##
## Call:
## }
##
## Call:
## best.ic <- Inf
##
## Call:
## for (i in 1:length(errortype)) {
##
## Call:
## for (j in 1:length(trendtype)) {
##
## Call:
## for (k in 1:length(seasontype)) {
##
## Call:
## for (l in 1:length(damped)) {
##
## Call:
## if (trendtype[j] == "N" && damped[l]) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if (errortype[i] == "A" && (trendtype[j] ==
##
## Call:
## "M" || seasontype[k] == "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (errortype[i] == "M" && trendtype[j] ==
##
## Call:
## "M" && seasontype[k] == "A") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (additive.only && (errortype[i] == "M" ||
##
## Call:
## trendtype[j] == "M" || seasontype[k] ==
##
## Call:
## "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (!data.positive && errortype[i] == "M") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## fit <- try(etsmodel(y, errortype[i], trendtype[j],
##
## Call:
## seasontype[k], damped[l], alpha, beta, gamma,
##
## Call:
## phi, lower = lower, upper = upper, opt.crit = opt.crit,
##
## Call:
## nmse = nmse, bounds = bounds, ...), silent = TRUE)
##
## Call:
## if (is.element("try-error", class(fit)))
##
## Call:
## fit.ic <- Inf
##
## Call:
## else fit.ic <- switch(ic, aic = fit$aic, bic = fit$bic,
##
## Call:
## aicc = fit$aicc)
##
## Call:
## if (!is.na(fit.ic)) {
##
## Call:
## if (fit.ic < best.ic) {
##
## Call:
## model <- fit
##
## Call:
## best.ic <- fit.ic
##
## Call:
## best.e <- errortype[i]
##
## Call:
## best.t <- trendtype[j]
##
## Call:
## best.s <- seasontype[k]
##
## Call:
## best.d <- damped[l]
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (best.ic == Inf) {
##
## Call:
## stop("No model able to be fitted")
##
## Call:
## }
##
## Call:
## model$m <- m
##
## Call:
## model$method <- paste("ETS(", best.e, ",", best.t, ifelse(best.d,
##
## Call:
## "d", ""), ",", best.s, ")", sep = "")
##
## Call:
## model$series <- seriesname
##
## Call:
## model$components <- c(best.e, best.t, best.s, best.d)
##
## Call:
## model$call <- match.call()
##
## Call:
## model$initstate <- model$states[1, ]
##
## Call:
## np <- length(model$par)
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda, biasadj,
##
## Call:
## model$sigma2)
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(structure(model, class = "ets"))
##
## Call:
## })(y = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6,
##
## Call:
## 200, 200.3, 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1,
##
## Call:
## 210.5, 210.5, 209.8, 208.8, 209.5, 213.2, 213.7, 215.1, 218.7,
##
## Call:
## 219.8, 220.5, 223.8, 222.8, 223.8, 221.7, 222.3, 220.8, 219.4,
##
## Call:
## 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7,
##
## Call:
## 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7,
##
## Call:
## 217, 215.9, 215.8, 214.1, 212.3, 213.9, 214.6, 213.6, 212.1,
##
## Call:
## 211.4, 213.1, 212.9, 213.3, 211.5, 212.3, 213, 211, 210.7, 210.1,
##
## Call:
## 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6, 211.9, 212.8,
##
## Call:
## 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4,
##
## Call:
## 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7,
##
## Call:
## 247.6), .Tsp = c(2008, 2016.16666666667, 12), class = "ts"),
##
## Call:
## opt.crit = "amse")
##
## Smoothing parameters:
## alpha = 0.8956
## beta = 0.3187
## phi = 0.8608
##
## Initial states:
## l = 200.0963
## b = -0.3159
##
## sigma: 0.0068
##
## AIC AICc BIC
## 537.7660 538.6790 553.3367
##
## $train$partition_1$ets2$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Apr 2016 248.1350 245.9714 250.2985 244.8261 251.4438
## May 2016 248.5214 245.1893 251.8535 243.4254 253.6174
## Jun 2016 248.8540 244.3384 253.3697 241.9479 255.7602
## Jul 2016 249.1404 243.4330 254.8478 240.4117 257.8691
## Aug 2016 249.3869 242.4899 256.2839 238.8388 259.9350
## Sep 2016 249.5991 241.5231 257.6752 237.2479 261.9504
## Oct 2016 249.7818 240.5436 259.0200 235.6532 263.9104
## Nov 2016 249.9390 239.5599 260.3182 234.0655 265.8125
## Dec 2016 250.0744 238.5786 261.5702 232.4930 267.6558
## Jan 2017 250.1909 237.6044 262.7775 230.9415 269.4404
## Feb 2017 250.2912 236.6410 263.9415 229.4150 271.1674
## Mar 2017 250.3776 235.6911 265.0641 227.9166 272.8386
##
## $train$partition_1$ets2$parameters
## $train$partition_1$ets2$parameters$type
## [1] "train"
##
## $train$partition_1$ets2$parameters$model_id
## [1] "ets2"
##
## $train$partition_1$ets2$parameters$method
## [1] "ets"
##
## $train$partition_1$ets2$parameters$horizon
## [1] 12
##
## $train$partition_1$ets2$parameters$partition
## [1] "partition_1"
##
##
##
## $train$partition_1$arima1
## $train$partition_1$arima1$model
##
## Call:
## (function (x, order = c(0L, 0L, 0L), seasonal = list(order = c(0L, 0L, 0L),
## period = NA), xreg = NULL, include.mean = TRUE, transform.pars = TRUE, fixed = NULL,
## init = NULL, method = c("CSS-ML", "ML", "CSS"), n.cond, SSinit = c("Gardner1980",
## "Rossignol2011"), optim.method = "BFGS", optim.control = list(), kappa = 1e+06)
## {
## "%+%" <- function(a, b) .Call(C_TSconv, a, b)
## SSinit <- match.arg(SSinit)
## SS.G <- SSinit == "Gardner1980"
## upARIMA <- function(mod, phi, theta) {
## p <- length(phi)
## q <- length(theta)
## mod$phi <- phi
## mod$theta <- theta
## r <- max(p, q + 1L)
## if (p > 0)
## mod$T[1L:p, 1L] <- phi
## if (r > 1L)
## mod$Pn[1L:r, 1L:r] <- if (SS.G)
## .Call(C_getQ0, phi, theta)
## else .Call(C_getQ0bis, phi, theta, tol = 0)
## else mod$Pn[1L, 1L] <- if (p > 0)
## 1/(1 - phi^2)
## else 1
## mod$a[] <- 0
## mod
## }
## arimaSS <- function(y, mod) {
## .Call(C_ARIMA_Like, y, mod, 0L, TRUE)
## }
## armafn <- function(p, trans) {
## par <- coef
## par[mask] <- p
## trarma <- .Call(C_ARIMA_transPars, par, arma, trans)
## if (is.null(Z <- tryCatch(upARIMA(mod, trarma[[1L]], trarma[[2L]]),
## error = function(e) NULL)))
## return(.Machine$double.xmax)
## if (ncxreg > 0)
## x <- x - xreg %*% par[narma + (1L:ncxreg)]
## res <- .Call(C_ARIMA_Like, x, Z, 0L, FALSE)
## s2 <- res[1L]/res[3L]
## 0.5 * (log(s2) + res[2L]/res[3L])
## }
## armaCSS <- function(p) {
## par <- as.double(fixed)
## par[mask] <- p
## trarma <- .Call(C_ARIMA_transPars, par, arma, FALSE)
## if (ncxreg > 0)
## x <- x - xreg %*% par[narma + (1L:ncxreg)]
## res <- .Call(C_ARIMA_CSS, x, arma, trarma[[1L]], trarma[[2L]], as.integer(ncond),
## FALSE)
## 0.5 * log(res)
## }
## arCheck <- function(ar) {
## p <- max(which(c(1, -ar) != 0)) - 1
## if (!p)
## return(TRUE)
## all(Mod(polyroot(c(1, -ar[1L:p]))) > 1)
## }
## maInvert <- function(ma) {
## q <- length(ma)
## q0 <- max(which(c(1, ma) != 0)) - 1L
## if (!q0)
## return(ma)
## roots <- polyroot(c(1, ma[1L:q0]))
## ind <- Mod(roots) < 1
## if (all(!ind))
## return(ma)
## if (q0 == 1)
## return(c(1/ma[1L], rep.int(0, q - q0)))
## roots[ind] <- 1/roots[ind]
## x <- 1
## for (r in roots) x <- c(x, 0) - c(0, x)/r
## c(Re(x[-1L]), rep.int(0, q - q0))
## }
## series <- deparse1(substitute(x))
## if (NCOL(x) > 1L)
## stop("only implemented for univariate time series")
## method <- match.arg(method)
## x <- as.ts(x)
## if (!is.numeric(x))
## stop("'x' must be numeric")
## storage.mode(x) <- "double"
## dim(x) <- NULL
## n <- length(x)
## if (!missing(order))
## if (!is.numeric(order) || length(order) != 3L || any(order < 0))
## stop("'order' must be a non-negative numeric vector of length 3")
## if (!missing(seasonal))
## if (is.list(seasonal)) {
## if (is.null(seasonal$order))
## stop("'seasonal' must be a list with component 'order'")
## if (!is.numeric(seasonal$order) || length(seasonal$order) != 3L ||
## any(seasonal$order < 0L))
## stop("'seasonal$order' must be a non-negative numeric vector of length 3")
## }
## else if (is.numeric(order)) {
## if (length(order) == 3L)
## seasonal <- list(order = seasonal)
## else ("'seasonal' is of the wrong length")
## }
## else stop("'seasonal' must be a list with component 'order'")
## if (is.null(seasonal$period) || is.na(seasonal$period) || seasonal$period ==
## 0)
## seasonal$period <- frequency(x)
## arma <- as.integer(c(order[-2L], seasonal$order[-2L], seasonal$period, order[2L],
## seasonal$order[2L]))
## narma <- sum(arma[1L:4L])
## xtsp <- tsp(x)
## tsp(x) <- NULL
## Delta <- 1
## for (i in seq_len(order[2L])) Delta <- Delta %+% c(1, -1)
## for (i in seq_len(seasonal$order[2L])) Delta <- Delta %+% c(1, rep.int(0,
## seasonal$period - 1), -1)
## Delta <- -Delta[-1L]
## nd <- order[2L] + seasonal$order[2L]
## n.used <- sum(!is.na(x)) - length(Delta)
## if (is.null(xreg)) {
## ncxreg <- 0L
## }
## else {
## nmxreg <- deparse1(substitute(xreg))
## if (NROW(xreg) != n)
## stop("lengths of 'x' and 'xreg' do not match")
## ncxreg <- NCOL(xreg)
## xreg <- as.matrix(xreg)
## storage.mode(xreg) <- "double"
## }
## class(xreg) <- NULL
## if (ncxreg > 0L && is.null(colnames(xreg)))
## colnames(xreg) <- if (ncxreg == 1L)
## nmxreg
## else paste0(nmxreg, 1L:ncxreg)
## if (include.mean && (nd == 0L)) {
## xreg <- cbind(intercept = rep(1, n), xreg = xreg)
## ncxreg <- ncxreg + 1L
## }
## if (method == "CSS-ML") {
## anyna <- anyNA(x)
## if (ncxreg)
## anyna <- anyna || anyNA(xreg)
## if (anyna)
## method <- "ML"
## }
## if (method == "CSS" || method == "CSS-ML") {
## ncond <- order[2L] + seasonal$order[2L] * seasonal$period
## ncond1 <- order[1L] + seasonal$period * seasonal$order[1L]
## ncond <- ncond + if (!missing(n.cond))
## max(n.cond, ncond1)
## else ncond1
## }
## else ncond <- 0
## if (is.null(fixed))
## fixed <- rep(NA_real_, narma + ncxreg)
## else if (length(fixed) != narma + ncxreg)
## stop("wrong length for 'fixed'")
## mask <- is.na(fixed)
## no.optim <- !any(mask)
## if (no.optim)
## transform.pars <- FALSE
## if (transform.pars) {
## ind <- arma[1L] + arma[2L] + seq_len(arma[3L])
## if (any(!mask[seq_len(arma[1L])]) || any(!mask[ind])) {
## warning("some AR parameters were fixed: setting transform.pars = FALSE")
## transform.pars <- FALSE
## }
## }
## init0 <- rep.int(0, narma)
## parscale <- rep(1, narma)
## if (ncxreg) {
## cn <- colnames(xreg)
## orig.xreg <- (ncxreg == 1L) || any(!mask[narma + 1L:ncxreg])
## if (!orig.xreg) {
## S <- svd(na.omit(xreg))
## xreg <- xreg %*% S$v
## }
## dx <- x
## dxreg <- xreg
## if (order[2L] > 0L) {
## dx <- diff(dx, 1L, order[2L])
## dxreg <- diff(dxreg, 1L, order[2L])
## }
## if (seasonal$period > 1L && seasonal$order[2L] > 0) {
## dx <- diff(dx, seasonal$period, seasonal$order[2L])
## dxreg <- diff(dxreg, seasonal$period, seasonal$order[2L])
## }
## fit <- if (length(dx) > ncol(dxreg))
## lm(dx ~ dxreg - 1, na.action = na.omit)
## else list(rank = 0L)
## if (fit$rank == 0L) {
## fit <- lm(x ~ xreg - 1, na.action = na.omit)
## }
## isna <- is.na(x) | apply(xreg, 1L, anyNA)
## n.used <- sum(!isna) - length(Delta)
## init0 <- c(init0, coef(fit))
## ses <- summary(fit)$coefficients[, 2L]
## parscale <- c(parscale, 10 * ses)
## }
## if (n.used <= 0)
## stop("too few non-missing observations")
## if (!is.null(init)) {
## if (length(init) != length(init0))
## stop("'init' is of the wrong length")
## if (any(ind <- is.na(init)))
## init[ind] <- init0[ind]
## if (method == "ML") {
## if (arma[1L] > 0)
## if (!arCheck(init[1L:arma[1L]]))
## stop("non-stationary AR part")
## if (arma[3L] > 0)
## if (!arCheck(init[sum(arma[1L:2L]) + 1L:arma[3L]]))
## stop("non-stationary seasonal AR part")
## if (transform.pars)
## init <- .Call(C_ARIMA_Invtrans, as.double(init), arma)
## }
## }
## else init <- init0
## coef <- as.double(fixed)
## if (!("parscale" %in% names(optim.control)))
## optim.control$parscale <- parscale[mask]
## if (method == "CSS") {
## res <- if (no.optim)
## list(convergence = 0L, par = numeric(), value = armaCSS(numeric()))
## else optim(init[mask], armaCSS, method = optim.method, hessian = TRUE,
## control = optim.control)
## if (res$convergence > 0)
## warning(gettextf("possible convergence problem: optim gave code = %d",
## res$convergence), domain = NA)
## coef[mask] <- res$par
## trarma <- .Call(C_ARIMA_transPars, coef, arma, FALSE)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## if (ncxreg > 0)
## x <- x - xreg %*% coef[narma + (1L:ncxreg)]
## arimaSS(x, mod)
## val <- .Call(C_ARIMA_CSS, x, arma, trarma[[1L]], trarma[[2L]], as.integer(ncond),
## TRUE)
## sigma2 <- val[[1L]]
## var <- if (no.optim)
## numeric()
## else solve(res$hessian * n.used)
## }
## else {
## if (method == "CSS-ML") {
## res <- if (no.optim)
## list(convergence = 0L, par = numeric(), value = armaCSS(numeric()))
## else optim(init[mask], armaCSS, method = optim.method, hessian = FALSE,
## control = optim.control)
## if (res$convergence == 0)
## init[mask] <- res$par
## if (arma[1L] > 0)
## if (!arCheck(init[1L:arma[1L]]))
## stop("non-stationary AR part from CSS")
## if (arma[3L] > 0)
## if (!arCheck(init[sum(arma[1L:2L]) + 1L:arma[3L]]))
## stop("non-stationary seasonal AR part from CSS")
## ncond <- 0L
## }
## if (transform.pars) {
## init <- .Call(C_ARIMA_Invtrans, init, arma)
## if (arma[2L] > 0) {
## ind <- arma[1L] + 1L:arma[2L]
## init[ind] <- maInvert(init[ind])
## }
## if (arma[4L] > 0) {
## ind <- sum(arma[1L:3L]) + 1L:arma[4L]
## init[ind] <- maInvert(init[ind])
## }
## }
## trarma <- .Call(C_ARIMA_transPars, init, arma, transform.pars)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## res <- if (no.optim)
## list(convergence = 0, par = numeric(), value = armafn(numeric(),
## as.logical(transform.pars)))
## else optim(init[mask], armafn, method = optim.method, hessian = TRUE,
## control = optim.control, trans = as.logical(transform.pars))
## if (res$convergence > 0)
## warning(gettextf("possible convergence problem: optim gave code = %d",
## res$convergence), domain = NA)
## coef[mask] <- res$par
## if (transform.pars) {
## if (arma[2L] > 0L) {
## ind <- arma[1L] + 1L:arma[2L]
## if (all(mask[ind]))
## coef[ind] <- maInvert(coef[ind])
## }
## if (arma[4L] > 0L) {
## ind <- sum(arma[1L:3L]) + 1L:arma[4L]
## if (all(mask[ind]))
## coef[ind] <- maInvert(coef[ind])
## }
## if (any(coef[mask] != res$par)) {
## oldcode <- res$convergence
## res <- optim(coef[mask], armafn, method = optim.method, hessian = TRUE,
## control = list(maxit = 0L, parscale = optim.control$parscale),
## trans = TRUE)
## res$convergence <- oldcode
## coef[mask] <- res$par
## }
## A <- .Call(C_ARIMA_Gradtrans, as.double(coef), arma)
## A <- A[mask, mask]
## var <- crossprod(A, solve(res$hessian * n.used, A))
## coef <- .Call(C_ARIMA_undoPars, coef, arma)
## }
## else var <- if (no.optim)
## numeric()
## else solve(res$hessian * n.used)
## trarma <- .Call(C_ARIMA_transPars, coef, arma, FALSE)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## val <- if (ncxreg > 0L)
## arimaSS(x - xreg %*% coef[narma + (1L:ncxreg)], mod)
## else arimaSS(x, mod)
## sigma2 <- val[[1L]][1L]/n.used
## }
## value <- 2 * n.used * res$value + n.used + n.used * log(2 * pi)
## aic <- if (method != "CSS")
## value + 2 * sum(mask) + 2
## else NA
## nm <- NULL
## if (arma[1L] > 0L)
## nm <- c(nm, paste0("ar", 1L:arma[1L]))
## if (arma[2L] > 0L)
## nm <- c(nm, paste0("ma", 1L:arma[2L]))
## if (arma[3L] > 0L)
## nm <- c(nm, paste0("sar", 1L:arma[3L]))
## if (arma[4L] > 0L)
## nm <- c(nm, paste0("sma", 1L:arma[4L]))
## if (ncxreg > 0L) {
## nm <- c(nm, cn)
## if (!orig.xreg) {
## ind <- narma + 1L:ncxreg
## coef[ind] <- S$v %*% coef[ind]
## A <- diag(narma + ncxreg)
## A[ind, ind] <- S$v
## A <- A[mask, mask]
## var <- A %*% var %*% t(A)
## }
## }
## names(coef) <- nm
## if (!no.optim)
## dimnames(var) <- list(nm[mask], nm[mask])
## resid <- val[[2L]]
## tsp(resid) <- xtsp
## class(resid) <- "ts"
## structure(list(coef = coef, sigma2 = sigma2, var.coef = var, mask = mask,
## loglik = -0.5 * value, aic = aic, arma = arma, residuals = resid, call = match.call(),
## series = series, code = res$convergence, n.cond = ncond, nobs = n.used,
## model = mod), class = "Arima")
## })(x = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6, 200, 200.3,
## 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1, 210.5, 210.5, 209.8, 208.8,
## 209.5, 213.2, 213.7, 215.1, 218.7, 219.8, 220.5, 223.8, 222.8, 223.8, 221.7,
## 222.3, 220.8, 219.4, 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7,
## 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7, 217, 215.9, 215.8,
## 214.1, 212.3, 213.9, 214.6, 213.6, 212.1, 211.4, 213.1, 212.9, 213.3, 211.5,
## 212.3, 213, 211, 210.7, 210.1, 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6,
## 211.9, 212.8, 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4,
## 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7, 247.6), .Tsp = c(2008,
## 2016.16666666667, 12), class = "ts"), order = c(2, 1, 0))
##
## Coefficients:
## ar1 ar2
## 0.3072 0.2375
## s.e. 0.0973 0.0974
##
## sigma^2 estimated as 2.176: log likelihood = -177.3, aic = 360.6
##
## $train$partition_1$arima1$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Apr 2016 247.9018 246.0113 249.7922 245.0106 250.7930
## May 2016 247.9707 244.8594 251.0821 243.2123 252.7291
## Jun 2016 248.0636 243.6725 252.4546 241.3480 254.7791
## Jul 2016 248.1085 242.5371 253.6798 239.5878 256.6292
## Aug 2016 248.1443 241.4674 254.8212 237.9329 258.3557
## Sep 2016 248.1660 240.4660 255.8659 236.3899 259.9420
## Oct 2016 248.1811 239.5306 256.8317 234.9513 261.4110
## Nov 2016 248.1909 238.6552 257.7267 233.6073 262.7746
## Dec 2016 248.1976 237.8338 258.5613 232.3476 264.0476
## Jan 2017 248.2019 237.0602 259.3436 231.1621 265.2417
## Feb 2017 248.2048 236.3289 260.0808 230.0422 266.3675
## Mar 2017 248.2068 235.6350 260.7786 228.9799 267.4337
##
## $train$partition_1$arima1$parameters
## $train$partition_1$arima1$parameters$type
## [1] "train"
##
## $train$partition_1$arima1$parameters$model_id
## [1] "arima1"
##
## $train$partition_1$arima1$parameters$method
## [1] "arima"
##
## $train$partition_1$arima1$parameters$horizon
## [1] 12
##
## $train$partition_1$arima1$parameters$partition
## [1] "partition_1"
##
##
##
## $train$partition_1$arima2
## $train$partition_1$arima2$model
##
## Call:
## (function (x, order = c(0L, 0L, 0L), seasonal = list(order = c(0L, 0L, 0L),
## period = NA), xreg = NULL, include.mean = TRUE, transform.pars = TRUE, fixed = NULL,
## init = NULL, method = c("CSS-ML", "ML", "CSS"), n.cond, SSinit = c("Gardner1980",
## "Rossignol2011"), optim.method = "BFGS", optim.control = list(), kappa = 1e+06)
## {
## "%+%" <- function(a, b) .Call(C_TSconv, a, b)
## SSinit <- match.arg(SSinit)
## SS.G <- SSinit == "Gardner1980"
## upARIMA <- function(mod, phi, theta) {
## p <- length(phi)
## q <- length(theta)
## mod$phi <- phi
## mod$theta <- theta
## r <- max(p, q + 1L)
## if (p > 0)
## mod$T[1L:p, 1L] <- phi
## if (r > 1L)
## mod$Pn[1L:r, 1L:r] <- if (SS.G)
## .Call(C_getQ0, phi, theta)
## else .Call(C_getQ0bis, phi, theta, tol = 0)
## else mod$Pn[1L, 1L] <- if (p > 0)
## 1/(1 - phi^2)
## else 1
## mod$a[] <- 0
## mod
## }
## arimaSS <- function(y, mod) {
## .Call(C_ARIMA_Like, y, mod, 0L, TRUE)
## }
## armafn <- function(p, trans) {
## par <- coef
## par[mask] <- p
## trarma <- .Call(C_ARIMA_transPars, par, arma, trans)
## if (is.null(Z <- tryCatch(upARIMA(mod, trarma[[1L]], trarma[[2L]]),
## error = function(e) NULL)))
## return(.Machine$double.xmax)
## if (ncxreg > 0)
## x <- x - xreg %*% par[narma + (1L:ncxreg)]
## res <- .Call(C_ARIMA_Like, x, Z, 0L, FALSE)
## s2 <- res[1L]/res[3L]
## 0.5 * (log(s2) + res[2L]/res[3L])
## }
## armaCSS <- function(p) {
## par <- as.double(fixed)
## par[mask] <- p
## trarma <- .Call(C_ARIMA_transPars, par, arma, FALSE)
## if (ncxreg > 0)
## x <- x - xreg %*% par[narma + (1L:ncxreg)]
## res <- .Call(C_ARIMA_CSS, x, arma, trarma[[1L]], trarma[[2L]], as.integer(ncond),
## FALSE)
## 0.5 * log(res)
## }
## arCheck <- function(ar) {
## p <- max(which(c(1, -ar) != 0)) - 1
## if (!p)
## return(TRUE)
## all(Mod(polyroot(c(1, -ar[1L:p]))) > 1)
## }
## maInvert <- function(ma) {
## q <- length(ma)
## q0 <- max(which(c(1, ma) != 0)) - 1L
## if (!q0)
## return(ma)
## roots <- polyroot(c(1, ma[1L:q0]))
## ind <- Mod(roots) < 1
## if (all(!ind))
## return(ma)
## if (q0 == 1)
## return(c(1/ma[1L], rep.int(0, q - q0)))
## roots[ind] <- 1/roots[ind]
## x <- 1
## for (r in roots) x <- c(x, 0) - c(0, x)/r
## c(Re(x[-1L]), rep.int(0, q - q0))
## }
## series <- deparse1(substitute(x))
## if (NCOL(x) > 1L)
## stop("only implemented for univariate time series")
## method <- match.arg(method)
## x <- as.ts(x)
## if (!is.numeric(x))
## stop("'x' must be numeric")
## storage.mode(x) <- "double"
## dim(x) <- NULL
## n <- length(x)
## if (!missing(order))
## if (!is.numeric(order) || length(order) != 3L || any(order < 0))
## stop("'order' must be a non-negative numeric vector of length 3")
## if (!missing(seasonal))
## if (is.list(seasonal)) {
## if (is.null(seasonal$order))
## stop("'seasonal' must be a list with component 'order'")
## if (!is.numeric(seasonal$order) || length(seasonal$order) != 3L ||
## any(seasonal$order < 0L))
## stop("'seasonal$order' must be a non-negative numeric vector of length 3")
## }
## else if (is.numeric(order)) {
## if (length(order) == 3L)
## seasonal <- list(order = seasonal)
## else ("'seasonal' is of the wrong length")
## }
## else stop("'seasonal' must be a list with component 'order'")
## if (is.null(seasonal$period) || is.na(seasonal$period) || seasonal$period ==
## 0)
## seasonal$period <- frequency(x)
## arma <- as.integer(c(order[-2L], seasonal$order[-2L], seasonal$period, order[2L],
## seasonal$order[2L]))
## narma <- sum(arma[1L:4L])
## xtsp <- tsp(x)
## tsp(x) <- NULL
## Delta <- 1
## for (i in seq_len(order[2L])) Delta <- Delta %+% c(1, -1)
## for (i in seq_len(seasonal$order[2L])) Delta <- Delta %+% c(1, rep.int(0,
## seasonal$period - 1), -1)
## Delta <- -Delta[-1L]
## nd <- order[2L] + seasonal$order[2L]
## n.used <- sum(!is.na(x)) - length(Delta)
## if (is.null(xreg)) {
## ncxreg <- 0L
## }
## else {
## nmxreg <- deparse1(substitute(xreg))
## if (NROW(xreg) != n)
## stop("lengths of 'x' and 'xreg' do not match")
## ncxreg <- NCOL(xreg)
## xreg <- as.matrix(xreg)
## storage.mode(xreg) <- "double"
## }
## class(xreg) <- NULL
## if (ncxreg > 0L && is.null(colnames(xreg)))
## colnames(xreg) <- if (ncxreg == 1L)
## nmxreg
## else paste0(nmxreg, 1L:ncxreg)
## if (include.mean && (nd == 0L)) {
## xreg <- cbind(intercept = rep(1, n), xreg = xreg)
## ncxreg <- ncxreg + 1L
## }
## if (method == "CSS-ML") {
## anyna <- anyNA(x)
## if (ncxreg)
## anyna <- anyna || anyNA(xreg)
## if (anyna)
## method <- "ML"
## }
## if (method == "CSS" || method == "CSS-ML") {
## ncond <- order[2L] + seasonal$order[2L] * seasonal$period
## ncond1 <- order[1L] + seasonal$period * seasonal$order[1L]
## ncond <- ncond + if (!missing(n.cond))
## max(n.cond, ncond1)
## else ncond1
## }
## else ncond <- 0
## if (is.null(fixed))
## fixed <- rep(NA_real_, narma + ncxreg)
## else if (length(fixed) != narma + ncxreg)
## stop("wrong length for 'fixed'")
## mask <- is.na(fixed)
## no.optim <- !any(mask)
## if (no.optim)
## transform.pars <- FALSE
## if (transform.pars) {
## ind <- arma[1L] + arma[2L] + seq_len(arma[3L])
## if (any(!mask[seq_len(arma[1L])]) || any(!mask[ind])) {
## warning("some AR parameters were fixed: setting transform.pars = FALSE")
## transform.pars <- FALSE
## }
## }
## init0 <- rep.int(0, narma)
## parscale <- rep(1, narma)
## if (ncxreg) {
## cn <- colnames(xreg)
## orig.xreg <- (ncxreg == 1L) || any(!mask[narma + 1L:ncxreg])
## if (!orig.xreg) {
## S <- svd(na.omit(xreg))
## xreg <- xreg %*% S$v
## }
## dx <- x
## dxreg <- xreg
## if (order[2L] > 0L) {
## dx <- diff(dx, 1L, order[2L])
## dxreg <- diff(dxreg, 1L, order[2L])
## }
## if (seasonal$period > 1L && seasonal$order[2L] > 0) {
## dx <- diff(dx, seasonal$period, seasonal$order[2L])
## dxreg <- diff(dxreg, seasonal$period, seasonal$order[2L])
## }
## fit <- if (length(dx) > ncol(dxreg))
## lm(dx ~ dxreg - 1, na.action = na.omit)
## else list(rank = 0L)
## if (fit$rank == 0L) {
## fit <- lm(x ~ xreg - 1, na.action = na.omit)
## }
## isna <- is.na(x) | apply(xreg, 1L, anyNA)
## n.used <- sum(!isna) - length(Delta)
## init0 <- c(init0, coef(fit))
## ses <- summary(fit)$coefficients[, 2L]
## parscale <- c(parscale, 10 * ses)
## }
## if (n.used <= 0)
## stop("too few non-missing observations")
## if (!is.null(init)) {
## if (length(init) != length(init0))
## stop("'init' is of the wrong length")
## if (any(ind <- is.na(init)))
## init[ind] <- init0[ind]
## if (method == "ML") {
## if (arma[1L] > 0)
## if (!arCheck(init[1L:arma[1L]]))
## stop("non-stationary AR part")
## if (arma[3L] > 0)
## if (!arCheck(init[sum(arma[1L:2L]) + 1L:arma[3L]]))
## stop("non-stationary seasonal AR part")
## if (transform.pars)
## init <- .Call(C_ARIMA_Invtrans, as.double(init), arma)
## }
## }
## else init <- init0
## coef <- as.double(fixed)
## if (!("parscale" %in% names(optim.control)))
## optim.control$parscale <- parscale[mask]
## if (method == "CSS") {
## res <- if (no.optim)
## list(convergence = 0L, par = numeric(), value = armaCSS(numeric()))
## else optim(init[mask], armaCSS, method = optim.method, hessian = TRUE,
## control = optim.control)
## if (res$convergence > 0)
## warning(gettextf("possible convergence problem: optim gave code = %d",
## res$convergence), domain = NA)
## coef[mask] <- res$par
## trarma <- .Call(C_ARIMA_transPars, coef, arma, FALSE)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## if (ncxreg > 0)
## x <- x - xreg %*% coef[narma + (1L:ncxreg)]
## arimaSS(x, mod)
## val <- .Call(C_ARIMA_CSS, x, arma, trarma[[1L]], trarma[[2L]], as.integer(ncond),
## TRUE)
## sigma2 <- val[[1L]]
## var <- if (no.optim)
## numeric()
## else solve(res$hessian * n.used)
## }
## else {
## if (method == "CSS-ML") {
## res <- if (no.optim)
## list(convergence = 0L, par = numeric(), value = armaCSS(numeric()))
## else optim(init[mask], armaCSS, method = optim.method, hessian = FALSE,
## control = optim.control)
## if (res$convergence == 0)
## init[mask] <- res$par
## if (arma[1L] > 0)
## if (!arCheck(init[1L:arma[1L]]))
## stop("non-stationary AR part from CSS")
## if (arma[3L] > 0)
## if (!arCheck(init[sum(arma[1L:2L]) + 1L:arma[3L]]))
## stop("non-stationary seasonal AR part from CSS")
## ncond <- 0L
## }
## if (transform.pars) {
## init <- .Call(C_ARIMA_Invtrans, init, arma)
## if (arma[2L] > 0) {
## ind <- arma[1L] + 1L:arma[2L]
## init[ind] <- maInvert(init[ind])
## }
## if (arma[4L] > 0) {
## ind <- sum(arma[1L:3L]) + 1L:arma[4L]
## init[ind] <- maInvert(init[ind])
## }
## }
## trarma <- .Call(C_ARIMA_transPars, init, arma, transform.pars)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## res <- if (no.optim)
## list(convergence = 0, par = numeric(), value = armafn(numeric(),
## as.logical(transform.pars)))
## else optim(init[mask], armafn, method = optim.method, hessian = TRUE,
## control = optim.control, trans = as.logical(transform.pars))
## if (res$convergence > 0)
## warning(gettextf("possible convergence problem: optim gave code = %d",
## res$convergence), domain = NA)
## coef[mask] <- res$par
## if (transform.pars) {
## if (arma[2L] > 0L) {
## ind <- arma[1L] + 1L:arma[2L]
## if (all(mask[ind]))
## coef[ind] <- maInvert(coef[ind])
## }
## if (arma[4L] > 0L) {
## ind <- sum(arma[1L:3L]) + 1L:arma[4L]
## if (all(mask[ind]))
## coef[ind] <- maInvert(coef[ind])
## }
## if (any(coef[mask] != res$par)) {
## oldcode <- res$convergence
## res <- optim(coef[mask], armafn, method = optim.method, hessian = TRUE,
## control = list(maxit = 0L, parscale = optim.control$parscale),
## trans = TRUE)
## res$convergence <- oldcode
## coef[mask] <- res$par
## }
## A <- .Call(C_ARIMA_Gradtrans, as.double(coef), arma)
## A <- A[mask, mask]
## var <- crossprod(A, solve(res$hessian * n.used, A))
## coef <- .Call(C_ARIMA_undoPars, coef, arma)
## }
## else var <- if (no.optim)
## numeric()
## else solve(res$hessian * n.used)
## trarma <- .Call(C_ARIMA_transPars, coef, arma, FALSE)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## val <- if (ncxreg > 0L)
## arimaSS(x - xreg %*% coef[narma + (1L:ncxreg)], mod)
## else arimaSS(x, mod)
## sigma2 <- val[[1L]][1L]/n.used
## }
## value <- 2 * n.used * res$value + n.used + n.used * log(2 * pi)
## aic <- if (method != "CSS")
## value + 2 * sum(mask) + 2
## else NA
## nm <- NULL
## if (arma[1L] > 0L)
## nm <- c(nm, paste0("ar", 1L:arma[1L]))
## if (arma[2L] > 0L)
## nm <- c(nm, paste0("ma", 1L:arma[2L]))
## if (arma[3L] > 0L)
## nm <- c(nm, paste0("sar", 1L:arma[3L]))
## if (arma[4L] > 0L)
## nm <- c(nm, paste0("sma", 1L:arma[4L]))
## if (ncxreg > 0L) {
## nm <- c(nm, cn)
## if (!orig.xreg) {
## ind <- narma + 1L:ncxreg
## coef[ind] <- S$v %*% coef[ind]
## A <- diag(narma + ncxreg)
## A[ind, ind] <- S$v
## A <- A[mask, mask]
## var <- A %*% var %*% t(A)
## }
## }
## names(coef) <- nm
## if (!no.optim)
## dimnames(var) <- list(nm[mask], nm[mask])
## resid <- val[[2L]]
## tsp(resid) <- xtsp
## class(resid) <- "ts"
## structure(list(coef = coef, sigma2 = sigma2, var.coef = var, mask = mask,
## loglik = -0.5 * value, aic = aic, arma = arma, residuals = resid, call = match.call(),
## series = series, code = res$convergence, n.cond = ncond, nobs = n.used,
## model = mod), class = "Arima")
## })(x = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6, 200, 200.3,
## 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1, 210.5, 210.5, 209.8, 208.8,
## 209.5, 213.2, 213.7, 215.1, 218.7, 219.8, 220.5, 223.8, 222.8, 223.8, 221.7,
## 222.3, 220.8, 219.4, 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7,
## 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7, 217, 215.9, 215.8,
## 214.1, 212.3, 213.9, 214.6, 213.6, 212.1, 211.4, 213.1, 212.9, 213.3, 211.5,
## 212.3, 213, 211, 210.7, 210.1, 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6,
## 211.9, 212.8, 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4,
## 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7, 247.6), .Tsp = c(2008,
## 2016.16666666667, 12), class = "ts"), order = c(2, 1, 2), seasonal = list(order = c(1,
## 1, 1)))
##
## Coefficients:## Warning in sqrt(diag(x$var.coef)): NaNs produced## ar1 ar2 ma1 ma2 sar1 sma1
## 0.0745 0.7083 0.1823 -0.4998 0.0528 -1.0000
## s.e. NaN NaN NaN NaN 0.1250 0.1873
##
## sigma^2 estimated as 2.097: log likelihood = -165.9, aic = 345.81
##
## $train$partition_1$arima2$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Apr 2016 248.7456 246.7793 250.7120 245.7383 251.7530
## May 2016 249.4437 246.2863 252.6012 244.6148 254.2726
## Jun 2016 250.6864 246.3881 254.9847 244.1128 257.2601
## Jul 2016 251.0881 245.6657 256.5106 242.7952 259.3810
## Aug 2016 251.5809 245.0447 258.1171 241.5847 261.5771
## Sep 2016 251.8836 244.2468 259.5203 240.2042 263.5630
## Oct 2016 253.4452 244.7231 262.1673 240.1059 266.7845
## Nov 2016 254.5170 244.7282 264.3059 239.5462 269.4878
## Dec 2016 255.4116 244.5764 266.2468 238.8405 271.9826
## Jan 2017 255.1984 243.3394 267.0573 237.0617 273.3351
## Feb 2017 255.5676 242.7107 268.4245 235.9047 275.2305
## Mar 2017 255.9647 242.1320 269.7975 234.8094 277.1201
##
## $train$partition_1$arima2$parameters
## $train$partition_1$arima2$parameters$type
## [1] "train"
##
## $train$partition_1$arima2$parameters$model_id
## [1] "arima2"
##
## $train$partition_1$arima2$parameters$method
## [1] "arima"
##
## $train$partition_1$arima2$parameters$horizon
## [1] 12
##
## $train$partition_1$arima2$parameters$partition
## [1] "partition_1"
##
##
##
## $train$partition_1$hw
## $train$partition_1$hw$model
## Holt-Winters exponential smoothing with trend and additive seasonal component.
##
## Call:
## (function (x, alpha = NULL, beta = NULL, gamma = NULL, seasonal = c("additive", "multiplicative"), start.periods = 2, l.start = NULL, b.start = NULL, s.start = NULL, optim.start = c(alpha = 0.3, beta = 0.1, gamma = 0.1), optim.control = list()) { x <- as.ts(x) seasonal <- match.arg(seasonal) f <- frequency(x) if (!is.null(alpha) && (alpha == 0)) stop("cannot fit models without level ('alpha' must not be 0 or FALSE)") if (!is.null(abg <- c(alpha, beta, gamma)) && any(abg < 0 | abg > 1)) stop("'alpha', 'beta' and 'gamma' must be within the unit interval") if (is.null(gamma) || gamma > 0) { if (seasonal == "multiplicative" && any(x == 0)) stop("data must be non-zero for multiplicative Holt-Winters") if (start.periods < 2) stop("need at least 2 periods to compute seasonal start values") } if (!is.null(gamma) && is.logical(gamma) && !gamma) { expsmooth <- !is.null(beta) && is.logical(beta) && !beta if (is.null(l.start)) l.start <- if (expsmooth) x[1L] else x[2L] if (is.null(b.start)) if (is.null(beta) || !is.logical(beta) || beta) b.start <- x[2L] - x[1L] start.time <- 3 - expsmooth s.start <- 0 } else { start.time <- f + 1 wind <- start.periods * f st <- decompose(ts(x[1L:wind], start = start(x), frequency = f), seasonal) if (is.null(l.start) || is.null(b.start)) { dat <- na.omit(st$trend) cf <- coef(.lm.fit(x = cbind(1, seq_along(dat)), y = dat)) if (is.null(l.start)) l.start <- cf[1L] if (is.null(b.start)) b.start <- cf[2L] } if (is.null(s.start)) s.start <- st$figure } lenx <- as.integer(length(x)) if (is.na(lenx)) stop("invalid length(x)") len <- lenx - start.time + 1 hw <- function(alpha, beta, gamma) .C(C_HoltWinters, as.double(x), lenx, as.double(max(min(alpha, 1), 0)), as.double(max(min(beta, 1), 0)), as.double(max(min(gamma, 1), 0)), as.integer(start.time), as.integer(!+(seasonal == "multiplicative")), as.integer(f), as.integer(!is.logical(beta) || beta), as.integer(!is.logical(gamma) || gamma), a = as.double(l.start), b = as.double(b.start), s = as.double(s.start), SSE = as.double(0), level = double(len + 1L), trend = double(len + 1L), seasonal = double(len + f)) if (is.null(gamma)) { if (is.null(alpha)) { if (is.null(beta)) { error <- function(p) hw(p[1L], p[2L], p[3L])$SSE sol <- optim(optim.start, error, method = "L-BFGS-B", lower = c(0, 0, 0), upper = c(1, 1, 1), control = optim.control) if (sol$convergence || any(sol$par < 0 | sol$par > 1)) { if (sol$convergence > 50) { warning(gettextf("optimization difficulties: %s", sol$message), domain = NA) } else stop("optimization failure") } alpha <- sol$par[1L] beta <- sol$par[2L] gamma <- sol$par[3L] } else { error <- function(p) hw(p[1L], beta, p[2L])$SSE sol <- optim(c(optim.start["alpha"], optim.start["gamma"]), error, method = "L-BFGS-B", lower = c(0, 0), upper = c(1, 1), control = optim.control) if (sol$convergence || any(sol$par < 0 | sol$par > 1)) { if (sol$convergence > 50) { warning(gettextf("optimization difficulties: %s", sol$message), domain = NA) } else stop("optimization failure") } alpha <- sol$par[1L] gamma <- sol$par[2L] } } else { if (is.null(beta)) { error <- function(p) hw(alpha, p[1L], p[2L])$SSE sol <- optim(c(optim.start["beta"], optim.start["gamma"]), error, method = "L-BFGS-B", lower = c(0, 0), upper = c(1, 1), control = optim.control) if (sol$convergence || any(sol$par < 0 | sol$par > 1)) { if (sol$convergence > 50) { warning(gettextf("optimization difficulties: %s", sol$message), domain = NA) } else stop("optimization failure") } beta <- sol$par[1L] gamma <- sol$par[2L] } else { error <- function(p) hw(alpha, beta, p)$SSE gamma <- optimize(error, lower = 0, upper = 1)$minimum } } } else { if (is.null(alpha)) { if (is.null(beta)) { error <- function(p) hw(p[1L], p[2L], gamma)$SSE sol <- optim(c(optim.start["alpha"], optim.start["beta"]), error, method = "L-BFGS-B", lower = c(0, 0), upper = c(1, 1), control = optim.control) if (sol$convergence || any(sol$par < 0 | sol$par > 1)) { if (sol$convergence > 50) { warning(gettextf("optimization difficulties: %s", sol$message), domain = NA) } else stop("optimization failure") } alpha <- sol$par[1L] beta <- sol$par[2L] } else { error <- function(p) hw(p, beta, gamma)$SSE alpha <- optimize(error, lower = 0, upper = 1)$minimum } } else { if (is.null(beta)) { error <- function(p) hw(alpha, p, gamma)$SSE beta <- optimize(error, lower = 0, upper = 1)$minimum } } } final.fit <- hw(alpha, beta, gamma) fitted <- ts(cbind(xhat = final.fit$level[-len - 1], level = final.fit$level[-len - 1], trend = if (!is.logical(beta) || beta) final.fit$trend[-len - 1], season = if (!is.logical(gamma) || gamma) final.fit$seasonal[1L:len]), start = start(lag(x, k = 1 - start.time)), frequency = frequency(x)) if (!is.logical(beta) || beta) fitted[, 1] <- fitted[, 1] + fitted[, "trend"] if (!is.logical(gamma) || gamma) fitted[, 1] <- if (seasonal == "multiplicative") fitted[, 1] * fitted[, "season"] else fitted[, 1] + fitted[, "season"] structure(list(fitted = fitted, x = x, alpha = alpha, beta = beta, gamma = gamma, coefficients = c(a = final.fit$level[len + 1], b = if (!is.logical(beta) || beta) final.fit$trend[len + 1], s = if (!is.logical(gamma) || gamma) final.fit$seasonal[len + 1L:f]), seasonal = seasonal, SSE = final.fit$SSE, call = match.call()), class = "HoltWinters")})(x = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6, 200, 200.3, 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1, 210.5, 210.5, 209.8, 208.8, 209.5, 213.2, 213.7, 215.1, 218.7, 219.8, 220.5, 223.8, 222.8, 223.8, 221.7, 222.3, 220.8, 219.4, 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7, 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7, 217, 215.9, 215.8, 214.1, 212.3, 213.9, 214.6, 213.6, 212.1, 211.4, 213.1, 212.9, 213.3, 211.5, 212.3, 213, 211, 210.7, 210.1, 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6, 211.9, 212.8, 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4, 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7, 247.6), .Tsp = c(2008, 2016.16666666667, 12), class = "ts"))
##
## Smoothing parameters:
## alpha: 0.848918
## beta : 0
## gamma: 1
##
## Coefficients:
## [,1]
## a 249.22167825
## b 0.78668415
## s1 -0.29468697
## s2 0.76115908
## s3 2.00681776
## s4 0.88344686
## s5 -0.30349026
## s6 -0.89691849
## s7 -0.09127364
## s8 -0.02364719
## s9 -0.23739564
## s10 -1.58156250
## s11 -1.76038231
## s12 -1.62167825
##
## $train$partition_1$hw$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Apr 2016 249.7137 246.9832 252.4442 245.5377 253.8896
## May 2016 251.5562 247.9745 255.1379 246.0785 257.0339
## Jun 2016 253.5885 249.3222 257.8549 247.0638 260.1133
## Jul 2016 253.2519 248.3965 258.1072 245.8262 260.6775
## Aug 2016 252.8516 247.4713 258.2319 244.6232 261.0800
## Sep 2016 253.0449 247.1865 258.9032 244.0853 262.0045
## Oct 2016 254.6372 248.3369 260.9375 245.0018 264.2726
## Nov 2016 255.4915 248.7784 262.2047 245.2246 265.7584
## Dec 2016 256.0644 248.9624 263.1665 245.2028 266.9261
## Jan 2017 255.5070 248.0362 262.9777 244.0814 266.9325
## Feb 2017 256.1148 248.2927 263.9369 244.1519 268.0777
## Mar 2017 257.0402 248.8819 265.1985 244.5631 269.5173
##
## $train$partition_1$hw$parameters
## $train$partition_1$hw$parameters$type
## [1] "train"
##
## $train$partition_1$hw$parameters$model_id
## [1] "hw"
##
## $train$partition_1$hw$parameters$method
## [1] "HoltWinters"
##
## $train$partition_1$hw$parameters$horizon
## [1] 12
##
## $train$partition_1$hw$parameters$partition
## [1] "partition_1"
##
##
##
## $train$partition_1$tslm
## $train$partition_1$tslm$model
##
## Call:
## (function (formula, data, subset, lambda = NULL, biasadj = FALSE,
## ...)
## {
## cl <- match.call()
## if (!("formula" %in% class(formula))) {
## formula <- stats::as.formula(formula)
## }
## if (missing(data)) {
## mt <- try(terms(formula))
## if (is.element("try-error", class(mt))) {
## stop("Cannot extract terms from formula, please provide data argument.")
## }
## }
## else {
## mt <- terms(formula, data = data)
## }
## vars <- attr(mt, "variables")
## tsvar <- match(c("trend", "season"), as.character(vars),
## 0L)
## fnvar <- NULL
## for (i in 2:length(vars)) {
## term <- vars[[i]]
## if (!is.symbol(term)) {
## if (typeof(eval(term[[1]])) == "closure") {
## fnvar <- c(fnvar, i)
## }
## }
## }
## attr(formula, ".Environment") <- environment()
## formula[[2]] <- as.symbol(deparse(formula[[2]]))
## if (sum(c(tsvar, fnvar)) > 0) {
## rmvar <- c(tsvar, fnvar)
## rmvar <- rmvar[rmvar != attr(mt, "response") + 1]
## if (any(rmvar != 0)) {
## vars <- vars[-rmvar]
## }
## }
## if (!missing(data)) {
## vars <- vars[c(TRUE, !as.character(vars[-1]) %in% colnames(data))]
## dataname <- substitute(data)
## }
## if (!missing(data)) {
## data <- datamat(do.call(datamat, as.list(vars[-1]), envir = parent.frame()),
## data)
## }
## else {
## data <- do.call(datamat, as.list(vars[-1]), envir = parent.frame())
## }
## if (is.null(dim(data)) && length(data) != 0) {
## cn <- as.character(vars)[2]
## }
## else {
## cn <- colnames(data)
## }
## if (is.null(tsp(data))) {
## if ((attr(mt, "response") + 1) %in% fnvar) {
## tspx <- tsp(eval(attr(mt, "variables")[[attr(mt,
## "response") + 1]]))
## }
## tspx <- tsp(data[, 1])
## }
## else {
## tspx <- tsp(data)
## }
## if (is.null(tspx)) {
## stop("Not time series data, use lm()")
## }
## tsdat <- match(c("trend", "season"), cn, 0L)
## if (tsdat[1] == 0) {
## trend <- 1:NROW(data)
## cn <- c(cn, "trend")
## data <- cbind(data, trend)
## }
## if (tsdat[2] == 0) {
## if (tsvar[2] != 0 && tspx[3] <= 1) {
## stop("Non-seasonal data cannot be modelled using a seasonal factor")
## }
## season <- as.factor(cycle(data[, 1]))
## cn <- c(cn, "season")
## data <- cbind(data, season)
## }
## colnames(data) <- cn
## if (!missing(subset)) {
## if (!is.logical(subset)) {
## stop("subset must be logical")
## }
## else if (NCOL(subset) > 1) {
## stop("subset must be a logical vector")
## }
## else if (NROW(subset) != NROW(data)) {
## stop("Subset must be the same length as the number of rows in the dataset")
## }
## warning("Subset has been assumed contiguous")
## timesx <- time(data[, 1])[subset]
## tspx <- recoverTSP(timesx)
## if (tspx[3] == 1 && tsdat[2] == 0 && tsvar[2] != 0) {
## stop("Non-seasonal data cannot be modelled using a seasonal factor")
## }
## data <- data[subset, ]
## }
## if (!is.null(lambda)) {
## resp_var <- deparse(attr(mt, "variables")[[attr(mt, "response") +
## 1]])
## data[, resp_var] <- BoxCox(data[, resp_var], lambda)
## lambda <- attr(data[, resp_var], "lambda")
## }
## if (tsdat[2] == 0 && tsvar[2] != 0) {
## data$season <- factor(data$season)
## }
## fit <- lm(formula, data = data, na.action = na.exclude, ...)
## fit$data <- data
## responsevar <- deparse(formula[[2]])
## fit$residuals <- ts(residuals(fit))
## fit$x <- fit$residuals
## fit$x[!is.na(fit$x)] <- model.frame(fit)[, responsevar]
## fit$fitted.values <- ts(fitted(fit))
## tsp(fit$residuals) <- tsp(fit$x) <- tsp(fit$fitted.values) <- tsp(data[,
## 1]) <- tspx
## fit$call <- cl
## fit$method <- "Linear regression model"
## if (exists("dataname")) {
## fit$call$data <- dataname
## }
## if (!is.null(lambda)) {
## attr(lambda, "biasadj") <- biasadj
## fit$lambda <- lambda
## fit$fitted.values <- InvBoxCox(fit$fitted.values, lambda,
## biasadj, var(fit$residuals))
## fit$x <- InvBoxCox(fit$x, lambda)
## }
## class(fit) <- c("tslm", class(fit))
## return(fit)
## })(formula = train ~ trend + season)
##
## Coefficients:
## (Intercept) trend season2 season3 season4 season5
## 203.99291 0.25547 -0.01103 0.11128 -1.75719 -1.61266
## season6 season7 season8 season9 season10 season11
## -1.05564 -1.19861 -1.16658 -1.43456 -0.31503 0.41700
## season12
## 1.03652
##
##
## $train$partition_1$tslm$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Apr 2016 227.7831 215.1519 240.4143 208.3401 247.2260
## May 2016 228.1831 215.5519 240.8143 208.7401 247.6260
## Jun 2016 228.9956 216.3644 241.6268 209.5526 248.4385
## Jul 2016 229.1081 216.4769 241.7393 209.6651 248.5510
## Aug 2016 229.3956 216.7644 242.0268 209.9526 248.8385
## Sep 2016 229.3831 216.7519 242.0143 209.9401 248.8260
## Oct 2016 230.7581 218.1269 243.3893 211.3151 250.2010
## Nov 2016 231.7456 219.1144 244.3768 212.3026 251.1885
## Dec 2016 232.6206 219.9894 245.2518 213.1776 252.0635
## Jan 2017 231.8395 219.2376 244.4415 212.4416 251.2374
## Feb 2017 232.0840 219.4820 244.6859 212.6861 251.4818
## Mar 2017 232.4617 219.8598 245.0637 213.0639 251.8596
##
## $train$partition_1$tslm$parameters
## $train$partition_1$tslm$parameters$type
## [1] "train"
##
## $train$partition_1$tslm$parameters$model_id
## [1] "tslm"
##
## $train$partition_1$tslm$parameters$method
## [1] "tslm"
##
## $train$partition_1$tslm$parameters$horizon
## [1] 12
##
## $train$partition_1$tslm$parameters$partition
## [1] "partition_1"
##
##
##
## $train$partition_1$train
## Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
## 2008 200.1 199.5 199.4 198.9 199.0 200.2 198.6 200.0 200.3 201.2 201.6 201.5
## 2009 201.5 203.5 204.9 207.1 210.5 210.5 209.8 208.8 209.5 213.2 213.7 215.1
## 2010 218.7 219.8 220.5 223.8 222.8 223.8 221.7 222.3 220.8 219.4 220.1 220.6
## 2011 218.9 217.8 217.7 215.0 215.3 215.9 216.7 216.7 217.7 218.7 222.9 224.9
## 2012 222.2 220.7 220.0 218.7 217.0 215.9 215.8 214.1 212.3 213.9 214.6 213.6
## 2013 212.1 211.4 213.1 212.9 213.3 211.5 212.3 213.0 211.0 210.7 210.1 211.4
## 2014 210.0 209.7 208.8 208.8 208.8 210.6 211.9 212.8 212.5 214.8 215.3 217.5
## 2015 218.8 220.7 222.2 226.7 228.4 233.2 235.7 237.1 240.6 243.8 245.3 246.0
## 2016 246.3 247.7 247.6
##
## $train$partition_1$test
## Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
## 2016 247.8 249.4 249.0 249.9 250.5 251.5 249.0 247.6 248.8
## 2017 250.4 250.7 253.0
##
##
## $train$partition_2
## $train$partition_2$ets1
## $train$partition_2$ets1$model
## ETS(M,Ad,N)
##
## Call:
## (function (y, model = "ZZZ", damped = NULL, alpha = NULL, beta = NULL,
##
## Call:
## gamma = NULL, phi = NULL, additive.only = FALSE, lambda = NULL,
##
## Call:
## biasadj = FALSE, lower = c(rep(1e-04, 3), 0.8), upper = c(rep(0.9999,
##
## Call:
## 3), 0.98), opt.crit = c("lik", "amse", "mse", "sigma",
##
## Call:
## "mae"), nmse = 3, bounds = c("both", "usual", "admissible"),
##
## Call:
## ic = c("aicc", "aic", "bic"), restrict = TRUE, allow.multiplicative.trend = FALSE,
##
## Call:
## use.initial.values = FALSE, na.action = c("na.contiguous",
##
## Call:
## "na.interp", "na.fail"), ...)
##
## Call:
## {
##
## Call:
## opt.crit <- match.arg(opt.crit)
##
## Call:
## bounds <- match.arg(bounds)
##
## Call:
## ic <- match.arg(ic)
##
## Call:
## if (!is.function(na.action)) {
##
## Call:
## na.fn_name <- match.arg(na.action)
##
## Call:
## na.action <- get(na.fn_name)
##
## Call:
## }
##
## Call:
## seriesname <- deparse(substitute(y))
##
## Call:
## if (any(class(y) %in% c("data.frame", "list", "matrix", "mts"))) {
##
## Call:
## stop("y should be a univariate time series")
##
## Call:
## }
##
## Call:
## y <- as.ts(y)
##
## Call:
## if (missing(model) && is.constant(y)) {
##
## Call:
## return(ses(y, alpha = 0.99999, initial = "simple")$model)
##
## Call:
## }
##
## Call:
## ny <- length(y)
##
## Call:
## y <- na.action(y)
##
## Call:
## if (ny != length(y) && na.fn_name == "na.contiguous") {
##
## Call:
## warning("Missing values encountered. Using longest contiguous portion of time series")
##
## Call:
## ny <- length(y)
##
## Call:
## }
##
## Call:
## orig.y <- y
##
## Call:
## if (identical(class(model), "ets") && is.null(lambda)) {
##
## Call:
## lambda <- model$lambda
##
## Call:
## }
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## y <- BoxCox(y, lambda)
##
## Call:
## lambda <- attr(y, "lambda")
##
## Call:
## additive.only <- TRUE
##
## Call:
## }
##
## Call:
## if (nmse < 1 || nmse > 30) {
##
## Call:
## stop("nmse out of range")
##
## Call:
## }
##
## Call:
## m <- frequency(y)
##
## Call:
## if (any(upper < lower)) {
##
## Call:
## stop("Lower limits must be less than upper limits")
##
## Call:
## }
##
## Call:
## if (class(model) == "ets") {
##
## Call:
## alpha <- max(model$par["alpha"], 1e-10)
##
## Call:
## beta <- model$par["beta"]
##
## Call:
## if (is.na(beta)) {
##
## Call:
## beta <- NULL
##
## Call:
## }
##
## Call:
## gamma <- model$par["gamma"]
##
## Call:
## if (is.na(gamma)) {
##
## Call:
## gamma <- NULL
##
## Call:
## }
##
## Call:
## phi <- model$par["phi"]
##
## Call:
## if (is.na(phi)) {
##
## Call:
## phi <- NULL
##
## Call:
## }
##
## Call:
## modelcomponents <- paste(model$components[1], model$components[2],
##
## Call:
## model$components[3], sep = "")
##
## Call:
## damped <- (model$components[4] == "TRUE")
##
## Call:
## if (use.initial.values) {
##
## Call:
## errortype <- substr(modelcomponents, 1, 1)
##
## Call:
## trendtype <- substr(modelcomponents, 2, 2)
##
## Call:
## seasontype <- substr(modelcomponents, 3, 3)
##
## Call:
## e <- pegelsresid.C(y, m, model$initstate, errortype,
##
## Call:
## trendtype, seasontype, damped, alpha, beta, gamma,
##
## Call:
## phi, nmse)
##
## Call:
## np <- length(model$par) + 1
##
## Call:
## model$loglik <- -0.5 * e$lik
##
## Call:
## model$aic <- e$lik + 2 * np
##
## Call:
## model$bic <- e$lik + log(ny) * np
##
## Call:
## model$aicc <- model$aic + 2 * np * (np + 1)/(ny -
##
## Call:
## np - 1)
##
## Call:
## model$mse <- e$amse[1]
##
## Call:
## model$amse <- mean(e$amse)
##
## Call:
## tsp.y <- tsp(y)
##
## Call:
## model$states <- ts(e$states, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1] - 1/tsp.y[3])
##
## Call:
## colnames(model$states)[1] <- "l"
##
## Call:
## if (trendtype != "N") {
##
## Call:
## colnames(model$states)[2] <- "b"
##
## Call:
## }
##
## Call:
## if (seasontype != "N") {
##
## Call:
## colnames(model$states)[(2 + (trendtype != "N")):ncol(model$states)] <- paste("s",
##
## Call:
## 1:m, sep = "")
##
## Call:
## }
##
## Call:
## if (errortype == "A") {
##
## Call:
## model$fitted <- ts(y - e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model$fitted <- ts(y/(1 + e$e), frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## model$residuals <- ts(e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## model$series <- seriesname
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda,
##
## Call:
## biasadj, var(model$residuals))
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(model)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model <- modelcomponents
##
## Call:
## if (missing(use.initial.values)) {
##
## Call:
## message("Model is being refit with current smoothing parameters but initial states are being re-estimated.\nSet 'use.initial.values=TRUE' if you want to re-use existing initial values.")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## errortype <- substr(model, 1, 1)
##
## Call:
## trendtype <- substr(model, 2, 2)
##
## Call:
## seasontype <- substr(model, 3, 3)
##
## Call:
## if (!is.element(errortype, c("M", "A", "Z"))) {
##
## Call:
## stop("Invalid error type")
##
## Call:
## }
##
## Call:
## if (!is.element(trendtype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid trend type")
##
## Call:
## }
##
## Call:
## if (!is.element(seasontype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid season type")
##
## Call:
## }
##
## Call:
## if (m < 1 || length(y) <= m) {
##
## Call:
## seasontype <- "N"
##
## Call:
## }
##
## Call:
## if (m == 1) {
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## stop("Nonseasonal data")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (m > 24) {
##
## Call:
## if (is.element(seasontype, c("A", "M"))) {
##
## Call:
## stop("Frequency too high")
##
## Call:
## }
##
## Call:
## else if (seasontype == "Z") {
##
## Call:
## warning("I can't handle data with frequency greater than 24. Seasonality will be ignored. Try stlf() if you need seasonal forecasts.")
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if ((errortype == "A" && (trendtype == "M" || seasontype ==
##
## Call:
## "M")) | (errortype == "M" && trendtype == "M" &&
##
## Call:
## seasontype == "A") || (additive.only && (errortype ==
##
## Call:
## "M" || trendtype == "M" || seasontype == "M"))) {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## data.positive <- (min(y) > 0)
##
## Call:
## if (!data.positive && errortype == "M") {
##
## Call:
## stop("Inappropriate model for data with negative or zero values")
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped && trendtype == "N") {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## n <- length(y)
##
## Call:
## npars <- 2L
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## npars <- npars + 2L
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## npars <- npars + m
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## npars <- npars + as.numeric(damped)
##
## Call:
## }
##
## Call:
## if (n <= npars + 4L) {
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped) {
##
## Call:
## warning("Not enough data to use damping")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = gamma, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), seasonal = ifelse(seasontype != "A",
##
## Call:
## "multiplicative", "additive"), lambda = lambda,
##
## Call:
## biasadj = biasadj, warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Seasonal component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Trend component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "N" && seasontype == "N") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, lambda = lambda, biasadj = biasadj,
##
## Call:
## warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## }
##
## Call:
## fit1 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## fit2 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if ("try-error" %in% class(fit1)) {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## else if (fit1$sigma2 < fit2$sigma2) {
##
## Call:
## fit <- fit1
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## if ("try-error" %in% class(fit))
##
## Call:
## stop("Unable to estimate a model.")
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## if (errortype == "Z") {
##
## Call:
## errortype <- c("A", "M")
##
## Call:
## }
##
## Call:
## if (trendtype == "Z") {
##
## Call:
## if (allow.multiplicative.trend) {
##
## Call:
## trendtype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## trendtype <- c("N", "A")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "Z") {
##
## Call:
## seasontype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## if (is.null(damped)) {
##
## Call:
## damped <- c(TRUE, FALSE)
##
## Call:
## }
##
## Call:
## best.ic <- Inf
##
## Call:
## for (i in 1:length(errortype)) {
##
## Call:
## for (j in 1:length(trendtype)) {
##
## Call:
## for (k in 1:length(seasontype)) {
##
## Call:
## for (l in 1:length(damped)) {
##
## Call:
## if (trendtype[j] == "N" && damped[l]) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if (errortype[i] == "A" && (trendtype[j] ==
##
## Call:
## "M" || seasontype[k] == "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (errortype[i] == "M" && trendtype[j] ==
##
## Call:
## "M" && seasontype[k] == "A") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (additive.only && (errortype[i] == "M" ||
##
## Call:
## trendtype[j] == "M" || seasontype[k] ==
##
## Call:
## "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (!data.positive && errortype[i] == "M") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## fit <- try(etsmodel(y, errortype[i], trendtype[j],
##
## Call:
## seasontype[k], damped[l], alpha, beta, gamma,
##
## Call:
## phi, lower = lower, upper = upper, opt.crit = opt.crit,
##
## Call:
## nmse = nmse, bounds = bounds, ...), silent = TRUE)
##
## Call:
## if (is.element("try-error", class(fit)))
##
## Call:
## fit.ic <- Inf
##
## Call:
## else fit.ic <- switch(ic, aic = fit$aic, bic = fit$bic,
##
## Call:
## aicc = fit$aicc)
##
## Call:
## if (!is.na(fit.ic)) {
##
## Call:
## if (fit.ic < best.ic) {
##
## Call:
## model <- fit
##
## Call:
## best.ic <- fit.ic
##
## Call:
## best.e <- errortype[i]
##
## Call:
## best.t <- trendtype[j]
##
## Call:
## best.s <- seasontype[k]
##
## Call:
## best.d <- damped[l]
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (best.ic == Inf) {
##
## Call:
## stop("No model able to be fitted")
##
## Call:
## }
##
## Call:
## model$m <- m
##
## Call:
## model$method <- paste("ETS(", best.e, ",", best.t, ifelse(best.d,
##
## Call:
## "d", ""), ",", best.s, ")", sep = "")
##
## Call:
## model$series <- seriesname
##
## Call:
## model$components <- c(best.e, best.t, best.s, best.d)
##
## Call:
## model$call <- match.call()
##
## Call:
## model$initstate <- model$states[1, ]
##
## Call:
## np <- length(model$par)
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda, biasadj,
##
## Call:
## model$sigma2)
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(structure(model, class = "ets"))
##
## Call:
## })(y = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6,
##
## Call:
## 200, 200.3, 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1,
##
## Call:
## 210.5, 210.5, 209.8, 208.8, 209.5, 213.2, 213.7, 215.1, 218.7,
##
## Call:
## 219.8, 220.5, 223.8, 222.8, 223.8, 221.7, 222.3, 220.8, 219.4,
##
## Call:
## 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7,
##
## Call:
## 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7,
##
## Call:
## 217, 215.9, 215.8, 214.1, 212.3, 213.9, 214.6, 213.6, 212.1,
##
## Call:
## 211.4, 213.1, 212.9, 213.3, 211.5, 212.3, 213, 211, 210.7, 210.1,
##
## Call:
## 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6, 211.9, 212.8,
##
## Call:
## 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4,
##
## Call:
## 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7,
##
## Call:
## 247.6, 247.8, 249.4, 249), .Tsp = c(2008, 2016.41666666667, 12
##
## Call:
## ), class = "ts"), opt.crit = "lik")
##
## Smoothing parameters:
## alpha = 0.9639
## beta = 0.301
## phi = 0.8916
##
## Initial states:
## l = 200.4239
## b = -0.3952
##
## sigma: 0.0067
##
## AIC AICc BIC
## 554.9579 555.8421 570.7077
##
## $train$partition_2$ets1$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jul 2016 249.3543 247.2100 251.4986 246.0748 252.6338
## Aug 2016 249.6374 246.2329 253.0418 244.4307 254.8441
## Sep 2016 249.8897 245.2451 254.5343 242.7864 256.9930
## Oct 2016 250.1147 244.2265 256.0028 241.1095 259.1198
## Nov 2016 250.3153 243.1804 257.4502 239.4034 261.2272
## Dec 2016 250.4941 242.1137 258.8745 237.6774 263.3108
## Jan 2017 250.6536 241.0339 260.2732 235.9416 265.3655
## Feb 2017 250.7957 239.9473 261.6441 234.2045 267.3869
## Mar 2017 250.9224 238.8592 262.9857 232.4732 269.3717
## Apr 2017 251.0354 237.7738 264.2971 230.7536 271.3173
## May 2017 251.1362 236.6948 265.5776 229.0500 273.2224
## Jun 2017 251.2260 235.6248 266.8272 227.3660 275.0860
##
## $train$partition_2$ets1$parameters
## $train$partition_2$ets1$parameters$type
## [1] "train"
##
## $train$partition_2$ets1$parameters$model_id
## [1] "ets1"
##
## $train$partition_2$ets1$parameters$method
## [1] "ets"
##
## $train$partition_2$ets1$parameters$horizon
## [1] 12
##
## $train$partition_2$ets1$parameters$partition
## [1] "partition_2"
##
##
##
## $train$partition_2$ets2
## $train$partition_2$ets2$model
## ETS(M,Ad,N)
##
## Call:
## (function (y, model = "ZZZ", damped = NULL, alpha = NULL, beta = NULL,
##
## Call:
## gamma = NULL, phi = NULL, additive.only = FALSE, lambda = NULL,
##
## Call:
## biasadj = FALSE, lower = c(rep(1e-04, 3), 0.8), upper = c(rep(0.9999,
##
## Call:
## 3), 0.98), opt.crit = c("lik", "amse", "mse", "sigma",
##
## Call:
## "mae"), nmse = 3, bounds = c("both", "usual", "admissible"),
##
## Call:
## ic = c("aicc", "aic", "bic"), restrict = TRUE, allow.multiplicative.trend = FALSE,
##
## Call:
## use.initial.values = FALSE, na.action = c("na.contiguous",
##
## Call:
## "na.interp", "na.fail"), ...)
##
## Call:
## {
##
## Call:
## opt.crit <- match.arg(opt.crit)
##
## Call:
## bounds <- match.arg(bounds)
##
## Call:
## ic <- match.arg(ic)
##
## Call:
## if (!is.function(na.action)) {
##
## Call:
## na.fn_name <- match.arg(na.action)
##
## Call:
## na.action <- get(na.fn_name)
##
## Call:
## }
##
## Call:
## seriesname <- deparse(substitute(y))
##
## Call:
## if (any(class(y) %in% c("data.frame", "list", "matrix", "mts"))) {
##
## Call:
## stop("y should be a univariate time series")
##
## Call:
## }
##
## Call:
## y <- as.ts(y)
##
## Call:
## if (missing(model) && is.constant(y)) {
##
## Call:
## return(ses(y, alpha = 0.99999, initial = "simple")$model)
##
## Call:
## }
##
## Call:
## ny <- length(y)
##
## Call:
## y <- na.action(y)
##
## Call:
## if (ny != length(y) && na.fn_name == "na.contiguous") {
##
## Call:
## warning("Missing values encountered. Using longest contiguous portion of time series")
##
## Call:
## ny <- length(y)
##
## Call:
## }
##
## Call:
## orig.y <- y
##
## Call:
## if (identical(class(model), "ets") && is.null(lambda)) {
##
## Call:
## lambda <- model$lambda
##
## Call:
## }
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## y <- BoxCox(y, lambda)
##
## Call:
## lambda <- attr(y, "lambda")
##
## Call:
## additive.only <- TRUE
##
## Call:
## }
##
## Call:
## if (nmse < 1 || nmse > 30) {
##
## Call:
## stop("nmse out of range")
##
## Call:
## }
##
## Call:
## m <- frequency(y)
##
## Call:
## if (any(upper < lower)) {
##
## Call:
## stop("Lower limits must be less than upper limits")
##
## Call:
## }
##
## Call:
## if (class(model) == "ets") {
##
## Call:
## alpha <- max(model$par["alpha"], 1e-10)
##
## Call:
## beta <- model$par["beta"]
##
## Call:
## if (is.na(beta)) {
##
## Call:
## beta <- NULL
##
## Call:
## }
##
## Call:
## gamma <- model$par["gamma"]
##
## Call:
## if (is.na(gamma)) {
##
## Call:
## gamma <- NULL
##
## Call:
## }
##
## Call:
## phi <- model$par["phi"]
##
## Call:
## if (is.na(phi)) {
##
## Call:
## phi <- NULL
##
## Call:
## }
##
## Call:
## modelcomponents <- paste(model$components[1], model$components[2],
##
## Call:
## model$components[3], sep = "")
##
## Call:
## damped <- (model$components[4] == "TRUE")
##
## Call:
## if (use.initial.values) {
##
## Call:
## errortype <- substr(modelcomponents, 1, 1)
##
## Call:
## trendtype <- substr(modelcomponents, 2, 2)
##
## Call:
## seasontype <- substr(modelcomponents, 3, 3)
##
## Call:
## e <- pegelsresid.C(y, m, model$initstate, errortype,
##
## Call:
## trendtype, seasontype, damped, alpha, beta, gamma,
##
## Call:
## phi, nmse)
##
## Call:
## np <- length(model$par) + 1
##
## Call:
## model$loglik <- -0.5 * e$lik
##
## Call:
## model$aic <- e$lik + 2 * np
##
## Call:
## model$bic <- e$lik + log(ny) * np
##
## Call:
## model$aicc <- model$aic + 2 * np * (np + 1)/(ny -
##
## Call:
## np - 1)
##
## Call:
## model$mse <- e$amse[1]
##
## Call:
## model$amse <- mean(e$amse)
##
## Call:
## tsp.y <- tsp(y)
##
## Call:
## model$states <- ts(e$states, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1] - 1/tsp.y[3])
##
## Call:
## colnames(model$states)[1] <- "l"
##
## Call:
## if (trendtype != "N") {
##
## Call:
## colnames(model$states)[2] <- "b"
##
## Call:
## }
##
## Call:
## if (seasontype != "N") {
##
## Call:
## colnames(model$states)[(2 + (trendtype != "N")):ncol(model$states)] <- paste("s",
##
## Call:
## 1:m, sep = "")
##
## Call:
## }
##
## Call:
## if (errortype == "A") {
##
## Call:
## model$fitted <- ts(y - e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model$fitted <- ts(y/(1 + e$e), frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## model$residuals <- ts(e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## model$series <- seriesname
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda,
##
## Call:
## biasadj, var(model$residuals))
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(model)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model <- modelcomponents
##
## Call:
## if (missing(use.initial.values)) {
##
## Call:
## message("Model is being refit with current smoothing parameters but initial states are being re-estimated.\nSet 'use.initial.values=TRUE' if you want to re-use existing initial values.")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## errortype <- substr(model, 1, 1)
##
## Call:
## trendtype <- substr(model, 2, 2)
##
## Call:
## seasontype <- substr(model, 3, 3)
##
## Call:
## if (!is.element(errortype, c("M", "A", "Z"))) {
##
## Call:
## stop("Invalid error type")
##
## Call:
## }
##
## Call:
## if (!is.element(trendtype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid trend type")
##
## Call:
## }
##
## Call:
## if (!is.element(seasontype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid season type")
##
## Call:
## }
##
## Call:
## if (m < 1 || length(y) <= m) {
##
## Call:
## seasontype <- "N"
##
## Call:
## }
##
## Call:
## if (m == 1) {
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## stop("Nonseasonal data")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (m > 24) {
##
## Call:
## if (is.element(seasontype, c("A", "M"))) {
##
## Call:
## stop("Frequency too high")
##
## Call:
## }
##
## Call:
## else if (seasontype == "Z") {
##
## Call:
## warning("I can't handle data with frequency greater than 24. Seasonality will be ignored. Try stlf() if you need seasonal forecasts.")
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if ((errortype == "A" && (trendtype == "M" || seasontype ==
##
## Call:
## "M")) | (errortype == "M" && trendtype == "M" &&
##
## Call:
## seasontype == "A") || (additive.only && (errortype ==
##
## Call:
## "M" || trendtype == "M" || seasontype == "M"))) {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## data.positive <- (min(y) > 0)
##
## Call:
## if (!data.positive && errortype == "M") {
##
## Call:
## stop("Inappropriate model for data with negative or zero values")
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped && trendtype == "N") {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## n <- length(y)
##
## Call:
## npars <- 2L
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## npars <- npars + 2L
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## npars <- npars + m
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## npars <- npars + as.numeric(damped)
##
## Call:
## }
##
## Call:
## if (n <= npars + 4L) {
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped) {
##
## Call:
## warning("Not enough data to use damping")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = gamma, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), seasonal = ifelse(seasontype != "A",
##
## Call:
## "multiplicative", "additive"), lambda = lambda,
##
## Call:
## biasadj = biasadj, warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Seasonal component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Trend component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "N" && seasontype == "N") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, lambda = lambda, biasadj = biasadj,
##
## Call:
## warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## }
##
## Call:
## fit1 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## fit2 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if ("try-error" %in% class(fit1)) {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## else if (fit1$sigma2 < fit2$sigma2) {
##
## Call:
## fit <- fit1
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## if ("try-error" %in% class(fit))
##
## Call:
## stop("Unable to estimate a model.")
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## if (errortype == "Z") {
##
## Call:
## errortype <- c("A", "M")
##
## Call:
## }
##
## Call:
## if (trendtype == "Z") {
##
## Call:
## if (allow.multiplicative.trend) {
##
## Call:
## trendtype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## trendtype <- c("N", "A")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "Z") {
##
## Call:
## seasontype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## if (is.null(damped)) {
##
## Call:
## damped <- c(TRUE, FALSE)
##
## Call:
## }
##
## Call:
## best.ic <- Inf
##
## Call:
## for (i in 1:length(errortype)) {
##
## Call:
## for (j in 1:length(trendtype)) {
##
## Call:
## for (k in 1:length(seasontype)) {
##
## Call:
## for (l in 1:length(damped)) {
##
## Call:
## if (trendtype[j] == "N" && damped[l]) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if (errortype[i] == "A" && (trendtype[j] ==
##
## Call:
## "M" || seasontype[k] == "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (errortype[i] == "M" && trendtype[j] ==
##
## Call:
## "M" && seasontype[k] == "A") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (additive.only && (errortype[i] == "M" ||
##
## Call:
## trendtype[j] == "M" || seasontype[k] ==
##
## Call:
## "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (!data.positive && errortype[i] == "M") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## fit <- try(etsmodel(y, errortype[i], trendtype[j],
##
## Call:
## seasontype[k], damped[l], alpha, beta, gamma,
##
## Call:
## phi, lower = lower, upper = upper, opt.crit = opt.crit,
##
## Call:
## nmse = nmse, bounds = bounds, ...), silent = TRUE)
##
## Call:
## if (is.element("try-error", class(fit)))
##
## Call:
## fit.ic <- Inf
##
## Call:
## else fit.ic <- switch(ic, aic = fit$aic, bic = fit$bic,
##
## Call:
## aicc = fit$aicc)
##
## Call:
## if (!is.na(fit.ic)) {
##
## Call:
## if (fit.ic < best.ic) {
##
## Call:
## model <- fit
##
## Call:
## best.ic <- fit.ic
##
## Call:
## best.e <- errortype[i]
##
## Call:
## best.t <- trendtype[j]
##
## Call:
## best.s <- seasontype[k]
##
## Call:
## best.d <- damped[l]
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (best.ic == Inf) {
##
## Call:
## stop("No model able to be fitted")
##
## Call:
## }
##
## Call:
## model$m <- m
##
## Call:
## model$method <- paste("ETS(", best.e, ",", best.t, ifelse(best.d,
##
## Call:
## "d", ""), ",", best.s, ")", sep = "")
##
## Call:
## model$series <- seriesname
##
## Call:
## model$components <- c(best.e, best.t, best.s, best.d)
##
## Call:
## model$call <- match.call()
##
## Call:
## model$initstate <- model$states[1, ]
##
## Call:
## np <- length(model$par)
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda, biasadj,
##
## Call:
## model$sigma2)
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(structure(model, class = "ets"))
##
## Call:
## })(y = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6,
##
## Call:
## 200, 200.3, 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1,
##
## Call:
## 210.5, 210.5, 209.8, 208.8, 209.5, 213.2, 213.7, 215.1, 218.7,
##
## Call:
## 219.8, 220.5, 223.8, 222.8, 223.8, 221.7, 222.3, 220.8, 219.4,
##
## Call:
## 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7,
##
## Call:
## 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7,
##
## Call:
## 217, 215.9, 215.8, 214.1, 212.3, 213.9, 214.6, 213.6, 212.1,
##
## Call:
## 211.4, 213.1, 212.9, 213.3, 211.5, 212.3, 213, 211, 210.7, 210.1,
##
## Call:
## 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6, 211.9, 212.8,
##
## Call:
## 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4,
##
## Call:
## 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7,
##
## Call:
## 247.6, 247.8, 249.4, 249), .Tsp = c(2008, 2016.41666666667, 12
##
## Call:
## ), class = "ts"), opt.crit = "amse")
##
## Smoothing parameters:
## alpha = 0.8855
## beta = 0.3238
## phi = 0.8559
##
## Initial states:
## l = 200.1077
## b = -0.3274
##
## sigma: 0.0067
##
## AIC AICc BIC
## 555.6122 556.4964 571.3620
##
## $train$partition_2$ets2$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jul 2016 249.3721 247.2205 251.5238 246.0815 252.6628
## Aug 2016 249.6074 246.3064 252.9084 244.5590 254.6558
## Sep 2016 249.8088 245.3380 254.2796 242.9713 256.6463
## Oct 2016 249.9811 244.3316 255.6306 241.3409 258.6213
## Nov 2016 250.1286 243.3034 256.9538 239.6904 260.5669
## Dec 2016 250.2549 242.2661 258.2437 238.0371 262.4727
## Jan 2017 250.3630 241.2291 259.4968 236.3939 264.3320
## Feb 2017 250.4555 240.1995 260.7114 234.7703 266.1406
## Mar 2017 250.5346 239.1822 261.8871 233.1726 267.8967
## Apr 2017 250.6024 238.1809 263.0239 231.6053 269.5995
## May 2017 250.6604 237.1979 264.1229 230.0713 271.2495
## Jun 2017 250.7100 236.2350 265.1851 228.5723 272.8478
##
## $train$partition_2$ets2$parameters
## $train$partition_2$ets2$parameters$type
## [1] "train"
##
## $train$partition_2$ets2$parameters$model_id
## [1] "ets2"
##
## $train$partition_2$ets2$parameters$method
## [1] "ets"
##
## $train$partition_2$ets2$parameters$horizon
## [1] 12
##
## $train$partition_2$ets2$parameters$partition
## [1] "partition_2"
##
##
##
## $train$partition_2$arima1
## $train$partition_2$arima1$model
##
## Call:
## (function (x, order = c(0L, 0L, 0L), seasonal = list(order = c(0L, 0L, 0L),
## period = NA), xreg = NULL, include.mean = TRUE, transform.pars = TRUE, fixed = NULL,
## init = NULL, method = c("CSS-ML", "ML", "CSS"), n.cond, SSinit = c("Gardner1980",
## "Rossignol2011"), optim.method = "BFGS", optim.control = list(), kappa = 1e+06)
## {
## "%+%" <- function(a, b) .Call(C_TSconv, a, b)
## SSinit <- match.arg(SSinit)
## SS.G <- SSinit == "Gardner1980"
## upARIMA <- function(mod, phi, theta) {
## p <- length(phi)
## q <- length(theta)
## mod$phi <- phi
## mod$theta <- theta
## r <- max(p, q + 1L)
## if (p > 0)
## mod$T[1L:p, 1L] <- phi
## if (r > 1L)
## mod$Pn[1L:r, 1L:r] <- if (SS.G)
## .Call(C_getQ0, phi, theta)
## else .Call(C_getQ0bis, phi, theta, tol = 0)
## else mod$Pn[1L, 1L] <- if (p > 0)
## 1/(1 - phi^2)
## else 1
## mod$a[] <- 0
## mod
## }
## arimaSS <- function(y, mod) {
## .Call(C_ARIMA_Like, y, mod, 0L, TRUE)
## }
## armafn <- function(p, trans) {
## par <- coef
## par[mask] <- p
## trarma <- .Call(C_ARIMA_transPars, par, arma, trans)
## if (is.null(Z <- tryCatch(upARIMA(mod, trarma[[1L]], trarma[[2L]]),
## error = function(e) NULL)))
## return(.Machine$double.xmax)
## if (ncxreg > 0)
## x <- x - xreg %*% par[narma + (1L:ncxreg)]
## res <- .Call(C_ARIMA_Like, x, Z, 0L, FALSE)
## s2 <- res[1L]/res[3L]
## 0.5 * (log(s2) + res[2L]/res[3L])
## }
## armaCSS <- function(p) {
## par <- as.double(fixed)
## par[mask] <- p
## trarma <- .Call(C_ARIMA_transPars, par, arma, FALSE)
## if (ncxreg > 0)
## x <- x - xreg %*% par[narma + (1L:ncxreg)]
## res <- .Call(C_ARIMA_CSS, x, arma, trarma[[1L]], trarma[[2L]], as.integer(ncond),
## FALSE)
## 0.5 * log(res)
## }
## arCheck <- function(ar) {
## p <- max(which(c(1, -ar) != 0)) - 1
## if (!p)
## return(TRUE)
## all(Mod(polyroot(c(1, -ar[1L:p]))) > 1)
## }
## maInvert <- function(ma) {
## q <- length(ma)
## q0 <- max(which(c(1, ma) != 0)) - 1L
## if (!q0)
## return(ma)
## roots <- polyroot(c(1, ma[1L:q0]))
## ind <- Mod(roots) < 1
## if (all(!ind))
## return(ma)
## if (q0 == 1)
## return(c(1/ma[1L], rep.int(0, q - q0)))
## roots[ind] <- 1/roots[ind]
## x <- 1
## for (r in roots) x <- c(x, 0) - c(0, x)/r
## c(Re(x[-1L]), rep.int(0, q - q0))
## }
## series <- deparse1(substitute(x))
## if (NCOL(x) > 1L)
## stop("only implemented for univariate time series")
## method <- match.arg(method)
## x <- as.ts(x)
## if (!is.numeric(x))
## stop("'x' must be numeric")
## storage.mode(x) <- "double"
## dim(x) <- NULL
## n <- length(x)
## if (!missing(order))
## if (!is.numeric(order) || length(order) != 3L || any(order < 0))
## stop("'order' must be a non-negative numeric vector of length 3")
## if (!missing(seasonal))
## if (is.list(seasonal)) {
## if (is.null(seasonal$order))
## stop("'seasonal' must be a list with component 'order'")
## if (!is.numeric(seasonal$order) || length(seasonal$order) != 3L ||
## any(seasonal$order < 0L))
## stop("'seasonal$order' must be a non-negative numeric vector of length 3")
## }
## else if (is.numeric(order)) {
## if (length(order) == 3L)
## seasonal <- list(order = seasonal)
## else ("'seasonal' is of the wrong length")
## }
## else stop("'seasonal' must be a list with component 'order'")
## if (is.null(seasonal$period) || is.na(seasonal$period) || seasonal$period ==
## 0)
## seasonal$period <- frequency(x)
## arma <- as.integer(c(order[-2L], seasonal$order[-2L], seasonal$period, order[2L],
## seasonal$order[2L]))
## narma <- sum(arma[1L:4L])
## xtsp <- tsp(x)
## tsp(x) <- NULL
## Delta <- 1
## for (i in seq_len(order[2L])) Delta <- Delta %+% c(1, -1)
## for (i in seq_len(seasonal$order[2L])) Delta <- Delta %+% c(1, rep.int(0,
## seasonal$period - 1), -1)
## Delta <- -Delta[-1L]
## nd <- order[2L] + seasonal$order[2L]
## n.used <- sum(!is.na(x)) - length(Delta)
## if (is.null(xreg)) {
## ncxreg <- 0L
## }
## else {
## nmxreg <- deparse1(substitute(xreg))
## if (NROW(xreg) != n)
## stop("lengths of 'x' and 'xreg' do not match")
## ncxreg <- NCOL(xreg)
## xreg <- as.matrix(xreg)
## storage.mode(xreg) <- "double"
## }
## class(xreg) <- NULL
## if (ncxreg > 0L && is.null(colnames(xreg)))
## colnames(xreg) <- if (ncxreg == 1L)
## nmxreg
## else paste0(nmxreg, 1L:ncxreg)
## if (include.mean && (nd == 0L)) {
## xreg <- cbind(intercept = rep(1, n), xreg = xreg)
## ncxreg <- ncxreg + 1L
## }
## if (method == "CSS-ML") {
## anyna <- anyNA(x)
## if (ncxreg)
## anyna <- anyna || anyNA(xreg)
## if (anyna)
## method <- "ML"
## }
## if (method == "CSS" || method == "CSS-ML") {
## ncond <- order[2L] + seasonal$order[2L] * seasonal$period
## ncond1 <- order[1L] + seasonal$period * seasonal$order[1L]
## ncond <- ncond + if (!missing(n.cond))
## max(n.cond, ncond1)
## else ncond1
## }
## else ncond <- 0
## if (is.null(fixed))
## fixed <- rep(NA_real_, narma + ncxreg)
## else if (length(fixed) != narma + ncxreg)
## stop("wrong length for 'fixed'")
## mask <- is.na(fixed)
## no.optim <- !any(mask)
## if (no.optim)
## transform.pars <- FALSE
## if (transform.pars) {
## ind <- arma[1L] + arma[2L] + seq_len(arma[3L])
## if (any(!mask[seq_len(arma[1L])]) || any(!mask[ind])) {
## warning("some AR parameters were fixed: setting transform.pars = FALSE")
## transform.pars <- FALSE
## }
## }
## init0 <- rep.int(0, narma)
## parscale <- rep(1, narma)
## if (ncxreg) {
## cn <- colnames(xreg)
## orig.xreg <- (ncxreg == 1L) || any(!mask[narma + 1L:ncxreg])
## if (!orig.xreg) {
## S <- svd(na.omit(xreg))
## xreg <- xreg %*% S$v
## }
## dx <- x
## dxreg <- xreg
## if (order[2L] > 0L) {
## dx <- diff(dx, 1L, order[2L])
## dxreg <- diff(dxreg, 1L, order[2L])
## }
## if (seasonal$period > 1L && seasonal$order[2L] > 0) {
## dx <- diff(dx, seasonal$period, seasonal$order[2L])
## dxreg <- diff(dxreg, seasonal$period, seasonal$order[2L])
## }
## fit <- if (length(dx) > ncol(dxreg))
## lm(dx ~ dxreg - 1, na.action = na.omit)
## else list(rank = 0L)
## if (fit$rank == 0L) {
## fit <- lm(x ~ xreg - 1, na.action = na.omit)
## }
## isna <- is.na(x) | apply(xreg, 1L, anyNA)
## n.used <- sum(!isna) - length(Delta)
## init0 <- c(init0, coef(fit))
## ses <- summary(fit)$coefficients[, 2L]
## parscale <- c(parscale, 10 * ses)
## }
## if (n.used <= 0)
## stop("too few non-missing observations")
## if (!is.null(init)) {
## if (length(init) != length(init0))
## stop("'init' is of the wrong length")
## if (any(ind <- is.na(init)))
## init[ind] <- init0[ind]
## if (method == "ML") {
## if (arma[1L] > 0)
## if (!arCheck(init[1L:arma[1L]]))
## stop("non-stationary AR part")
## if (arma[3L] > 0)
## if (!arCheck(init[sum(arma[1L:2L]) + 1L:arma[3L]]))
## stop("non-stationary seasonal AR part")
## if (transform.pars)
## init <- .Call(C_ARIMA_Invtrans, as.double(init), arma)
## }
## }
## else init <- init0
## coef <- as.double(fixed)
## if (!("parscale" %in% names(optim.control)))
## optim.control$parscale <- parscale[mask]
## if (method == "CSS") {
## res <- if (no.optim)
## list(convergence = 0L, par = numeric(), value = armaCSS(numeric()))
## else optim(init[mask], armaCSS, method = optim.method, hessian = TRUE,
## control = optim.control)
## if (res$convergence > 0)
## warning(gettextf("possible convergence problem: optim gave code = %d",
## res$convergence), domain = NA)
## coef[mask] <- res$par
## trarma <- .Call(C_ARIMA_transPars, coef, arma, FALSE)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## if (ncxreg > 0)
## x <- x - xreg %*% coef[narma + (1L:ncxreg)]
## arimaSS(x, mod)
## val <- .Call(C_ARIMA_CSS, x, arma, trarma[[1L]], trarma[[2L]], as.integer(ncond),
## TRUE)
## sigma2 <- val[[1L]]
## var <- if (no.optim)
## numeric()
## else solve(res$hessian * n.used)
## }
## else {
## if (method == "CSS-ML") {
## res <- if (no.optim)
## list(convergence = 0L, par = numeric(), value = armaCSS(numeric()))
## else optim(init[mask], armaCSS, method = optim.method, hessian = FALSE,
## control = optim.control)
## if (res$convergence == 0)
## init[mask] <- res$par
## if (arma[1L] > 0)
## if (!arCheck(init[1L:arma[1L]]))
## stop("non-stationary AR part from CSS")
## if (arma[3L] > 0)
## if (!arCheck(init[sum(arma[1L:2L]) + 1L:arma[3L]]))
## stop("non-stationary seasonal AR part from CSS")
## ncond <- 0L
## }
## if (transform.pars) {
## init <- .Call(C_ARIMA_Invtrans, init, arma)
## if (arma[2L] > 0) {
## ind <- arma[1L] + 1L:arma[2L]
## init[ind] <- maInvert(init[ind])
## }
## if (arma[4L] > 0) {
## ind <- sum(arma[1L:3L]) + 1L:arma[4L]
## init[ind] <- maInvert(init[ind])
## }
## }
## trarma <- .Call(C_ARIMA_transPars, init, arma, transform.pars)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## res <- if (no.optim)
## list(convergence = 0, par = numeric(), value = armafn(numeric(),
## as.logical(transform.pars)))
## else optim(init[mask], armafn, method = optim.method, hessian = TRUE,
## control = optim.control, trans = as.logical(transform.pars))
## if (res$convergence > 0)
## warning(gettextf("possible convergence problem: optim gave code = %d",
## res$convergence), domain = NA)
## coef[mask] <- res$par
## if (transform.pars) {
## if (arma[2L] > 0L) {
## ind <- arma[1L] + 1L:arma[2L]
## if (all(mask[ind]))
## coef[ind] <- maInvert(coef[ind])
## }
## if (arma[4L] > 0L) {
## ind <- sum(arma[1L:3L]) + 1L:arma[4L]
## if (all(mask[ind]))
## coef[ind] <- maInvert(coef[ind])
## }
## if (any(coef[mask] != res$par)) {
## oldcode <- res$convergence
## res <- optim(coef[mask], armafn, method = optim.method, hessian = TRUE,
## control = list(maxit = 0L, parscale = optim.control$parscale),
## trans = TRUE)
## res$convergence <- oldcode
## coef[mask] <- res$par
## }
## A <- .Call(C_ARIMA_Gradtrans, as.double(coef), arma)
## A <- A[mask, mask]
## var <- crossprod(A, solve(res$hessian * n.used, A))
## coef <- .Call(C_ARIMA_undoPars, coef, arma)
## }
## else var <- if (no.optim)
## numeric()
## else solve(res$hessian * n.used)
## trarma <- .Call(C_ARIMA_transPars, coef, arma, FALSE)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## val <- if (ncxreg > 0L)
## arimaSS(x - xreg %*% coef[narma + (1L:ncxreg)], mod)
## else arimaSS(x, mod)
## sigma2 <- val[[1L]][1L]/n.used
## }
## value <- 2 * n.used * res$value + n.used + n.used * log(2 * pi)
## aic <- if (method != "CSS")
## value + 2 * sum(mask) + 2
## else NA
## nm <- NULL
## if (arma[1L] > 0L)
## nm <- c(nm, paste0("ar", 1L:arma[1L]))
## if (arma[2L] > 0L)
## nm <- c(nm, paste0("ma", 1L:arma[2L]))
## if (arma[3L] > 0L)
## nm <- c(nm, paste0("sar", 1L:arma[3L]))
## if (arma[4L] > 0L)
## nm <- c(nm, paste0("sma", 1L:arma[4L]))
## if (ncxreg > 0L) {
## nm <- c(nm, cn)
## if (!orig.xreg) {
## ind <- narma + 1L:ncxreg
## coef[ind] <- S$v %*% coef[ind]
## A <- diag(narma + ncxreg)
## A[ind, ind] <- S$v
## A <- A[mask, mask]
## var <- A %*% var %*% t(A)
## }
## }
## names(coef) <- nm
## if (!no.optim)
## dimnames(var) <- list(nm[mask], nm[mask])
## resid <- val[[2L]]
## tsp(resid) <- xtsp
## class(resid) <- "ts"
## structure(list(coef = coef, sigma2 = sigma2, var.coef = var, mask = mask,
## loglik = -0.5 * value, aic = aic, arma = arma, residuals = resid, call = match.call(),
## series = series, code = res$convergence, n.cond = ncond, nobs = n.used,
## model = mod), class = "Arima")
## })(x = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6, 200, 200.3,
## 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1, 210.5, 210.5, 209.8, 208.8,
## 209.5, 213.2, 213.7, 215.1, 218.7, 219.8, 220.5, 223.8, 222.8, 223.8, 221.7,
## 222.3, 220.8, 219.4, 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7,
## 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7, 217, 215.9, 215.8,
## 214.1, 212.3, 213.9, 214.6, 213.6, 212.1, 211.4, 213.1, 212.9, 213.3, 211.5,
## 212.3, 213, 211, 210.7, 210.1, 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6,
## 211.9, 212.8, 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4,
## 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7, 247.6, 247.8, 249.4,
## 249), .Tsp = c(2008, 2016.41666666667, 12), class = "ts"), order = c(2, 1, 0
## ))
##
## Coefficients:
## ar1 ar2
## 0.303 0.2376
## s.e. 0.096 0.0963
##
## sigma^2 estimated as 2.144: log likelihood = -181.98, aic = 369.97
##
## $train$partition_2$arima1$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jul 2016 249.2589 247.3822 251.1356 246.3887 252.1291
## Aug 2016 249.2423 246.1598 252.3248 244.5280 253.9566
## Sep 2016 249.2988 244.9529 253.6447 242.6523 255.9453
## Oct 2016 249.3120 243.8028 254.8211 240.8864 257.7375
## Nov 2016 249.3294 242.7316 255.9272 239.2389 259.4198
## Dec 2016 249.3378 241.7333 256.9422 237.7078 260.9678
## Jan 2017 249.3445 240.8052 257.8838 236.2847 262.4042
## Feb 2017 249.3485 239.9390 258.7580 234.9579 263.7391
## Mar 2017 249.3513 239.1280 259.5746 233.7161 264.9865
## Apr 2017 249.3531 238.3654 260.3408 232.5488 266.1574
## May 2017 249.3543 237.6452 261.0634 231.4468 267.2619
## Jun 2017 249.3551 236.9623 261.7479 230.4020 268.3083
##
## $train$partition_2$arima1$parameters
## $train$partition_2$arima1$parameters$type
## [1] "train"
##
## $train$partition_2$arima1$parameters$model_id
## [1] "arima1"
##
## $train$partition_2$arima1$parameters$method
## [1] "arima"
##
## $train$partition_2$arima1$parameters$horizon
## [1] 12
##
## $train$partition_2$arima1$parameters$partition
## [1] "partition_2"
##
##
##
## $train$partition_2$arima2
## $train$partition_2$arima2$model
##
## Call:
## (function (x, order = c(0L, 0L, 0L), seasonal = list(order = c(0L, 0L, 0L),
## period = NA), xreg = NULL, include.mean = TRUE, transform.pars = TRUE, fixed = NULL,
## init = NULL, method = c("CSS-ML", "ML", "CSS"), n.cond, SSinit = c("Gardner1980",
## "Rossignol2011"), optim.method = "BFGS", optim.control = list(), kappa = 1e+06)
## {
## "%+%" <- function(a, b) .Call(C_TSconv, a, b)
## SSinit <- match.arg(SSinit)
## SS.G <- SSinit == "Gardner1980"
## upARIMA <- function(mod, phi, theta) {
## p <- length(phi)
## q <- length(theta)
## mod$phi <- phi
## mod$theta <- theta
## r <- max(p, q + 1L)
## if (p > 0)
## mod$T[1L:p, 1L] <- phi
## if (r > 1L)
## mod$Pn[1L:r, 1L:r] <- if (SS.G)
## .Call(C_getQ0, phi, theta)
## else .Call(C_getQ0bis, phi, theta, tol = 0)
## else mod$Pn[1L, 1L] <- if (p > 0)
## 1/(1 - phi^2)
## else 1
## mod$a[] <- 0
## mod
## }
## arimaSS <- function(y, mod) {
## .Call(C_ARIMA_Like, y, mod, 0L, TRUE)
## }
## armafn <- function(p, trans) {
## par <- coef
## par[mask] <- p
## trarma <- .Call(C_ARIMA_transPars, par, arma, trans)
## if (is.null(Z <- tryCatch(upARIMA(mod, trarma[[1L]], trarma[[2L]]),
## error = function(e) NULL)))
## return(.Machine$double.xmax)
## if (ncxreg > 0)
## x <- x - xreg %*% par[narma + (1L:ncxreg)]
## res <- .Call(C_ARIMA_Like, x, Z, 0L, FALSE)
## s2 <- res[1L]/res[3L]
## 0.5 * (log(s2) + res[2L]/res[3L])
## }
## armaCSS <- function(p) {
## par <- as.double(fixed)
## par[mask] <- p
## trarma <- .Call(C_ARIMA_transPars, par, arma, FALSE)
## if (ncxreg > 0)
## x <- x - xreg %*% par[narma + (1L:ncxreg)]
## res <- .Call(C_ARIMA_CSS, x, arma, trarma[[1L]], trarma[[2L]], as.integer(ncond),
## FALSE)
## 0.5 * log(res)
## }
## arCheck <- function(ar) {
## p <- max(which(c(1, -ar) != 0)) - 1
## if (!p)
## return(TRUE)
## all(Mod(polyroot(c(1, -ar[1L:p]))) > 1)
## }
## maInvert <- function(ma) {
## q <- length(ma)
## q0 <- max(which(c(1, ma) != 0)) - 1L
## if (!q0)
## return(ma)
## roots <- polyroot(c(1, ma[1L:q0]))
## ind <- Mod(roots) < 1
## if (all(!ind))
## return(ma)
## if (q0 == 1)
## return(c(1/ma[1L], rep.int(0, q - q0)))
## roots[ind] <- 1/roots[ind]
## x <- 1
## for (r in roots) x <- c(x, 0) - c(0, x)/r
## c(Re(x[-1L]), rep.int(0, q - q0))
## }
## series <- deparse1(substitute(x))
## if (NCOL(x) > 1L)
## stop("only implemented for univariate time series")
## method <- match.arg(method)
## x <- as.ts(x)
## if (!is.numeric(x))
## stop("'x' must be numeric")
## storage.mode(x) <- "double"
## dim(x) <- NULL
## n <- length(x)
## if (!missing(order))
## if (!is.numeric(order) || length(order) != 3L || any(order < 0))
## stop("'order' must be a non-negative numeric vector of length 3")
## if (!missing(seasonal))
## if (is.list(seasonal)) {
## if (is.null(seasonal$order))
## stop("'seasonal' must be a list with component 'order'")
## if (!is.numeric(seasonal$order) || length(seasonal$order) != 3L ||
## any(seasonal$order < 0L))
## stop("'seasonal$order' must be a non-negative numeric vector of length 3")
## }
## else if (is.numeric(order)) {
## if (length(order) == 3L)
## seasonal <- list(order = seasonal)
## else ("'seasonal' is of the wrong length")
## }
## else stop("'seasonal' must be a list with component 'order'")
## if (is.null(seasonal$period) || is.na(seasonal$period) || seasonal$period ==
## 0)
## seasonal$period <- frequency(x)
## arma <- as.integer(c(order[-2L], seasonal$order[-2L], seasonal$period, order[2L],
## seasonal$order[2L]))
## narma <- sum(arma[1L:4L])
## xtsp <- tsp(x)
## tsp(x) <- NULL
## Delta <- 1
## for (i in seq_len(order[2L])) Delta <- Delta %+% c(1, -1)
## for (i in seq_len(seasonal$order[2L])) Delta <- Delta %+% c(1, rep.int(0,
## seasonal$period - 1), -1)
## Delta <- -Delta[-1L]
## nd <- order[2L] + seasonal$order[2L]
## n.used <- sum(!is.na(x)) - length(Delta)
## if (is.null(xreg)) {
## ncxreg <- 0L
## }
## else {
## nmxreg <- deparse1(substitute(xreg))
## if (NROW(xreg) != n)
## stop("lengths of 'x' and 'xreg' do not match")
## ncxreg <- NCOL(xreg)
## xreg <- as.matrix(xreg)
## storage.mode(xreg) <- "double"
## }
## class(xreg) <- NULL
## if (ncxreg > 0L && is.null(colnames(xreg)))
## colnames(xreg) <- if (ncxreg == 1L)
## nmxreg
## else paste0(nmxreg, 1L:ncxreg)
## if (include.mean && (nd == 0L)) {
## xreg <- cbind(intercept = rep(1, n), xreg = xreg)
## ncxreg <- ncxreg + 1L
## }
## if (method == "CSS-ML") {
## anyna <- anyNA(x)
## if (ncxreg)
## anyna <- anyna || anyNA(xreg)
## if (anyna)
## method <- "ML"
## }
## if (method == "CSS" || method == "CSS-ML") {
## ncond <- order[2L] + seasonal$order[2L] * seasonal$period
## ncond1 <- order[1L] + seasonal$period * seasonal$order[1L]
## ncond <- ncond + if (!missing(n.cond))
## max(n.cond, ncond1)
## else ncond1
## }
## else ncond <- 0
## if (is.null(fixed))
## fixed <- rep(NA_real_, narma + ncxreg)
## else if (length(fixed) != narma + ncxreg)
## stop("wrong length for 'fixed'")
## mask <- is.na(fixed)
## no.optim <- !any(mask)
## if (no.optim)
## transform.pars <- FALSE
## if (transform.pars) {
## ind <- arma[1L] + arma[2L] + seq_len(arma[3L])
## if (any(!mask[seq_len(arma[1L])]) || any(!mask[ind])) {
## warning("some AR parameters were fixed: setting transform.pars = FALSE")
## transform.pars <- FALSE
## }
## }
## init0 <- rep.int(0, narma)
## parscale <- rep(1, narma)
## if (ncxreg) {
## cn <- colnames(xreg)
## orig.xreg <- (ncxreg == 1L) || any(!mask[narma + 1L:ncxreg])
## if (!orig.xreg) {
## S <- svd(na.omit(xreg))
## xreg <- xreg %*% S$v
## }
## dx <- x
## dxreg <- xreg
## if (order[2L] > 0L) {
## dx <- diff(dx, 1L, order[2L])
## dxreg <- diff(dxreg, 1L, order[2L])
## }
## if (seasonal$period > 1L && seasonal$order[2L] > 0) {
## dx <- diff(dx, seasonal$period, seasonal$order[2L])
## dxreg <- diff(dxreg, seasonal$period, seasonal$order[2L])
## }
## fit <- if (length(dx) > ncol(dxreg))
## lm(dx ~ dxreg - 1, na.action = na.omit)
## else list(rank = 0L)
## if (fit$rank == 0L) {
## fit <- lm(x ~ xreg - 1, na.action = na.omit)
## }
## isna <- is.na(x) | apply(xreg, 1L, anyNA)
## n.used <- sum(!isna) - length(Delta)
## init0 <- c(init0, coef(fit))
## ses <- summary(fit)$coefficients[, 2L]
## parscale <- c(parscale, 10 * ses)
## }
## if (n.used <= 0)
## stop("too few non-missing observations")
## if (!is.null(init)) {
## if (length(init) != length(init0))
## stop("'init' is of the wrong length")
## if (any(ind <- is.na(init)))
## init[ind] <- init0[ind]
## if (method == "ML") {
## if (arma[1L] > 0)
## if (!arCheck(init[1L:arma[1L]]))
## stop("non-stationary AR part")
## if (arma[3L] > 0)
## if (!arCheck(init[sum(arma[1L:2L]) + 1L:arma[3L]]))
## stop("non-stationary seasonal AR part")
## if (transform.pars)
## init <- .Call(C_ARIMA_Invtrans, as.double(init), arma)
## }
## }
## else init <- init0
## coef <- as.double(fixed)
## if (!("parscale" %in% names(optim.control)))
## optim.control$parscale <- parscale[mask]
## if (method == "CSS") {
## res <- if (no.optim)
## list(convergence = 0L, par = numeric(), value = armaCSS(numeric()))
## else optim(init[mask], armaCSS, method = optim.method, hessian = TRUE,
## control = optim.control)
## if (res$convergence > 0)
## warning(gettextf("possible convergence problem: optim gave code = %d",
## res$convergence), domain = NA)
## coef[mask] <- res$par
## trarma <- .Call(C_ARIMA_transPars, coef, arma, FALSE)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## if (ncxreg > 0)
## x <- x - xreg %*% coef[narma + (1L:ncxreg)]
## arimaSS(x, mod)
## val <- .Call(C_ARIMA_CSS, x, arma, trarma[[1L]], trarma[[2L]], as.integer(ncond),
## TRUE)
## sigma2 <- val[[1L]]
## var <- if (no.optim)
## numeric()
## else solve(res$hessian * n.used)
## }
## else {
## if (method == "CSS-ML") {
## res <- if (no.optim)
## list(convergence = 0L, par = numeric(), value = armaCSS(numeric()))
## else optim(init[mask], armaCSS, method = optim.method, hessian = FALSE,
## control = optim.control)
## if (res$convergence == 0)
## init[mask] <- res$par
## if (arma[1L] > 0)
## if (!arCheck(init[1L:arma[1L]]))
## stop("non-stationary AR part from CSS")
## if (arma[3L] > 0)
## if (!arCheck(init[sum(arma[1L:2L]) + 1L:arma[3L]]))
## stop("non-stationary seasonal AR part from CSS")
## ncond <- 0L
## }
## if (transform.pars) {
## init <- .Call(C_ARIMA_Invtrans, init, arma)
## if (arma[2L] > 0) {
## ind <- arma[1L] + 1L:arma[2L]
## init[ind] <- maInvert(init[ind])
## }
## if (arma[4L] > 0) {
## ind <- sum(arma[1L:3L]) + 1L:arma[4L]
## init[ind] <- maInvert(init[ind])
## }
## }
## trarma <- .Call(C_ARIMA_transPars, init, arma, transform.pars)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## res <- if (no.optim)
## list(convergence = 0, par = numeric(), value = armafn(numeric(),
## as.logical(transform.pars)))
## else optim(init[mask], armafn, method = optim.method, hessian = TRUE,
## control = optim.control, trans = as.logical(transform.pars))
## if (res$convergence > 0)
## warning(gettextf("possible convergence problem: optim gave code = %d",
## res$convergence), domain = NA)
## coef[mask] <- res$par
## if (transform.pars) {
## if (arma[2L] > 0L) {
## ind <- arma[1L] + 1L:arma[2L]
## if (all(mask[ind]))
## coef[ind] <- maInvert(coef[ind])
## }
## if (arma[4L] > 0L) {
## ind <- sum(arma[1L:3L]) + 1L:arma[4L]
## if (all(mask[ind]))
## coef[ind] <- maInvert(coef[ind])
## }
## if (any(coef[mask] != res$par)) {
## oldcode <- res$convergence
## res <- optim(coef[mask], armafn, method = optim.method, hessian = TRUE,
## control = list(maxit = 0L, parscale = optim.control$parscale),
## trans = TRUE)
## res$convergence <- oldcode
## coef[mask] <- res$par
## }
## A <- .Call(C_ARIMA_Gradtrans, as.double(coef), arma)
## A <- A[mask, mask]
## var <- crossprod(A, solve(res$hessian * n.used, A))
## coef <- .Call(C_ARIMA_undoPars, coef, arma)
## }
## else var <- if (no.optim)
## numeric()
## else solve(res$hessian * n.used)
## trarma <- .Call(C_ARIMA_transPars, coef, arma, FALSE)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## val <- if (ncxreg > 0L)
## arimaSS(x - xreg %*% coef[narma + (1L:ncxreg)], mod)
## else arimaSS(x, mod)
## sigma2 <- val[[1L]][1L]/n.used
## }
## value <- 2 * n.used * res$value + n.used + n.used * log(2 * pi)
## aic <- if (method != "CSS")
## value + 2 * sum(mask) + 2
## else NA
## nm <- NULL
## if (arma[1L] > 0L)
## nm <- c(nm, paste0("ar", 1L:arma[1L]))
## if (arma[2L] > 0L)
## nm <- c(nm, paste0("ma", 1L:arma[2L]))
## if (arma[3L] > 0L)
## nm <- c(nm, paste0("sar", 1L:arma[3L]))
## if (arma[4L] > 0L)
## nm <- c(nm, paste0("sma", 1L:arma[4L]))
## if (ncxreg > 0L) {
## nm <- c(nm, cn)
## if (!orig.xreg) {
## ind <- narma + 1L:ncxreg
## coef[ind] <- S$v %*% coef[ind]
## A <- diag(narma + ncxreg)
## A[ind, ind] <- S$v
## A <- A[mask, mask]
## var <- A %*% var %*% t(A)
## }
## }
## names(coef) <- nm
## if (!no.optim)
## dimnames(var) <- list(nm[mask], nm[mask])
## resid <- val[[2L]]
## tsp(resid) <- xtsp
## class(resid) <- "ts"
## structure(list(coef = coef, sigma2 = sigma2, var.coef = var, mask = mask,
## loglik = -0.5 * value, aic = aic, arma = arma, residuals = resid, call = match.call(),
## series = series, code = res$convergence, n.cond = ncond, nobs = n.used,
## model = mod), class = "Arima")
## })(x = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6, 200, 200.3,
## 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1, 210.5, 210.5, 209.8, 208.8,
## 209.5, 213.2, 213.7, 215.1, 218.7, 219.8, 220.5, 223.8, 222.8, 223.8, 221.7,
## 222.3, 220.8, 219.4, 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7,
## 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7, 217, 215.9, 215.8,
## 214.1, 212.3, 213.9, 214.6, 213.6, 212.1, 211.4, 213.1, 212.9, 213.3, 211.5,
## 212.3, 213, 211, 210.7, 210.1, 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6,
## 211.9, 212.8, 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4,
## 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7, 247.6, 247.8, 249.4,
## 249), .Tsp = c(2008, 2016.41666666667, 12), class = "ts"), order = c(2, 1, 2
## ), seasonal = list(order = c(1, 1, 1)))
##
## Coefficients:## Warning in sqrt(diag(x$var.coef)): NaNs produced## ar1 ar2 ma1 ma2 sar1 sma1
## 0.0752 0.7075 0.1813 -0.5027 0.0013 -1.0000
## s.e. NaN NaN NaN NaN 0.1160 0.1593
##
## sigma^2 estimated as 2.049: log likelihood = -170.94, aic = 355.88
##
## $train$partition_2$arima2$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jul 2016 249.0098 247.0648 250.9547 246.0352 251.9844
## Aug 2016 249.2014 246.0790 252.3239 244.4261 253.9768
## Sep 2016 249.0966 244.8509 253.3424 242.6034 255.5899
## Oct 2016 250.3805 245.0274 255.7337 242.1936 258.5675
## Nov 2016 251.2731 244.8249 257.7212 241.4115 261.1347
## Dec 2016 252.0518 244.5216 259.5819 240.5353 263.5682
## Jan 2017 251.6897 243.0940 260.2853 238.5438 264.8355
## Feb 2017 251.8924 242.2557 261.5292 237.1543 266.6306
## Mar 2017 252.2272 241.5680 262.8865 235.9254 268.5291
## Apr 2017 252.7969 241.1353 264.4586 234.9620 270.6318
## May 2017 253.2908 240.6483 265.9333 233.9558 272.6259
## Jun 2017 253.9263 240.3250 267.5275 233.1249 274.7276
##
## $train$partition_2$arima2$parameters
## $train$partition_2$arima2$parameters$type
## [1] "train"
##
## $train$partition_2$arima2$parameters$model_id
## [1] "arima2"
##
## $train$partition_2$arima2$parameters$method
## [1] "arima"
##
## $train$partition_2$arima2$parameters$horizon
## [1] 12
##
## $train$partition_2$arima2$parameters$partition
## [1] "partition_2"
##
##
##
## $train$partition_2$hw
## $train$partition_2$hw$model
## Holt-Winters exponential smoothing with trend and additive seasonal component.
##
## Call:
## (function (x, alpha = NULL, beta = NULL, gamma = NULL, seasonal = c("additive", "multiplicative"), start.periods = 2, l.start = NULL, b.start = NULL, s.start = NULL, optim.start = c(alpha = 0.3, beta = 0.1, gamma = 0.1), optim.control = list()) { x <- as.ts(x) seasonal <- match.arg(seasonal) f <- frequency(x) if (!is.null(alpha) && (alpha == 0)) stop("cannot fit models without level ('alpha' must not be 0 or FALSE)") if (!is.null(abg <- c(alpha, beta, gamma)) && any(abg < 0 | abg > 1)) stop("'alpha', 'beta' and 'gamma' must be within the unit interval") if (is.null(gamma) || gamma > 0) { if (seasonal == "multiplicative" && any(x == 0)) stop("data must be non-zero for multiplicative Holt-Winters") if (start.periods < 2) stop("need at least 2 periods to compute seasonal start values") } if (!is.null(gamma) && is.logical(gamma) && !gamma) { expsmooth <- !is.null(beta) && is.logical(beta) && !beta if (is.null(l.start)) l.start <- if (expsmooth) x[1L] else x[2L] if (is.null(b.start)) if (is.null(beta) || !is.logical(beta) || beta) b.start <- x[2L] - x[1L] start.time <- 3 - expsmooth s.start <- 0 } else { start.time <- f + 1 wind <- start.periods * f st <- decompose(ts(x[1L:wind], start = start(x), frequency = f), seasonal) if (is.null(l.start) || is.null(b.start)) { dat <- na.omit(st$trend) cf <- coef(.lm.fit(x = cbind(1, seq_along(dat)), y = dat)) if (is.null(l.start)) l.start <- cf[1L] if (is.null(b.start)) b.start <- cf[2L] } if (is.null(s.start)) s.start <- st$figure } lenx <- as.integer(length(x)) if (is.na(lenx)) stop("invalid length(x)") len <- lenx - start.time + 1 hw <- function(alpha, beta, gamma) .C(C_HoltWinters, as.double(x), lenx, as.double(max(min(alpha, 1), 0)), as.double(max(min(beta, 1), 0)), as.double(max(min(gamma, 1), 0)), as.integer(start.time), as.integer(!+(seasonal == "multiplicative")), as.integer(f), as.integer(!is.logical(beta) || beta), as.integer(!is.logical(gamma) || gamma), a = as.double(l.start), b = as.double(b.start), s = as.double(s.start), SSE = as.double(0), level = double(len + 1L), trend = double(len + 1L), seasonal = double(len + f)) if (is.null(gamma)) { if (is.null(alpha)) { if (is.null(beta)) { error <- function(p) hw(p[1L], p[2L], p[3L])$SSE sol <- optim(optim.start, error, method = "L-BFGS-B", lower = c(0, 0, 0), upper = c(1, 1, 1), control = optim.control) if (sol$convergence || any(sol$par < 0 | sol$par > 1)) { if (sol$convergence > 50) { warning(gettextf("optimization difficulties: %s", sol$message), domain = NA) } else stop("optimization failure") } alpha <- sol$par[1L] beta <- sol$par[2L] gamma <- sol$par[3L] } else { error <- function(p) hw(p[1L], beta, p[2L])$SSE sol <- optim(c(optim.start["alpha"], optim.start["gamma"]), error, method = "L-BFGS-B", lower = c(0, 0), upper = c(1, 1), control = optim.control) if (sol$convergence || any(sol$par < 0 | sol$par > 1)) { if (sol$convergence > 50) { warning(gettextf("optimization difficulties: %s", sol$message), domain = NA) } else stop("optimization failure") } alpha <- sol$par[1L] gamma <- sol$par[2L] } } else { if (is.null(beta)) { error <- function(p) hw(alpha, p[1L], p[2L])$SSE sol <- optim(c(optim.start["beta"], optim.start["gamma"]), error, method = "L-BFGS-B", lower = c(0, 0), upper = c(1, 1), control = optim.control) if (sol$convergence || any(sol$par < 0 | sol$par > 1)) { if (sol$convergence > 50) { warning(gettextf("optimization difficulties: %s", sol$message), domain = NA) } else stop("optimization failure") } beta <- sol$par[1L] gamma <- sol$par[2L] } else { error <- function(p) hw(alpha, beta, p)$SSE gamma <- optimize(error, lower = 0, upper = 1)$minimum } } } else { if (is.null(alpha)) { if (is.null(beta)) { error <- function(p) hw(p[1L], p[2L], gamma)$SSE sol <- optim(c(optim.start["alpha"], optim.start["beta"]), error, method = "L-BFGS-B", lower = c(0, 0), upper = c(1, 1), control = optim.control) if (sol$convergence || any(sol$par < 0 | sol$par > 1)) { if (sol$convergence > 50) { warning(gettextf("optimization difficulties: %s", sol$message), domain = NA) } else stop("optimization failure") } alpha <- sol$par[1L] beta <- sol$par[2L] } else { error <- function(p) hw(p, beta, gamma)$SSE alpha <- optimize(error, lower = 0, upper = 1)$minimum } } else { if (is.null(beta)) { error <- function(p) hw(alpha, p, gamma)$SSE beta <- optimize(error, lower = 0, upper = 1)$minimum } } } final.fit <- hw(alpha, beta, gamma) fitted <- ts(cbind(xhat = final.fit$level[-len - 1], level = final.fit$level[-len - 1], trend = if (!is.logical(beta) || beta) final.fit$trend[-len - 1], season = if (!is.logical(gamma) || gamma) final.fit$seasonal[1L:len]), start = start(lag(x, k = 1 - start.time)), frequency = frequency(x)) if (!is.logical(beta) || beta) fitted[, 1] <- fitted[, 1] + fitted[, "trend"] if (!is.logical(gamma) || gamma) fitted[, 1] <- if (seasonal == "multiplicative") fitted[, 1] * fitted[, "season"] else fitted[, 1] + fitted[, "season"] structure(list(fitted = fitted, x = x, alpha = alpha, beta = beta, gamma = gamma, coefficients = c(a = final.fit$level[len + 1], b = if (!is.logical(beta) || beta) final.fit$trend[len + 1], s = if (!is.logical(gamma) || gamma) final.fit$seasonal[len + 1L:f]), seasonal = seasonal, SSE = final.fit$SSE, call = match.call()), class = "HoltWinters")})(x = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6, 200, 200.3, 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1, 210.5, 210.5, 209.8, 208.8, 209.5, 213.2, 213.7, 215.1, 218.7, 219.8, 220.5, 223.8, 222.8, 223.8, 221.7, 222.3, 220.8, 219.4, 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7, 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7, 217, 215.9, 215.8, 214.1, 212.3, 213.9, 214.6, 213.6, 212.1, 211.4, 213.1, 212.9, 213.3, 211.5, 212.3, 213, 211, 210.7, 210.1, 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6, 211.9, 212.8, 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4, 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7, 247.6, 247.8, 249.4, 249), .Tsp = c(2008, 2016.41666666667, 12), class = "ts"))
##
## Smoothing parameters:
## alpha: 0.5134972
## beta : 0.4768227
## gamma: 1
##
## Coefficients:
## [,1]
## a 250.8049965
## b 0.6957999
## s1 -0.5066900
## s2 -0.2518198
## s3 0.8800606
## s4 1.7360307
## s5 1.1190656
## s6 1.0604530
## s7 0.6596816
## s8 0.6002755
## s9 -0.9683010
## s10 -1.3409285
## s11 -1.3634151
## s12 -1.8049965
##
## $train$partition_2$hw$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jul 2016 250.9941 248.5154 253.4728 247.2032 254.7850
## Aug 2016 251.9448 248.8339 255.0556 247.1872 256.7024
## Sep 2016 253.7725 249.7899 257.7550 247.6817 259.8632
## Oct 2016 255.3242 250.2814 260.3671 247.6118 263.0366
## Nov 2016 255.4031 249.1482 261.6580 245.8370 264.9691
## Dec 2016 256.0402 248.4457 263.6348 244.4254 267.6551
## Jan 2017 256.3353 247.2895 265.3811 242.5009 270.1696
## Feb 2017 256.9717 246.3741 267.5693 240.7640 273.1793
## Mar 2017 256.0989 243.8571 268.3407 237.3766 274.8212
## Apr 2017 256.4221 242.4499 270.3943 235.0534 277.7907
## May 2017 257.0954 241.3117 272.8791 232.9563 281.2345
## Jun 2017 257.3496 239.6774 275.0218 230.3223 284.3769
##
## $train$partition_2$hw$parameters
## $train$partition_2$hw$parameters$type
## [1] "train"
##
## $train$partition_2$hw$parameters$model_id
## [1] "hw"
##
## $train$partition_2$hw$parameters$method
## [1] "HoltWinters"
##
## $train$partition_2$hw$parameters$horizon
## [1] 12
##
## $train$partition_2$hw$parameters$partition
## [1] "partition_2"
##
##
##
## $train$partition_2$tslm
## $train$partition_2$tslm$model
##
## Call:
## (function (formula, data, subset, lambda = NULL, biasadj = FALSE,
## ...)
## {
## cl <- match.call()
## if (!("formula" %in% class(formula))) {
## formula <- stats::as.formula(formula)
## }
## if (missing(data)) {
## mt <- try(terms(formula))
## if (is.element("try-error", class(mt))) {
## stop("Cannot extract terms from formula, please provide data argument.")
## }
## }
## else {
## mt <- terms(formula, data = data)
## }
## vars <- attr(mt, "variables")
## tsvar <- match(c("trend", "season"), as.character(vars),
## 0L)
## fnvar <- NULL
## for (i in 2:length(vars)) {
## term <- vars[[i]]
## if (!is.symbol(term)) {
## if (typeof(eval(term[[1]])) == "closure") {
## fnvar <- c(fnvar, i)
## }
## }
## }
## attr(formula, ".Environment") <- environment()
## formula[[2]] <- as.symbol(deparse(formula[[2]]))
## if (sum(c(tsvar, fnvar)) > 0) {
## rmvar <- c(tsvar, fnvar)
## rmvar <- rmvar[rmvar != attr(mt, "response") + 1]
## if (any(rmvar != 0)) {
## vars <- vars[-rmvar]
## }
## }
## if (!missing(data)) {
## vars <- vars[c(TRUE, !as.character(vars[-1]) %in% colnames(data))]
## dataname <- substitute(data)
## }
## if (!missing(data)) {
## data <- datamat(do.call(datamat, as.list(vars[-1]), envir = parent.frame()),
## data)
## }
## else {
## data <- do.call(datamat, as.list(vars[-1]), envir = parent.frame())
## }
## if (is.null(dim(data)) && length(data) != 0) {
## cn <- as.character(vars)[2]
## }
## else {
## cn <- colnames(data)
## }
## if (is.null(tsp(data))) {
## if ((attr(mt, "response") + 1) %in% fnvar) {
## tspx <- tsp(eval(attr(mt, "variables")[[attr(mt,
## "response") + 1]]))
## }
## tspx <- tsp(data[, 1])
## }
## else {
## tspx <- tsp(data)
## }
## if (is.null(tspx)) {
## stop("Not time series data, use lm()")
## }
## tsdat <- match(c("trend", "season"), cn, 0L)
## if (tsdat[1] == 0) {
## trend <- 1:NROW(data)
## cn <- c(cn, "trend")
## data <- cbind(data, trend)
## }
## if (tsdat[2] == 0) {
## if (tsvar[2] != 0 && tspx[3] <= 1) {
## stop("Non-seasonal data cannot be modelled using a seasonal factor")
## }
## season <- as.factor(cycle(data[, 1]))
## cn <- c(cn, "season")
## data <- cbind(data, season)
## }
## colnames(data) <- cn
## if (!missing(subset)) {
## if (!is.logical(subset)) {
## stop("subset must be logical")
## }
## else if (NCOL(subset) > 1) {
## stop("subset must be a logical vector")
## }
## else if (NROW(subset) != NROW(data)) {
## stop("Subset must be the same length as the number of rows in the dataset")
## }
## warning("Subset has been assumed contiguous")
## timesx <- time(data[, 1])[subset]
## tspx <- recoverTSP(timesx)
## if (tspx[3] == 1 && tsdat[2] == 0 && tsvar[2] != 0) {
## stop("Non-seasonal data cannot be modelled using a seasonal factor")
## }
## data <- data[subset, ]
## }
## if (!is.null(lambda)) {
## resp_var <- deparse(attr(mt, "variables")[[attr(mt, "response") +
## 1]])
## data[, resp_var] <- BoxCox(data[, resp_var], lambda)
## lambda <- attr(data[, resp_var], "lambda")
## }
## if (tsdat[2] == 0 && tsvar[2] != 0) {
## data$season <- factor(data$season)
## }
## fit <- lm(formula, data = data, na.action = na.exclude, ...)
## fit$data <- data
## responsevar <- deparse(formula[[2]])
## fit$residuals <- ts(residuals(fit))
## fit$x <- fit$residuals
## fit$x[!is.na(fit$x)] <- model.frame(fit)[, responsevar]
## fit$fitted.values <- ts(fitted(fit))
## tsp(fit$residuals) <- tsp(fit$x) <- tsp(fit$fitted.values) <- tsp(data[,
## 1]) <- tspx
## fit$call <- cl
## fit$method <- "Linear regression model"
## if (exists("dataname")) {
## fit$call$data <- dataname
## }
## if (!is.null(lambda)) {
## attr(lambda, "biasadj") <- biasadj
## fit$lambda <- lambda
## fit$fitted.values <- InvBoxCox(fit$fitted.values, lambda,
## biasadj, var(fit$residuals))
## fit$x <- InvBoxCox(fit$x, lambda)
## }
## class(fit) <- c("tslm", class(fit))
## return(fit)
## })(formula = train ~ trend + season)
##
## Coefficients:
## (Intercept) trend season2 season3 season4 season5
## 202.35856 0.28883 -0.04438 0.04457 0.36685 0.61136
## season6 season7 season8 season9 season10 season11
## 1.00031 -1.19861 -1.19994 -1.50127 -0.41509 0.28358
## season12
## 0.86975
##
##
## $train$partition_2$tslm$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jul 2016 230.9092 217.6555 244.1628 210.5127 251.3057
## Aug 2016 231.1967 217.9430 244.4503 210.8002 251.5932
## Sep 2016 231.1842 217.9305 244.4378 210.7877 251.5807
## Oct 2016 232.5592 219.3055 245.8128 212.1627 252.9557
## Nov 2016 233.5467 220.2930 246.8003 213.1502 253.9432
## Dec 2016 234.4217 221.1680 247.6753 214.0252 254.8182
## Jan 2017 233.8408 220.6222 247.0593 213.4983 254.1833
## Feb 2017 234.0852 220.8667 247.3037 213.7427 254.4277
## Mar 2017 234.4630 221.2445 247.6815 214.1205 254.8055
## Apr 2017 235.0741 221.8556 248.2926 214.7316 255.4166
## May 2017 235.6074 222.3889 248.8260 215.2649 255.9499
## Jun 2017 236.2852 223.0667 249.5037 215.9427 256.6277
##
## $train$partition_2$tslm$parameters
## $train$partition_2$tslm$parameters$type
## [1] "train"
##
## $train$partition_2$tslm$parameters$model_id
## [1] "tslm"
##
## $train$partition_2$tslm$parameters$method
## [1] "tslm"
##
## $train$partition_2$tslm$parameters$horizon
## [1] 12
##
## $train$partition_2$tslm$parameters$partition
## [1] "partition_2"
##
##
##
## $train$partition_2$train
## Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
## 2008 200.1 199.5 199.4 198.9 199.0 200.2 198.6 200.0 200.3 201.2 201.6 201.5
## 2009 201.5 203.5 204.9 207.1 210.5 210.5 209.8 208.8 209.5 213.2 213.7 215.1
## 2010 218.7 219.8 220.5 223.8 222.8 223.8 221.7 222.3 220.8 219.4 220.1 220.6
## 2011 218.9 217.8 217.7 215.0 215.3 215.9 216.7 216.7 217.7 218.7 222.9 224.9
## 2012 222.2 220.7 220.0 218.7 217.0 215.9 215.8 214.1 212.3 213.9 214.6 213.6
## 2013 212.1 211.4 213.1 212.9 213.3 211.5 212.3 213.0 211.0 210.7 210.1 211.4
## 2014 210.0 209.7 208.8 208.8 208.8 210.6 211.9 212.8 212.5 214.8 215.3 217.5
## 2015 218.8 220.7 222.2 226.7 228.4 233.2 235.7 237.1 240.6 243.8 245.3 246.0
## 2016 246.3 247.7 247.6 247.8 249.4 249.0
##
## $train$partition_2$test
## Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
## 2016 249.9 250.5 251.5 249.0 247.6 248.8
## 2017 250.4 250.7 253.0 253.7 255.0 256.2
##
##
## $train$partition_3
## $train$partition_3$ets1
## $train$partition_3$ets1$model
## ETS(A,Ad,N)
##
## Call:
## (function (y, model = "ZZZ", damped = NULL, alpha = NULL, beta = NULL,
##
## Call:
## gamma = NULL, phi = NULL, additive.only = FALSE, lambda = NULL,
##
## Call:
## biasadj = FALSE, lower = c(rep(1e-04, 3), 0.8), upper = c(rep(0.9999,
##
## Call:
## 3), 0.98), opt.crit = c("lik", "amse", "mse", "sigma",
##
## Call:
## "mae"), nmse = 3, bounds = c("both", "usual", "admissible"),
##
## Call:
## ic = c("aicc", "aic", "bic"), restrict = TRUE, allow.multiplicative.trend = FALSE,
##
## Call:
## use.initial.values = FALSE, na.action = c("na.contiguous",
##
## Call:
## "na.interp", "na.fail"), ...)
##
## Call:
## {
##
## Call:
## opt.crit <- match.arg(opt.crit)
##
## Call:
## bounds <- match.arg(bounds)
##
## Call:
## ic <- match.arg(ic)
##
## Call:
## if (!is.function(na.action)) {
##
## Call:
## na.fn_name <- match.arg(na.action)
##
## Call:
## na.action <- get(na.fn_name)
##
## Call:
## }
##
## Call:
## seriesname <- deparse(substitute(y))
##
## Call:
## if (any(class(y) %in% c("data.frame", "list", "matrix", "mts"))) {
##
## Call:
## stop("y should be a univariate time series")
##
## Call:
## }
##
## Call:
## y <- as.ts(y)
##
## Call:
## if (missing(model) && is.constant(y)) {
##
## Call:
## return(ses(y, alpha = 0.99999, initial = "simple")$model)
##
## Call:
## }
##
## Call:
## ny <- length(y)
##
## Call:
## y <- na.action(y)
##
## Call:
## if (ny != length(y) && na.fn_name == "na.contiguous") {
##
## Call:
## warning("Missing values encountered. Using longest contiguous portion of time series")
##
## Call:
## ny <- length(y)
##
## Call:
## }
##
## Call:
## orig.y <- y
##
## Call:
## if (identical(class(model), "ets") && is.null(lambda)) {
##
## Call:
## lambda <- model$lambda
##
## Call:
## }
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## y <- BoxCox(y, lambda)
##
## Call:
## lambda <- attr(y, "lambda")
##
## Call:
## additive.only <- TRUE
##
## Call:
## }
##
## Call:
## if (nmse < 1 || nmse > 30) {
##
## Call:
## stop("nmse out of range")
##
## Call:
## }
##
## Call:
## m <- frequency(y)
##
## Call:
## if (any(upper < lower)) {
##
## Call:
## stop("Lower limits must be less than upper limits")
##
## Call:
## }
##
## Call:
## if (class(model) == "ets") {
##
## Call:
## alpha <- max(model$par["alpha"], 1e-10)
##
## Call:
## beta <- model$par["beta"]
##
## Call:
## if (is.na(beta)) {
##
## Call:
## beta <- NULL
##
## Call:
## }
##
## Call:
## gamma <- model$par["gamma"]
##
## Call:
## if (is.na(gamma)) {
##
## Call:
## gamma <- NULL
##
## Call:
## }
##
## Call:
## phi <- model$par["phi"]
##
## Call:
## if (is.na(phi)) {
##
## Call:
## phi <- NULL
##
## Call:
## }
##
## Call:
## modelcomponents <- paste(model$components[1], model$components[2],
##
## Call:
## model$components[3], sep = "")
##
## Call:
## damped <- (model$components[4] == "TRUE")
##
## Call:
## if (use.initial.values) {
##
## Call:
## errortype <- substr(modelcomponents, 1, 1)
##
## Call:
## trendtype <- substr(modelcomponents, 2, 2)
##
## Call:
## seasontype <- substr(modelcomponents, 3, 3)
##
## Call:
## e <- pegelsresid.C(y, m, model$initstate, errortype,
##
## Call:
## trendtype, seasontype, damped, alpha, beta, gamma,
##
## Call:
## phi, nmse)
##
## Call:
## np <- length(model$par) + 1
##
## Call:
## model$loglik <- -0.5 * e$lik
##
## Call:
## model$aic <- e$lik + 2 * np
##
## Call:
## model$bic <- e$lik + log(ny) * np
##
## Call:
## model$aicc <- model$aic + 2 * np * (np + 1)/(ny -
##
## Call:
## np - 1)
##
## Call:
## model$mse <- e$amse[1]
##
## Call:
## model$amse <- mean(e$amse)
##
## Call:
## tsp.y <- tsp(y)
##
## Call:
## model$states <- ts(e$states, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1] - 1/tsp.y[3])
##
## Call:
## colnames(model$states)[1] <- "l"
##
## Call:
## if (trendtype != "N") {
##
## Call:
## colnames(model$states)[2] <- "b"
##
## Call:
## }
##
## Call:
## if (seasontype != "N") {
##
## Call:
## colnames(model$states)[(2 + (trendtype != "N")):ncol(model$states)] <- paste("s",
##
## Call:
## 1:m, sep = "")
##
## Call:
## }
##
## Call:
## if (errortype == "A") {
##
## Call:
## model$fitted <- ts(y - e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model$fitted <- ts(y/(1 + e$e), frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## model$residuals <- ts(e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## model$series <- seriesname
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda,
##
## Call:
## biasadj, var(model$residuals))
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(model)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model <- modelcomponents
##
## Call:
## if (missing(use.initial.values)) {
##
## Call:
## message("Model is being refit with current smoothing parameters but initial states are being re-estimated.\nSet 'use.initial.values=TRUE' if you want to re-use existing initial values.")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## errortype <- substr(model, 1, 1)
##
## Call:
## trendtype <- substr(model, 2, 2)
##
## Call:
## seasontype <- substr(model, 3, 3)
##
## Call:
## if (!is.element(errortype, c("M", "A", "Z"))) {
##
## Call:
## stop("Invalid error type")
##
## Call:
## }
##
## Call:
## if (!is.element(trendtype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid trend type")
##
## Call:
## }
##
## Call:
## if (!is.element(seasontype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid season type")
##
## Call:
## }
##
## Call:
## if (m < 1 || length(y) <= m) {
##
## Call:
## seasontype <- "N"
##
## Call:
## }
##
## Call:
## if (m == 1) {
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## stop("Nonseasonal data")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (m > 24) {
##
## Call:
## if (is.element(seasontype, c("A", "M"))) {
##
## Call:
## stop("Frequency too high")
##
## Call:
## }
##
## Call:
## else if (seasontype == "Z") {
##
## Call:
## warning("I can't handle data with frequency greater than 24. Seasonality will be ignored. Try stlf() if you need seasonal forecasts.")
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if ((errortype == "A" && (trendtype == "M" || seasontype ==
##
## Call:
## "M")) | (errortype == "M" && trendtype == "M" &&
##
## Call:
## seasontype == "A") || (additive.only && (errortype ==
##
## Call:
## "M" || trendtype == "M" || seasontype == "M"))) {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## data.positive <- (min(y) > 0)
##
## Call:
## if (!data.positive && errortype == "M") {
##
## Call:
## stop("Inappropriate model for data with negative or zero values")
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped && trendtype == "N") {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## n <- length(y)
##
## Call:
## npars <- 2L
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## npars <- npars + 2L
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## npars <- npars + m
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## npars <- npars + as.numeric(damped)
##
## Call:
## }
##
## Call:
## if (n <= npars + 4L) {
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped) {
##
## Call:
## warning("Not enough data to use damping")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = gamma, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), seasonal = ifelse(seasontype != "A",
##
## Call:
## "multiplicative", "additive"), lambda = lambda,
##
## Call:
## biasadj = biasadj, warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Seasonal component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Trend component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "N" && seasontype == "N") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, lambda = lambda, biasadj = biasadj,
##
## Call:
## warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## }
##
## Call:
## fit1 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## fit2 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if ("try-error" %in% class(fit1)) {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## else if (fit1$sigma2 < fit2$sigma2) {
##
## Call:
## fit <- fit1
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## if ("try-error" %in% class(fit))
##
## Call:
## stop("Unable to estimate a model.")
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## if (errortype == "Z") {
##
## Call:
## errortype <- c("A", "M")
##
## Call:
## }
##
## Call:
## if (trendtype == "Z") {
##
## Call:
## if (allow.multiplicative.trend) {
##
## Call:
## trendtype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## trendtype <- c("N", "A")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "Z") {
##
## Call:
## seasontype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## if (is.null(damped)) {
##
## Call:
## damped <- c(TRUE, FALSE)
##
## Call:
## }
##
## Call:
## best.ic <- Inf
##
## Call:
## for (i in 1:length(errortype)) {
##
## Call:
## for (j in 1:length(trendtype)) {
##
## Call:
## for (k in 1:length(seasontype)) {
##
## Call:
## for (l in 1:length(damped)) {
##
## Call:
## if (trendtype[j] == "N" && damped[l]) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if (errortype[i] == "A" && (trendtype[j] ==
##
## Call:
## "M" || seasontype[k] == "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (errortype[i] == "M" && trendtype[j] ==
##
## Call:
## "M" && seasontype[k] == "A") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (additive.only && (errortype[i] == "M" ||
##
## Call:
## trendtype[j] == "M" || seasontype[k] ==
##
## Call:
## "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (!data.positive && errortype[i] == "M") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## fit <- try(etsmodel(y, errortype[i], trendtype[j],
##
## Call:
## seasontype[k], damped[l], alpha, beta, gamma,
##
## Call:
## phi, lower = lower, upper = upper, opt.crit = opt.crit,
##
## Call:
## nmse = nmse, bounds = bounds, ...), silent = TRUE)
##
## Call:
## if (is.element("try-error", class(fit)))
##
## Call:
## fit.ic <- Inf
##
## Call:
## else fit.ic <- switch(ic, aic = fit$aic, bic = fit$bic,
##
## Call:
## aicc = fit$aicc)
##
## Call:
## if (!is.na(fit.ic)) {
##
## Call:
## if (fit.ic < best.ic) {
##
## Call:
## model <- fit
##
## Call:
## best.ic <- fit.ic
##
## Call:
## best.e <- errortype[i]
##
## Call:
## best.t <- trendtype[j]
##
## Call:
## best.s <- seasontype[k]
##
## Call:
## best.d <- damped[l]
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (best.ic == Inf) {
##
## Call:
## stop("No model able to be fitted")
##
## Call:
## }
##
## Call:
## model$m <- m
##
## Call:
## model$method <- paste("ETS(", best.e, ",", best.t, ifelse(best.d,
##
## Call:
## "d", ""), ",", best.s, ")", sep = "")
##
## Call:
## model$series <- seriesname
##
## Call:
## model$components <- c(best.e, best.t, best.s, best.d)
##
## Call:
## model$call <- match.call()
##
## Call:
## model$initstate <- model$states[1, ]
##
## Call:
## np <- length(model$par)
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda, biasadj,
##
## Call:
## model$sigma2)
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(structure(model, class = "ets"))
##
## Call:
## })(y = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6,
##
## Call:
## 200, 200.3, 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1,
##
## Call:
## 210.5, 210.5, 209.8, 208.8, 209.5, 213.2, 213.7, 215.1, 218.7,
##
## Call:
## 219.8, 220.5, 223.8, 222.8, 223.8, 221.7, 222.3, 220.8, 219.4,
##
## Call:
## 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7,
##
## Call:
## 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7,
##
## Call:
## 217, 215.9, 215.8, 214.1, 212.3, 213.9, 214.6, 213.6, 212.1,
##
## Call:
## 211.4, 213.1, 212.9, 213.3, 211.5, 212.3, 213, 211, 210.7, 210.1,
##
## Call:
## 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6, 211.9, 212.8,
##
## Call:
## 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4,
##
## Call:
## 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7,
##
## Call:
## 247.6, 247.8, 249.4, 249, 249.9, 250.5, 251.5), .Tsp = c(2008,
##
## Call:
## 2016.66666666667, 12), class = "ts"), opt.crit = "lik")
##
## Smoothing parameters:
## alpha = 0.9606
## beta = 0.3027
## phi = 0.8931
##
## Initial states:
## l = 200.4219
## b = -0.3783
##
## sigma: 1.4394
##
## AIC AICc BIC
## 572.0348 572.8919 587.9585
##
## $train$partition_3$ets1$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Oct 2016 252.0217 250.1770 253.8664 249.2005 254.8429
## Nov 2016 252.5077 249.5821 255.4333 248.0334 256.9820
## Dec 2016 252.9417 248.9497 256.9337 246.8364 259.0469
## Jan 2017 253.3293 248.2665 258.3921 245.5864 261.0721
## Feb 2017 253.6754 247.5382 259.8126 244.2894 263.0615
## Mar 2017 253.9846 246.7734 261.1957 242.9561 265.0130
## Apr 2017 254.2606 245.9805 262.5408 241.5973 266.9240
## May 2017 254.5072 245.1667 263.8476 240.2222 268.7922
## Jun 2017 254.7274 244.3384 265.1164 238.8388 270.6160
## Jul 2017 254.9240 243.5006 266.3474 237.4534 272.3947
## Aug 2017 255.0996 242.6576 267.5416 236.0712 274.1280
## Sep 2017 255.2564 241.8131 268.6998 234.6966 275.8163
##
## $train$partition_3$ets1$parameters
## $train$partition_3$ets1$parameters$type
## [1] "train"
##
## $train$partition_3$ets1$parameters$model_id
## [1] "ets1"
##
## $train$partition_3$ets1$parameters$method
## [1] "ets"
##
## $train$partition_3$ets1$parameters$horizon
## [1] 12
##
## $train$partition_3$ets1$parameters$partition
## [1] "partition_3"
##
##
##
## $train$partition_3$ets2
## $train$partition_3$ets2$model
## ETS(A,Ad,N)
##
## Call:
## (function (y, model = "ZZZ", damped = NULL, alpha = NULL, beta = NULL,
##
## Call:
## gamma = NULL, phi = NULL, additive.only = FALSE, lambda = NULL,
##
## Call:
## biasadj = FALSE, lower = c(rep(1e-04, 3), 0.8), upper = c(rep(0.9999,
##
## Call:
## 3), 0.98), opt.crit = c("lik", "amse", "mse", "sigma",
##
## Call:
## "mae"), nmse = 3, bounds = c("both", "usual", "admissible"),
##
## Call:
## ic = c("aicc", "aic", "bic"), restrict = TRUE, allow.multiplicative.trend = FALSE,
##
## Call:
## use.initial.values = FALSE, na.action = c("na.contiguous",
##
## Call:
## "na.interp", "na.fail"), ...)
##
## Call:
## {
##
## Call:
## opt.crit <- match.arg(opt.crit)
##
## Call:
## bounds <- match.arg(bounds)
##
## Call:
## ic <- match.arg(ic)
##
## Call:
## if (!is.function(na.action)) {
##
## Call:
## na.fn_name <- match.arg(na.action)
##
## Call:
## na.action <- get(na.fn_name)
##
## Call:
## }
##
## Call:
## seriesname <- deparse(substitute(y))
##
## Call:
## if (any(class(y) %in% c("data.frame", "list", "matrix", "mts"))) {
##
## Call:
## stop("y should be a univariate time series")
##
## Call:
## }
##
## Call:
## y <- as.ts(y)
##
## Call:
## if (missing(model) && is.constant(y)) {
##
## Call:
## return(ses(y, alpha = 0.99999, initial = "simple")$model)
##
## Call:
## }
##
## Call:
## ny <- length(y)
##
## Call:
## y <- na.action(y)
##
## Call:
## if (ny != length(y) && na.fn_name == "na.contiguous") {
##
## Call:
## warning("Missing values encountered. Using longest contiguous portion of time series")
##
## Call:
## ny <- length(y)
##
## Call:
## }
##
## Call:
## orig.y <- y
##
## Call:
## if (identical(class(model), "ets") && is.null(lambda)) {
##
## Call:
## lambda <- model$lambda
##
## Call:
## }
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## y <- BoxCox(y, lambda)
##
## Call:
## lambda <- attr(y, "lambda")
##
## Call:
## additive.only <- TRUE
##
## Call:
## }
##
## Call:
## if (nmse < 1 || nmse > 30) {
##
## Call:
## stop("nmse out of range")
##
## Call:
## }
##
## Call:
## m <- frequency(y)
##
## Call:
## if (any(upper < lower)) {
##
## Call:
## stop("Lower limits must be less than upper limits")
##
## Call:
## }
##
## Call:
## if (class(model) == "ets") {
##
## Call:
## alpha <- max(model$par["alpha"], 1e-10)
##
## Call:
## beta <- model$par["beta"]
##
## Call:
## if (is.na(beta)) {
##
## Call:
## beta <- NULL
##
## Call:
## }
##
## Call:
## gamma <- model$par["gamma"]
##
## Call:
## if (is.na(gamma)) {
##
## Call:
## gamma <- NULL
##
## Call:
## }
##
## Call:
## phi <- model$par["phi"]
##
## Call:
## if (is.na(phi)) {
##
## Call:
## phi <- NULL
##
## Call:
## }
##
## Call:
## modelcomponents <- paste(model$components[1], model$components[2],
##
## Call:
## model$components[3], sep = "")
##
## Call:
## damped <- (model$components[4] == "TRUE")
##
## Call:
## if (use.initial.values) {
##
## Call:
## errortype <- substr(modelcomponents, 1, 1)
##
## Call:
## trendtype <- substr(modelcomponents, 2, 2)
##
## Call:
## seasontype <- substr(modelcomponents, 3, 3)
##
## Call:
## e <- pegelsresid.C(y, m, model$initstate, errortype,
##
## Call:
## trendtype, seasontype, damped, alpha, beta, gamma,
##
## Call:
## phi, nmse)
##
## Call:
## np <- length(model$par) + 1
##
## Call:
## model$loglik <- -0.5 * e$lik
##
## Call:
## model$aic <- e$lik + 2 * np
##
## Call:
## model$bic <- e$lik + log(ny) * np
##
## Call:
## model$aicc <- model$aic + 2 * np * (np + 1)/(ny -
##
## Call:
## np - 1)
##
## Call:
## model$mse <- e$amse[1]
##
## Call:
## model$amse <- mean(e$amse)
##
## Call:
## tsp.y <- tsp(y)
##
## Call:
## model$states <- ts(e$states, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1] - 1/tsp.y[3])
##
## Call:
## colnames(model$states)[1] <- "l"
##
## Call:
## if (trendtype != "N") {
##
## Call:
## colnames(model$states)[2] <- "b"
##
## Call:
## }
##
## Call:
## if (seasontype != "N") {
##
## Call:
## colnames(model$states)[(2 + (trendtype != "N")):ncol(model$states)] <- paste("s",
##
## Call:
## 1:m, sep = "")
##
## Call:
## }
##
## Call:
## if (errortype == "A") {
##
## Call:
## model$fitted <- ts(y - e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model$fitted <- ts(y/(1 + e$e), frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## model$residuals <- ts(e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## model$series <- seriesname
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda,
##
## Call:
## biasadj, var(model$residuals))
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(model)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model <- modelcomponents
##
## Call:
## if (missing(use.initial.values)) {
##
## Call:
## message("Model is being refit with current smoothing parameters but initial states are being re-estimated.\nSet 'use.initial.values=TRUE' if you want to re-use existing initial values.")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## errortype <- substr(model, 1, 1)
##
## Call:
## trendtype <- substr(model, 2, 2)
##
## Call:
## seasontype <- substr(model, 3, 3)
##
## Call:
## if (!is.element(errortype, c("M", "A", "Z"))) {
##
## Call:
## stop("Invalid error type")
##
## Call:
## }
##
## Call:
## if (!is.element(trendtype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid trend type")
##
## Call:
## }
##
## Call:
## if (!is.element(seasontype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid season type")
##
## Call:
## }
##
## Call:
## if (m < 1 || length(y) <= m) {
##
## Call:
## seasontype <- "N"
##
## Call:
## }
##
## Call:
## if (m == 1) {
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## stop("Nonseasonal data")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (m > 24) {
##
## Call:
## if (is.element(seasontype, c("A", "M"))) {
##
## Call:
## stop("Frequency too high")
##
## Call:
## }
##
## Call:
## else if (seasontype == "Z") {
##
## Call:
## warning("I can't handle data with frequency greater than 24. Seasonality will be ignored. Try stlf() if you need seasonal forecasts.")
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if ((errortype == "A" && (trendtype == "M" || seasontype ==
##
## Call:
## "M")) | (errortype == "M" && trendtype == "M" &&
##
## Call:
## seasontype == "A") || (additive.only && (errortype ==
##
## Call:
## "M" || trendtype == "M" || seasontype == "M"))) {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## data.positive <- (min(y) > 0)
##
## Call:
## if (!data.positive && errortype == "M") {
##
## Call:
## stop("Inappropriate model for data with negative or zero values")
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped && trendtype == "N") {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## n <- length(y)
##
## Call:
## npars <- 2L
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## npars <- npars + 2L
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## npars <- npars + m
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## npars <- npars + as.numeric(damped)
##
## Call:
## }
##
## Call:
## if (n <= npars + 4L) {
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped) {
##
## Call:
## warning("Not enough data to use damping")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = gamma, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), seasonal = ifelse(seasontype != "A",
##
## Call:
## "multiplicative", "additive"), lambda = lambda,
##
## Call:
## biasadj = biasadj, warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Seasonal component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Trend component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "N" && seasontype == "N") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, lambda = lambda, biasadj = biasadj,
##
## Call:
## warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## }
##
## Call:
## fit1 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## fit2 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if ("try-error" %in% class(fit1)) {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## else if (fit1$sigma2 < fit2$sigma2) {
##
## Call:
## fit <- fit1
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## if ("try-error" %in% class(fit))
##
## Call:
## stop("Unable to estimate a model.")
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## if (errortype == "Z") {
##
## Call:
## errortype <- c("A", "M")
##
## Call:
## }
##
## Call:
## if (trendtype == "Z") {
##
## Call:
## if (allow.multiplicative.trend) {
##
## Call:
## trendtype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## trendtype <- c("N", "A")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "Z") {
##
## Call:
## seasontype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## if (is.null(damped)) {
##
## Call:
## damped <- c(TRUE, FALSE)
##
## Call:
## }
##
## Call:
## best.ic <- Inf
##
## Call:
## for (i in 1:length(errortype)) {
##
## Call:
## for (j in 1:length(trendtype)) {
##
## Call:
## for (k in 1:length(seasontype)) {
##
## Call:
## for (l in 1:length(damped)) {
##
## Call:
## if (trendtype[j] == "N" && damped[l]) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if (errortype[i] == "A" && (trendtype[j] ==
##
## Call:
## "M" || seasontype[k] == "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (errortype[i] == "M" && trendtype[j] ==
##
## Call:
## "M" && seasontype[k] == "A") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (additive.only && (errortype[i] == "M" ||
##
## Call:
## trendtype[j] == "M" || seasontype[k] ==
##
## Call:
## "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (!data.positive && errortype[i] == "M") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## fit <- try(etsmodel(y, errortype[i], trendtype[j],
##
## Call:
## seasontype[k], damped[l], alpha, beta, gamma,
##
## Call:
## phi, lower = lower, upper = upper, opt.crit = opt.crit,
##
## Call:
## nmse = nmse, bounds = bounds, ...), silent = TRUE)
##
## Call:
## if (is.element("try-error", class(fit)))
##
## Call:
## fit.ic <- Inf
##
## Call:
## else fit.ic <- switch(ic, aic = fit$aic, bic = fit$bic,
##
## Call:
## aicc = fit$aicc)
##
## Call:
## if (!is.na(fit.ic)) {
##
## Call:
## if (fit.ic < best.ic) {
##
## Call:
## model <- fit
##
## Call:
## best.ic <- fit.ic
##
## Call:
## best.e <- errortype[i]
##
## Call:
## best.t <- trendtype[j]
##
## Call:
## best.s <- seasontype[k]
##
## Call:
## best.d <- damped[l]
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (best.ic == Inf) {
##
## Call:
## stop("No model able to be fitted")
##
## Call:
## }
##
## Call:
## model$m <- m
##
## Call:
## model$method <- paste("ETS(", best.e, ",", best.t, ifelse(best.d,
##
## Call:
## "d", ""), ",", best.s, ")", sep = "")
##
## Call:
## model$series <- seriesname
##
## Call:
## model$components <- c(best.e, best.t, best.s, best.d)
##
## Call:
## model$call <- match.call()
##
## Call:
## model$initstate <- model$states[1, ]
##
## Call:
## np <- length(model$par)
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda, biasadj,
##
## Call:
## model$sigma2)
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(structure(model, class = "ets"))
##
## Call:
## })(y = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6,
##
## Call:
## 200, 200.3, 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1,
##
## Call:
## 210.5, 210.5, 209.8, 208.8, 209.5, 213.2, 213.7, 215.1, 218.7,
##
## Call:
## 219.8, 220.5, 223.8, 222.8, 223.8, 221.7, 222.3, 220.8, 219.4,
##
## Call:
## 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7,
##
## Call:
## 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7,
##
## Call:
## 217, 215.9, 215.8, 214.1, 212.3, 213.9, 214.6, 213.6, 212.1,
##
## Call:
## 211.4, 213.1, 212.9, 213.3, 211.5, 212.3, 213, 211, 210.7, 210.1,
##
## Call:
## 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6, 211.9, 212.8,
##
## Call:
## 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4,
##
## Call:
## 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7,
##
## Call:
## 247.6, 247.8, 249.4, 249, 249.9, 250.5, 251.5), .Tsp = c(2008,
##
## Call:
## 2016.66666666667, 12), class = "ts"), opt.crit = "amse")
##
## Smoothing parameters:
## alpha = 0.8842
## beta = 0.3195
## phi = 0.8597
##
## Initial states:
## l = 200.0963
## b = -0.3237
##
## sigma: 1.4442
##
## AIC AICc BIC
## 572.7297 573.5869 588.6535
##
## $train$partition_3$ets2$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Oct 2016 251.9485 250.0977 253.7994 249.1180 254.7791
## Nov 2016 252.3965 249.5636 255.2294 248.0639 256.7290
## Dec 2016 252.7816 248.9488 256.6144 246.9198 258.6434
## Jan 2017 253.1127 248.2715 257.9538 245.7087 260.5166
## Feb 2017 253.3973 247.5494 259.2452 244.4537 262.3408
## Mar 2017 253.6420 246.7967 260.4872 243.1731 264.1109
## Apr 2017 253.8523 246.0247 261.6800 241.8809 265.8237
## May 2017 254.0332 245.2418 262.8246 240.5879 267.4784
## Jun 2017 254.1887 244.4548 263.9225 239.3021 269.0753
## Jul 2017 254.3223 243.6688 264.9758 238.0292 270.6154
## Aug 2017 254.4372 242.8877 265.9868 236.7737 272.1008
## Sep 2017 254.5360 242.1142 266.9578 235.5385 273.5335
##
## $train$partition_3$ets2$parameters
## $train$partition_3$ets2$parameters$type
## [1] "train"
##
## $train$partition_3$ets2$parameters$model_id
## [1] "ets2"
##
## $train$partition_3$ets2$parameters$method
## [1] "ets"
##
## $train$partition_3$ets2$parameters$horizon
## [1] 12
##
## $train$partition_3$ets2$parameters$partition
## [1] "partition_3"
##
##
##
## $train$partition_3$arima1
## $train$partition_3$arima1$model
##
## Call:
## (function (x, order = c(0L, 0L, 0L), seasonal = list(order = c(0L, 0L, 0L),
## period = NA), xreg = NULL, include.mean = TRUE, transform.pars = TRUE, fixed = NULL,
## init = NULL, method = c("CSS-ML", "ML", "CSS"), n.cond, SSinit = c("Gardner1980",
## "Rossignol2011"), optim.method = "BFGS", optim.control = list(), kappa = 1e+06)
## {
## "%+%" <- function(a, b) .Call(C_TSconv, a, b)
## SSinit <- match.arg(SSinit)
## SS.G <- SSinit == "Gardner1980"
## upARIMA <- function(mod, phi, theta) {
## p <- length(phi)
## q <- length(theta)
## mod$phi <- phi
## mod$theta <- theta
## r <- max(p, q + 1L)
## if (p > 0)
## mod$T[1L:p, 1L] <- phi
## if (r > 1L)
## mod$Pn[1L:r, 1L:r] <- if (SS.G)
## .Call(C_getQ0, phi, theta)
## else .Call(C_getQ0bis, phi, theta, tol = 0)
## else mod$Pn[1L, 1L] <- if (p > 0)
## 1/(1 - phi^2)
## else 1
## mod$a[] <- 0
## mod
## }
## arimaSS <- function(y, mod) {
## .Call(C_ARIMA_Like, y, mod, 0L, TRUE)
## }
## armafn <- function(p, trans) {
## par <- coef
## par[mask] <- p
## trarma <- .Call(C_ARIMA_transPars, par, arma, trans)
## if (is.null(Z <- tryCatch(upARIMA(mod, trarma[[1L]], trarma[[2L]]),
## error = function(e) NULL)))
## return(.Machine$double.xmax)
## if (ncxreg > 0)
## x <- x - xreg %*% par[narma + (1L:ncxreg)]
## res <- .Call(C_ARIMA_Like, x, Z, 0L, FALSE)
## s2 <- res[1L]/res[3L]
## 0.5 * (log(s2) + res[2L]/res[3L])
## }
## armaCSS <- function(p) {
## par <- as.double(fixed)
## par[mask] <- p
## trarma <- .Call(C_ARIMA_transPars, par, arma, FALSE)
## if (ncxreg > 0)
## x <- x - xreg %*% par[narma + (1L:ncxreg)]
## res <- .Call(C_ARIMA_CSS, x, arma, trarma[[1L]], trarma[[2L]], as.integer(ncond),
## FALSE)
## 0.5 * log(res)
## }
## arCheck <- function(ar) {
## p <- max(which(c(1, -ar) != 0)) - 1
## if (!p)
## return(TRUE)
## all(Mod(polyroot(c(1, -ar[1L:p]))) > 1)
## }
## maInvert <- function(ma) {
## q <- length(ma)
## q0 <- max(which(c(1, ma) != 0)) - 1L
## if (!q0)
## return(ma)
## roots <- polyroot(c(1, ma[1L:q0]))
## ind <- Mod(roots) < 1
## if (all(!ind))
## return(ma)
## if (q0 == 1)
## return(c(1/ma[1L], rep.int(0, q - q0)))
## roots[ind] <- 1/roots[ind]
## x <- 1
## for (r in roots) x <- c(x, 0) - c(0, x)/r
## c(Re(x[-1L]), rep.int(0, q - q0))
## }
## series <- deparse1(substitute(x))
## if (NCOL(x) > 1L)
## stop("only implemented for univariate time series")
## method <- match.arg(method)
## x <- as.ts(x)
## if (!is.numeric(x))
## stop("'x' must be numeric")
## storage.mode(x) <- "double"
## dim(x) <- NULL
## n <- length(x)
## if (!missing(order))
## if (!is.numeric(order) || length(order) != 3L || any(order < 0))
## stop("'order' must be a non-negative numeric vector of length 3")
## if (!missing(seasonal))
## if (is.list(seasonal)) {
## if (is.null(seasonal$order))
## stop("'seasonal' must be a list with component 'order'")
## if (!is.numeric(seasonal$order) || length(seasonal$order) != 3L ||
## any(seasonal$order < 0L))
## stop("'seasonal$order' must be a non-negative numeric vector of length 3")
## }
## else if (is.numeric(order)) {
## if (length(order) == 3L)
## seasonal <- list(order = seasonal)
## else ("'seasonal' is of the wrong length")
## }
## else stop("'seasonal' must be a list with component 'order'")
## if (is.null(seasonal$period) || is.na(seasonal$period) || seasonal$period ==
## 0)
## seasonal$period <- frequency(x)
## arma <- as.integer(c(order[-2L], seasonal$order[-2L], seasonal$period, order[2L],
## seasonal$order[2L]))
## narma <- sum(arma[1L:4L])
## xtsp <- tsp(x)
## tsp(x) <- NULL
## Delta <- 1
## for (i in seq_len(order[2L])) Delta <- Delta %+% c(1, -1)
## for (i in seq_len(seasonal$order[2L])) Delta <- Delta %+% c(1, rep.int(0,
## seasonal$period - 1), -1)
## Delta <- -Delta[-1L]
## nd <- order[2L] + seasonal$order[2L]
## n.used <- sum(!is.na(x)) - length(Delta)
## if (is.null(xreg)) {
## ncxreg <- 0L
## }
## else {
## nmxreg <- deparse1(substitute(xreg))
## if (NROW(xreg) != n)
## stop("lengths of 'x' and 'xreg' do not match")
## ncxreg <- NCOL(xreg)
## xreg <- as.matrix(xreg)
## storage.mode(xreg) <- "double"
## }
## class(xreg) <- NULL
## if (ncxreg > 0L && is.null(colnames(xreg)))
## colnames(xreg) <- if (ncxreg == 1L)
## nmxreg
## else paste0(nmxreg, 1L:ncxreg)
## if (include.mean && (nd == 0L)) {
## xreg <- cbind(intercept = rep(1, n), xreg = xreg)
## ncxreg <- ncxreg + 1L
## }
## if (method == "CSS-ML") {
## anyna <- anyNA(x)
## if (ncxreg)
## anyna <- anyna || anyNA(xreg)
## if (anyna)
## method <- "ML"
## }
## if (method == "CSS" || method == "CSS-ML") {
## ncond <- order[2L] + seasonal$order[2L] * seasonal$period
## ncond1 <- order[1L] + seasonal$period * seasonal$order[1L]
## ncond <- ncond + if (!missing(n.cond))
## max(n.cond, ncond1)
## else ncond1
## }
## else ncond <- 0
## if (is.null(fixed))
## fixed <- rep(NA_real_, narma + ncxreg)
## else if (length(fixed) != narma + ncxreg)
## stop("wrong length for 'fixed'")
## mask <- is.na(fixed)
## no.optim <- !any(mask)
## if (no.optim)
## transform.pars <- FALSE
## if (transform.pars) {
## ind <- arma[1L] + arma[2L] + seq_len(arma[3L])
## if (any(!mask[seq_len(arma[1L])]) || any(!mask[ind])) {
## warning("some AR parameters were fixed: setting transform.pars = FALSE")
## transform.pars <- FALSE
## }
## }
## init0 <- rep.int(0, narma)
## parscale <- rep(1, narma)
## if (ncxreg) {
## cn <- colnames(xreg)
## orig.xreg <- (ncxreg == 1L) || any(!mask[narma + 1L:ncxreg])
## if (!orig.xreg) {
## S <- svd(na.omit(xreg))
## xreg <- xreg %*% S$v
## }
## dx <- x
## dxreg <- xreg
## if (order[2L] > 0L) {
## dx <- diff(dx, 1L, order[2L])
## dxreg <- diff(dxreg, 1L, order[2L])
## }
## if (seasonal$period > 1L && seasonal$order[2L] > 0) {
## dx <- diff(dx, seasonal$period, seasonal$order[2L])
## dxreg <- diff(dxreg, seasonal$period, seasonal$order[2L])
## }
## fit <- if (length(dx) > ncol(dxreg))
## lm(dx ~ dxreg - 1, na.action = na.omit)
## else list(rank = 0L)
## if (fit$rank == 0L) {
## fit <- lm(x ~ xreg - 1, na.action = na.omit)
## }
## isna <- is.na(x) | apply(xreg, 1L, anyNA)
## n.used <- sum(!isna) - length(Delta)
## init0 <- c(init0, coef(fit))
## ses <- summary(fit)$coefficients[, 2L]
## parscale <- c(parscale, 10 * ses)
## }
## if (n.used <= 0)
## stop("too few non-missing observations")
## if (!is.null(init)) {
## if (length(init) != length(init0))
## stop("'init' is of the wrong length")
## if (any(ind <- is.na(init)))
## init[ind] <- init0[ind]
## if (method == "ML") {
## if (arma[1L] > 0)
## if (!arCheck(init[1L:arma[1L]]))
## stop("non-stationary AR part")
## if (arma[3L] > 0)
## if (!arCheck(init[sum(arma[1L:2L]) + 1L:arma[3L]]))
## stop("non-stationary seasonal AR part")
## if (transform.pars)
## init <- .Call(C_ARIMA_Invtrans, as.double(init), arma)
## }
## }
## else init <- init0
## coef <- as.double(fixed)
## if (!("parscale" %in% names(optim.control)))
## optim.control$parscale <- parscale[mask]
## if (method == "CSS") {
## res <- if (no.optim)
## list(convergence = 0L, par = numeric(), value = armaCSS(numeric()))
## else optim(init[mask], armaCSS, method = optim.method, hessian = TRUE,
## control = optim.control)
## if (res$convergence > 0)
## warning(gettextf("possible convergence problem: optim gave code = %d",
## res$convergence), domain = NA)
## coef[mask] <- res$par
## trarma <- .Call(C_ARIMA_transPars, coef, arma, FALSE)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## if (ncxreg > 0)
## x <- x - xreg %*% coef[narma + (1L:ncxreg)]
## arimaSS(x, mod)
## val <- .Call(C_ARIMA_CSS, x, arma, trarma[[1L]], trarma[[2L]], as.integer(ncond),
## TRUE)
## sigma2 <- val[[1L]]
## var <- if (no.optim)
## numeric()
## else solve(res$hessian * n.used)
## }
## else {
## if (method == "CSS-ML") {
## res <- if (no.optim)
## list(convergence = 0L, par = numeric(), value = armaCSS(numeric()))
## else optim(init[mask], armaCSS, method = optim.method, hessian = FALSE,
## control = optim.control)
## if (res$convergence == 0)
## init[mask] <- res$par
## if (arma[1L] > 0)
## if (!arCheck(init[1L:arma[1L]]))
## stop("non-stationary AR part from CSS")
## if (arma[3L] > 0)
## if (!arCheck(init[sum(arma[1L:2L]) + 1L:arma[3L]]))
## stop("non-stationary seasonal AR part from CSS")
## ncond <- 0L
## }
## if (transform.pars) {
## init <- .Call(C_ARIMA_Invtrans, init, arma)
## if (arma[2L] > 0) {
## ind <- arma[1L] + 1L:arma[2L]
## init[ind] <- maInvert(init[ind])
## }
## if (arma[4L] > 0) {
## ind <- sum(arma[1L:3L]) + 1L:arma[4L]
## init[ind] <- maInvert(init[ind])
## }
## }
## trarma <- .Call(C_ARIMA_transPars, init, arma, transform.pars)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## res <- if (no.optim)
## list(convergence = 0, par = numeric(), value = armafn(numeric(),
## as.logical(transform.pars)))
## else optim(init[mask], armafn, method = optim.method, hessian = TRUE,
## control = optim.control, trans = as.logical(transform.pars))
## if (res$convergence > 0)
## warning(gettextf("possible convergence problem: optim gave code = %d",
## res$convergence), domain = NA)
## coef[mask] <- res$par
## if (transform.pars) {
## if (arma[2L] > 0L) {
## ind <- arma[1L] + 1L:arma[2L]
## if (all(mask[ind]))
## coef[ind] <- maInvert(coef[ind])
## }
## if (arma[4L] > 0L) {
## ind <- sum(arma[1L:3L]) + 1L:arma[4L]
## if (all(mask[ind]))
## coef[ind] <- maInvert(coef[ind])
## }
## if (any(coef[mask] != res$par)) {
## oldcode <- res$convergence
## res <- optim(coef[mask], armafn, method = optim.method, hessian = TRUE,
## control = list(maxit = 0L, parscale = optim.control$parscale),
## trans = TRUE)
## res$convergence <- oldcode
## coef[mask] <- res$par
## }
## A <- .Call(C_ARIMA_Gradtrans, as.double(coef), arma)
## A <- A[mask, mask]
## var <- crossprod(A, solve(res$hessian * n.used, A))
## coef <- .Call(C_ARIMA_undoPars, coef, arma)
## }
## else var <- if (no.optim)
## numeric()
## else solve(res$hessian * n.used)
## trarma <- .Call(C_ARIMA_transPars, coef, arma, FALSE)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## val <- if (ncxreg > 0L)
## arimaSS(x - xreg %*% coef[narma + (1L:ncxreg)], mod)
## else arimaSS(x, mod)
## sigma2 <- val[[1L]][1L]/n.used
## }
## value <- 2 * n.used * res$value + n.used + n.used * log(2 * pi)
## aic <- if (method != "CSS")
## value + 2 * sum(mask) + 2
## else NA
## nm <- NULL
## if (arma[1L] > 0L)
## nm <- c(nm, paste0("ar", 1L:arma[1L]))
## if (arma[2L] > 0L)
## nm <- c(nm, paste0("ma", 1L:arma[2L]))
## if (arma[3L] > 0L)
## nm <- c(nm, paste0("sar", 1L:arma[3L]))
## if (arma[4L] > 0L)
## nm <- c(nm, paste0("sma", 1L:arma[4L]))
## if (ncxreg > 0L) {
## nm <- c(nm, cn)
## if (!orig.xreg) {
## ind <- narma + 1L:ncxreg
## coef[ind] <- S$v %*% coef[ind]
## A <- diag(narma + ncxreg)
## A[ind, ind] <- S$v
## A <- A[mask, mask]
## var <- A %*% var %*% t(A)
## }
## }
## names(coef) <- nm
## if (!no.optim)
## dimnames(var) <- list(nm[mask], nm[mask])
## resid <- val[[2L]]
## tsp(resid) <- xtsp
## class(resid) <- "ts"
## structure(list(coef = coef, sigma2 = sigma2, var.coef = var, mask = mask,
## loglik = -0.5 * value, aic = aic, arma = arma, residuals = resid, call = match.call(),
## series = series, code = res$convergence, n.cond = ncond, nobs = n.used,
## model = mod), class = "Arima")
## })(x = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6, 200, 200.3,
## 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1, 210.5, 210.5, 209.8, 208.8,
## 209.5, 213.2, 213.7, 215.1, 218.7, 219.8, 220.5, 223.8, 222.8, 223.8, 221.7,
## 222.3, 220.8, 219.4, 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7,
## 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7, 217, 215.9, 215.8,
## 214.1, 212.3, 213.9, 214.6, 213.6, 212.1, 211.4, 213.1, 212.9, 213.3, 211.5,
## 212.3, 213, 211, 210.7, 210.1, 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6,
## 211.9, 212.8, 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4,
## 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7, 247.6, 247.8, 249.4,
## 249, 249.9, 250.5, 251.5), .Tsp = c(2008, 2016.66666666667, 12), class = "ts"),
## order = c(2, 1, 0))
##
## Coefficients:
## ar1 ar2
## 0.3027 0.2428
## s.e. 0.0944 0.0942
##
## sigma^2 estimated as 2.092: log likelihood = -186.09, aic = 378.18
##
## $train$partition_3$arima1$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Oct 2016 251.9484 250.0950 253.8018 249.1138 254.7829
## Nov 2016 252.3269 249.2831 255.3707 247.6718 256.9820
## Dec 2016 252.5503 248.2525 256.8482 245.9773 259.1234
## Jan 2017 252.7099 247.2556 258.1641 244.3684 261.0514
## Feb 2017 252.8124 246.2736 259.3513 242.8121 262.8127
## Mar 2017 252.8822 245.3391 260.4252 241.3461 264.4183
## Apr 2017 252.9282 244.4515 261.4049 239.9642 265.8922
## May 2017 252.9591 243.6127 262.3055 238.6650 267.2532
## Jun 2017 252.9796 242.8194 263.1397 237.4410 268.5182
## Jul 2017 252.9933 242.0685 263.9181 236.2852 269.7014
## Aug 2017 253.0024 241.3559 264.6490 235.1905 270.8143
## Sep 2017 253.0085 240.6778 265.3392 234.1504 271.8667
##
## $train$partition_3$arima1$parameters
## $train$partition_3$arima1$parameters$type
## [1] "train"
##
## $train$partition_3$arima1$parameters$model_id
## [1] "arima1"
##
## $train$partition_3$arima1$parameters$method
## [1] "arima"
##
## $train$partition_3$arima1$parameters$horizon
## [1] 12
##
## $train$partition_3$arima1$parameters$partition
## [1] "partition_3"
##
##
##
## $train$partition_3$arima2
## $train$partition_3$arima2$model
##
## Call:
## (function (x, order = c(0L, 0L, 0L), seasonal = list(order = c(0L, 0L, 0L),
## period = NA), xreg = NULL, include.mean = TRUE, transform.pars = TRUE, fixed = NULL,
## init = NULL, method = c("CSS-ML", "ML", "CSS"), n.cond, SSinit = c("Gardner1980",
## "Rossignol2011"), optim.method = "BFGS", optim.control = list(), kappa = 1e+06)
## {
## "%+%" <- function(a, b) .Call(C_TSconv, a, b)
## SSinit <- match.arg(SSinit)
## SS.G <- SSinit == "Gardner1980"
## upARIMA <- function(mod, phi, theta) {
## p <- length(phi)
## q <- length(theta)
## mod$phi <- phi
## mod$theta <- theta
## r <- max(p, q + 1L)
## if (p > 0)
## mod$T[1L:p, 1L] <- phi
## if (r > 1L)
## mod$Pn[1L:r, 1L:r] <- if (SS.G)
## .Call(C_getQ0, phi, theta)
## else .Call(C_getQ0bis, phi, theta, tol = 0)
## else mod$Pn[1L, 1L] <- if (p > 0)
## 1/(1 - phi^2)
## else 1
## mod$a[] <- 0
## mod
## }
## arimaSS <- function(y, mod) {
## .Call(C_ARIMA_Like, y, mod, 0L, TRUE)
## }
## armafn <- function(p, trans) {
## par <- coef
## par[mask] <- p
## trarma <- .Call(C_ARIMA_transPars, par, arma, trans)
## if (is.null(Z <- tryCatch(upARIMA(mod, trarma[[1L]], trarma[[2L]]),
## error = function(e) NULL)))
## return(.Machine$double.xmax)
## if (ncxreg > 0)
## x <- x - xreg %*% par[narma + (1L:ncxreg)]
## res <- .Call(C_ARIMA_Like, x, Z, 0L, FALSE)
## s2 <- res[1L]/res[3L]
## 0.5 * (log(s2) + res[2L]/res[3L])
## }
## armaCSS <- function(p) {
## par <- as.double(fixed)
## par[mask] <- p
## trarma <- .Call(C_ARIMA_transPars, par, arma, FALSE)
## if (ncxreg > 0)
## x <- x - xreg %*% par[narma + (1L:ncxreg)]
## res <- .Call(C_ARIMA_CSS, x, arma, trarma[[1L]], trarma[[2L]], as.integer(ncond),
## FALSE)
## 0.5 * log(res)
## }
## arCheck <- function(ar) {
## p <- max(which(c(1, -ar) != 0)) - 1
## if (!p)
## return(TRUE)
## all(Mod(polyroot(c(1, -ar[1L:p]))) > 1)
## }
## maInvert <- function(ma) {
## q <- length(ma)
## q0 <- max(which(c(1, ma) != 0)) - 1L
## if (!q0)
## return(ma)
## roots <- polyroot(c(1, ma[1L:q0]))
## ind <- Mod(roots) < 1
## if (all(!ind))
## return(ma)
## if (q0 == 1)
## return(c(1/ma[1L], rep.int(0, q - q0)))
## roots[ind] <- 1/roots[ind]
## x <- 1
## for (r in roots) x <- c(x, 0) - c(0, x)/r
## c(Re(x[-1L]), rep.int(0, q - q0))
## }
## series <- deparse1(substitute(x))
## if (NCOL(x) > 1L)
## stop("only implemented for univariate time series")
## method <- match.arg(method)
## x <- as.ts(x)
## if (!is.numeric(x))
## stop("'x' must be numeric")
## storage.mode(x) <- "double"
## dim(x) <- NULL
## n <- length(x)
## if (!missing(order))
## if (!is.numeric(order) || length(order) != 3L || any(order < 0))
## stop("'order' must be a non-negative numeric vector of length 3")
## if (!missing(seasonal))
## if (is.list(seasonal)) {
## if (is.null(seasonal$order))
## stop("'seasonal' must be a list with component 'order'")
## if (!is.numeric(seasonal$order) || length(seasonal$order) != 3L ||
## any(seasonal$order < 0L))
## stop("'seasonal$order' must be a non-negative numeric vector of length 3")
## }
## else if (is.numeric(order)) {
## if (length(order) == 3L)
## seasonal <- list(order = seasonal)
## else ("'seasonal' is of the wrong length")
## }
## else stop("'seasonal' must be a list with component 'order'")
## if (is.null(seasonal$period) || is.na(seasonal$period) || seasonal$period ==
## 0)
## seasonal$period <- frequency(x)
## arma <- as.integer(c(order[-2L], seasonal$order[-2L], seasonal$period, order[2L],
## seasonal$order[2L]))
## narma <- sum(arma[1L:4L])
## xtsp <- tsp(x)
## tsp(x) <- NULL
## Delta <- 1
## for (i in seq_len(order[2L])) Delta <- Delta %+% c(1, -1)
## for (i in seq_len(seasonal$order[2L])) Delta <- Delta %+% c(1, rep.int(0,
## seasonal$period - 1), -1)
## Delta <- -Delta[-1L]
## nd <- order[2L] + seasonal$order[2L]
## n.used <- sum(!is.na(x)) - length(Delta)
## if (is.null(xreg)) {
## ncxreg <- 0L
## }
## else {
## nmxreg <- deparse1(substitute(xreg))
## if (NROW(xreg) != n)
## stop("lengths of 'x' and 'xreg' do not match")
## ncxreg <- NCOL(xreg)
## xreg <- as.matrix(xreg)
## storage.mode(xreg) <- "double"
## }
## class(xreg) <- NULL
## if (ncxreg > 0L && is.null(colnames(xreg)))
## colnames(xreg) <- if (ncxreg == 1L)
## nmxreg
## else paste0(nmxreg, 1L:ncxreg)
## if (include.mean && (nd == 0L)) {
## xreg <- cbind(intercept = rep(1, n), xreg = xreg)
## ncxreg <- ncxreg + 1L
## }
## if (method == "CSS-ML") {
## anyna <- anyNA(x)
## if (ncxreg)
## anyna <- anyna || anyNA(xreg)
## if (anyna)
## method <- "ML"
## }
## if (method == "CSS" || method == "CSS-ML") {
## ncond <- order[2L] + seasonal$order[2L] * seasonal$period
## ncond1 <- order[1L] + seasonal$period * seasonal$order[1L]
## ncond <- ncond + if (!missing(n.cond))
## max(n.cond, ncond1)
## else ncond1
## }
## else ncond <- 0
## if (is.null(fixed))
## fixed <- rep(NA_real_, narma + ncxreg)
## else if (length(fixed) != narma + ncxreg)
## stop("wrong length for 'fixed'")
## mask <- is.na(fixed)
## no.optim <- !any(mask)
## if (no.optim)
## transform.pars <- FALSE
## if (transform.pars) {
## ind <- arma[1L] + arma[2L] + seq_len(arma[3L])
## if (any(!mask[seq_len(arma[1L])]) || any(!mask[ind])) {
## warning("some AR parameters were fixed: setting transform.pars = FALSE")
## transform.pars <- FALSE
## }
## }
## init0 <- rep.int(0, narma)
## parscale <- rep(1, narma)
## if (ncxreg) {
## cn <- colnames(xreg)
## orig.xreg <- (ncxreg == 1L) || any(!mask[narma + 1L:ncxreg])
## if (!orig.xreg) {
## S <- svd(na.omit(xreg))
## xreg <- xreg %*% S$v
## }
## dx <- x
## dxreg <- xreg
## if (order[2L] > 0L) {
## dx <- diff(dx, 1L, order[2L])
## dxreg <- diff(dxreg, 1L, order[2L])
## }
## if (seasonal$period > 1L && seasonal$order[2L] > 0) {
## dx <- diff(dx, seasonal$period, seasonal$order[2L])
## dxreg <- diff(dxreg, seasonal$period, seasonal$order[2L])
## }
## fit <- if (length(dx) > ncol(dxreg))
## lm(dx ~ dxreg - 1, na.action = na.omit)
## else list(rank = 0L)
## if (fit$rank == 0L) {
## fit <- lm(x ~ xreg - 1, na.action = na.omit)
## }
## isna <- is.na(x) | apply(xreg, 1L, anyNA)
## n.used <- sum(!isna) - length(Delta)
## init0 <- c(init0, coef(fit))
## ses <- summary(fit)$coefficients[, 2L]
## parscale <- c(parscale, 10 * ses)
## }
## if (n.used <= 0)
## stop("too few non-missing observations")
## if (!is.null(init)) {
## if (length(init) != length(init0))
## stop("'init' is of the wrong length")
## if (any(ind <- is.na(init)))
## init[ind] <- init0[ind]
## if (method == "ML") {
## if (arma[1L] > 0)
## if (!arCheck(init[1L:arma[1L]]))
## stop("non-stationary AR part")
## if (arma[3L] > 0)
## if (!arCheck(init[sum(arma[1L:2L]) + 1L:arma[3L]]))
## stop("non-stationary seasonal AR part")
## if (transform.pars)
## init <- .Call(C_ARIMA_Invtrans, as.double(init), arma)
## }
## }
## else init <- init0
## coef <- as.double(fixed)
## if (!("parscale" %in% names(optim.control)))
## optim.control$parscale <- parscale[mask]
## if (method == "CSS") {
## res <- if (no.optim)
## list(convergence = 0L, par = numeric(), value = armaCSS(numeric()))
## else optim(init[mask], armaCSS, method = optim.method, hessian = TRUE,
## control = optim.control)
## if (res$convergence > 0)
## warning(gettextf("possible convergence problem: optim gave code = %d",
## res$convergence), domain = NA)
## coef[mask] <- res$par
## trarma <- .Call(C_ARIMA_transPars, coef, arma, FALSE)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## if (ncxreg > 0)
## x <- x - xreg %*% coef[narma + (1L:ncxreg)]
## arimaSS(x, mod)
## val <- .Call(C_ARIMA_CSS, x, arma, trarma[[1L]], trarma[[2L]], as.integer(ncond),
## TRUE)
## sigma2 <- val[[1L]]
## var <- if (no.optim)
## numeric()
## else solve(res$hessian * n.used)
## }
## else {
## if (method == "CSS-ML") {
## res <- if (no.optim)
## list(convergence = 0L, par = numeric(), value = armaCSS(numeric()))
## else optim(init[mask], armaCSS, method = optim.method, hessian = FALSE,
## control = optim.control)
## if (res$convergence == 0)
## init[mask] <- res$par
## if (arma[1L] > 0)
## if (!arCheck(init[1L:arma[1L]]))
## stop("non-stationary AR part from CSS")
## if (arma[3L] > 0)
## if (!arCheck(init[sum(arma[1L:2L]) + 1L:arma[3L]]))
## stop("non-stationary seasonal AR part from CSS")
## ncond <- 0L
## }
## if (transform.pars) {
## init <- .Call(C_ARIMA_Invtrans, init, arma)
## if (arma[2L] > 0) {
## ind <- arma[1L] + 1L:arma[2L]
## init[ind] <- maInvert(init[ind])
## }
## if (arma[4L] > 0) {
## ind <- sum(arma[1L:3L]) + 1L:arma[4L]
## init[ind] <- maInvert(init[ind])
## }
## }
## trarma <- .Call(C_ARIMA_transPars, init, arma, transform.pars)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## res <- if (no.optim)
## list(convergence = 0, par = numeric(), value = armafn(numeric(),
## as.logical(transform.pars)))
## else optim(init[mask], armafn, method = optim.method, hessian = TRUE,
## control = optim.control, trans = as.logical(transform.pars))
## if (res$convergence > 0)
## warning(gettextf("possible convergence problem: optim gave code = %d",
## res$convergence), domain = NA)
## coef[mask] <- res$par
## if (transform.pars) {
## if (arma[2L] > 0L) {
## ind <- arma[1L] + 1L:arma[2L]
## if (all(mask[ind]))
## coef[ind] <- maInvert(coef[ind])
## }
## if (arma[4L] > 0L) {
## ind <- sum(arma[1L:3L]) + 1L:arma[4L]
## if (all(mask[ind]))
## coef[ind] <- maInvert(coef[ind])
## }
## if (any(coef[mask] != res$par)) {
## oldcode <- res$convergence
## res <- optim(coef[mask], armafn, method = optim.method, hessian = TRUE,
## control = list(maxit = 0L, parscale = optim.control$parscale),
## trans = TRUE)
## res$convergence <- oldcode
## coef[mask] <- res$par
## }
## A <- .Call(C_ARIMA_Gradtrans, as.double(coef), arma)
## A <- A[mask, mask]
## var <- crossprod(A, solve(res$hessian * n.used, A))
## coef <- .Call(C_ARIMA_undoPars, coef, arma)
## }
## else var <- if (no.optim)
## numeric()
## else solve(res$hessian * n.used)
## trarma <- .Call(C_ARIMA_transPars, coef, arma, FALSE)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## val <- if (ncxreg > 0L)
## arimaSS(x - xreg %*% coef[narma + (1L:ncxreg)], mod)
## else arimaSS(x, mod)
## sigma2 <- val[[1L]][1L]/n.used
## }
## value <- 2 * n.used * res$value + n.used + n.used * log(2 * pi)
## aic <- if (method != "CSS")
## value + 2 * sum(mask) + 2
## else NA
## nm <- NULL
## if (arma[1L] > 0L)
## nm <- c(nm, paste0("ar", 1L:arma[1L]))
## if (arma[2L] > 0L)
## nm <- c(nm, paste0("ma", 1L:arma[2L]))
## if (arma[3L] > 0L)
## nm <- c(nm, paste0("sar", 1L:arma[3L]))
## if (arma[4L] > 0L)
## nm <- c(nm, paste0("sma", 1L:arma[4L]))
## if (ncxreg > 0L) {
## nm <- c(nm, cn)
## if (!orig.xreg) {
## ind <- narma + 1L:ncxreg
## coef[ind] <- S$v %*% coef[ind]
## A <- diag(narma + ncxreg)
## A[ind, ind] <- S$v
## A <- A[mask, mask]
## var <- A %*% var %*% t(A)
## }
## }
## names(coef) <- nm
## if (!no.optim)
## dimnames(var) <- list(nm[mask], nm[mask])
## resid <- val[[2L]]
## tsp(resid) <- xtsp
## class(resid) <- "ts"
## structure(list(coef = coef, sigma2 = sigma2, var.coef = var, mask = mask,
## loglik = -0.5 * value, aic = aic, arma = arma, residuals = resid, call = match.call(),
## series = series, code = res$convergence, n.cond = ncond, nobs = n.used,
## model = mod), class = "Arima")
## })(x = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6, 200, 200.3,
## 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1, 210.5, 210.5, 209.8, 208.8,
## 209.5, 213.2, 213.7, 215.1, 218.7, 219.8, 220.5, 223.8, 222.8, 223.8, 221.7,
## 222.3, 220.8, 219.4, 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7,
## 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7, 217, 215.9, 215.8,
## 214.1, 212.3, 213.9, 214.6, 213.6, 212.1, 211.4, 213.1, 212.9, 213.3, 211.5,
## 212.3, 213, 211, 210.7, 210.1, 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6,
## 211.9, 212.8, 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4,
## 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7, 247.6, 247.8, 249.4,
## 249, 249.9, 250.5, 251.5), .Tsp = c(2008, 2016.66666666667, 12), class = "ts"),
## order = c(2, 1, 2), seasonal = list(order = c(1, 1, 1)))
##
## Coefficients:
## ar1 ar2 ma1 ma2 sar1 sma1
## 1.2160 -0.3785 -1.0455 0.4437 0.0578 -1.0000
## s.e. 0.3151 0.3055 0.2991 0.2867 0.1157 0.1586
##
## sigma^2 estimated as 1.984: log likelihood = -174.62, aic = 363.23
##
## $train$partition_3$arima2$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Oct 2016 253.1852 251.2727 255.0977 250.2603 256.1101
## Nov 2016 254.4773 251.5344 257.4202 249.9765 258.9781
## Dec 2016 255.5800 251.5484 259.6115 249.4142 261.7457
## Jan 2017 255.5412 250.3541 260.7284 247.6082 263.4743
## Feb 2017 256.0411 249.6853 262.3970 246.3207 265.7616
## Mar 2017 256.5175 249.0118 264.0232 245.0385 267.9965
## Apr 2017 257.1843 248.5730 265.7957 244.0145 270.3542
## May 2017 257.8400 248.1795 267.5006 243.0655 272.6145
## Jun 2017 258.4845 247.8347 269.1344 242.1970 274.7721
## Jul 2017 258.7321 247.1513 270.3130 241.0208 276.4435
## Aug 2017 259.0779 246.6206 271.5352 240.0262 278.1297
## Sep 2017 259.2219 245.9379 272.5060 238.9058 279.5381
##
## $train$partition_3$arima2$parameters
## $train$partition_3$arima2$parameters$type
## [1] "train"
##
## $train$partition_3$arima2$parameters$model_id
## [1] "arima2"
##
## $train$partition_3$arima2$parameters$method
## [1] "arima"
##
## $train$partition_3$arima2$parameters$horizon
## [1] 12
##
## $train$partition_3$arima2$parameters$partition
## [1] "partition_3"
##
##
##
## $train$partition_3$hw
## $train$partition_3$hw$model
## Holt-Winters exponential smoothing with trend and additive seasonal component.
##
## Call:
## (function (x, alpha = NULL, beta = NULL, gamma = NULL, seasonal = c("additive", "multiplicative"), start.periods = 2, l.start = NULL, b.start = NULL, s.start = NULL, optim.start = c(alpha = 0.3, beta = 0.1, gamma = 0.1), optim.control = list()) { x <- as.ts(x) seasonal <- match.arg(seasonal) f <- frequency(x) if (!is.null(alpha) && (alpha == 0)) stop("cannot fit models without level ('alpha' must not be 0 or FALSE)") if (!is.null(abg <- c(alpha, beta, gamma)) && any(abg < 0 | abg > 1)) stop("'alpha', 'beta' and 'gamma' must be within the unit interval") if (is.null(gamma) || gamma > 0) { if (seasonal == "multiplicative" && any(x == 0)) stop("data must be non-zero for multiplicative Holt-Winters") if (start.periods < 2) stop("need at least 2 periods to compute seasonal start values") } if (!is.null(gamma) && is.logical(gamma) && !gamma) { expsmooth <- !is.null(beta) && is.logical(beta) && !beta if (is.null(l.start)) l.start <- if (expsmooth) x[1L] else x[2L] if (is.null(b.start)) if (is.null(beta) || !is.logical(beta) || beta) b.start <- x[2L] - x[1L] start.time <- 3 - expsmooth s.start <- 0 } else { start.time <- f + 1 wind <- start.periods * f st <- decompose(ts(x[1L:wind], start = start(x), frequency = f), seasonal) if (is.null(l.start) || is.null(b.start)) { dat <- na.omit(st$trend) cf <- coef(.lm.fit(x = cbind(1, seq_along(dat)), y = dat)) if (is.null(l.start)) l.start <- cf[1L] if (is.null(b.start)) b.start <- cf[2L] } if (is.null(s.start)) s.start <- st$figure } lenx <- as.integer(length(x)) if (is.na(lenx)) stop("invalid length(x)") len <- lenx - start.time + 1 hw <- function(alpha, beta, gamma) .C(C_HoltWinters, as.double(x), lenx, as.double(max(min(alpha, 1), 0)), as.double(max(min(beta, 1), 0)), as.double(max(min(gamma, 1), 0)), as.integer(start.time), as.integer(!+(seasonal == "multiplicative")), as.integer(f), as.integer(!is.logical(beta) || beta), as.integer(!is.logical(gamma) || gamma), a = as.double(l.start), b = as.double(b.start), s = as.double(s.start), SSE = as.double(0), level = double(len + 1L), trend = double(len + 1L), seasonal = double(len + f)) if (is.null(gamma)) { if (is.null(alpha)) { if (is.null(beta)) { error <- function(p) hw(p[1L], p[2L], p[3L])$SSE sol <- optim(optim.start, error, method = "L-BFGS-B", lower = c(0, 0, 0), upper = c(1, 1, 1), control = optim.control) if (sol$convergence || any(sol$par < 0 | sol$par > 1)) { if (sol$convergence > 50) { warning(gettextf("optimization difficulties: %s", sol$message), domain = NA) } else stop("optimization failure") } alpha <- sol$par[1L] beta <- sol$par[2L] gamma <- sol$par[3L] } else { error <- function(p) hw(p[1L], beta, p[2L])$SSE sol <- optim(c(optim.start["alpha"], optim.start["gamma"]), error, method = "L-BFGS-B", lower = c(0, 0), upper = c(1, 1), control = optim.control) if (sol$convergence || any(sol$par < 0 | sol$par > 1)) { if (sol$convergence > 50) { warning(gettextf("optimization difficulties: %s", sol$message), domain = NA) } else stop("optimization failure") } alpha <- sol$par[1L] gamma <- sol$par[2L] } } else { if (is.null(beta)) { error <- function(p) hw(alpha, p[1L], p[2L])$SSE sol <- optim(c(optim.start["beta"], optim.start["gamma"]), error, method = "L-BFGS-B", lower = c(0, 0), upper = c(1, 1), control = optim.control) if (sol$convergence || any(sol$par < 0 | sol$par > 1)) { if (sol$convergence > 50) { warning(gettextf("optimization difficulties: %s", sol$message), domain = NA) } else stop("optimization failure") } beta <- sol$par[1L] gamma <- sol$par[2L] } else { error <- function(p) hw(alpha, beta, p)$SSE gamma <- optimize(error, lower = 0, upper = 1)$minimum } } } else { if (is.null(alpha)) { if (is.null(beta)) { error <- function(p) hw(p[1L], p[2L], gamma)$SSE sol <- optim(c(optim.start["alpha"], optim.start["beta"]), error, method = "L-BFGS-B", lower = c(0, 0), upper = c(1, 1), control = optim.control) if (sol$convergence || any(sol$par < 0 | sol$par > 1)) { if (sol$convergence > 50) { warning(gettextf("optimization difficulties: %s", sol$message), domain = NA) } else stop("optimization failure") } alpha <- sol$par[1L] beta <- sol$par[2L] } else { error <- function(p) hw(p, beta, gamma)$SSE alpha <- optimize(error, lower = 0, upper = 1)$minimum } } else { if (is.null(beta)) { error <- function(p) hw(alpha, p, gamma)$SSE beta <- optimize(error, lower = 0, upper = 1)$minimum } } } final.fit <- hw(alpha, beta, gamma) fitted <- ts(cbind(xhat = final.fit$level[-len - 1], level = final.fit$level[-len - 1], trend = if (!is.logical(beta) || beta) final.fit$trend[-len - 1], season = if (!is.logical(gamma) || gamma) final.fit$seasonal[1L:len]), start = start(lag(x, k = 1 - start.time)), frequency = frequency(x)) if (!is.logical(beta) || beta) fitted[, 1] <- fitted[, 1] + fitted[, "trend"] if (!is.logical(gamma) || gamma) fitted[, 1] <- if (seasonal == "multiplicative") fitted[, 1] * fitted[, "season"] else fitted[, 1] + fitted[, "season"] structure(list(fitted = fitted, x = x, alpha = alpha, beta = beta, gamma = gamma, coefficients = c(a = final.fit$level[len + 1], b = if (!is.logical(beta) || beta) final.fit$trend[len + 1], s = if (!is.logical(gamma) || gamma) final.fit$seasonal[len + 1L:f]), seasonal = seasonal, SSE = final.fit$SSE, call = match.call()), class = "HoltWinters")})(x = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6, 200, 200.3, 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1, 210.5, 210.5, 209.8, 208.8, 209.5, 213.2, 213.7, 215.1, 218.7, 219.8, 220.5, 223.8, 222.8, 223.8, 221.7, 222.3, 220.8, 219.4, 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7, 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7, 217, 215.9, 215.8, 214.1, 212.3, 213.9, 214.6, 213.6, 212.1, 211.4, 213.1, 212.9, 213.3, 211.5, 212.3, 213, 211, 210.7, 210.1, 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6, 211.9, 212.8, 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4, 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7, 247.6, 247.8, 249.4, 249, 249.9, 250.5, 251.5), .Tsp = c(2008, 2016.66666666667, 12), class = "ts"))
##
## Smoothing parameters:
## alpha: 0.5167235
## beta : 0.4627971
## gamma: 1
##
## Coefficients:
## [,1]
## a 250.9446060
## b 0.1402399
## s1 1.6715117
## s2 1.0394769
## s3 0.9933832
## s4 0.6008811
## s5 0.5548789
## s6 -0.9755131
## s7 -1.3035949
## s8 -1.3013217
## s9 -1.7135653
## s10 -0.9471915
## s11 -0.4807444
## s12 0.5553940
##
## $train$partition_3$hw$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Oct 2016 252.7564 250.3115 255.2012 249.0173 256.4954
## Nov 2016 252.2646 249.1999 255.3292 247.5775 256.9516
## Dec 2016 252.3587 248.4459 256.2715 246.3746 258.3428
## Jan 2017 252.1064 247.1654 257.0475 244.5498 259.6631
## Feb 2017 252.2007 246.0861 258.3153 242.8493 261.5521
## Mar 2017 250.8105 243.4000 258.2210 239.4771 262.1439
## Apr 2017 250.6227 241.8090 259.4363 237.1434 264.1020
## May 2017 250.7652 240.4518 261.0786 234.9922 266.5382
## Jun 2017 250.4932 238.5912 262.3952 232.2907 268.6957
## Jul 2017 251.3998 237.8265 264.9731 230.6412 272.1584
## Aug 2017 252.0065 236.6838 267.3292 228.5724 275.4406
## Sep 2017 253.1829 236.0367 270.3291 226.9600 279.4057
##
## $train$partition_3$hw$parameters
## $train$partition_3$hw$parameters$type
## [1] "train"
##
## $train$partition_3$hw$parameters$model_id
## [1] "hw"
##
## $train$partition_3$hw$parameters$method
## [1] "HoltWinters"
##
## $train$partition_3$hw$parameters$horizon
## [1] 12
##
## $train$partition_3$hw$parameters$partition
## [1] "partition_3"
##
##
##
## $train$partition_3$tslm
## $train$partition_3$tslm$model
##
## Call:
## (function (formula, data, subset, lambda = NULL, biasadj = FALSE,
## ...)
## {
## cl <- match.call()
## if (!("formula" %in% class(formula))) {
## formula <- stats::as.formula(formula)
## }
## if (missing(data)) {
## mt <- try(terms(formula))
## if (is.element("try-error", class(mt))) {
## stop("Cannot extract terms from formula, please provide data argument.")
## }
## }
## else {
## mt <- terms(formula, data = data)
## }
## vars <- attr(mt, "variables")
## tsvar <- match(c("trend", "season"), as.character(vars),
## 0L)
## fnvar <- NULL
## for (i in 2:length(vars)) {
## term <- vars[[i]]
## if (!is.symbol(term)) {
## if (typeof(eval(term[[1]])) == "closure") {
## fnvar <- c(fnvar, i)
## }
## }
## }
## attr(formula, ".Environment") <- environment()
## formula[[2]] <- as.symbol(deparse(formula[[2]]))
## if (sum(c(tsvar, fnvar)) > 0) {
## rmvar <- c(tsvar, fnvar)
## rmvar <- rmvar[rmvar != attr(mt, "response") + 1]
## if (any(rmvar != 0)) {
## vars <- vars[-rmvar]
## }
## }
## if (!missing(data)) {
## vars <- vars[c(TRUE, !as.character(vars[-1]) %in% colnames(data))]
## dataname <- substitute(data)
## }
## if (!missing(data)) {
## data <- datamat(do.call(datamat, as.list(vars[-1]), envir = parent.frame()),
## data)
## }
## else {
## data <- do.call(datamat, as.list(vars[-1]), envir = parent.frame())
## }
## if (is.null(dim(data)) && length(data) != 0) {
## cn <- as.character(vars)[2]
## }
## else {
## cn <- colnames(data)
## }
## if (is.null(tsp(data))) {
## if ((attr(mt, "response") + 1) %in% fnvar) {
## tspx <- tsp(eval(attr(mt, "variables")[[attr(mt,
## "response") + 1]]))
## }
## tspx <- tsp(data[, 1])
## }
## else {
## tspx <- tsp(data)
## }
## if (is.null(tspx)) {
## stop("Not time series data, use lm()")
## }
## tsdat <- match(c("trend", "season"), cn, 0L)
## if (tsdat[1] == 0) {
## trend <- 1:NROW(data)
## cn <- c(cn, "trend")
## data <- cbind(data, trend)
## }
## if (tsdat[2] == 0) {
## if (tsvar[2] != 0 && tspx[3] <= 1) {
## stop("Non-seasonal data cannot be modelled using a seasonal factor")
## }
## season <- as.factor(cycle(data[, 1]))
## cn <- c(cn, "season")
## data <- cbind(data, season)
## }
## colnames(data) <- cn
## if (!missing(subset)) {
## if (!is.logical(subset)) {
## stop("subset must be logical")
## }
## else if (NCOL(subset) > 1) {
## stop("subset must be a logical vector")
## }
## else if (NROW(subset) != NROW(data)) {
## stop("Subset must be the same length as the number of rows in the dataset")
## }
## warning("Subset has been assumed contiguous")
## timesx <- time(data[, 1])[subset]
## tspx <- recoverTSP(timesx)
## if (tspx[3] == 1 && tsdat[2] == 0 && tsvar[2] != 0) {
## stop("Non-seasonal data cannot be modelled using a seasonal factor")
## }
## data <- data[subset, ]
## }
## if (!is.null(lambda)) {
## resp_var <- deparse(attr(mt, "variables")[[attr(mt, "response") +
## 1]])
## data[, resp_var] <- BoxCox(data[, resp_var], lambda)
## lambda <- attr(data[, resp_var], "lambda")
## }
## if (tsdat[2] == 0 && tsvar[2] != 0) {
## data$season <- factor(data$season)
## }
## fit <- lm(formula, data = data, na.action = na.exclude, ...)
## fit$data <- data
## responsevar <- deparse(formula[[2]])
## fit$residuals <- ts(residuals(fit))
## fit$x <- fit$residuals
## fit$x[!is.na(fit$x)] <- model.frame(fit)[, responsevar]
## fit$fitted.values <- ts(fitted(fit))
## tsp(fit$residuals) <- tsp(fit$x) <- tsp(fit$fitted.values) <- tsp(data[,
## 1]) <- tspx
## fit$call <- cl
## fit$method <- "Linear regression model"
## if (exists("dataname")) {
## fit$call$data <- dataname
## }
## if (!is.null(lambda)) {
## attr(lambda, "biasadj") <- biasadj
## fit$lambda <- lambda
## fit$fitted.values <- InvBoxCox(fit$fitted.values, lambda,
## biasadj, var(fit$residuals))
## fit$x <- InvBoxCox(fit$x, lambda)
## }
## class(fit) <- c("tslm", class(fit))
## return(fit)
## })(formula = train ~ trend + season)
##
## Coefficients:
## (Intercept) trend season2 season3 season4 season5
## 200.92118 0.31816 -0.07372 -0.01410 0.27885 0.49402
## season6 season7 season8 season9 season10 season11
## 0.85363 0.73547 0.73953 0.52137 -0.50310 0.16624
## season12
## 0.72308
##
##
## $train$partition_3$tslm$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Oct 2016 234.1432 220.3939 247.8926 212.9882 255.2983
## Nov 2016 235.1307 221.3814 248.8801 213.9757 256.2858
## Dec 2016 236.0057 222.2564 249.7551 214.8507 257.1608
## Jan 2017 235.6008 221.8918 249.3099 214.5078 256.6939
## Feb 2017 235.8453 222.1362 249.5543 214.7522 256.9383
## Mar 2017 236.2230 222.5140 249.9321 215.1300 257.3161
## Apr 2017 236.8342 223.1251 250.5432 215.7411 257.9272
## May 2017 237.3675 223.6584 251.0766 216.2744 258.4606
## Jun 2017 238.0453 224.3362 251.7543 216.9522 259.1383
## Jul 2017 238.2453 224.5362 251.9543 217.1522 259.3383
## Aug 2017 238.5675 224.8584 252.2766 217.4744 259.6606
## Sep 2017 238.6675 224.9584 252.3766 217.5744 259.7606
##
## $train$partition_3$tslm$parameters
## $train$partition_3$tslm$parameters$type
## [1] "train"
##
## $train$partition_3$tslm$parameters$model_id
## [1] "tslm"
##
## $train$partition_3$tslm$parameters$method
## [1] "tslm"
##
## $train$partition_3$tslm$parameters$horizon
## [1] 12
##
## $train$partition_3$tslm$parameters$partition
## [1] "partition_3"
##
##
##
## $train$partition_3$train
## Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
## 2008 200.1 199.5 199.4 198.9 199.0 200.2 198.6 200.0 200.3 201.2 201.6 201.5
## 2009 201.5 203.5 204.9 207.1 210.5 210.5 209.8 208.8 209.5 213.2 213.7 215.1
## 2010 218.7 219.8 220.5 223.8 222.8 223.8 221.7 222.3 220.8 219.4 220.1 220.6
## 2011 218.9 217.8 217.7 215.0 215.3 215.9 216.7 216.7 217.7 218.7 222.9 224.9
## 2012 222.2 220.7 220.0 218.7 217.0 215.9 215.8 214.1 212.3 213.9 214.6 213.6
## 2013 212.1 211.4 213.1 212.9 213.3 211.5 212.3 213.0 211.0 210.7 210.1 211.4
## 2014 210.0 209.7 208.8 208.8 208.8 210.6 211.9 212.8 212.5 214.8 215.3 217.5
## 2015 218.8 220.7 222.2 226.7 228.4 233.2 235.7 237.1 240.6 243.8 245.3 246.0
## 2016 246.3 247.7 247.6 247.8 249.4 249.0 249.9 250.5 251.5
##
## $train$partition_3$test
## Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
## 2016 249.0 247.6 248.8
## 2017 250.4 250.7 253.0 253.7 255.0 256.2 256.0 257.4 260.4
##
##
## $train$partition_4
## $train$partition_4$ets1
## $train$partition_4$ets1$model
## ETS(M,Ad,N)
##
## Call:
## (function (y, model = "ZZZ", damped = NULL, alpha = NULL, beta = NULL,
##
## Call:
## gamma = NULL, phi = NULL, additive.only = FALSE, lambda = NULL,
##
## Call:
## biasadj = FALSE, lower = c(rep(1e-04, 3), 0.8), upper = c(rep(0.9999,
##
## Call:
## 3), 0.98), opt.crit = c("lik", "amse", "mse", "sigma",
##
## Call:
## "mae"), nmse = 3, bounds = c("both", "usual", "admissible"),
##
## Call:
## ic = c("aicc", "aic", "bic"), restrict = TRUE, allow.multiplicative.trend = FALSE,
##
## Call:
## use.initial.values = FALSE, na.action = c("na.contiguous",
##
## Call:
## "na.interp", "na.fail"), ...)
##
## Call:
## {
##
## Call:
## opt.crit <- match.arg(opt.crit)
##
## Call:
## bounds <- match.arg(bounds)
##
## Call:
## ic <- match.arg(ic)
##
## Call:
## if (!is.function(na.action)) {
##
## Call:
## na.fn_name <- match.arg(na.action)
##
## Call:
## na.action <- get(na.fn_name)
##
## Call:
## }
##
## Call:
## seriesname <- deparse(substitute(y))
##
## Call:
## if (any(class(y) %in% c("data.frame", "list", "matrix", "mts"))) {
##
## Call:
## stop("y should be a univariate time series")
##
## Call:
## }
##
## Call:
## y <- as.ts(y)
##
## Call:
## if (missing(model) && is.constant(y)) {
##
## Call:
## return(ses(y, alpha = 0.99999, initial = "simple")$model)
##
## Call:
## }
##
## Call:
## ny <- length(y)
##
## Call:
## y <- na.action(y)
##
## Call:
## if (ny != length(y) && na.fn_name == "na.contiguous") {
##
## Call:
## warning("Missing values encountered. Using longest contiguous portion of time series")
##
## Call:
## ny <- length(y)
##
## Call:
## }
##
## Call:
## orig.y <- y
##
## Call:
## if (identical(class(model), "ets") && is.null(lambda)) {
##
## Call:
## lambda <- model$lambda
##
## Call:
## }
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## y <- BoxCox(y, lambda)
##
## Call:
## lambda <- attr(y, "lambda")
##
## Call:
## additive.only <- TRUE
##
## Call:
## }
##
## Call:
## if (nmse < 1 || nmse > 30) {
##
## Call:
## stop("nmse out of range")
##
## Call:
## }
##
## Call:
## m <- frequency(y)
##
## Call:
## if (any(upper < lower)) {
##
## Call:
## stop("Lower limits must be less than upper limits")
##
## Call:
## }
##
## Call:
## if (class(model) == "ets") {
##
## Call:
## alpha <- max(model$par["alpha"], 1e-10)
##
## Call:
## beta <- model$par["beta"]
##
## Call:
## if (is.na(beta)) {
##
## Call:
## beta <- NULL
##
## Call:
## }
##
## Call:
## gamma <- model$par["gamma"]
##
## Call:
## if (is.na(gamma)) {
##
## Call:
## gamma <- NULL
##
## Call:
## }
##
## Call:
## phi <- model$par["phi"]
##
## Call:
## if (is.na(phi)) {
##
## Call:
## phi <- NULL
##
## Call:
## }
##
## Call:
## modelcomponents <- paste(model$components[1], model$components[2],
##
## Call:
## model$components[3], sep = "")
##
## Call:
## damped <- (model$components[4] == "TRUE")
##
## Call:
## if (use.initial.values) {
##
## Call:
## errortype <- substr(modelcomponents, 1, 1)
##
## Call:
## trendtype <- substr(modelcomponents, 2, 2)
##
## Call:
## seasontype <- substr(modelcomponents, 3, 3)
##
## Call:
## e <- pegelsresid.C(y, m, model$initstate, errortype,
##
## Call:
## trendtype, seasontype, damped, alpha, beta, gamma,
##
## Call:
## phi, nmse)
##
## Call:
## np <- length(model$par) + 1
##
## Call:
## model$loglik <- -0.5 * e$lik
##
## Call:
## model$aic <- e$lik + 2 * np
##
## Call:
## model$bic <- e$lik + log(ny) * np
##
## Call:
## model$aicc <- model$aic + 2 * np * (np + 1)/(ny -
##
## Call:
## np - 1)
##
## Call:
## model$mse <- e$amse[1]
##
## Call:
## model$amse <- mean(e$amse)
##
## Call:
## tsp.y <- tsp(y)
##
## Call:
## model$states <- ts(e$states, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1] - 1/tsp.y[3])
##
## Call:
## colnames(model$states)[1] <- "l"
##
## Call:
## if (trendtype != "N") {
##
## Call:
## colnames(model$states)[2] <- "b"
##
## Call:
## }
##
## Call:
## if (seasontype != "N") {
##
## Call:
## colnames(model$states)[(2 + (trendtype != "N")):ncol(model$states)] <- paste("s",
##
## Call:
## 1:m, sep = "")
##
## Call:
## }
##
## Call:
## if (errortype == "A") {
##
## Call:
## model$fitted <- ts(y - e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model$fitted <- ts(y/(1 + e$e), frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## model$residuals <- ts(e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## model$series <- seriesname
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda,
##
## Call:
## biasadj, var(model$residuals))
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(model)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model <- modelcomponents
##
## Call:
## if (missing(use.initial.values)) {
##
## Call:
## message("Model is being refit with current smoothing parameters but initial states are being re-estimated.\nSet 'use.initial.values=TRUE' if you want to re-use existing initial values.")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## errortype <- substr(model, 1, 1)
##
## Call:
## trendtype <- substr(model, 2, 2)
##
## Call:
## seasontype <- substr(model, 3, 3)
##
## Call:
## if (!is.element(errortype, c("M", "A", "Z"))) {
##
## Call:
## stop("Invalid error type")
##
## Call:
## }
##
## Call:
## if (!is.element(trendtype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid trend type")
##
## Call:
## }
##
## Call:
## if (!is.element(seasontype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid season type")
##
## Call:
## }
##
## Call:
## if (m < 1 || length(y) <= m) {
##
## Call:
## seasontype <- "N"
##
## Call:
## }
##
## Call:
## if (m == 1) {
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## stop("Nonseasonal data")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (m > 24) {
##
## Call:
## if (is.element(seasontype, c("A", "M"))) {
##
## Call:
## stop("Frequency too high")
##
## Call:
## }
##
## Call:
## else if (seasontype == "Z") {
##
## Call:
## warning("I can't handle data with frequency greater than 24. Seasonality will be ignored. Try stlf() if you need seasonal forecasts.")
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if ((errortype == "A" && (trendtype == "M" || seasontype ==
##
## Call:
## "M")) | (errortype == "M" && trendtype == "M" &&
##
## Call:
## seasontype == "A") || (additive.only && (errortype ==
##
## Call:
## "M" || trendtype == "M" || seasontype == "M"))) {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## data.positive <- (min(y) > 0)
##
## Call:
## if (!data.positive && errortype == "M") {
##
## Call:
## stop("Inappropriate model for data with negative or zero values")
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped && trendtype == "N") {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## n <- length(y)
##
## Call:
## npars <- 2L
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## npars <- npars + 2L
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## npars <- npars + m
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## npars <- npars + as.numeric(damped)
##
## Call:
## }
##
## Call:
## if (n <= npars + 4L) {
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped) {
##
## Call:
## warning("Not enough data to use damping")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = gamma, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), seasonal = ifelse(seasontype != "A",
##
## Call:
## "multiplicative", "additive"), lambda = lambda,
##
## Call:
## biasadj = biasadj, warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Seasonal component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Trend component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "N" && seasontype == "N") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, lambda = lambda, biasadj = biasadj,
##
## Call:
## warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## }
##
## Call:
## fit1 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## fit2 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if ("try-error" %in% class(fit1)) {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## else if (fit1$sigma2 < fit2$sigma2) {
##
## Call:
## fit <- fit1
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## if ("try-error" %in% class(fit))
##
## Call:
## stop("Unable to estimate a model.")
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## if (errortype == "Z") {
##
## Call:
## errortype <- c("A", "M")
##
## Call:
## }
##
## Call:
## if (trendtype == "Z") {
##
## Call:
## if (allow.multiplicative.trend) {
##
## Call:
## trendtype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## trendtype <- c("N", "A")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "Z") {
##
## Call:
## seasontype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## if (is.null(damped)) {
##
## Call:
## damped <- c(TRUE, FALSE)
##
## Call:
## }
##
## Call:
## best.ic <- Inf
##
## Call:
## for (i in 1:length(errortype)) {
##
## Call:
## for (j in 1:length(trendtype)) {
##
## Call:
## for (k in 1:length(seasontype)) {
##
## Call:
## for (l in 1:length(damped)) {
##
## Call:
## if (trendtype[j] == "N" && damped[l]) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if (errortype[i] == "A" && (trendtype[j] ==
##
## Call:
## "M" || seasontype[k] == "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (errortype[i] == "M" && trendtype[j] ==
##
## Call:
## "M" && seasontype[k] == "A") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (additive.only && (errortype[i] == "M" ||
##
## Call:
## trendtype[j] == "M" || seasontype[k] ==
##
## Call:
## "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (!data.positive && errortype[i] == "M") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## fit <- try(etsmodel(y, errortype[i], trendtype[j],
##
## Call:
## seasontype[k], damped[l], alpha, beta, gamma,
##
## Call:
## phi, lower = lower, upper = upper, opt.crit = opt.crit,
##
## Call:
## nmse = nmse, bounds = bounds, ...), silent = TRUE)
##
## Call:
## if (is.element("try-error", class(fit)))
##
## Call:
## fit.ic <- Inf
##
## Call:
## else fit.ic <- switch(ic, aic = fit$aic, bic = fit$bic,
##
## Call:
## aicc = fit$aicc)
##
## Call:
## if (!is.na(fit.ic)) {
##
## Call:
## if (fit.ic < best.ic) {
##
## Call:
## model <- fit
##
## Call:
## best.ic <- fit.ic
##
## Call:
## best.e <- errortype[i]
##
## Call:
## best.t <- trendtype[j]
##
## Call:
## best.s <- seasontype[k]
##
## Call:
## best.d <- damped[l]
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (best.ic == Inf) {
##
## Call:
## stop("No model able to be fitted")
##
## Call:
## }
##
## Call:
## model$m <- m
##
## Call:
## model$method <- paste("ETS(", best.e, ",", best.t, ifelse(best.d,
##
## Call:
## "d", ""), ",", best.s, ")", sep = "")
##
## Call:
## model$series <- seriesname
##
## Call:
## model$components <- c(best.e, best.t, best.s, best.d)
##
## Call:
## model$call <- match.call()
##
## Call:
## model$initstate <- model$states[1, ]
##
## Call:
## np <- length(model$par)
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda, biasadj,
##
## Call:
## model$sigma2)
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(structure(model, class = "ets"))
##
## Call:
## })(y = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6,
##
## Call:
## 200, 200.3, 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1,
##
## Call:
## 210.5, 210.5, 209.8, 208.8, 209.5, 213.2, 213.7, 215.1, 218.7,
##
## Call:
## 219.8, 220.5, 223.8, 222.8, 223.8, 221.7, 222.3, 220.8, 219.4,
##
## Call:
## 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7,
##
## Call:
## 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7,
##
## Call:
## 217, 215.9, 215.8, 214.1, 212.3, 213.9, 214.6, 213.6, 212.1,
##
## Call:
## 211.4, 213.1, 212.9, 213.3, 211.5, 212.3, 213, 211, 210.7, 210.1,
##
## Call:
## 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6, 211.9, 212.8,
##
## Call:
## 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4,
##
## Call:
## 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7,
##
## Call:
## 247.6, 247.8, 249.4, 249, 249.9, 250.5, 251.5, 249, 247.6, 248.8
##
## Call:
## ), .Tsp = c(2008, 2016.91666666667, 12), class = "ts"), opt.crit = "lik")
##
## Smoothing parameters:
## alpha = 0.9771
## beta = 0.2848
## phi = 0.8921
##
## Initial states:
## l = 200.4124
## b = -0.3724
##
## sigma: 0.0067
##
## AIC AICc BIC
## 594.0654 594.8971 610.1582
##
## $train$partition_4$ets1$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jan 2017 248.7006 246.5719 250.8293 245.4451 251.9562
## Feb 2017 248.6474 245.2712 252.0236 243.4840 253.8108
## Mar 2017 248.6000 244.0146 253.1853 241.5872 255.6127
## Apr 2017 248.5576 242.7691 254.3461 239.7049 257.4103
## May 2017 248.5198 241.5308 255.5088 237.8311 259.2085
## Jun 2017 248.4861 240.3018 256.6704 235.9693 261.0029
## Jul 2017 248.4561 239.0852 257.8269 234.1245 262.7876
## Aug 2017 248.4292 237.8839 258.9746 232.3015 264.5569
## Sep 2017 248.4053 236.7005 260.1102 230.5043 266.3063
## Oct 2017 248.3840 235.5367 261.2312 228.7358 268.0322
## Nov 2017 248.3649 234.3940 262.3359 226.9982 269.7316
## Dec 2017 248.3479 233.2732 263.4226 225.2932 271.4027
##
## $train$partition_4$ets1$parameters
## $train$partition_4$ets1$parameters$type
## [1] "train"
##
## $train$partition_4$ets1$parameters$model_id
## [1] "ets1"
##
## $train$partition_4$ets1$parameters$method
## [1] "ets"
##
## $train$partition_4$ets1$parameters$horizon
## [1] 12
##
## $train$partition_4$ets1$parameters$partition
## [1] "partition_4"
##
##
##
## $train$partition_4$ets2
## $train$partition_4$ets2$model
## ETS(M,Ad,N)
##
## Call:
## (function (y, model = "ZZZ", damped = NULL, alpha = NULL, beta = NULL,
##
## Call:
## gamma = NULL, phi = NULL, additive.only = FALSE, lambda = NULL,
##
## Call:
## biasadj = FALSE, lower = c(rep(1e-04, 3), 0.8), upper = c(rep(0.9999,
##
## Call:
## 3), 0.98), opt.crit = c("lik", "amse", "mse", "sigma",
##
## Call:
## "mae"), nmse = 3, bounds = c("both", "usual", "admissible"),
##
## Call:
## ic = c("aicc", "aic", "bic"), restrict = TRUE, allow.multiplicative.trend = FALSE,
##
## Call:
## use.initial.values = FALSE, na.action = c("na.contiguous",
##
## Call:
## "na.interp", "na.fail"), ...)
##
## Call:
## {
##
## Call:
## opt.crit <- match.arg(opt.crit)
##
## Call:
## bounds <- match.arg(bounds)
##
## Call:
## ic <- match.arg(ic)
##
## Call:
## if (!is.function(na.action)) {
##
## Call:
## na.fn_name <- match.arg(na.action)
##
## Call:
## na.action <- get(na.fn_name)
##
## Call:
## }
##
## Call:
## seriesname <- deparse(substitute(y))
##
## Call:
## if (any(class(y) %in% c("data.frame", "list", "matrix", "mts"))) {
##
## Call:
## stop("y should be a univariate time series")
##
## Call:
## }
##
## Call:
## y <- as.ts(y)
##
## Call:
## if (missing(model) && is.constant(y)) {
##
## Call:
## return(ses(y, alpha = 0.99999, initial = "simple")$model)
##
## Call:
## }
##
## Call:
## ny <- length(y)
##
## Call:
## y <- na.action(y)
##
## Call:
## if (ny != length(y) && na.fn_name == "na.contiguous") {
##
## Call:
## warning("Missing values encountered. Using longest contiguous portion of time series")
##
## Call:
## ny <- length(y)
##
## Call:
## }
##
## Call:
## orig.y <- y
##
## Call:
## if (identical(class(model), "ets") && is.null(lambda)) {
##
## Call:
## lambda <- model$lambda
##
## Call:
## }
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## y <- BoxCox(y, lambda)
##
## Call:
## lambda <- attr(y, "lambda")
##
## Call:
## additive.only <- TRUE
##
## Call:
## }
##
## Call:
## if (nmse < 1 || nmse > 30) {
##
## Call:
## stop("nmse out of range")
##
## Call:
## }
##
## Call:
## m <- frequency(y)
##
## Call:
## if (any(upper < lower)) {
##
## Call:
## stop("Lower limits must be less than upper limits")
##
## Call:
## }
##
## Call:
## if (class(model) == "ets") {
##
## Call:
## alpha <- max(model$par["alpha"], 1e-10)
##
## Call:
## beta <- model$par["beta"]
##
## Call:
## if (is.na(beta)) {
##
## Call:
## beta <- NULL
##
## Call:
## }
##
## Call:
## gamma <- model$par["gamma"]
##
## Call:
## if (is.na(gamma)) {
##
## Call:
## gamma <- NULL
##
## Call:
## }
##
## Call:
## phi <- model$par["phi"]
##
## Call:
## if (is.na(phi)) {
##
## Call:
## phi <- NULL
##
## Call:
## }
##
## Call:
## modelcomponents <- paste(model$components[1], model$components[2],
##
## Call:
## model$components[3], sep = "")
##
## Call:
## damped <- (model$components[4] == "TRUE")
##
## Call:
## if (use.initial.values) {
##
## Call:
## errortype <- substr(modelcomponents, 1, 1)
##
## Call:
## trendtype <- substr(modelcomponents, 2, 2)
##
## Call:
## seasontype <- substr(modelcomponents, 3, 3)
##
## Call:
## e <- pegelsresid.C(y, m, model$initstate, errortype,
##
## Call:
## trendtype, seasontype, damped, alpha, beta, gamma,
##
## Call:
## phi, nmse)
##
## Call:
## np <- length(model$par) + 1
##
## Call:
## model$loglik <- -0.5 * e$lik
##
## Call:
## model$aic <- e$lik + 2 * np
##
## Call:
## model$bic <- e$lik + log(ny) * np
##
## Call:
## model$aicc <- model$aic + 2 * np * (np + 1)/(ny -
##
## Call:
## np - 1)
##
## Call:
## model$mse <- e$amse[1]
##
## Call:
## model$amse <- mean(e$amse)
##
## Call:
## tsp.y <- tsp(y)
##
## Call:
## model$states <- ts(e$states, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1] - 1/tsp.y[3])
##
## Call:
## colnames(model$states)[1] <- "l"
##
## Call:
## if (trendtype != "N") {
##
## Call:
## colnames(model$states)[2] <- "b"
##
## Call:
## }
##
## Call:
## if (seasontype != "N") {
##
## Call:
## colnames(model$states)[(2 + (trendtype != "N")):ncol(model$states)] <- paste("s",
##
## Call:
## 1:m, sep = "")
##
## Call:
## }
##
## Call:
## if (errortype == "A") {
##
## Call:
## model$fitted <- ts(y - e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model$fitted <- ts(y/(1 + e$e), frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## model$residuals <- ts(e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## model$series <- seriesname
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda,
##
## Call:
## biasadj, var(model$residuals))
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(model)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model <- modelcomponents
##
## Call:
## if (missing(use.initial.values)) {
##
## Call:
## message("Model is being refit with current smoothing parameters but initial states are being re-estimated.\nSet 'use.initial.values=TRUE' if you want to re-use existing initial values.")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## errortype <- substr(model, 1, 1)
##
## Call:
## trendtype <- substr(model, 2, 2)
##
## Call:
## seasontype <- substr(model, 3, 3)
##
## Call:
## if (!is.element(errortype, c("M", "A", "Z"))) {
##
## Call:
## stop("Invalid error type")
##
## Call:
## }
##
## Call:
## if (!is.element(trendtype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid trend type")
##
## Call:
## }
##
## Call:
## if (!is.element(seasontype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid season type")
##
## Call:
## }
##
## Call:
## if (m < 1 || length(y) <= m) {
##
## Call:
## seasontype <- "N"
##
## Call:
## }
##
## Call:
## if (m == 1) {
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## stop("Nonseasonal data")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (m > 24) {
##
## Call:
## if (is.element(seasontype, c("A", "M"))) {
##
## Call:
## stop("Frequency too high")
##
## Call:
## }
##
## Call:
## else if (seasontype == "Z") {
##
## Call:
## warning("I can't handle data with frequency greater than 24. Seasonality will be ignored. Try stlf() if you need seasonal forecasts.")
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if ((errortype == "A" && (trendtype == "M" || seasontype ==
##
## Call:
## "M")) | (errortype == "M" && trendtype == "M" &&
##
## Call:
## seasontype == "A") || (additive.only && (errortype ==
##
## Call:
## "M" || trendtype == "M" || seasontype == "M"))) {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## data.positive <- (min(y) > 0)
##
## Call:
## if (!data.positive && errortype == "M") {
##
## Call:
## stop("Inappropriate model for data with negative or zero values")
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped && trendtype == "N") {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## n <- length(y)
##
## Call:
## npars <- 2L
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## npars <- npars + 2L
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## npars <- npars + m
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## npars <- npars + as.numeric(damped)
##
## Call:
## }
##
## Call:
## if (n <= npars + 4L) {
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped) {
##
## Call:
## warning("Not enough data to use damping")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = gamma, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), seasonal = ifelse(seasontype != "A",
##
## Call:
## "multiplicative", "additive"), lambda = lambda,
##
## Call:
## biasadj = biasadj, warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Seasonal component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Trend component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "N" && seasontype == "N") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, lambda = lambda, biasadj = biasadj,
##
## Call:
## warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## }
##
## Call:
## fit1 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## fit2 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if ("try-error" %in% class(fit1)) {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## else if (fit1$sigma2 < fit2$sigma2) {
##
## Call:
## fit <- fit1
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## if ("try-error" %in% class(fit))
##
## Call:
## stop("Unable to estimate a model.")
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## if (errortype == "Z") {
##
## Call:
## errortype <- c("A", "M")
##
## Call:
## }
##
## Call:
## if (trendtype == "Z") {
##
## Call:
## if (allow.multiplicative.trend) {
##
## Call:
## trendtype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## trendtype <- c("N", "A")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "Z") {
##
## Call:
## seasontype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## if (is.null(damped)) {
##
## Call:
## damped <- c(TRUE, FALSE)
##
## Call:
## }
##
## Call:
## best.ic <- Inf
##
## Call:
## for (i in 1:length(errortype)) {
##
## Call:
## for (j in 1:length(trendtype)) {
##
## Call:
## for (k in 1:length(seasontype)) {
##
## Call:
## for (l in 1:length(damped)) {
##
## Call:
## if (trendtype[j] == "N" && damped[l]) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if (errortype[i] == "A" && (trendtype[j] ==
##
## Call:
## "M" || seasontype[k] == "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (errortype[i] == "M" && trendtype[j] ==
##
## Call:
## "M" && seasontype[k] == "A") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (additive.only && (errortype[i] == "M" ||
##
## Call:
## trendtype[j] == "M" || seasontype[k] ==
##
## Call:
## "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (!data.positive && errortype[i] == "M") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## fit <- try(etsmodel(y, errortype[i], trendtype[j],
##
## Call:
## seasontype[k], damped[l], alpha, beta, gamma,
##
## Call:
## phi, lower = lower, upper = upper, opt.crit = opt.crit,
##
## Call:
## nmse = nmse, bounds = bounds, ...), silent = TRUE)
##
## Call:
## if (is.element("try-error", class(fit)))
##
## Call:
## fit.ic <- Inf
##
## Call:
## else fit.ic <- switch(ic, aic = fit$aic, bic = fit$bic,
##
## Call:
## aicc = fit$aicc)
##
## Call:
## if (!is.na(fit.ic)) {
##
## Call:
## if (fit.ic < best.ic) {
##
## Call:
## model <- fit
##
## Call:
## best.ic <- fit.ic
##
## Call:
## best.e <- errortype[i]
##
## Call:
## best.t <- trendtype[j]
##
## Call:
## best.s <- seasontype[k]
##
## Call:
## best.d <- damped[l]
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (best.ic == Inf) {
##
## Call:
## stop("No model able to be fitted")
##
## Call:
## }
##
## Call:
## model$m <- m
##
## Call:
## model$method <- paste("ETS(", best.e, ",", best.t, ifelse(best.d,
##
## Call:
## "d", ""), ",", best.s, ")", sep = "")
##
## Call:
## model$series <- seriesname
##
## Call:
## model$components <- c(best.e, best.t, best.s, best.d)
##
## Call:
## model$call <- match.call()
##
## Call:
## model$initstate <- model$states[1, ]
##
## Call:
## np <- length(model$par)
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda, biasadj,
##
## Call:
## model$sigma2)
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(structure(model, class = "ets"))
##
## Call:
## })(y = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6,
##
## Call:
## 200, 200.3, 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1,
##
## Call:
## 210.5, 210.5, 209.8, 208.8, 209.5, 213.2, 213.7, 215.1, 218.7,
##
## Call:
## 219.8, 220.5, 223.8, 222.8, 223.8, 221.7, 222.3, 220.8, 219.4,
##
## Call:
## 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7,
##
## Call:
## 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7,
##
## Call:
## 217, 215.9, 215.8, 214.1, 212.3, 213.9, 214.6, 213.6, 212.1,
##
## Call:
## 211.4, 213.1, 212.9, 213.3, 211.5, 212.3, 213, 211, 210.7, 210.1,
##
## Call:
## 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6, 211.9, 212.8,
##
## Call:
## 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4,
##
## Call:
## 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7,
##
## Call:
## 247.6, 247.8, 249.4, 249, 249.9, 250.5, 251.5, 249, 247.6, 248.8
##
## Call:
## ), .Tsp = c(2008, 2016.91666666667, 12), class = "ts"), opt.crit = "amse")
##
## Smoothing parameters:
## alpha = 0.8694
## beta = 0.321
## phi = 0.8481
##
## Initial states:
## l = 200.1409
## b = -0.3418
##
## sigma: 0.0067
##
## AIC AICc BIC
## 595.1089 595.9406 611.2017
##
## $train$partition_4$ets2$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jan 2017 248.4531 246.3159 250.5903 245.1846 251.7216
## Feb 2017 248.3482 245.1052 251.5911 243.3885 253.3079
## Mar 2017 248.2592 243.8873 252.6311 241.5730 254.9454
## Apr 2017 248.1837 242.6760 253.6914 239.7604 256.6070
## May 2017 248.1197 241.4823 254.7571 237.9687 258.2708
## Jun 2017 248.0654 240.3136 255.8173 236.2100 259.9208
## Jul 2017 248.0194 239.1746 256.8642 234.4924 261.5464
## Aug 2017 247.9803 238.0679 257.8928 232.8206 263.1401
## Sep 2017 247.9472 236.9948 258.8996 231.1970 264.6975
## Oct 2017 247.9191 235.9557 259.8826 229.6227 266.2156
## Nov 2017 247.8953 234.9502 260.8405 228.0974 267.6933
## Dec 2017 247.8751 233.9773 261.7729 226.6203 269.1300
##
## $train$partition_4$ets2$parameters
## $train$partition_4$ets2$parameters$type
## [1] "train"
##
## $train$partition_4$ets2$parameters$model_id
## [1] "ets2"
##
## $train$partition_4$ets2$parameters$method
## [1] "ets"
##
## $train$partition_4$ets2$parameters$horizon
## [1] 12
##
## $train$partition_4$ets2$parameters$partition
## [1] "partition_4"
##
##
##
## $train$partition_4$arima1
## $train$partition_4$arima1$model
##
## Call:
## (function (x, order = c(0L, 0L, 0L), seasonal = list(order = c(0L, 0L, 0L),
## period = NA), xreg = NULL, include.mean = TRUE, transform.pars = TRUE, fixed = NULL,
## init = NULL, method = c("CSS-ML", "ML", "CSS"), n.cond, SSinit = c("Gardner1980",
## "Rossignol2011"), optim.method = "BFGS", optim.control = list(), kappa = 1e+06)
## {
## "%+%" <- function(a, b) .Call(C_TSconv, a, b)
## SSinit <- match.arg(SSinit)
## SS.G <- SSinit == "Gardner1980"
## upARIMA <- function(mod, phi, theta) {
## p <- length(phi)
## q <- length(theta)
## mod$phi <- phi
## mod$theta <- theta
## r <- max(p, q + 1L)
## if (p > 0)
## mod$T[1L:p, 1L] <- phi
## if (r > 1L)
## mod$Pn[1L:r, 1L:r] <- if (SS.G)
## .Call(C_getQ0, phi, theta)
## else .Call(C_getQ0bis, phi, theta, tol = 0)
## else mod$Pn[1L, 1L] <- if (p > 0)
## 1/(1 - phi^2)
## else 1
## mod$a[] <- 0
## mod
## }
## arimaSS <- function(y, mod) {
## .Call(C_ARIMA_Like, y, mod, 0L, TRUE)
## }
## armafn <- function(p, trans) {
## par <- coef
## par[mask] <- p
## trarma <- .Call(C_ARIMA_transPars, par, arma, trans)
## if (is.null(Z <- tryCatch(upARIMA(mod, trarma[[1L]], trarma[[2L]]),
## error = function(e) NULL)))
## return(.Machine$double.xmax)
## if (ncxreg > 0)
## x <- x - xreg %*% par[narma + (1L:ncxreg)]
## res <- .Call(C_ARIMA_Like, x, Z, 0L, FALSE)
## s2 <- res[1L]/res[3L]
## 0.5 * (log(s2) + res[2L]/res[3L])
## }
## armaCSS <- function(p) {
## par <- as.double(fixed)
## par[mask] <- p
## trarma <- .Call(C_ARIMA_transPars, par, arma, FALSE)
## if (ncxreg > 0)
## x <- x - xreg %*% par[narma + (1L:ncxreg)]
## res <- .Call(C_ARIMA_CSS, x, arma, trarma[[1L]], trarma[[2L]], as.integer(ncond),
## FALSE)
## 0.5 * log(res)
## }
## arCheck <- function(ar) {
## p <- max(which(c(1, -ar) != 0)) - 1
## if (!p)
## return(TRUE)
## all(Mod(polyroot(c(1, -ar[1L:p]))) > 1)
## }
## maInvert <- function(ma) {
## q <- length(ma)
## q0 <- max(which(c(1, ma) != 0)) - 1L
## if (!q0)
## return(ma)
## roots <- polyroot(c(1, ma[1L:q0]))
## ind <- Mod(roots) < 1
## if (all(!ind))
## return(ma)
## if (q0 == 1)
## return(c(1/ma[1L], rep.int(0, q - q0)))
## roots[ind] <- 1/roots[ind]
## x <- 1
## for (r in roots) x <- c(x, 0) - c(0, x)/r
## c(Re(x[-1L]), rep.int(0, q - q0))
## }
## series <- deparse1(substitute(x))
## if (NCOL(x) > 1L)
## stop("only implemented for univariate time series")
## method <- match.arg(method)
## x <- as.ts(x)
## if (!is.numeric(x))
## stop("'x' must be numeric")
## storage.mode(x) <- "double"
## dim(x) <- NULL
## n <- length(x)
## if (!missing(order))
## if (!is.numeric(order) || length(order) != 3L || any(order < 0))
## stop("'order' must be a non-negative numeric vector of length 3")
## if (!missing(seasonal))
## if (is.list(seasonal)) {
## if (is.null(seasonal$order))
## stop("'seasonal' must be a list with component 'order'")
## if (!is.numeric(seasonal$order) || length(seasonal$order) != 3L ||
## any(seasonal$order < 0L))
## stop("'seasonal$order' must be a non-negative numeric vector of length 3")
## }
## else if (is.numeric(order)) {
## if (length(order) == 3L)
## seasonal <- list(order = seasonal)
## else ("'seasonal' is of the wrong length")
## }
## else stop("'seasonal' must be a list with component 'order'")
## if (is.null(seasonal$period) || is.na(seasonal$period) || seasonal$period ==
## 0)
## seasonal$period <- frequency(x)
## arma <- as.integer(c(order[-2L], seasonal$order[-2L], seasonal$period, order[2L],
## seasonal$order[2L]))
## narma <- sum(arma[1L:4L])
## xtsp <- tsp(x)
## tsp(x) <- NULL
## Delta <- 1
## for (i in seq_len(order[2L])) Delta <- Delta %+% c(1, -1)
## for (i in seq_len(seasonal$order[2L])) Delta <- Delta %+% c(1, rep.int(0,
## seasonal$period - 1), -1)
## Delta <- -Delta[-1L]
## nd <- order[2L] + seasonal$order[2L]
## n.used <- sum(!is.na(x)) - length(Delta)
## if (is.null(xreg)) {
## ncxreg <- 0L
## }
## else {
## nmxreg <- deparse1(substitute(xreg))
## if (NROW(xreg) != n)
## stop("lengths of 'x' and 'xreg' do not match")
## ncxreg <- NCOL(xreg)
## xreg <- as.matrix(xreg)
## storage.mode(xreg) <- "double"
## }
## class(xreg) <- NULL
## if (ncxreg > 0L && is.null(colnames(xreg)))
## colnames(xreg) <- if (ncxreg == 1L)
## nmxreg
## else paste0(nmxreg, 1L:ncxreg)
## if (include.mean && (nd == 0L)) {
## xreg <- cbind(intercept = rep(1, n), xreg = xreg)
## ncxreg <- ncxreg + 1L
## }
## if (method == "CSS-ML") {
## anyna <- anyNA(x)
## if (ncxreg)
## anyna <- anyna || anyNA(xreg)
## if (anyna)
## method <- "ML"
## }
## if (method == "CSS" || method == "CSS-ML") {
## ncond <- order[2L] + seasonal$order[2L] * seasonal$period
## ncond1 <- order[1L] + seasonal$period * seasonal$order[1L]
## ncond <- ncond + if (!missing(n.cond))
## max(n.cond, ncond1)
## else ncond1
## }
## else ncond <- 0
## if (is.null(fixed))
## fixed <- rep(NA_real_, narma + ncxreg)
## else if (length(fixed) != narma + ncxreg)
## stop("wrong length for 'fixed'")
## mask <- is.na(fixed)
## no.optim <- !any(mask)
## if (no.optim)
## transform.pars <- FALSE
## if (transform.pars) {
## ind <- arma[1L] + arma[2L] + seq_len(arma[3L])
## if (any(!mask[seq_len(arma[1L])]) || any(!mask[ind])) {
## warning("some AR parameters were fixed: setting transform.pars = FALSE")
## transform.pars <- FALSE
## }
## }
## init0 <- rep.int(0, narma)
## parscale <- rep(1, narma)
## if (ncxreg) {
## cn <- colnames(xreg)
## orig.xreg <- (ncxreg == 1L) || any(!mask[narma + 1L:ncxreg])
## if (!orig.xreg) {
## S <- svd(na.omit(xreg))
## xreg <- xreg %*% S$v
## }
## dx <- x
## dxreg <- xreg
## if (order[2L] > 0L) {
## dx <- diff(dx, 1L, order[2L])
## dxreg <- diff(dxreg, 1L, order[2L])
## }
## if (seasonal$period > 1L && seasonal$order[2L] > 0) {
## dx <- diff(dx, seasonal$period, seasonal$order[2L])
## dxreg <- diff(dxreg, seasonal$period, seasonal$order[2L])
## }
## fit <- if (length(dx) > ncol(dxreg))
## lm(dx ~ dxreg - 1, na.action = na.omit)
## else list(rank = 0L)
## if (fit$rank == 0L) {
## fit <- lm(x ~ xreg - 1, na.action = na.omit)
## }
## isna <- is.na(x) | apply(xreg, 1L, anyNA)
## n.used <- sum(!isna) - length(Delta)
## init0 <- c(init0, coef(fit))
## ses <- summary(fit)$coefficients[, 2L]
## parscale <- c(parscale, 10 * ses)
## }
## if (n.used <= 0)
## stop("too few non-missing observations")
## if (!is.null(init)) {
## if (length(init) != length(init0))
## stop("'init' is of the wrong length")
## if (any(ind <- is.na(init)))
## init[ind] <- init0[ind]
## if (method == "ML") {
## if (arma[1L] > 0)
## if (!arCheck(init[1L:arma[1L]]))
## stop("non-stationary AR part")
## if (arma[3L] > 0)
## if (!arCheck(init[sum(arma[1L:2L]) + 1L:arma[3L]]))
## stop("non-stationary seasonal AR part")
## if (transform.pars)
## init <- .Call(C_ARIMA_Invtrans, as.double(init), arma)
## }
## }
## else init <- init0
## coef <- as.double(fixed)
## if (!("parscale" %in% names(optim.control)))
## optim.control$parscale <- parscale[mask]
## if (method == "CSS") {
## res <- if (no.optim)
## list(convergence = 0L, par = numeric(), value = armaCSS(numeric()))
## else optim(init[mask], armaCSS, method = optim.method, hessian = TRUE,
## control = optim.control)
## if (res$convergence > 0)
## warning(gettextf("possible convergence problem: optim gave code = %d",
## res$convergence), domain = NA)
## coef[mask] <- res$par
## trarma <- .Call(C_ARIMA_transPars, coef, arma, FALSE)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## if (ncxreg > 0)
## x <- x - xreg %*% coef[narma + (1L:ncxreg)]
## arimaSS(x, mod)
## val <- .Call(C_ARIMA_CSS, x, arma, trarma[[1L]], trarma[[2L]], as.integer(ncond),
## TRUE)
## sigma2 <- val[[1L]]
## var <- if (no.optim)
## numeric()
## else solve(res$hessian * n.used)
## }
## else {
## if (method == "CSS-ML") {
## res <- if (no.optim)
## list(convergence = 0L, par = numeric(), value = armaCSS(numeric()))
## else optim(init[mask], armaCSS, method = optim.method, hessian = FALSE,
## control = optim.control)
## if (res$convergence == 0)
## init[mask] <- res$par
## if (arma[1L] > 0)
## if (!arCheck(init[1L:arma[1L]]))
## stop("non-stationary AR part from CSS")
## if (arma[3L] > 0)
## if (!arCheck(init[sum(arma[1L:2L]) + 1L:arma[3L]]))
## stop("non-stationary seasonal AR part from CSS")
## ncond <- 0L
## }
## if (transform.pars) {
## init <- .Call(C_ARIMA_Invtrans, init, arma)
## if (arma[2L] > 0) {
## ind <- arma[1L] + 1L:arma[2L]
## init[ind] <- maInvert(init[ind])
## }
## if (arma[4L] > 0) {
## ind <- sum(arma[1L:3L]) + 1L:arma[4L]
## init[ind] <- maInvert(init[ind])
## }
## }
## trarma <- .Call(C_ARIMA_transPars, init, arma, transform.pars)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## res <- if (no.optim)
## list(convergence = 0, par = numeric(), value = armafn(numeric(),
## as.logical(transform.pars)))
## else optim(init[mask], armafn, method = optim.method, hessian = TRUE,
## control = optim.control, trans = as.logical(transform.pars))
## if (res$convergence > 0)
## warning(gettextf("possible convergence problem: optim gave code = %d",
## res$convergence), domain = NA)
## coef[mask] <- res$par
## if (transform.pars) {
## if (arma[2L] > 0L) {
## ind <- arma[1L] + 1L:arma[2L]
## if (all(mask[ind]))
## coef[ind] <- maInvert(coef[ind])
## }
## if (arma[4L] > 0L) {
## ind <- sum(arma[1L:3L]) + 1L:arma[4L]
## if (all(mask[ind]))
## coef[ind] <- maInvert(coef[ind])
## }
## if (any(coef[mask] != res$par)) {
## oldcode <- res$convergence
## res <- optim(coef[mask], armafn, method = optim.method, hessian = TRUE,
## control = list(maxit = 0L, parscale = optim.control$parscale),
## trans = TRUE)
## res$convergence <- oldcode
## coef[mask] <- res$par
## }
## A <- .Call(C_ARIMA_Gradtrans, as.double(coef), arma)
## A <- A[mask, mask]
## var <- crossprod(A, solve(res$hessian * n.used, A))
## coef <- .Call(C_ARIMA_undoPars, coef, arma)
## }
## else var <- if (no.optim)
## numeric()
## else solve(res$hessian * n.used)
## trarma <- .Call(C_ARIMA_transPars, coef, arma, FALSE)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## val <- if (ncxreg > 0L)
## arimaSS(x - xreg %*% coef[narma + (1L:ncxreg)], mod)
## else arimaSS(x, mod)
## sigma2 <- val[[1L]][1L]/n.used
## }
## value <- 2 * n.used * res$value + n.used + n.used * log(2 * pi)
## aic <- if (method != "CSS")
## value + 2 * sum(mask) + 2
## else NA
## nm <- NULL
## if (arma[1L] > 0L)
## nm <- c(nm, paste0("ar", 1L:arma[1L]))
## if (arma[2L] > 0L)
## nm <- c(nm, paste0("ma", 1L:arma[2L]))
## if (arma[3L] > 0L)
## nm <- c(nm, paste0("sar", 1L:arma[3L]))
## if (arma[4L] > 0L)
## nm <- c(nm, paste0("sma", 1L:arma[4L]))
## if (ncxreg > 0L) {
## nm <- c(nm, cn)
## if (!orig.xreg) {
## ind <- narma + 1L:ncxreg
## coef[ind] <- S$v %*% coef[ind]
## A <- diag(narma + ncxreg)
## A[ind, ind] <- S$v
## A <- A[mask, mask]
## var <- A %*% var %*% t(A)
## }
## }
## names(coef) <- nm
## if (!no.optim)
## dimnames(var) <- list(nm[mask], nm[mask])
## resid <- val[[2L]]
## tsp(resid) <- xtsp
## class(resid) <- "ts"
## structure(list(coef = coef, sigma2 = sigma2, var.coef = var, mask = mask,
## loglik = -0.5 * value, aic = aic, arma = arma, residuals = resid, call = match.call(),
## series = series, code = res$convergence, n.cond = ncond, nobs = n.used,
## model = mod), class = "Arima")
## })(x = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6, 200, 200.3,
## 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1, 210.5, 210.5, 209.8, 208.8,
## 209.5, 213.2, 213.7, 215.1, 218.7, 219.8, 220.5, 223.8, 222.8, 223.8, 221.7,
## 222.3, 220.8, 219.4, 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7,
## 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7, 217, 215.9, 215.8,
## 214.1, 212.3, 213.9, 214.6, 213.6, 212.1, 211.4, 213.1, 212.9, 213.3, 211.5,
## 212.3, 213, 211, 210.7, 210.1, 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6,
## 211.9, 212.8, 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4,
## 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7, 247.6, 247.8, 249.4,
## 249, 249.9, 250.5, 251.5, 249, 247.6, 248.8), .Tsp = c(2008, 2016.91666666667,
## 12), class = "ts"), order = c(2, 1, 0))
##
## Coefficients:
## ar1 ar2
## 0.3004 0.2151
## s.e. 0.0943 0.0944
##
## sigma^2 estimated as 2.167: log likelihood = -193.32, aic = 392.64
##
## $train$partition_4$arima1$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jan 2017 248.8592 246.9729 250.7456 245.9743 251.7442
## Feb 2017 249.1352 246.0408 252.2297 244.4027 253.8678
## Mar 2017 249.2308 244.9007 253.5610 242.6084 255.8533
## Apr 2017 249.3189 243.8601 254.7778 240.9703 257.6676
## May 2017 249.3660 242.8617 255.8703 239.4185 259.3134
## Jun 2017 249.3991 241.9339 256.8642 237.9821 260.8161
## Jul 2017 249.4191 241.0660 257.7722 236.6442 262.1941
## Aug 2017 249.4323 240.2553 258.6092 235.3973 263.4672
## Sep 2017 249.4405 239.4948 259.3862 234.2299 264.6512
## Oct 2017 249.4458 238.7789 260.1128 233.1322 265.7595
## Nov 2017 249.4492 238.1022 260.7963 232.0954 266.8030
## Dec 2017 249.4514 237.4599 261.4428 231.1120 267.7908
##
## $train$partition_4$arima1$parameters
## $train$partition_4$arima1$parameters$type
## [1] "train"
##
## $train$partition_4$arima1$parameters$model_id
## [1] "arima1"
##
## $train$partition_4$arima1$parameters$method
## [1] "arima"
##
## $train$partition_4$arima1$parameters$horizon
## [1] 12
##
## $train$partition_4$arima1$parameters$partition
## [1] "partition_4"
##
##
##
## $train$partition_4$arima2
## $train$partition_4$arima2$model
##
## Call:
## (function (x, order = c(0L, 0L, 0L), seasonal = list(order = c(0L, 0L, 0L),
## period = NA), xreg = NULL, include.mean = TRUE, transform.pars = TRUE, fixed = NULL,
## init = NULL, method = c("CSS-ML", "ML", "CSS"), n.cond, SSinit = c("Gardner1980",
## "Rossignol2011"), optim.method = "BFGS", optim.control = list(), kappa = 1e+06)
## {
## "%+%" <- function(a, b) .Call(C_TSconv, a, b)
## SSinit <- match.arg(SSinit)
## SS.G <- SSinit == "Gardner1980"
## upARIMA <- function(mod, phi, theta) {
## p <- length(phi)
## q <- length(theta)
## mod$phi <- phi
## mod$theta <- theta
## r <- max(p, q + 1L)
## if (p > 0)
## mod$T[1L:p, 1L] <- phi
## if (r > 1L)
## mod$Pn[1L:r, 1L:r] <- if (SS.G)
## .Call(C_getQ0, phi, theta)
## else .Call(C_getQ0bis, phi, theta, tol = 0)
## else mod$Pn[1L, 1L] <- if (p > 0)
## 1/(1 - phi^2)
## else 1
## mod$a[] <- 0
## mod
## }
## arimaSS <- function(y, mod) {
## .Call(C_ARIMA_Like, y, mod, 0L, TRUE)
## }
## armafn <- function(p, trans) {
## par <- coef
## par[mask] <- p
## trarma <- .Call(C_ARIMA_transPars, par, arma, trans)
## if (is.null(Z <- tryCatch(upARIMA(mod, trarma[[1L]], trarma[[2L]]),
## error = function(e) NULL)))
## return(.Machine$double.xmax)
## if (ncxreg > 0)
## x <- x - xreg %*% par[narma + (1L:ncxreg)]
## res <- .Call(C_ARIMA_Like, x, Z, 0L, FALSE)
## s2 <- res[1L]/res[3L]
## 0.5 * (log(s2) + res[2L]/res[3L])
## }
## armaCSS <- function(p) {
## par <- as.double(fixed)
## par[mask] <- p
## trarma <- .Call(C_ARIMA_transPars, par, arma, FALSE)
## if (ncxreg > 0)
## x <- x - xreg %*% par[narma + (1L:ncxreg)]
## res <- .Call(C_ARIMA_CSS, x, arma, trarma[[1L]], trarma[[2L]], as.integer(ncond),
## FALSE)
## 0.5 * log(res)
## }
## arCheck <- function(ar) {
## p <- max(which(c(1, -ar) != 0)) - 1
## if (!p)
## return(TRUE)
## all(Mod(polyroot(c(1, -ar[1L:p]))) > 1)
## }
## maInvert <- function(ma) {
## q <- length(ma)
## q0 <- max(which(c(1, ma) != 0)) - 1L
## if (!q0)
## return(ma)
## roots <- polyroot(c(1, ma[1L:q0]))
## ind <- Mod(roots) < 1
## if (all(!ind))
## return(ma)
## if (q0 == 1)
## return(c(1/ma[1L], rep.int(0, q - q0)))
## roots[ind] <- 1/roots[ind]
## x <- 1
## for (r in roots) x <- c(x, 0) - c(0, x)/r
## c(Re(x[-1L]), rep.int(0, q - q0))
## }
## series <- deparse1(substitute(x))
## if (NCOL(x) > 1L)
## stop("only implemented for univariate time series")
## method <- match.arg(method)
## x <- as.ts(x)
## if (!is.numeric(x))
## stop("'x' must be numeric")
## storage.mode(x) <- "double"
## dim(x) <- NULL
## n <- length(x)
## if (!missing(order))
## if (!is.numeric(order) || length(order) != 3L || any(order < 0))
## stop("'order' must be a non-negative numeric vector of length 3")
## if (!missing(seasonal))
## if (is.list(seasonal)) {
## if (is.null(seasonal$order))
## stop("'seasonal' must be a list with component 'order'")
## if (!is.numeric(seasonal$order) || length(seasonal$order) != 3L ||
## any(seasonal$order < 0L))
## stop("'seasonal$order' must be a non-negative numeric vector of length 3")
## }
## else if (is.numeric(order)) {
## if (length(order) == 3L)
## seasonal <- list(order = seasonal)
## else ("'seasonal' is of the wrong length")
## }
## else stop("'seasonal' must be a list with component 'order'")
## if (is.null(seasonal$period) || is.na(seasonal$period) || seasonal$period ==
## 0)
## seasonal$period <- frequency(x)
## arma <- as.integer(c(order[-2L], seasonal$order[-2L], seasonal$period, order[2L],
## seasonal$order[2L]))
## narma <- sum(arma[1L:4L])
## xtsp <- tsp(x)
## tsp(x) <- NULL
## Delta <- 1
## for (i in seq_len(order[2L])) Delta <- Delta %+% c(1, -1)
## for (i in seq_len(seasonal$order[2L])) Delta <- Delta %+% c(1, rep.int(0,
## seasonal$period - 1), -1)
## Delta <- -Delta[-1L]
## nd <- order[2L] + seasonal$order[2L]
## n.used <- sum(!is.na(x)) - length(Delta)
## if (is.null(xreg)) {
## ncxreg <- 0L
## }
## else {
## nmxreg <- deparse1(substitute(xreg))
## if (NROW(xreg) != n)
## stop("lengths of 'x' and 'xreg' do not match")
## ncxreg <- NCOL(xreg)
## xreg <- as.matrix(xreg)
## storage.mode(xreg) <- "double"
## }
## class(xreg) <- NULL
## if (ncxreg > 0L && is.null(colnames(xreg)))
## colnames(xreg) <- if (ncxreg == 1L)
## nmxreg
## else paste0(nmxreg, 1L:ncxreg)
## if (include.mean && (nd == 0L)) {
## xreg <- cbind(intercept = rep(1, n), xreg = xreg)
## ncxreg <- ncxreg + 1L
## }
## if (method == "CSS-ML") {
## anyna <- anyNA(x)
## if (ncxreg)
## anyna <- anyna || anyNA(xreg)
## if (anyna)
## method <- "ML"
## }
## if (method == "CSS" || method == "CSS-ML") {
## ncond <- order[2L] + seasonal$order[2L] * seasonal$period
## ncond1 <- order[1L] + seasonal$period * seasonal$order[1L]
## ncond <- ncond + if (!missing(n.cond))
## max(n.cond, ncond1)
## else ncond1
## }
## else ncond <- 0
## if (is.null(fixed))
## fixed <- rep(NA_real_, narma + ncxreg)
## else if (length(fixed) != narma + ncxreg)
## stop("wrong length for 'fixed'")
## mask <- is.na(fixed)
## no.optim <- !any(mask)
## if (no.optim)
## transform.pars <- FALSE
## if (transform.pars) {
## ind <- arma[1L] + arma[2L] + seq_len(arma[3L])
## if (any(!mask[seq_len(arma[1L])]) || any(!mask[ind])) {
## warning("some AR parameters were fixed: setting transform.pars = FALSE")
## transform.pars <- FALSE
## }
## }
## init0 <- rep.int(0, narma)
## parscale <- rep(1, narma)
## if (ncxreg) {
## cn <- colnames(xreg)
## orig.xreg <- (ncxreg == 1L) || any(!mask[narma + 1L:ncxreg])
## if (!orig.xreg) {
## S <- svd(na.omit(xreg))
## xreg <- xreg %*% S$v
## }
## dx <- x
## dxreg <- xreg
## if (order[2L] > 0L) {
## dx <- diff(dx, 1L, order[2L])
## dxreg <- diff(dxreg, 1L, order[2L])
## }
## if (seasonal$period > 1L && seasonal$order[2L] > 0) {
## dx <- diff(dx, seasonal$period, seasonal$order[2L])
## dxreg <- diff(dxreg, seasonal$period, seasonal$order[2L])
## }
## fit <- if (length(dx) > ncol(dxreg))
## lm(dx ~ dxreg - 1, na.action = na.omit)
## else list(rank = 0L)
## if (fit$rank == 0L) {
## fit <- lm(x ~ xreg - 1, na.action = na.omit)
## }
## isna <- is.na(x) | apply(xreg, 1L, anyNA)
## n.used <- sum(!isna) - length(Delta)
## init0 <- c(init0, coef(fit))
## ses <- summary(fit)$coefficients[, 2L]
## parscale <- c(parscale, 10 * ses)
## }
## if (n.used <= 0)
## stop("too few non-missing observations")
## if (!is.null(init)) {
## if (length(init) != length(init0))
## stop("'init' is of the wrong length")
## if (any(ind <- is.na(init)))
## init[ind] <- init0[ind]
## if (method == "ML") {
## if (arma[1L] > 0)
## if (!arCheck(init[1L:arma[1L]]))
## stop("non-stationary AR part")
## if (arma[3L] > 0)
## if (!arCheck(init[sum(arma[1L:2L]) + 1L:arma[3L]]))
## stop("non-stationary seasonal AR part")
## if (transform.pars)
## init <- .Call(C_ARIMA_Invtrans, as.double(init), arma)
## }
## }
## else init <- init0
## coef <- as.double(fixed)
## if (!("parscale" %in% names(optim.control)))
## optim.control$parscale <- parscale[mask]
## if (method == "CSS") {
## res <- if (no.optim)
## list(convergence = 0L, par = numeric(), value = armaCSS(numeric()))
## else optim(init[mask], armaCSS, method = optim.method, hessian = TRUE,
## control = optim.control)
## if (res$convergence > 0)
## warning(gettextf("possible convergence problem: optim gave code = %d",
## res$convergence), domain = NA)
## coef[mask] <- res$par
## trarma <- .Call(C_ARIMA_transPars, coef, arma, FALSE)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## if (ncxreg > 0)
## x <- x - xreg %*% coef[narma + (1L:ncxreg)]
## arimaSS(x, mod)
## val <- .Call(C_ARIMA_CSS, x, arma, trarma[[1L]], trarma[[2L]], as.integer(ncond),
## TRUE)
## sigma2 <- val[[1L]]
## var <- if (no.optim)
## numeric()
## else solve(res$hessian * n.used)
## }
## else {
## if (method == "CSS-ML") {
## res <- if (no.optim)
## list(convergence = 0L, par = numeric(), value = armaCSS(numeric()))
## else optim(init[mask], armaCSS, method = optim.method, hessian = FALSE,
## control = optim.control)
## if (res$convergence == 0)
## init[mask] <- res$par
## if (arma[1L] > 0)
## if (!arCheck(init[1L:arma[1L]]))
## stop("non-stationary AR part from CSS")
## if (arma[3L] > 0)
## if (!arCheck(init[sum(arma[1L:2L]) + 1L:arma[3L]]))
## stop("non-stationary seasonal AR part from CSS")
## ncond <- 0L
## }
## if (transform.pars) {
## init <- .Call(C_ARIMA_Invtrans, init, arma)
## if (arma[2L] > 0) {
## ind <- arma[1L] + 1L:arma[2L]
## init[ind] <- maInvert(init[ind])
## }
## if (arma[4L] > 0) {
## ind <- sum(arma[1L:3L]) + 1L:arma[4L]
## init[ind] <- maInvert(init[ind])
## }
## }
## trarma <- .Call(C_ARIMA_transPars, init, arma, transform.pars)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## res <- if (no.optim)
## list(convergence = 0, par = numeric(), value = armafn(numeric(),
## as.logical(transform.pars)))
## else optim(init[mask], armafn, method = optim.method, hessian = TRUE,
## control = optim.control, trans = as.logical(transform.pars))
## if (res$convergence > 0)
## warning(gettextf("possible convergence problem: optim gave code = %d",
## res$convergence), domain = NA)
## coef[mask] <- res$par
## if (transform.pars) {
## if (arma[2L] > 0L) {
## ind <- arma[1L] + 1L:arma[2L]
## if (all(mask[ind]))
## coef[ind] <- maInvert(coef[ind])
## }
## if (arma[4L] > 0L) {
## ind <- sum(arma[1L:3L]) + 1L:arma[4L]
## if (all(mask[ind]))
## coef[ind] <- maInvert(coef[ind])
## }
## if (any(coef[mask] != res$par)) {
## oldcode <- res$convergence
## res <- optim(coef[mask], armafn, method = optim.method, hessian = TRUE,
## control = list(maxit = 0L, parscale = optim.control$parscale),
## trans = TRUE)
## res$convergence <- oldcode
## coef[mask] <- res$par
## }
## A <- .Call(C_ARIMA_Gradtrans, as.double(coef), arma)
## A <- A[mask, mask]
## var <- crossprod(A, solve(res$hessian * n.used, A))
## coef <- .Call(C_ARIMA_undoPars, coef, arma)
## }
## else var <- if (no.optim)
## numeric()
## else solve(res$hessian * n.used)
## trarma <- .Call(C_ARIMA_transPars, coef, arma, FALSE)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## val <- if (ncxreg > 0L)
## arimaSS(x - xreg %*% coef[narma + (1L:ncxreg)], mod)
## else arimaSS(x, mod)
## sigma2 <- val[[1L]][1L]/n.used
## }
## value <- 2 * n.used * res$value + n.used + n.used * log(2 * pi)
## aic <- if (method != "CSS")
## value + 2 * sum(mask) + 2
## else NA
## nm <- NULL
## if (arma[1L] > 0L)
## nm <- c(nm, paste0("ar", 1L:arma[1L]))
## if (arma[2L] > 0L)
## nm <- c(nm, paste0("ma", 1L:arma[2L]))
## if (arma[3L] > 0L)
## nm <- c(nm, paste0("sar", 1L:arma[3L]))
## if (arma[4L] > 0L)
## nm <- c(nm, paste0("sma", 1L:arma[4L]))
## if (ncxreg > 0L) {
## nm <- c(nm, cn)
## if (!orig.xreg) {
## ind <- narma + 1L:ncxreg
## coef[ind] <- S$v %*% coef[ind]
## A <- diag(narma + ncxreg)
## A[ind, ind] <- S$v
## A <- A[mask, mask]
## var <- A %*% var %*% t(A)
## }
## }
## names(coef) <- nm
## if (!no.optim)
## dimnames(var) <- list(nm[mask], nm[mask])
## resid <- val[[2L]]
## tsp(resid) <- xtsp
## class(resid) <- "ts"
## structure(list(coef = coef, sigma2 = sigma2, var.coef = var, mask = mask,
## loglik = -0.5 * value, aic = aic, arma = arma, residuals = resid, call = match.call(),
## series = series, code = res$convergence, n.cond = ncond, nobs = n.used,
## model = mod), class = "Arima")
## })(x = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6, 200, 200.3,
## 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1, 210.5, 210.5, 209.8, 208.8,
## 209.5, 213.2, 213.7, 215.1, 218.7, 219.8, 220.5, 223.8, 222.8, 223.8, 221.7,
## 222.3, 220.8, 219.4, 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7,
## 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7, 217, 215.9, 215.8,
## 214.1, 212.3, 213.9, 214.6, 213.6, 212.1, 211.4, 213.1, 212.9, 213.3, 211.5,
## 212.3, 213, 211, 210.7, 210.1, 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6,
## 211.9, 212.8, 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4,
## 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7, 247.6, 247.8, 249.4,
## 249, 249.9, 250.5, 251.5, 249, 247.6, 248.8), .Tsp = c(2008, 2016.91666666667,
## 12), class = "ts"), order = c(2, 1, 2), seasonal = list(order = c(1, 1, 1)))
##
## Coefficients:
## ar1 ar2 ma1 ma2 sar1 sma1
## -0.0715 0.8315 0.3614 -0.6386 0.0273 -1.0000
## s.e. 0.1011 0.0912 0.1370 0.1291 0.1156 0.2066
##
## sigma^2 estimated as 2.084: log likelihood = -183.8, aic = 381.6
##
## $train$partition_4$arima2$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jan 2017 247.9259 245.9469 249.9050 244.8993 250.9526
## Feb 2017 247.7146 244.5249 250.9043 242.8364 252.5929
## Mar 2017 247.6264 243.3381 251.9148 241.0679 254.1850
## Apr 2017 247.8402 242.4401 253.2404 239.5814 256.0990
## May 2017 248.0510 241.5863 254.5157 238.1641 257.9379
## Jun 2017 248.3958 240.8569 255.9347 236.8661 259.9255
## Jul 2017 248.3303 239.7581 256.9026 235.2202 261.4404
## Aug 2017 248.4205 238.8150 258.0260 233.7302 263.1109
## Sep 2017 248.3200 237.7203 258.9198 232.1091 264.5309
## Oct 2017 248.9572 237.3703 260.5440 231.2365 266.6778
## Nov 2017 249.4228 236.8861 261.9596 230.2495 268.5961
## Dec 2017 250.1634 236.6884 263.6384 229.5551 270.7716
##
## $train$partition_4$arima2$parameters
## $train$partition_4$arima2$parameters$type
## [1] "train"
##
## $train$partition_4$arima2$parameters$model_id
## [1] "arima2"
##
## $train$partition_4$arima2$parameters$method
## [1] "arima"
##
## $train$partition_4$arima2$parameters$horizon
## [1] 12
##
## $train$partition_4$arima2$parameters$partition
## [1] "partition_4"
##
##
##
## $train$partition_4$hw
## $train$partition_4$hw$model
## Holt-Winters exponential smoothing with trend and additive seasonal component.
##
## Call:
## (function (x, alpha = NULL, beta = NULL, gamma = NULL, seasonal = c("additive", "multiplicative"), start.periods = 2, l.start = NULL, b.start = NULL, s.start = NULL, optim.start = c(alpha = 0.3, beta = 0.1, gamma = 0.1), optim.control = list()) { x <- as.ts(x) seasonal <- match.arg(seasonal) f <- frequency(x) if (!is.null(alpha) && (alpha == 0)) stop("cannot fit models without level ('alpha' must not be 0 or FALSE)") if (!is.null(abg <- c(alpha, beta, gamma)) && any(abg < 0 | abg > 1)) stop("'alpha', 'beta' and 'gamma' must be within the unit interval") if (is.null(gamma) || gamma > 0) { if (seasonal == "multiplicative" && any(x == 0)) stop("data must be non-zero for multiplicative Holt-Winters") if (start.periods < 2) stop("need at least 2 periods to compute seasonal start values") } if (!is.null(gamma) && is.logical(gamma) && !gamma) { expsmooth <- !is.null(beta) && is.logical(beta) && !beta if (is.null(l.start)) l.start <- if (expsmooth) x[1L] else x[2L] if (is.null(b.start)) if (is.null(beta) || !is.logical(beta) || beta) b.start <- x[2L] - x[1L] start.time <- 3 - expsmooth s.start <- 0 } else { start.time <- f + 1 wind <- start.periods * f st <- decompose(ts(x[1L:wind], start = start(x), frequency = f), seasonal) if (is.null(l.start) || is.null(b.start)) { dat <- na.omit(st$trend) cf <- coef(.lm.fit(x = cbind(1, seq_along(dat)), y = dat)) if (is.null(l.start)) l.start <- cf[1L] if (is.null(b.start)) b.start <- cf[2L] } if (is.null(s.start)) s.start <- st$figure } lenx <- as.integer(length(x)) if (is.na(lenx)) stop("invalid length(x)") len <- lenx - start.time + 1 hw <- function(alpha, beta, gamma) .C(C_HoltWinters, as.double(x), lenx, as.double(max(min(alpha, 1), 0)), as.double(max(min(beta, 1), 0)), as.double(max(min(gamma, 1), 0)), as.integer(start.time), as.integer(!+(seasonal == "multiplicative")), as.integer(f), as.integer(!is.logical(beta) || beta), as.integer(!is.logical(gamma) || gamma), a = as.double(l.start), b = as.double(b.start), s = as.double(s.start), SSE = as.double(0), level = double(len + 1L), trend = double(len + 1L), seasonal = double(len + f)) if (is.null(gamma)) { if (is.null(alpha)) { if (is.null(beta)) { error <- function(p) hw(p[1L], p[2L], p[3L])$SSE sol <- optim(optim.start, error, method = "L-BFGS-B", lower = c(0, 0, 0), upper = c(1, 1, 1), control = optim.control) if (sol$convergence || any(sol$par < 0 | sol$par > 1)) { if (sol$convergence > 50) { warning(gettextf("optimization difficulties: %s", sol$message), domain = NA) } else stop("optimization failure") } alpha <- sol$par[1L] beta <- sol$par[2L] gamma <- sol$par[3L] } else { error <- function(p) hw(p[1L], beta, p[2L])$SSE sol <- optim(c(optim.start["alpha"], optim.start["gamma"]), error, method = "L-BFGS-B", lower = c(0, 0), upper = c(1, 1), control = optim.control) if (sol$convergence || any(sol$par < 0 | sol$par > 1)) { if (sol$convergence > 50) { warning(gettextf("optimization difficulties: %s", sol$message), domain = NA) } else stop("optimization failure") } alpha <- sol$par[1L] gamma <- sol$par[2L] } } else { if (is.null(beta)) { error <- function(p) hw(alpha, p[1L], p[2L])$SSE sol <- optim(c(optim.start["beta"], optim.start["gamma"]), error, method = "L-BFGS-B", lower = c(0, 0), upper = c(1, 1), control = optim.control) if (sol$convergence || any(sol$par < 0 | sol$par > 1)) { if (sol$convergence > 50) { warning(gettextf("optimization difficulties: %s", sol$message), domain = NA) } else stop("optimization failure") } beta <- sol$par[1L] gamma <- sol$par[2L] } else { error <- function(p) hw(alpha, beta, p)$SSE gamma <- optimize(error, lower = 0, upper = 1)$minimum } } } else { if (is.null(alpha)) { if (is.null(beta)) { error <- function(p) hw(p[1L], p[2L], gamma)$SSE sol <- optim(c(optim.start["alpha"], optim.start["beta"]), error, method = "L-BFGS-B", lower = c(0, 0), upper = c(1, 1), control = optim.control) if (sol$convergence || any(sol$par < 0 | sol$par > 1)) { if (sol$convergence > 50) { warning(gettextf("optimization difficulties: %s", sol$message), domain = NA) } else stop("optimization failure") } alpha <- sol$par[1L] beta <- sol$par[2L] } else { error <- function(p) hw(p, beta, gamma)$SSE alpha <- optimize(error, lower = 0, upper = 1)$minimum } } else { if (is.null(beta)) { error <- function(p) hw(alpha, p, gamma)$SSE beta <- optimize(error, lower = 0, upper = 1)$minimum } } } final.fit <- hw(alpha, beta, gamma) fitted <- ts(cbind(xhat = final.fit$level[-len - 1], level = final.fit$level[-len - 1], trend = if (!is.logical(beta) || beta) final.fit$trend[-len - 1], season = if (!is.logical(gamma) || gamma) final.fit$seasonal[1L:len]), start = start(lag(x, k = 1 - start.time)), frequency = frequency(x)) if (!is.logical(beta) || beta) fitted[, 1] <- fitted[, 1] + fitted[, "trend"] if (!is.logical(gamma) || gamma) fitted[, 1] <- if (seasonal == "multiplicative") fitted[, 1] * fitted[, "season"] else fitted[, 1] + fitted[, "season"] structure(list(fitted = fitted, x = x, alpha = alpha, beta = beta, gamma = gamma, coefficients = c(a = final.fit$level[len + 1], b = if (!is.logical(beta) || beta) final.fit$trend[len + 1], s = if (!is.logical(gamma) || gamma) final.fit$seasonal[len + 1L:f]), seasonal = seasonal, SSE = final.fit$SSE, call = match.call()), class = "HoltWinters")})(x = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6, 200, 200.3, 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1, 210.5, 210.5, 209.8, 208.8, 209.5, 213.2, 213.7, 215.1, 218.7, 219.8, 220.5, 223.8, 222.8, 223.8, 221.7, 222.3, 220.8, 219.4, 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7, 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7, 217, 215.9, 215.8, 214.1, 212.3, 213.9, 214.6, 213.6, 212.1, 211.4, 213.1, 212.9, 213.3, 211.5, 212.3, 213, 211, 210.7, 210.1, 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6, 211.9, 212.8, 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4, 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7, 247.6, 247.8, 249.4, 249, 249.9, 250.5, 251.5, 249, 247.6, 248.8), .Tsp = c(2008, 2016.91666666667, 12), class = "ts"))
##
## Smoothing parameters:
## alpha: 0.5678666
## beta : 0.4026555
## gamma: 1
##
## Coefficients:
## [,1]
## a 247.4370361
## b -0.4925798
## s1 0.1665800
## s2 -0.0634546
## s3 -1.5076190
## s4 -1.5803802
## s5 -1.3826210
## s6 -1.3413829
## s7 -0.2386897
## s8 0.4085368
## s9 1.2553685
## s10 0.3120015
## s11 0.1910207
## s12 1.3629639
##
## $train$partition_4$hw$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jan 2017 247.1110 244.6499 249.5721 243.3471 250.8749
## Feb 2017 246.3884 243.2420 249.5348 241.5764 251.2004
## Mar 2017 244.4517 240.4186 248.4847 238.2837 250.6197
## Apr 2017 243.8863 238.8082 248.9645 236.1200 251.6527
## May 2017 243.5915 237.3386 249.8445 234.0285 253.1546
## Jun 2017 243.1402 235.6013 250.6790 231.6105 254.6698
## Jul 2017 243.7503 234.8270 252.6736 230.1033 257.3973
## Aug 2017 243.9049 233.5075 254.3023 228.0035 259.8064
## Sep 2017 244.2592 232.3047 256.2137 225.9764 262.5420
## Oct 2017 242.8232 229.2339 256.4126 222.0401 263.6063
## Nov 2017 242.2097 226.9120 257.5074 218.8138 265.6055
## Dec 2017 242.8890 225.8129 259.9652 216.7734 269.0047
##
## $train$partition_4$hw$parameters
## $train$partition_4$hw$parameters$type
## [1] "train"
##
## $train$partition_4$hw$parameters$model_id
## [1] "hw"
##
## $train$partition_4$hw$parameters$method
## [1] "HoltWinters"
##
## $train$partition_4$hw$parameters$horizon
## [1] 12
##
## $train$partition_4$hw$parameters$partition
## [1] "partition_4"
##
##
##
## $train$partition_4$tslm
## $train$partition_4$tslm$model
##
## Call:
## (function (formula, data, subset, lambda = NULL, biasadj = FALSE,
## ...)
## {
## cl <- match.call()
## if (!("formula" %in% class(formula))) {
## formula <- stats::as.formula(formula)
## }
## if (missing(data)) {
## mt <- try(terms(formula))
## if (is.element("try-error", class(mt))) {
## stop("Cannot extract terms from formula, please provide data argument.")
## }
## }
## else {
## mt <- terms(formula, data = data)
## }
## vars <- attr(mt, "variables")
## tsvar <- match(c("trend", "season"), as.character(vars),
## 0L)
## fnvar <- NULL
## for (i in 2:length(vars)) {
## term <- vars[[i]]
## if (!is.symbol(term)) {
## if (typeof(eval(term[[1]])) == "closure") {
## fnvar <- c(fnvar, i)
## }
## }
## }
## attr(formula, ".Environment") <- environment()
## formula[[2]] <- as.symbol(deparse(formula[[2]]))
## if (sum(c(tsvar, fnvar)) > 0) {
## rmvar <- c(tsvar, fnvar)
## rmvar <- rmvar[rmvar != attr(mt, "response") + 1]
## if (any(rmvar != 0)) {
## vars <- vars[-rmvar]
## }
## }
## if (!missing(data)) {
## vars <- vars[c(TRUE, !as.character(vars[-1]) %in% colnames(data))]
## dataname <- substitute(data)
## }
## if (!missing(data)) {
## data <- datamat(do.call(datamat, as.list(vars[-1]), envir = parent.frame()),
## data)
## }
## else {
## data <- do.call(datamat, as.list(vars[-1]), envir = parent.frame())
## }
## if (is.null(dim(data)) && length(data) != 0) {
## cn <- as.character(vars)[2]
## }
## else {
## cn <- colnames(data)
## }
## if (is.null(tsp(data))) {
## if ((attr(mt, "response") + 1) %in% fnvar) {
## tspx <- tsp(eval(attr(mt, "variables")[[attr(mt,
## "response") + 1]]))
## }
## tspx <- tsp(data[, 1])
## }
## else {
## tspx <- tsp(data)
## }
## if (is.null(tspx)) {
## stop("Not time series data, use lm()")
## }
## tsdat <- match(c("trend", "season"), cn, 0L)
## if (tsdat[1] == 0) {
## trend <- 1:NROW(data)
## cn <- c(cn, "trend")
## data <- cbind(data, trend)
## }
## if (tsdat[2] == 0) {
## if (tsvar[2] != 0 && tspx[3] <= 1) {
## stop("Non-seasonal data cannot be modelled using a seasonal factor")
## }
## season <- as.factor(cycle(data[, 1]))
## cn <- c(cn, "season")
## data <- cbind(data, season)
## }
## colnames(data) <- cn
## if (!missing(subset)) {
## if (!is.logical(subset)) {
## stop("subset must be logical")
## }
## else if (NCOL(subset) > 1) {
## stop("subset must be a logical vector")
## }
## else if (NROW(subset) != NROW(data)) {
## stop("Subset must be the same length as the number of rows in the dataset")
## }
## warning("Subset has been assumed contiguous")
## timesx <- time(data[, 1])[subset]
## tspx <- recoverTSP(timesx)
## if (tspx[3] == 1 && tsdat[2] == 0 && tsvar[2] != 0) {
## stop("Non-seasonal data cannot be modelled using a seasonal factor")
## }
## data <- data[subset, ]
## }
## if (!is.null(lambda)) {
## resp_var <- deparse(attr(mt, "variables")[[attr(mt, "response") +
## 1]])
## data[, resp_var] <- BoxCox(data[, resp_var], lambda)
## lambda <- attr(data[, resp_var], "lambda")
## }
## if (tsdat[2] == 0 && tsvar[2] != 0) {
## data$season <- factor(data$season)
## }
## fit <- lm(formula, data = data, na.action = na.exclude, ...)
## fit$data <- data
## responsevar <- deparse(formula[[2]])
## fit$residuals <- ts(residuals(fit))
## fit$x <- fit$residuals
## fit$x[!is.na(fit$x)] <- model.frame(fit)[, responsevar]
## fit$fitted.values <- ts(fitted(fit))
## tsp(fit$residuals) <- tsp(fit$x) <- tsp(fit$fitted.values) <- tsp(data[,
## 1]) <- tspx
## fit$call <- cl
## fit$method <- "Linear regression model"
## if (exists("dataname")) {
## fit$call$data <- dataname
## }
## if (!is.null(lambda)) {
## attr(lambda, "biasadj") <- biasadj
## fit$lambda <- lambda
## fit$fitted.values <- InvBoxCox(fit$fitted.values, lambda,
## biasadj, var(fit$residuals))
## fit$x <- InvBoxCox(fit$x, lambda)
## }
## class(fit) <- c("tslm", class(fit))
## return(fit)
## })(formula = train ~ trend + season)
##
## Coefficients:
## (Intercept) trend season2 season3 season4 season5
## 200.01104 0.33674 -0.09229 -0.05125 0.22312 0.41972
## season6 season7 season8 season9 season10 season11
## 0.76076 0.62403 0.60951 0.37278 0.98049 1.36597
## season12
## 1.94035
##
##
## $train$partition_4$tslm$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jan 2017 236.7153 222.9169 250.5137 215.4888 257.9418
## Feb 2017 236.9597 223.1613 250.7581 215.7332 258.1862
## Mar 2017 237.3375 223.5391 251.1359 216.1110 258.5640
## Apr 2017 237.9486 224.1502 251.7470 216.7221 259.1751
## May 2017 238.4819 224.6835 252.2804 217.2555 259.7084
## Jun 2017 239.1597 225.3613 252.9581 217.9332 260.3862
## Jul 2017 239.3597 225.5613 253.1581 218.1332 260.5862
## Aug 2017 239.6819 225.8835 253.4804 218.4555 260.9084
## Sep 2017 239.7819 225.9835 253.5804 218.5555 261.0084
## Oct 2017 240.7264 226.9280 254.5248 219.4999 261.9529
## Nov 2017 241.4486 227.6502 255.2470 220.2221 262.6751
## Dec 2017 242.3597 228.5613 256.1581 221.1332 263.5862
##
## $train$partition_4$tslm$parameters
## $train$partition_4$tslm$parameters$type
## [1] "train"
##
## $train$partition_4$tslm$parameters$model_id
## [1] "tslm"
##
## $train$partition_4$tslm$parameters$method
## [1] "tslm"
##
## $train$partition_4$tslm$parameters$horizon
## [1] 12
##
## $train$partition_4$tslm$parameters$partition
## [1] "partition_4"
##
##
##
## $train$partition_4$train
## Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
## 2008 200.1 199.5 199.4 198.9 199.0 200.2 198.6 200.0 200.3 201.2 201.6 201.5
## 2009 201.5 203.5 204.9 207.1 210.5 210.5 209.8 208.8 209.5 213.2 213.7 215.1
## 2010 218.7 219.8 220.5 223.8 222.8 223.8 221.7 222.3 220.8 219.4 220.1 220.6
## 2011 218.9 217.8 217.7 215.0 215.3 215.9 216.7 216.7 217.7 218.7 222.9 224.9
## 2012 222.2 220.7 220.0 218.7 217.0 215.9 215.8 214.1 212.3 213.9 214.6 213.6
## 2013 212.1 211.4 213.1 212.9 213.3 211.5 212.3 213.0 211.0 210.7 210.1 211.4
## 2014 210.0 209.7 208.8 208.8 208.8 210.6 211.9 212.8 212.5 214.8 215.3 217.5
## 2015 218.8 220.7 222.2 226.7 228.4 233.2 235.7 237.1 240.6 243.8 245.3 246.0
## 2016 246.3 247.7 247.6 247.8 249.4 249.0 249.9 250.5 251.5 249.0 247.6 248.8
##
## $train$partition_4$test
## Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
## 2017 250.4 250.7 253.0 253.7 255.0 256.2 256.0 257.4 260.4 260.0 261.3 260.4
##
##
## $train$partition_5
## $train$partition_5$ets1
## $train$partition_5$ets1$model
## ETS(M,Ad,N)
##
## Call:
## (function (y, model = "ZZZ", damped = NULL, alpha = NULL, beta = NULL,
##
## Call:
## gamma = NULL, phi = NULL, additive.only = FALSE, lambda = NULL,
##
## Call:
## biasadj = FALSE, lower = c(rep(1e-04, 3), 0.8), upper = c(rep(0.9999,
##
## Call:
## 3), 0.98), opt.crit = c("lik", "amse", "mse", "sigma",
##
## Call:
## "mae"), nmse = 3, bounds = c("both", "usual", "admissible"),
##
## Call:
## ic = c("aicc", "aic", "bic"), restrict = TRUE, allow.multiplicative.trend = FALSE,
##
## Call:
## use.initial.values = FALSE, na.action = c("na.contiguous",
##
## Call:
## "na.interp", "na.fail"), ...)
##
## Call:
## {
##
## Call:
## opt.crit <- match.arg(opt.crit)
##
## Call:
## bounds <- match.arg(bounds)
##
## Call:
## ic <- match.arg(ic)
##
## Call:
## if (!is.function(na.action)) {
##
## Call:
## na.fn_name <- match.arg(na.action)
##
## Call:
## na.action <- get(na.fn_name)
##
## Call:
## }
##
## Call:
## seriesname <- deparse(substitute(y))
##
## Call:
## if (any(class(y) %in% c("data.frame", "list", "matrix", "mts"))) {
##
## Call:
## stop("y should be a univariate time series")
##
## Call:
## }
##
## Call:
## y <- as.ts(y)
##
## Call:
## if (missing(model) && is.constant(y)) {
##
## Call:
## return(ses(y, alpha = 0.99999, initial = "simple")$model)
##
## Call:
## }
##
## Call:
## ny <- length(y)
##
## Call:
## y <- na.action(y)
##
## Call:
## if (ny != length(y) && na.fn_name == "na.contiguous") {
##
## Call:
## warning("Missing values encountered. Using longest contiguous portion of time series")
##
## Call:
## ny <- length(y)
##
## Call:
## }
##
## Call:
## orig.y <- y
##
## Call:
## if (identical(class(model), "ets") && is.null(lambda)) {
##
## Call:
## lambda <- model$lambda
##
## Call:
## }
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## y <- BoxCox(y, lambda)
##
## Call:
## lambda <- attr(y, "lambda")
##
## Call:
## additive.only <- TRUE
##
## Call:
## }
##
## Call:
## if (nmse < 1 || nmse > 30) {
##
## Call:
## stop("nmse out of range")
##
## Call:
## }
##
## Call:
## m <- frequency(y)
##
## Call:
## if (any(upper < lower)) {
##
## Call:
## stop("Lower limits must be less than upper limits")
##
## Call:
## }
##
## Call:
## if (class(model) == "ets") {
##
## Call:
## alpha <- max(model$par["alpha"], 1e-10)
##
## Call:
## beta <- model$par["beta"]
##
## Call:
## if (is.na(beta)) {
##
## Call:
## beta <- NULL
##
## Call:
## }
##
## Call:
## gamma <- model$par["gamma"]
##
## Call:
## if (is.na(gamma)) {
##
## Call:
## gamma <- NULL
##
## Call:
## }
##
## Call:
## phi <- model$par["phi"]
##
## Call:
## if (is.na(phi)) {
##
## Call:
## phi <- NULL
##
## Call:
## }
##
## Call:
## modelcomponents <- paste(model$components[1], model$components[2],
##
## Call:
## model$components[3], sep = "")
##
## Call:
## damped <- (model$components[4] == "TRUE")
##
## Call:
## if (use.initial.values) {
##
## Call:
## errortype <- substr(modelcomponents, 1, 1)
##
## Call:
## trendtype <- substr(modelcomponents, 2, 2)
##
## Call:
## seasontype <- substr(modelcomponents, 3, 3)
##
## Call:
## e <- pegelsresid.C(y, m, model$initstate, errortype,
##
## Call:
## trendtype, seasontype, damped, alpha, beta, gamma,
##
## Call:
## phi, nmse)
##
## Call:
## np <- length(model$par) + 1
##
## Call:
## model$loglik <- -0.5 * e$lik
##
## Call:
## model$aic <- e$lik + 2 * np
##
## Call:
## model$bic <- e$lik + log(ny) * np
##
## Call:
## model$aicc <- model$aic + 2 * np * (np + 1)/(ny -
##
## Call:
## np - 1)
##
## Call:
## model$mse <- e$amse[1]
##
## Call:
## model$amse <- mean(e$amse)
##
## Call:
## tsp.y <- tsp(y)
##
## Call:
## model$states <- ts(e$states, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1] - 1/tsp.y[3])
##
## Call:
## colnames(model$states)[1] <- "l"
##
## Call:
## if (trendtype != "N") {
##
## Call:
## colnames(model$states)[2] <- "b"
##
## Call:
## }
##
## Call:
## if (seasontype != "N") {
##
## Call:
## colnames(model$states)[(2 + (trendtype != "N")):ncol(model$states)] <- paste("s",
##
## Call:
## 1:m, sep = "")
##
## Call:
## }
##
## Call:
## if (errortype == "A") {
##
## Call:
## model$fitted <- ts(y - e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model$fitted <- ts(y/(1 + e$e), frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## model$residuals <- ts(e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## model$series <- seriesname
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda,
##
## Call:
## biasadj, var(model$residuals))
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(model)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model <- modelcomponents
##
## Call:
## if (missing(use.initial.values)) {
##
## Call:
## message("Model is being refit with current smoothing parameters but initial states are being re-estimated.\nSet 'use.initial.values=TRUE' if you want to re-use existing initial values.")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## errortype <- substr(model, 1, 1)
##
## Call:
## trendtype <- substr(model, 2, 2)
##
## Call:
## seasontype <- substr(model, 3, 3)
##
## Call:
## if (!is.element(errortype, c("M", "A", "Z"))) {
##
## Call:
## stop("Invalid error type")
##
## Call:
## }
##
## Call:
## if (!is.element(trendtype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid trend type")
##
## Call:
## }
##
## Call:
## if (!is.element(seasontype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid season type")
##
## Call:
## }
##
## Call:
## if (m < 1 || length(y) <= m) {
##
## Call:
## seasontype <- "N"
##
## Call:
## }
##
## Call:
## if (m == 1) {
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## stop("Nonseasonal data")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (m > 24) {
##
## Call:
## if (is.element(seasontype, c("A", "M"))) {
##
## Call:
## stop("Frequency too high")
##
## Call:
## }
##
## Call:
## else if (seasontype == "Z") {
##
## Call:
## warning("I can't handle data with frequency greater than 24. Seasonality will be ignored. Try stlf() if you need seasonal forecasts.")
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if ((errortype == "A" && (trendtype == "M" || seasontype ==
##
## Call:
## "M")) | (errortype == "M" && trendtype == "M" &&
##
## Call:
## seasontype == "A") || (additive.only && (errortype ==
##
## Call:
## "M" || trendtype == "M" || seasontype == "M"))) {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## data.positive <- (min(y) > 0)
##
## Call:
## if (!data.positive && errortype == "M") {
##
## Call:
## stop("Inappropriate model for data with negative or zero values")
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped && trendtype == "N") {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## n <- length(y)
##
## Call:
## npars <- 2L
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## npars <- npars + 2L
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## npars <- npars + m
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## npars <- npars + as.numeric(damped)
##
## Call:
## }
##
## Call:
## if (n <= npars + 4L) {
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped) {
##
## Call:
## warning("Not enough data to use damping")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = gamma, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), seasonal = ifelse(seasontype != "A",
##
## Call:
## "multiplicative", "additive"), lambda = lambda,
##
## Call:
## biasadj = biasadj, warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Seasonal component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Trend component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "N" && seasontype == "N") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, lambda = lambda, biasadj = biasadj,
##
## Call:
## warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## }
##
## Call:
## fit1 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## fit2 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if ("try-error" %in% class(fit1)) {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## else if (fit1$sigma2 < fit2$sigma2) {
##
## Call:
## fit <- fit1
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## if ("try-error" %in% class(fit))
##
## Call:
## stop("Unable to estimate a model.")
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## if (errortype == "Z") {
##
## Call:
## errortype <- c("A", "M")
##
## Call:
## }
##
## Call:
## if (trendtype == "Z") {
##
## Call:
## if (allow.multiplicative.trend) {
##
## Call:
## trendtype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## trendtype <- c("N", "A")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "Z") {
##
## Call:
## seasontype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## if (is.null(damped)) {
##
## Call:
## damped <- c(TRUE, FALSE)
##
## Call:
## }
##
## Call:
## best.ic <- Inf
##
## Call:
## for (i in 1:length(errortype)) {
##
## Call:
## for (j in 1:length(trendtype)) {
##
## Call:
## for (k in 1:length(seasontype)) {
##
## Call:
## for (l in 1:length(damped)) {
##
## Call:
## if (trendtype[j] == "N" && damped[l]) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if (errortype[i] == "A" && (trendtype[j] ==
##
## Call:
## "M" || seasontype[k] == "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (errortype[i] == "M" && trendtype[j] ==
##
## Call:
## "M" && seasontype[k] == "A") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (additive.only && (errortype[i] == "M" ||
##
## Call:
## trendtype[j] == "M" || seasontype[k] ==
##
## Call:
## "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (!data.positive && errortype[i] == "M") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## fit <- try(etsmodel(y, errortype[i], trendtype[j],
##
## Call:
## seasontype[k], damped[l], alpha, beta, gamma,
##
## Call:
## phi, lower = lower, upper = upper, opt.crit = opt.crit,
##
## Call:
## nmse = nmse, bounds = bounds, ...), silent = TRUE)
##
## Call:
## if (is.element("try-error", class(fit)))
##
## Call:
## fit.ic <- Inf
##
## Call:
## else fit.ic <- switch(ic, aic = fit$aic, bic = fit$bic,
##
## Call:
## aicc = fit$aicc)
##
## Call:
## if (!is.na(fit.ic)) {
##
## Call:
## if (fit.ic < best.ic) {
##
## Call:
## model <- fit
##
## Call:
## best.ic <- fit.ic
##
## Call:
## best.e <- errortype[i]
##
## Call:
## best.t <- trendtype[j]
##
## Call:
## best.s <- seasontype[k]
##
## Call:
## best.d <- damped[l]
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (best.ic == Inf) {
##
## Call:
## stop("No model able to be fitted")
##
## Call:
## }
##
## Call:
## model$m <- m
##
## Call:
## model$method <- paste("ETS(", best.e, ",", best.t, ifelse(best.d,
##
## Call:
## "d", ""), ",", best.s, ")", sep = "")
##
## Call:
## model$series <- seriesname
##
## Call:
## model$components <- c(best.e, best.t, best.s, best.d)
##
## Call:
## model$call <- match.call()
##
## Call:
## model$initstate <- model$states[1, ]
##
## Call:
## np <- length(model$par)
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda, biasadj,
##
## Call:
## model$sigma2)
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(structure(model, class = "ets"))
##
## Call:
## })(y = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6,
##
## Call:
## 200, 200.3, 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1,
##
## Call:
## 210.5, 210.5, 209.8, 208.8, 209.5, 213.2, 213.7, 215.1, 218.7,
##
## Call:
## 219.8, 220.5, 223.8, 222.8, 223.8, 221.7, 222.3, 220.8, 219.4,
##
## Call:
## 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7,
##
## Call:
## 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7,
##
## Call:
## 217, 215.9, 215.8, 214.1, 212.3, 213.9, 214.6, 213.6, 212.1,
##
## Call:
## 211.4, 213.1, 212.9, 213.3, 211.5, 212.3, 213, 211, 210.7, 210.1,
##
## Call:
## 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6, 211.9, 212.8,
##
## Call:
## 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4,
##
## Call:
## 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7,
##
## Call:
## 247.6, 247.8, 249.4, 249, 249.9, 250.5, 251.5, 249, 247.6, 248.8,
##
## Call:
## 250.4, 250.7, 253), .Tsp = c(2008, 2017.16666666667, 12), class = "ts"),
##
## Call:
## opt.crit = "lik")
##
## Smoothing parameters:
## alpha = 0.9907
## beta = 0.2815
## phi = 0.8948
##
## Initial states:
## l = 200.4079
## b = -0.3587
##
## sigma: 0.0067
##
## AIC AICc BIC
## 613.6217 614.4294 629.8789
##
## $train$partition_5$ets1$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Apr 2017 253.7668 251.6008 255.9328 250.4541 257.0795
## May 2017 254.4695 251.0109 257.9281 249.1800 259.7590
## Jun 2017 255.0983 250.3933 259.8033 247.9026 262.2940
## Jul 2017 255.6610 249.7169 261.6050 246.5703 264.7516
## Aug 2017 256.1645 248.9832 263.3457 245.1817 267.1472
## Sep 2017 256.6150 248.2003 265.0298 243.7458 269.4843
## Oct 2017 257.0182 247.3769 266.6595 242.2731 271.7633
## Nov 2017 257.3789 246.5213 268.2366 240.7737 273.9842
## Dec 2017 257.7018 245.6410 269.7626 239.2564 276.1472
## Jan 2018 257.9907 244.7421 271.2393 237.7287 278.2527
## Feb 2018 258.2492 243.8300 272.6684 236.1969 280.3014
## Mar 2018 258.4805 242.9093 274.0517 234.6664 282.2946
##
## $train$partition_5$ets1$parameters
## $train$partition_5$ets1$parameters$type
## [1] "train"
##
## $train$partition_5$ets1$parameters$model_id
## [1] "ets1"
##
## $train$partition_5$ets1$parameters$method
## [1] "ets"
##
## $train$partition_5$ets1$parameters$horizon
## [1] 12
##
## $train$partition_5$ets1$parameters$partition
## [1] "partition_5"
##
##
##
## $train$partition_5$ets2
## $train$partition_5$ets2$model
## ETS(M,Ad,N)
##
## Call:
## (function (y, model = "ZZZ", damped = NULL, alpha = NULL, beta = NULL,
##
## Call:
## gamma = NULL, phi = NULL, additive.only = FALSE, lambda = NULL,
##
## Call:
## biasadj = FALSE, lower = c(rep(1e-04, 3), 0.8), upper = c(rep(0.9999,
##
## Call:
## 3), 0.98), opt.crit = c("lik", "amse", "mse", "sigma",
##
## Call:
## "mae"), nmse = 3, bounds = c("both", "usual", "admissible"),
##
## Call:
## ic = c("aicc", "aic", "bic"), restrict = TRUE, allow.multiplicative.trend = FALSE,
##
## Call:
## use.initial.values = FALSE, na.action = c("na.contiguous",
##
## Call:
## "na.interp", "na.fail"), ...)
##
## Call:
## {
##
## Call:
## opt.crit <- match.arg(opt.crit)
##
## Call:
## bounds <- match.arg(bounds)
##
## Call:
## ic <- match.arg(ic)
##
## Call:
## if (!is.function(na.action)) {
##
## Call:
## na.fn_name <- match.arg(na.action)
##
## Call:
## na.action <- get(na.fn_name)
##
## Call:
## }
##
## Call:
## seriesname <- deparse(substitute(y))
##
## Call:
## if (any(class(y) %in% c("data.frame", "list", "matrix", "mts"))) {
##
## Call:
## stop("y should be a univariate time series")
##
## Call:
## }
##
## Call:
## y <- as.ts(y)
##
## Call:
## if (missing(model) && is.constant(y)) {
##
## Call:
## return(ses(y, alpha = 0.99999, initial = "simple")$model)
##
## Call:
## }
##
## Call:
## ny <- length(y)
##
## Call:
## y <- na.action(y)
##
## Call:
## if (ny != length(y) && na.fn_name == "na.contiguous") {
##
## Call:
## warning("Missing values encountered. Using longest contiguous portion of time series")
##
## Call:
## ny <- length(y)
##
## Call:
## }
##
## Call:
## orig.y <- y
##
## Call:
## if (identical(class(model), "ets") && is.null(lambda)) {
##
## Call:
## lambda <- model$lambda
##
## Call:
## }
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## y <- BoxCox(y, lambda)
##
## Call:
## lambda <- attr(y, "lambda")
##
## Call:
## additive.only <- TRUE
##
## Call:
## }
##
## Call:
## if (nmse < 1 || nmse > 30) {
##
## Call:
## stop("nmse out of range")
##
## Call:
## }
##
## Call:
## m <- frequency(y)
##
## Call:
## if (any(upper < lower)) {
##
## Call:
## stop("Lower limits must be less than upper limits")
##
## Call:
## }
##
## Call:
## if (class(model) == "ets") {
##
## Call:
## alpha <- max(model$par["alpha"], 1e-10)
##
## Call:
## beta <- model$par["beta"]
##
## Call:
## if (is.na(beta)) {
##
## Call:
## beta <- NULL
##
## Call:
## }
##
## Call:
## gamma <- model$par["gamma"]
##
## Call:
## if (is.na(gamma)) {
##
## Call:
## gamma <- NULL
##
## Call:
## }
##
## Call:
## phi <- model$par["phi"]
##
## Call:
## if (is.na(phi)) {
##
## Call:
## phi <- NULL
##
## Call:
## }
##
## Call:
## modelcomponents <- paste(model$components[1], model$components[2],
##
## Call:
## model$components[3], sep = "")
##
## Call:
## damped <- (model$components[4] == "TRUE")
##
## Call:
## if (use.initial.values) {
##
## Call:
## errortype <- substr(modelcomponents, 1, 1)
##
## Call:
## trendtype <- substr(modelcomponents, 2, 2)
##
## Call:
## seasontype <- substr(modelcomponents, 3, 3)
##
## Call:
## e <- pegelsresid.C(y, m, model$initstate, errortype,
##
## Call:
## trendtype, seasontype, damped, alpha, beta, gamma,
##
## Call:
## phi, nmse)
##
## Call:
## np <- length(model$par) + 1
##
## Call:
## model$loglik <- -0.5 * e$lik
##
## Call:
## model$aic <- e$lik + 2 * np
##
## Call:
## model$bic <- e$lik + log(ny) * np
##
## Call:
## model$aicc <- model$aic + 2 * np * (np + 1)/(ny -
##
## Call:
## np - 1)
##
## Call:
## model$mse <- e$amse[1]
##
## Call:
## model$amse <- mean(e$amse)
##
## Call:
## tsp.y <- tsp(y)
##
## Call:
## model$states <- ts(e$states, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1] - 1/tsp.y[3])
##
## Call:
## colnames(model$states)[1] <- "l"
##
## Call:
## if (trendtype != "N") {
##
## Call:
## colnames(model$states)[2] <- "b"
##
## Call:
## }
##
## Call:
## if (seasontype != "N") {
##
## Call:
## colnames(model$states)[(2 + (trendtype != "N")):ncol(model$states)] <- paste("s",
##
## Call:
## 1:m, sep = "")
##
## Call:
## }
##
## Call:
## if (errortype == "A") {
##
## Call:
## model$fitted <- ts(y - e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model$fitted <- ts(y/(1 + e$e), frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## model$residuals <- ts(e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## model$series <- seriesname
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda,
##
## Call:
## biasadj, var(model$residuals))
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(model)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model <- modelcomponents
##
## Call:
## if (missing(use.initial.values)) {
##
## Call:
## message("Model is being refit with current smoothing parameters but initial states are being re-estimated.\nSet 'use.initial.values=TRUE' if you want to re-use existing initial values.")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## errortype <- substr(model, 1, 1)
##
## Call:
## trendtype <- substr(model, 2, 2)
##
## Call:
## seasontype <- substr(model, 3, 3)
##
## Call:
## if (!is.element(errortype, c("M", "A", "Z"))) {
##
## Call:
## stop("Invalid error type")
##
## Call:
## }
##
## Call:
## if (!is.element(trendtype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid trend type")
##
## Call:
## }
##
## Call:
## if (!is.element(seasontype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid season type")
##
## Call:
## }
##
## Call:
## if (m < 1 || length(y) <= m) {
##
## Call:
## seasontype <- "N"
##
## Call:
## }
##
## Call:
## if (m == 1) {
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## stop("Nonseasonal data")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (m > 24) {
##
## Call:
## if (is.element(seasontype, c("A", "M"))) {
##
## Call:
## stop("Frequency too high")
##
## Call:
## }
##
## Call:
## else if (seasontype == "Z") {
##
## Call:
## warning("I can't handle data with frequency greater than 24. Seasonality will be ignored. Try stlf() if you need seasonal forecasts.")
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if ((errortype == "A" && (trendtype == "M" || seasontype ==
##
## Call:
## "M")) | (errortype == "M" && trendtype == "M" &&
##
## Call:
## seasontype == "A") || (additive.only && (errortype ==
##
## Call:
## "M" || trendtype == "M" || seasontype == "M"))) {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## data.positive <- (min(y) > 0)
##
## Call:
## if (!data.positive && errortype == "M") {
##
## Call:
## stop("Inappropriate model for data with negative or zero values")
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped && trendtype == "N") {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## n <- length(y)
##
## Call:
## npars <- 2L
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## npars <- npars + 2L
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## npars <- npars + m
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## npars <- npars + as.numeric(damped)
##
## Call:
## }
##
## Call:
## if (n <= npars + 4L) {
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped) {
##
## Call:
## warning("Not enough data to use damping")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = gamma, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), seasonal = ifelse(seasontype != "A",
##
## Call:
## "multiplicative", "additive"), lambda = lambda,
##
## Call:
## biasadj = biasadj, warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Seasonal component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Trend component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "N" && seasontype == "N") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, lambda = lambda, biasadj = biasadj,
##
## Call:
## warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## }
##
## Call:
## fit1 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## fit2 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if ("try-error" %in% class(fit1)) {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## else if (fit1$sigma2 < fit2$sigma2) {
##
## Call:
## fit <- fit1
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## if ("try-error" %in% class(fit))
##
## Call:
## stop("Unable to estimate a model.")
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## if (errortype == "Z") {
##
## Call:
## errortype <- c("A", "M")
##
## Call:
## }
##
## Call:
## if (trendtype == "Z") {
##
## Call:
## if (allow.multiplicative.trend) {
##
## Call:
## trendtype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## trendtype <- c("N", "A")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "Z") {
##
## Call:
## seasontype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## if (is.null(damped)) {
##
## Call:
## damped <- c(TRUE, FALSE)
##
## Call:
## }
##
## Call:
## best.ic <- Inf
##
## Call:
## for (i in 1:length(errortype)) {
##
## Call:
## for (j in 1:length(trendtype)) {
##
## Call:
## for (k in 1:length(seasontype)) {
##
## Call:
## for (l in 1:length(damped)) {
##
## Call:
## if (trendtype[j] == "N" && damped[l]) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if (errortype[i] == "A" && (trendtype[j] ==
##
## Call:
## "M" || seasontype[k] == "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (errortype[i] == "M" && trendtype[j] ==
##
## Call:
## "M" && seasontype[k] == "A") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (additive.only && (errortype[i] == "M" ||
##
## Call:
## trendtype[j] == "M" || seasontype[k] ==
##
## Call:
## "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (!data.positive && errortype[i] == "M") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## fit <- try(etsmodel(y, errortype[i], trendtype[j],
##
## Call:
## seasontype[k], damped[l], alpha, beta, gamma,
##
## Call:
## phi, lower = lower, upper = upper, opt.crit = opt.crit,
##
## Call:
## nmse = nmse, bounds = bounds, ...), silent = TRUE)
##
## Call:
## if (is.element("try-error", class(fit)))
##
## Call:
## fit.ic <- Inf
##
## Call:
## else fit.ic <- switch(ic, aic = fit$aic, bic = fit$bic,
##
## Call:
## aicc = fit$aicc)
##
## Call:
## if (!is.na(fit.ic)) {
##
## Call:
## if (fit.ic < best.ic) {
##
## Call:
## model <- fit
##
## Call:
## best.ic <- fit.ic
##
## Call:
## best.e <- errortype[i]
##
## Call:
## best.t <- trendtype[j]
##
## Call:
## best.s <- seasontype[k]
##
## Call:
## best.d <- damped[l]
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (best.ic == Inf) {
##
## Call:
## stop("No model able to be fitted")
##
## Call:
## }
##
## Call:
## model$m <- m
##
## Call:
## model$method <- paste("ETS(", best.e, ",", best.t, ifelse(best.d,
##
## Call:
## "d", ""), ",", best.s, ")", sep = "")
##
## Call:
## model$series <- seriesname
##
## Call:
## model$components <- c(best.e, best.t, best.s, best.d)
##
## Call:
## model$call <- match.call()
##
## Call:
## model$initstate <- model$states[1, ]
##
## Call:
## np <- length(model$par)
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda, biasadj,
##
## Call:
## model$sigma2)
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(structure(model, class = "ets"))
##
## Call:
## })(y = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6,
##
## Call:
## 200, 200.3, 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1,
##
## Call:
## 210.5, 210.5, 209.8, 208.8, 209.5, 213.2, 213.7, 215.1, 218.7,
##
## Call:
## 219.8, 220.5, 223.8, 222.8, 223.8, 221.7, 222.3, 220.8, 219.4,
##
## Call:
## 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7,
##
## Call:
## 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7,
##
## Call:
## 217, 215.9, 215.8, 214.1, 212.3, 213.9, 214.6, 213.6, 212.1,
##
## Call:
## 211.4, 213.1, 212.9, 213.3, 211.5, 212.3, 213, 211, 210.7, 210.1,
##
## Call:
## 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6, 211.9, 212.8,
##
## Call:
## 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4,
##
## Call:
## 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7,
##
## Call:
## 247.6, 247.8, 249.4, 249, 249.9, 250.5, 251.5, 249, 247.6, 248.8,
##
## Call:
## 250.4, 250.7, 253), .Tsp = c(2008, 2017.16666666667, 12), class = "ts"),
##
## Call:
## opt.crit = "amse")
##
## Smoothing parameters:
## alpha = 0.9345
## beta = 0.2852
## phi = 0.8663
##
## Initial states:
## l = 200.0404
## b = -0.2653
##
## sigma: 0.0067
##
## AIC AICc BIC
## 614.1753 614.9829 630.4324
##
## $train$partition_5$ets2$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Apr 2017 253.6460 251.4754 255.8167 250.3263 256.9658
## May 2017 254.3175 250.9538 257.6812 249.1731 259.4618
## Jun 2017 254.8991 250.3661 259.4321 247.9665 261.8317
## Jul 2017 255.4030 249.7089 261.0971 246.6946 264.1113
## Aug 2017 255.8394 248.9938 262.6850 245.3700 266.3089
## Sep 2017 256.2175 248.2342 264.2008 244.0080 268.4270
## Oct 2017 256.5450 247.4416 265.6485 242.6225 270.4675
## Nov 2017 256.8287 246.6258 267.0316 241.2248 272.4327
## Dec 2017 257.0745 245.7950 268.3540 239.8239 274.3251
## Jan 2018 257.2874 244.9554 269.6194 238.4272 276.1476
## Feb 2018 257.4718 244.1123 270.8313 237.0402 277.9035
## Mar 2018 257.6316 243.2698 271.9933 235.6671 279.5960
##
## $train$partition_5$ets2$parameters
## $train$partition_5$ets2$parameters$type
## [1] "train"
##
## $train$partition_5$ets2$parameters$model_id
## [1] "ets2"
##
## $train$partition_5$ets2$parameters$method
## [1] "ets"
##
## $train$partition_5$ets2$parameters$horizon
## [1] 12
##
## $train$partition_5$ets2$parameters$partition
## [1] "partition_5"
##
##
##
## $train$partition_5$arima1
## $train$partition_5$arima1$model
##
## Call:
## (function (x, order = c(0L, 0L, 0L), seasonal = list(order = c(0L, 0L, 0L),
## period = NA), xreg = NULL, include.mean = TRUE, transform.pars = TRUE, fixed = NULL,
## init = NULL, method = c("CSS-ML", "ML", "CSS"), n.cond, SSinit = c("Gardner1980",
## "Rossignol2011"), optim.method = "BFGS", optim.control = list(), kappa = 1e+06)
## {
## "%+%" <- function(a, b) .Call(C_TSconv, a, b)
## SSinit <- match.arg(SSinit)
## SS.G <- SSinit == "Gardner1980"
## upARIMA <- function(mod, phi, theta) {
## p <- length(phi)
## q <- length(theta)
## mod$phi <- phi
## mod$theta <- theta
## r <- max(p, q + 1L)
## if (p > 0)
## mod$T[1L:p, 1L] <- phi
## if (r > 1L)
## mod$Pn[1L:r, 1L:r] <- if (SS.G)
## .Call(C_getQ0, phi, theta)
## else .Call(C_getQ0bis, phi, theta, tol = 0)
## else mod$Pn[1L, 1L] <- if (p > 0)
## 1/(1 - phi^2)
## else 1
## mod$a[] <- 0
## mod
## }
## arimaSS <- function(y, mod) {
## .Call(C_ARIMA_Like, y, mod, 0L, TRUE)
## }
## armafn <- function(p, trans) {
## par <- coef
## par[mask] <- p
## trarma <- .Call(C_ARIMA_transPars, par, arma, trans)
## if (is.null(Z <- tryCatch(upARIMA(mod, trarma[[1L]], trarma[[2L]]),
## error = function(e) NULL)))
## return(.Machine$double.xmax)
## if (ncxreg > 0)
## x <- x - xreg %*% par[narma + (1L:ncxreg)]
## res <- .Call(C_ARIMA_Like, x, Z, 0L, FALSE)
## s2 <- res[1L]/res[3L]
## 0.5 * (log(s2) + res[2L]/res[3L])
## }
## armaCSS <- function(p) {
## par <- as.double(fixed)
## par[mask] <- p
## trarma <- .Call(C_ARIMA_transPars, par, arma, FALSE)
## if (ncxreg > 0)
## x <- x - xreg %*% par[narma + (1L:ncxreg)]
## res <- .Call(C_ARIMA_CSS, x, arma, trarma[[1L]], trarma[[2L]], as.integer(ncond),
## FALSE)
## 0.5 * log(res)
## }
## arCheck <- function(ar) {
## p <- max(which(c(1, -ar) != 0)) - 1
## if (!p)
## return(TRUE)
## all(Mod(polyroot(c(1, -ar[1L:p]))) > 1)
## }
## maInvert <- function(ma) {
## q <- length(ma)
## q0 <- max(which(c(1, ma) != 0)) - 1L
## if (!q0)
## return(ma)
## roots <- polyroot(c(1, ma[1L:q0]))
## ind <- Mod(roots) < 1
## if (all(!ind))
## return(ma)
## if (q0 == 1)
## return(c(1/ma[1L], rep.int(0, q - q0)))
## roots[ind] <- 1/roots[ind]
## x <- 1
## for (r in roots) x <- c(x, 0) - c(0, x)/r
## c(Re(x[-1L]), rep.int(0, q - q0))
## }
## series <- deparse1(substitute(x))
## if (NCOL(x) > 1L)
## stop("only implemented for univariate time series")
## method <- match.arg(method)
## x <- as.ts(x)
## if (!is.numeric(x))
## stop("'x' must be numeric")
## storage.mode(x) <- "double"
## dim(x) <- NULL
## n <- length(x)
## if (!missing(order))
## if (!is.numeric(order) || length(order) != 3L || any(order < 0))
## stop("'order' must be a non-negative numeric vector of length 3")
## if (!missing(seasonal))
## if (is.list(seasonal)) {
## if (is.null(seasonal$order))
## stop("'seasonal' must be a list with component 'order'")
## if (!is.numeric(seasonal$order) || length(seasonal$order) != 3L ||
## any(seasonal$order < 0L))
## stop("'seasonal$order' must be a non-negative numeric vector of length 3")
## }
## else if (is.numeric(order)) {
## if (length(order) == 3L)
## seasonal <- list(order = seasonal)
## else ("'seasonal' is of the wrong length")
## }
## else stop("'seasonal' must be a list with component 'order'")
## if (is.null(seasonal$period) || is.na(seasonal$period) || seasonal$period ==
## 0)
## seasonal$period <- frequency(x)
## arma <- as.integer(c(order[-2L], seasonal$order[-2L], seasonal$period, order[2L],
## seasonal$order[2L]))
## narma <- sum(arma[1L:4L])
## xtsp <- tsp(x)
## tsp(x) <- NULL
## Delta <- 1
## for (i in seq_len(order[2L])) Delta <- Delta %+% c(1, -1)
## for (i in seq_len(seasonal$order[2L])) Delta <- Delta %+% c(1, rep.int(0,
## seasonal$period - 1), -1)
## Delta <- -Delta[-1L]
## nd <- order[2L] + seasonal$order[2L]
## n.used <- sum(!is.na(x)) - length(Delta)
## if (is.null(xreg)) {
## ncxreg <- 0L
## }
## else {
## nmxreg <- deparse1(substitute(xreg))
## if (NROW(xreg) != n)
## stop("lengths of 'x' and 'xreg' do not match")
## ncxreg <- NCOL(xreg)
## xreg <- as.matrix(xreg)
## storage.mode(xreg) <- "double"
## }
## class(xreg) <- NULL
## if (ncxreg > 0L && is.null(colnames(xreg)))
## colnames(xreg) <- if (ncxreg == 1L)
## nmxreg
## else paste0(nmxreg, 1L:ncxreg)
## if (include.mean && (nd == 0L)) {
## xreg <- cbind(intercept = rep(1, n), xreg = xreg)
## ncxreg <- ncxreg + 1L
## }
## if (method == "CSS-ML") {
## anyna <- anyNA(x)
## if (ncxreg)
## anyna <- anyna || anyNA(xreg)
## if (anyna)
## method <- "ML"
## }
## if (method == "CSS" || method == "CSS-ML") {
## ncond <- order[2L] + seasonal$order[2L] * seasonal$period
## ncond1 <- order[1L] + seasonal$period * seasonal$order[1L]
## ncond <- ncond + if (!missing(n.cond))
## max(n.cond, ncond1)
## else ncond1
## }
## else ncond <- 0
## if (is.null(fixed))
## fixed <- rep(NA_real_, narma + ncxreg)
## else if (length(fixed) != narma + ncxreg)
## stop("wrong length for 'fixed'")
## mask <- is.na(fixed)
## no.optim <- !any(mask)
## if (no.optim)
## transform.pars <- FALSE
## if (transform.pars) {
## ind <- arma[1L] + arma[2L] + seq_len(arma[3L])
## if (any(!mask[seq_len(arma[1L])]) || any(!mask[ind])) {
## warning("some AR parameters were fixed: setting transform.pars = FALSE")
## transform.pars <- FALSE
## }
## }
## init0 <- rep.int(0, narma)
## parscale <- rep(1, narma)
## if (ncxreg) {
## cn <- colnames(xreg)
## orig.xreg <- (ncxreg == 1L) || any(!mask[narma + 1L:ncxreg])
## if (!orig.xreg) {
## S <- svd(na.omit(xreg))
## xreg <- xreg %*% S$v
## }
## dx <- x
## dxreg <- xreg
## if (order[2L] > 0L) {
## dx <- diff(dx, 1L, order[2L])
## dxreg <- diff(dxreg, 1L, order[2L])
## }
## if (seasonal$period > 1L && seasonal$order[2L] > 0) {
## dx <- diff(dx, seasonal$period, seasonal$order[2L])
## dxreg <- diff(dxreg, seasonal$period, seasonal$order[2L])
## }
## fit <- if (length(dx) > ncol(dxreg))
## lm(dx ~ dxreg - 1, na.action = na.omit)
## else list(rank = 0L)
## if (fit$rank == 0L) {
## fit <- lm(x ~ xreg - 1, na.action = na.omit)
## }
## isna <- is.na(x) | apply(xreg, 1L, anyNA)
## n.used <- sum(!isna) - length(Delta)
## init0 <- c(init0, coef(fit))
## ses <- summary(fit)$coefficients[, 2L]
## parscale <- c(parscale, 10 * ses)
## }
## if (n.used <= 0)
## stop("too few non-missing observations")
## if (!is.null(init)) {
## if (length(init) != length(init0))
## stop("'init' is of the wrong length")
## if (any(ind <- is.na(init)))
## init[ind] <- init0[ind]
## if (method == "ML") {
## if (arma[1L] > 0)
## if (!arCheck(init[1L:arma[1L]]))
## stop("non-stationary AR part")
## if (arma[3L] > 0)
## if (!arCheck(init[sum(arma[1L:2L]) + 1L:arma[3L]]))
## stop("non-stationary seasonal AR part")
## if (transform.pars)
## init <- .Call(C_ARIMA_Invtrans, as.double(init), arma)
## }
## }
## else init <- init0
## coef <- as.double(fixed)
## if (!("parscale" %in% names(optim.control)))
## optim.control$parscale <- parscale[mask]
## if (method == "CSS") {
## res <- if (no.optim)
## list(convergence = 0L, par = numeric(), value = armaCSS(numeric()))
## else optim(init[mask], armaCSS, method = optim.method, hessian = TRUE,
## control = optim.control)
## if (res$convergence > 0)
## warning(gettextf("possible convergence problem: optim gave code = %d",
## res$convergence), domain = NA)
## coef[mask] <- res$par
## trarma <- .Call(C_ARIMA_transPars, coef, arma, FALSE)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## if (ncxreg > 0)
## x <- x - xreg %*% coef[narma + (1L:ncxreg)]
## arimaSS(x, mod)
## val <- .Call(C_ARIMA_CSS, x, arma, trarma[[1L]], trarma[[2L]], as.integer(ncond),
## TRUE)
## sigma2 <- val[[1L]]
## var <- if (no.optim)
## numeric()
## else solve(res$hessian * n.used)
## }
## else {
## if (method == "CSS-ML") {
## res <- if (no.optim)
## list(convergence = 0L, par = numeric(), value = armaCSS(numeric()))
## else optim(init[mask], armaCSS, method = optim.method, hessian = FALSE,
## control = optim.control)
## if (res$convergence == 0)
## init[mask] <- res$par
## if (arma[1L] > 0)
## if (!arCheck(init[1L:arma[1L]]))
## stop("non-stationary AR part from CSS")
## if (arma[3L] > 0)
## if (!arCheck(init[sum(arma[1L:2L]) + 1L:arma[3L]]))
## stop("non-stationary seasonal AR part from CSS")
## ncond <- 0L
## }
## if (transform.pars) {
## init <- .Call(C_ARIMA_Invtrans, init, arma)
## if (arma[2L] > 0) {
## ind <- arma[1L] + 1L:arma[2L]
## init[ind] <- maInvert(init[ind])
## }
## if (arma[4L] > 0) {
## ind <- sum(arma[1L:3L]) + 1L:arma[4L]
## init[ind] <- maInvert(init[ind])
## }
## }
## trarma <- .Call(C_ARIMA_transPars, init, arma, transform.pars)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## res <- if (no.optim)
## list(convergence = 0, par = numeric(), value = armafn(numeric(),
## as.logical(transform.pars)))
## else optim(init[mask], armafn, method = optim.method, hessian = TRUE,
## control = optim.control, trans = as.logical(transform.pars))
## if (res$convergence > 0)
## warning(gettextf("possible convergence problem: optim gave code = %d",
## res$convergence), domain = NA)
## coef[mask] <- res$par
## if (transform.pars) {
## if (arma[2L] > 0L) {
## ind <- arma[1L] + 1L:arma[2L]
## if (all(mask[ind]))
## coef[ind] <- maInvert(coef[ind])
## }
## if (arma[4L] > 0L) {
## ind <- sum(arma[1L:3L]) + 1L:arma[4L]
## if (all(mask[ind]))
## coef[ind] <- maInvert(coef[ind])
## }
## if (any(coef[mask] != res$par)) {
## oldcode <- res$convergence
## res <- optim(coef[mask], armafn, method = optim.method, hessian = TRUE,
## control = list(maxit = 0L, parscale = optim.control$parscale),
## trans = TRUE)
## res$convergence <- oldcode
## coef[mask] <- res$par
## }
## A <- .Call(C_ARIMA_Gradtrans, as.double(coef), arma)
## A <- A[mask, mask]
## var <- crossprod(A, solve(res$hessian * n.used, A))
## coef <- .Call(C_ARIMA_undoPars, coef, arma)
## }
## else var <- if (no.optim)
## numeric()
## else solve(res$hessian * n.used)
## trarma <- .Call(C_ARIMA_transPars, coef, arma, FALSE)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## val <- if (ncxreg > 0L)
## arimaSS(x - xreg %*% coef[narma + (1L:ncxreg)], mod)
## else arimaSS(x, mod)
## sigma2 <- val[[1L]][1L]/n.used
## }
## value <- 2 * n.used * res$value + n.used + n.used * log(2 * pi)
## aic <- if (method != "CSS")
## value + 2 * sum(mask) + 2
## else NA
## nm <- NULL
## if (arma[1L] > 0L)
## nm <- c(nm, paste0("ar", 1L:arma[1L]))
## if (arma[2L] > 0L)
## nm <- c(nm, paste0("ma", 1L:arma[2L]))
## if (arma[3L] > 0L)
## nm <- c(nm, paste0("sar", 1L:arma[3L]))
## if (arma[4L] > 0L)
## nm <- c(nm, paste0("sma", 1L:arma[4L]))
## if (ncxreg > 0L) {
## nm <- c(nm, cn)
## if (!orig.xreg) {
## ind <- narma + 1L:ncxreg
## coef[ind] <- S$v %*% coef[ind]
## A <- diag(narma + ncxreg)
## A[ind, ind] <- S$v
## A <- A[mask, mask]
## var <- A %*% var %*% t(A)
## }
## }
## names(coef) <- nm
## if (!no.optim)
## dimnames(var) <- list(nm[mask], nm[mask])
## resid <- val[[2L]]
## tsp(resid) <- xtsp
## class(resid) <- "ts"
## structure(list(coef = coef, sigma2 = sigma2, var.coef = var, mask = mask,
## loglik = -0.5 * value, aic = aic, arma = arma, residuals = resid, call = match.call(),
## series = series, code = res$convergence, n.cond = ncond, nobs = n.used,
## model = mod), class = "Arima")
## })(x = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6, 200, 200.3,
## 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1, 210.5, 210.5, 209.8, 208.8,
## 209.5, 213.2, 213.7, 215.1, 218.7, 219.8, 220.5, 223.8, 222.8, 223.8, 221.7,
## 222.3, 220.8, 219.4, 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7,
## 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7, 217, 215.9, 215.8,
## 214.1, 212.3, 213.9, 214.6, 213.6, 212.1, 211.4, 213.1, 212.9, 213.3, 211.5,
## 212.3, 213, 211, 210.7, 210.1, 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6,
## 211.9, 212.8, 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4,
## 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7, 247.6, 247.8, 249.4,
## 249, 249.9, 250.5, 251.5, 249, 247.6, 248.8, 250.4, 250.7, 253), .Tsp = c(2008,
## 2017.16666666667, 12), class = "ts"), order = c(2, 1, 0))
##
## Coefficients:
## ar1 ar2
## 0.3068 0.2136
## s.e. 0.0933 0.0931
##
## sigma^2 estimated as 2.162: log likelihood = -198.63, aic = 403.26
##
## $train$partition_5$arima1$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Apr 2017 253.7697 251.8852 255.6542 250.8876 256.6518
## May 2017 254.4971 251.3962 257.5981 249.7547 259.2396
## Jun 2017 254.8848 250.5404 259.2291 248.2407 261.5288
## Jul 2017 255.1591 249.6768 260.6413 246.7747 263.5435
## Aug 2017 255.3260 248.7891 261.8630 245.3287 265.3234
## Sep 2017 255.4359 247.9288 262.9429 243.9548 266.9169
## Oct 2017 255.5052 247.1014 263.9091 242.6526 268.3578
## Nov 2017 255.5500 246.3137 264.7862 241.4243 269.6756
## Dec 2017 255.5785 245.5654 265.5916 240.2648 270.8922
## Jan 2018 255.5968 244.8548 266.3388 239.1684 272.0252
## Feb 2018 255.6085 244.1792 267.0379 238.1289 273.0882
## Mar 2018 255.6160 243.5354 267.6967 237.1403 274.0917
##
## $train$partition_5$arima1$parameters
## $train$partition_5$arima1$parameters$type
## [1] "train"
##
## $train$partition_5$arima1$parameters$model_id
## [1] "arima1"
##
## $train$partition_5$arima1$parameters$method
## [1] "arima"
##
## $train$partition_5$arima1$parameters$horizon
## [1] 12
##
## $train$partition_5$arima1$parameters$partition
## [1] "partition_5"
##
##
##
## $train$partition_5$arima2
## $train$partition_5$arima2$model
##
## Call:
## (function (x, order = c(0L, 0L, 0L), seasonal = list(order = c(0L, 0L, 0L),
## period = NA), xreg = NULL, include.mean = TRUE, transform.pars = TRUE, fixed = NULL,
## init = NULL, method = c("CSS-ML", "ML", "CSS"), n.cond, SSinit = c("Gardner1980",
## "Rossignol2011"), optim.method = "BFGS", optim.control = list(), kappa = 1e+06)
## {
## "%+%" <- function(a, b) .Call(C_TSconv, a, b)
## SSinit <- match.arg(SSinit)
## SS.G <- SSinit == "Gardner1980"
## upARIMA <- function(mod, phi, theta) {
## p <- length(phi)
## q <- length(theta)
## mod$phi <- phi
## mod$theta <- theta
## r <- max(p, q + 1L)
## if (p > 0)
## mod$T[1L:p, 1L] <- phi
## if (r > 1L)
## mod$Pn[1L:r, 1L:r] <- if (SS.G)
## .Call(C_getQ0, phi, theta)
## else .Call(C_getQ0bis, phi, theta, tol = 0)
## else mod$Pn[1L, 1L] <- if (p > 0)
## 1/(1 - phi^2)
## else 1
## mod$a[] <- 0
## mod
## }
## arimaSS <- function(y, mod) {
## .Call(C_ARIMA_Like, y, mod, 0L, TRUE)
## }
## armafn <- function(p, trans) {
## par <- coef
## par[mask] <- p
## trarma <- .Call(C_ARIMA_transPars, par, arma, trans)
## if (is.null(Z <- tryCatch(upARIMA(mod, trarma[[1L]], trarma[[2L]]),
## error = function(e) NULL)))
## return(.Machine$double.xmax)
## if (ncxreg > 0)
## x <- x - xreg %*% par[narma + (1L:ncxreg)]
## res <- .Call(C_ARIMA_Like, x, Z, 0L, FALSE)
## s2 <- res[1L]/res[3L]
## 0.5 * (log(s2) + res[2L]/res[3L])
## }
## armaCSS <- function(p) {
## par <- as.double(fixed)
## par[mask] <- p
## trarma <- .Call(C_ARIMA_transPars, par, arma, FALSE)
## if (ncxreg > 0)
## x <- x - xreg %*% par[narma + (1L:ncxreg)]
## res <- .Call(C_ARIMA_CSS, x, arma, trarma[[1L]], trarma[[2L]], as.integer(ncond),
## FALSE)
## 0.5 * log(res)
## }
## arCheck <- function(ar) {
## p <- max(which(c(1, -ar) != 0)) - 1
## if (!p)
## return(TRUE)
## all(Mod(polyroot(c(1, -ar[1L:p]))) > 1)
## }
## maInvert <- function(ma) {
## q <- length(ma)
## q0 <- max(which(c(1, ma) != 0)) - 1L
## if (!q0)
## return(ma)
## roots <- polyroot(c(1, ma[1L:q0]))
## ind <- Mod(roots) < 1
## if (all(!ind))
## return(ma)
## if (q0 == 1)
## return(c(1/ma[1L], rep.int(0, q - q0)))
## roots[ind] <- 1/roots[ind]
## x <- 1
## for (r in roots) x <- c(x, 0) - c(0, x)/r
## c(Re(x[-1L]), rep.int(0, q - q0))
## }
## series <- deparse1(substitute(x))
## if (NCOL(x) > 1L)
## stop("only implemented for univariate time series")
## method <- match.arg(method)
## x <- as.ts(x)
## if (!is.numeric(x))
## stop("'x' must be numeric")
## storage.mode(x) <- "double"
## dim(x) <- NULL
## n <- length(x)
## if (!missing(order))
## if (!is.numeric(order) || length(order) != 3L || any(order < 0))
## stop("'order' must be a non-negative numeric vector of length 3")
## if (!missing(seasonal))
## if (is.list(seasonal)) {
## if (is.null(seasonal$order))
## stop("'seasonal' must be a list with component 'order'")
## if (!is.numeric(seasonal$order) || length(seasonal$order) != 3L ||
## any(seasonal$order < 0L))
## stop("'seasonal$order' must be a non-negative numeric vector of length 3")
## }
## else if (is.numeric(order)) {
## if (length(order) == 3L)
## seasonal <- list(order = seasonal)
## else ("'seasonal' is of the wrong length")
## }
## else stop("'seasonal' must be a list with component 'order'")
## if (is.null(seasonal$period) || is.na(seasonal$period) || seasonal$period ==
## 0)
## seasonal$period <- frequency(x)
## arma <- as.integer(c(order[-2L], seasonal$order[-2L], seasonal$period, order[2L],
## seasonal$order[2L]))
## narma <- sum(arma[1L:4L])
## xtsp <- tsp(x)
## tsp(x) <- NULL
## Delta <- 1
## for (i in seq_len(order[2L])) Delta <- Delta %+% c(1, -1)
## for (i in seq_len(seasonal$order[2L])) Delta <- Delta %+% c(1, rep.int(0,
## seasonal$period - 1), -1)
## Delta <- -Delta[-1L]
## nd <- order[2L] + seasonal$order[2L]
## n.used <- sum(!is.na(x)) - length(Delta)
## if (is.null(xreg)) {
## ncxreg <- 0L
## }
## else {
## nmxreg <- deparse1(substitute(xreg))
## if (NROW(xreg) != n)
## stop("lengths of 'x' and 'xreg' do not match")
## ncxreg <- NCOL(xreg)
## xreg <- as.matrix(xreg)
## storage.mode(xreg) <- "double"
## }
## class(xreg) <- NULL
## if (ncxreg > 0L && is.null(colnames(xreg)))
## colnames(xreg) <- if (ncxreg == 1L)
## nmxreg
## else paste0(nmxreg, 1L:ncxreg)
## if (include.mean && (nd == 0L)) {
## xreg <- cbind(intercept = rep(1, n), xreg = xreg)
## ncxreg <- ncxreg + 1L
## }
## if (method == "CSS-ML") {
## anyna <- anyNA(x)
## if (ncxreg)
## anyna <- anyna || anyNA(xreg)
## if (anyna)
## method <- "ML"
## }
## if (method == "CSS" || method == "CSS-ML") {
## ncond <- order[2L] + seasonal$order[2L] * seasonal$period
## ncond1 <- order[1L] + seasonal$period * seasonal$order[1L]
## ncond <- ncond + if (!missing(n.cond))
## max(n.cond, ncond1)
## else ncond1
## }
## else ncond <- 0
## if (is.null(fixed))
## fixed <- rep(NA_real_, narma + ncxreg)
## else if (length(fixed) != narma + ncxreg)
## stop("wrong length for 'fixed'")
## mask <- is.na(fixed)
## no.optim <- !any(mask)
## if (no.optim)
## transform.pars <- FALSE
## if (transform.pars) {
## ind <- arma[1L] + arma[2L] + seq_len(arma[3L])
## if (any(!mask[seq_len(arma[1L])]) || any(!mask[ind])) {
## warning("some AR parameters were fixed: setting transform.pars = FALSE")
## transform.pars <- FALSE
## }
## }
## init0 <- rep.int(0, narma)
## parscale <- rep(1, narma)
## if (ncxreg) {
## cn <- colnames(xreg)
## orig.xreg <- (ncxreg == 1L) || any(!mask[narma + 1L:ncxreg])
## if (!orig.xreg) {
## S <- svd(na.omit(xreg))
## xreg <- xreg %*% S$v
## }
## dx <- x
## dxreg <- xreg
## if (order[2L] > 0L) {
## dx <- diff(dx, 1L, order[2L])
## dxreg <- diff(dxreg, 1L, order[2L])
## }
## if (seasonal$period > 1L && seasonal$order[2L] > 0) {
## dx <- diff(dx, seasonal$period, seasonal$order[2L])
## dxreg <- diff(dxreg, seasonal$period, seasonal$order[2L])
## }
## fit <- if (length(dx) > ncol(dxreg))
## lm(dx ~ dxreg - 1, na.action = na.omit)
## else list(rank = 0L)
## if (fit$rank == 0L) {
## fit <- lm(x ~ xreg - 1, na.action = na.omit)
## }
## isna <- is.na(x) | apply(xreg, 1L, anyNA)
## n.used <- sum(!isna) - length(Delta)
## init0 <- c(init0, coef(fit))
## ses <- summary(fit)$coefficients[, 2L]
## parscale <- c(parscale, 10 * ses)
## }
## if (n.used <= 0)
## stop("too few non-missing observations")
## if (!is.null(init)) {
## if (length(init) != length(init0))
## stop("'init' is of the wrong length")
## if (any(ind <- is.na(init)))
## init[ind] <- init0[ind]
## if (method == "ML") {
## if (arma[1L] > 0)
## if (!arCheck(init[1L:arma[1L]]))
## stop("non-stationary AR part")
## if (arma[3L] > 0)
## if (!arCheck(init[sum(arma[1L:2L]) + 1L:arma[3L]]))
## stop("non-stationary seasonal AR part")
## if (transform.pars)
## init <- .Call(C_ARIMA_Invtrans, as.double(init), arma)
## }
## }
## else init <- init0
## coef <- as.double(fixed)
## if (!("parscale" %in% names(optim.control)))
## optim.control$parscale <- parscale[mask]
## if (method == "CSS") {
## res <- if (no.optim)
## list(convergence = 0L, par = numeric(), value = armaCSS(numeric()))
## else optim(init[mask], armaCSS, method = optim.method, hessian = TRUE,
## control = optim.control)
## if (res$convergence > 0)
## warning(gettextf("possible convergence problem: optim gave code = %d",
## res$convergence), domain = NA)
## coef[mask] <- res$par
## trarma <- .Call(C_ARIMA_transPars, coef, arma, FALSE)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## if (ncxreg > 0)
## x <- x - xreg %*% coef[narma + (1L:ncxreg)]
## arimaSS(x, mod)
## val <- .Call(C_ARIMA_CSS, x, arma, trarma[[1L]], trarma[[2L]], as.integer(ncond),
## TRUE)
## sigma2 <- val[[1L]]
## var <- if (no.optim)
## numeric()
## else solve(res$hessian * n.used)
## }
## else {
## if (method == "CSS-ML") {
## res <- if (no.optim)
## list(convergence = 0L, par = numeric(), value = armaCSS(numeric()))
## else optim(init[mask], armaCSS, method = optim.method, hessian = FALSE,
## control = optim.control)
## if (res$convergence == 0)
## init[mask] <- res$par
## if (arma[1L] > 0)
## if (!arCheck(init[1L:arma[1L]]))
## stop("non-stationary AR part from CSS")
## if (arma[3L] > 0)
## if (!arCheck(init[sum(arma[1L:2L]) + 1L:arma[3L]]))
## stop("non-stationary seasonal AR part from CSS")
## ncond <- 0L
## }
## if (transform.pars) {
## init <- .Call(C_ARIMA_Invtrans, init, arma)
## if (arma[2L] > 0) {
## ind <- arma[1L] + 1L:arma[2L]
## init[ind] <- maInvert(init[ind])
## }
## if (arma[4L] > 0) {
## ind <- sum(arma[1L:3L]) + 1L:arma[4L]
## init[ind] <- maInvert(init[ind])
## }
## }
## trarma <- .Call(C_ARIMA_transPars, init, arma, transform.pars)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## res <- if (no.optim)
## list(convergence = 0, par = numeric(), value = armafn(numeric(),
## as.logical(transform.pars)))
## else optim(init[mask], armafn, method = optim.method, hessian = TRUE,
## control = optim.control, trans = as.logical(transform.pars))
## if (res$convergence > 0)
## warning(gettextf("possible convergence problem: optim gave code = %d",
## res$convergence), domain = NA)
## coef[mask] <- res$par
## if (transform.pars) {
## if (arma[2L] > 0L) {
## ind <- arma[1L] + 1L:arma[2L]
## if (all(mask[ind]))
## coef[ind] <- maInvert(coef[ind])
## }
## if (arma[4L] > 0L) {
## ind <- sum(arma[1L:3L]) + 1L:arma[4L]
## if (all(mask[ind]))
## coef[ind] <- maInvert(coef[ind])
## }
## if (any(coef[mask] != res$par)) {
## oldcode <- res$convergence
## res <- optim(coef[mask], armafn, method = optim.method, hessian = TRUE,
## control = list(maxit = 0L, parscale = optim.control$parscale),
## trans = TRUE)
## res$convergence <- oldcode
## coef[mask] <- res$par
## }
## A <- .Call(C_ARIMA_Gradtrans, as.double(coef), arma)
## A <- A[mask, mask]
## var <- crossprod(A, solve(res$hessian * n.used, A))
## coef <- .Call(C_ARIMA_undoPars, coef, arma)
## }
## else var <- if (no.optim)
## numeric()
## else solve(res$hessian * n.used)
## trarma <- .Call(C_ARIMA_transPars, coef, arma, FALSE)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## val <- if (ncxreg > 0L)
## arimaSS(x - xreg %*% coef[narma + (1L:ncxreg)], mod)
## else arimaSS(x, mod)
## sigma2 <- val[[1L]][1L]/n.used
## }
## value <- 2 * n.used * res$value + n.used + n.used * log(2 * pi)
## aic <- if (method != "CSS")
## value + 2 * sum(mask) + 2
## else NA
## nm <- NULL
## if (arma[1L] > 0L)
## nm <- c(nm, paste0("ar", 1L:arma[1L]))
## if (arma[2L] > 0L)
## nm <- c(nm, paste0("ma", 1L:arma[2L]))
## if (arma[3L] > 0L)
## nm <- c(nm, paste0("sar", 1L:arma[3L]))
## if (arma[4L] > 0L)
## nm <- c(nm, paste0("sma", 1L:arma[4L]))
## if (ncxreg > 0L) {
## nm <- c(nm, cn)
## if (!orig.xreg) {
## ind <- narma + 1L:ncxreg
## coef[ind] <- S$v %*% coef[ind]
## A <- diag(narma + ncxreg)
## A[ind, ind] <- S$v
## A <- A[mask, mask]
## var <- A %*% var %*% t(A)
## }
## }
## names(coef) <- nm
## if (!no.optim)
## dimnames(var) <- list(nm[mask], nm[mask])
## resid <- val[[2L]]
## tsp(resid) <- xtsp
## class(resid) <- "ts"
## structure(list(coef = coef, sigma2 = sigma2, var.coef = var, mask = mask,
## loglik = -0.5 * value, aic = aic, arma = arma, residuals = resid, call = match.call(),
## series = series, code = res$convergence, n.cond = ncond, nobs = n.used,
## model = mod), class = "Arima")
## })(x = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6, 200, 200.3,
## 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1, 210.5, 210.5, 209.8, 208.8,
## 209.5, 213.2, 213.7, 215.1, 218.7, 219.8, 220.5, 223.8, 222.8, 223.8, 221.7,
## 222.3, 220.8, 219.4, 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7,
## 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7, 217, 215.9, 215.8,
## 214.1, 212.3, 213.9, 214.6, 213.6, 212.1, 211.4, 213.1, 212.9, 213.3, 211.5,
## 212.3, 213, 211, 210.7, 210.1, 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6,
## 211.9, 212.8, 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4,
## 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7, 247.6, 247.8, 249.4,
## 249, 249.9, 250.5, 251.5, 249, 247.6, 248.8, 250.4, 250.7, 253), .Tsp = c(2008,
## 2017.16666666667, 12), class = "ts"), order = c(2, 1, 2), seasonal = list(order = c(1,
## 1, 1)))
##
## Coefficients:
## ar1 ar2 ma1 ma2 sar1 sma1
## 0.0305 0.7117 0.2088 -0.4988 0.0107 -1.0000
## s.e. 0.5941 0.5132 0.6022 0.3893 0.1155 0.1861
##
## sigma^2 estimated as 2.167: log likelihood = -190.12, aic = 394.24
##
## $train$partition_5$arima2$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Apr 2017 254.0939 252.1058 256.0820 251.0533 257.1345
## May 2017 255.1179 251.9523 258.2834 250.2766 259.9592
## Jun 2017 256.1370 251.8437 260.4302 249.5710 262.7029
## Jul 2017 256.6836 251.2982 262.0689 248.4474 264.9197
## Aug 2017 257.2599 250.7976 263.7222 247.3767 267.1432
## Sep 2017 257.6059 250.0936 265.1182 246.1168 269.0950
## Oct 2017 258.6771 250.1352 267.2191 245.6134 271.7409
## Nov 2017 259.5258 249.9825 269.0690 244.9306 274.1209
## Dec 2017 260.5402 250.0204 271.0600 244.4515 276.6288
## Jan 2018 260.5880 249.1208 272.0552 243.0504 278.1256
## Feb 2018 260.9392 248.5532 273.3252 241.9965 279.8819
## Mar 2018 261.6224 248.3444 274.9004 241.3154 281.9294
##
## $train$partition_5$arima2$parameters
## $train$partition_5$arima2$parameters$type
## [1] "train"
##
## $train$partition_5$arima2$parameters$model_id
## [1] "arima2"
##
## $train$partition_5$arima2$parameters$method
## [1] "arima"
##
## $train$partition_5$arima2$parameters$horizon
## [1] 12
##
## $train$partition_5$arima2$parameters$partition
## [1] "partition_5"
##
##
##
## $train$partition_5$hw
## $train$partition_5$hw$model
## Holt-Winters exponential smoothing with trend and additive seasonal component.
##
## Call:
## (function (x, alpha = NULL, beta = NULL, gamma = NULL, seasonal = c("additive", "multiplicative"), start.periods = 2, l.start = NULL, b.start = NULL, s.start = NULL, optim.start = c(alpha = 0.3, beta = 0.1, gamma = 0.1), optim.control = list()) { x <- as.ts(x) seasonal <- match.arg(seasonal) f <- frequency(x) if (!is.null(alpha) && (alpha == 0)) stop("cannot fit models without level ('alpha' must not be 0 or FALSE)") if (!is.null(abg <- c(alpha, beta, gamma)) && any(abg < 0 | abg > 1)) stop("'alpha', 'beta' and 'gamma' must be within the unit interval") if (is.null(gamma) || gamma > 0) { if (seasonal == "multiplicative" && any(x == 0)) stop("data must be non-zero for multiplicative Holt-Winters") if (start.periods < 2) stop("need at least 2 periods to compute seasonal start values") } if (!is.null(gamma) && is.logical(gamma) && !gamma) { expsmooth <- !is.null(beta) && is.logical(beta) && !beta if (is.null(l.start)) l.start <- if (expsmooth) x[1L] else x[2L] if (is.null(b.start)) if (is.null(beta) || !is.logical(beta) || beta) b.start <- x[2L] - x[1L] start.time <- 3 - expsmooth s.start <- 0 } else { start.time <- f + 1 wind <- start.periods * f st <- decompose(ts(x[1L:wind], start = start(x), frequency = f), seasonal) if (is.null(l.start) || is.null(b.start)) { dat <- na.omit(st$trend) cf <- coef(.lm.fit(x = cbind(1, seq_along(dat)), y = dat)) if (is.null(l.start)) l.start <- cf[1L] if (is.null(b.start)) b.start <- cf[2L] } if (is.null(s.start)) s.start <- st$figure } lenx <- as.integer(length(x)) if (is.na(lenx)) stop("invalid length(x)") len <- lenx - start.time + 1 hw <- function(alpha, beta, gamma) .C(C_HoltWinters, as.double(x), lenx, as.double(max(min(alpha, 1), 0)), as.double(max(min(beta, 1), 0)), as.double(max(min(gamma, 1), 0)), as.integer(start.time), as.integer(!+(seasonal == "multiplicative")), as.integer(f), as.integer(!is.logical(beta) || beta), as.integer(!is.logical(gamma) || gamma), a = as.double(l.start), b = as.double(b.start), s = as.double(s.start), SSE = as.double(0), level = double(len + 1L), trend = double(len + 1L), seasonal = double(len + f)) if (is.null(gamma)) { if (is.null(alpha)) { if (is.null(beta)) { error <- function(p) hw(p[1L], p[2L], p[3L])$SSE sol <- optim(optim.start, error, method = "L-BFGS-B", lower = c(0, 0, 0), upper = c(1, 1, 1), control = optim.control) if (sol$convergence || any(sol$par < 0 | sol$par > 1)) { if (sol$convergence > 50) { warning(gettextf("optimization difficulties: %s", sol$message), domain = NA) } else stop("optimization failure") } alpha <- sol$par[1L] beta <- sol$par[2L] gamma <- sol$par[3L] } else { error <- function(p) hw(p[1L], beta, p[2L])$SSE sol <- optim(c(optim.start["alpha"], optim.start["gamma"]), error, method = "L-BFGS-B", lower = c(0, 0), upper = c(1, 1), control = optim.control) if (sol$convergence || any(sol$par < 0 | sol$par > 1)) { if (sol$convergence > 50) { warning(gettextf("optimization difficulties: %s", sol$message), domain = NA) } else stop("optimization failure") } alpha <- sol$par[1L] gamma <- sol$par[2L] } } else { if (is.null(beta)) { error <- function(p) hw(alpha, p[1L], p[2L])$SSE sol <- optim(c(optim.start["beta"], optim.start["gamma"]), error, method = "L-BFGS-B", lower = c(0, 0), upper = c(1, 1), control = optim.control) if (sol$convergence || any(sol$par < 0 | sol$par > 1)) { if (sol$convergence > 50) { warning(gettextf("optimization difficulties: %s", sol$message), domain = NA) } else stop("optimization failure") } beta <- sol$par[1L] gamma <- sol$par[2L] } else { error <- function(p) hw(alpha, beta, p)$SSE gamma <- optimize(error, lower = 0, upper = 1)$minimum } } } else { if (is.null(alpha)) { if (is.null(beta)) { error <- function(p) hw(p[1L], p[2L], gamma)$SSE sol <- optim(c(optim.start["alpha"], optim.start["beta"]), error, method = "L-BFGS-B", lower = c(0, 0), upper = c(1, 1), control = optim.control) if (sol$convergence || any(sol$par < 0 | sol$par > 1)) { if (sol$convergence > 50) { warning(gettextf("optimization difficulties: %s", sol$message), domain = NA) } else stop("optimization failure") } alpha <- sol$par[1L] beta <- sol$par[2L] } else { error <- function(p) hw(p, beta, gamma)$SSE alpha <- optimize(error, lower = 0, upper = 1)$minimum } } else { if (is.null(beta)) { error <- function(p) hw(alpha, p, gamma)$SSE beta <- optimize(error, lower = 0, upper = 1)$minimum } } } final.fit <- hw(alpha, beta, gamma) fitted <- ts(cbind(xhat = final.fit$level[-len - 1], level = final.fit$level[-len - 1], trend = if (!is.logical(beta) || beta) final.fit$trend[-len - 1], season = if (!is.logical(gamma) || gamma) final.fit$seasonal[1L:len]), start = start(lag(x, k = 1 - start.time)), frequency = frequency(x)) if (!is.logical(beta) || beta) fitted[, 1] <- fitted[, 1] + fitted[, "trend"] if (!is.logical(gamma) || gamma) fitted[, 1] <- if (seasonal == "multiplicative") fitted[, 1] * fitted[, "season"] else fitted[, 1] + fitted[, "season"] structure(list(fitted = fitted, x = x, alpha = alpha, beta = beta, gamma = gamma, coefficients = c(a = final.fit$level[len + 1], b = if (!is.logical(beta) || beta) final.fit$trend[len + 1], s = if (!is.logical(gamma) || gamma) final.fit$seasonal[len + 1L:f]), seasonal = seasonal, SSE = final.fit$SSE, call = match.call()), class = "HoltWinters")})(x = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6, 200, 200.3, 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1, 210.5, 210.5, 209.8, 208.8, 209.5, 213.2, 213.7, 215.1, 218.7, 219.8, 220.5, 223.8, 222.8, 223.8, 221.7, 222.3, 220.8, 219.4, 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7, 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7, 217, 215.9, 215.8, 214.1, 212.3, 213.9, 214.6, 213.6, 212.1, 211.4, 213.1, 212.9, 213.3, 211.5, 212.3, 213, 211, 210.7, 210.1, 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6, 211.9, 212.8, 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4, 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7, 247.6, 247.8, 249.4, 249, 249.9, 250.5, 251.5, 249, 247.6, 248.8, 250.4, 250.7, 253), .Tsp = c(2008, 2017.16666666667, 12), class = "ts"))
##
## Smoothing parameters:
## alpha: 0.6044901
## beta : 0.3504634
## gamma: 1
##
## Coefficients:
## [,1]
## a 253.28008822
## b 1.38365481
## s1 -1.58822128
## s2 -1.26115226
## s3 -0.92797516
## s4 0.30740406
## s5 0.89797950
## s6 1.41642328
## s7 0.25695343
## s8 -0.05356428
## s9 1.00520351
## s10 1.12587225
## s11 0.21566100
## s12 -0.28008822
##
## $train$partition_5$hw$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Apr 2017 253.0755 250.5635 255.5875 249.2337 256.9173
## May 2017 254.7862 251.5435 258.0290 249.8269 259.7456
## Jun 2017 256.5031 252.3574 260.6487 250.1629 262.8433
## Jul 2017 259.1221 253.9366 264.3076 251.1916 267.0527
## Aug 2017 261.0963 254.7567 267.4360 251.4007 270.7920
## Sep 2017 262.9984 255.4051 270.5917 251.3855 274.6114
## Oct 2017 263.2226 254.2864 272.1589 249.5558 276.8894
## Nov 2017 264.2958 253.9346 274.6569 248.4498 280.1417
## Dec 2017 266.7382 254.8759 278.6004 248.5964 284.8799
## Jan 2018 268.2425 254.8073 281.6777 247.6952 288.7899
## Feb 2018 268.7160 253.6397 283.7922 245.6588 291.7731
## Mar 2018 269.6039 252.8216 286.3861 243.9376 295.2701
##
## $train$partition_5$hw$parameters
## $train$partition_5$hw$parameters$type
## [1] "train"
##
## $train$partition_5$hw$parameters$model_id
## [1] "hw"
##
## $train$partition_5$hw$parameters$method
## [1] "HoltWinters"
##
## $train$partition_5$hw$parameters$horizon
## [1] 12
##
## $train$partition_5$hw$parameters$partition
## [1] "partition_5"
##
##
##
## $train$partition_5$tslm
## $train$partition_5$tslm$model
##
## Call:
## (function (formula, data, subset, lambda = NULL, biasadj = FALSE,
## ...)
## {
## cl <- match.call()
## if (!("formula" %in% class(formula))) {
## formula <- stats::as.formula(formula)
## }
## if (missing(data)) {
## mt <- try(terms(formula))
## if (is.element("try-error", class(mt))) {
## stop("Cannot extract terms from formula, please provide data argument.")
## }
## }
## else {
## mt <- terms(formula, data = data)
## }
## vars <- attr(mt, "variables")
## tsvar <- match(c("trend", "season"), as.character(vars),
## 0L)
## fnvar <- NULL
## for (i in 2:length(vars)) {
## term <- vars[[i]]
## if (!is.symbol(term)) {
## if (typeof(eval(term[[1]])) == "closure") {
## fnvar <- c(fnvar, i)
## }
## }
## }
## attr(formula, ".Environment") <- environment()
## formula[[2]] <- as.symbol(deparse(formula[[2]]))
## if (sum(c(tsvar, fnvar)) > 0) {
## rmvar <- c(tsvar, fnvar)
## rmvar <- rmvar[rmvar != attr(mt, "response") + 1]
## if (any(rmvar != 0)) {
## vars <- vars[-rmvar]
## }
## }
## if (!missing(data)) {
## vars <- vars[c(TRUE, !as.character(vars[-1]) %in% colnames(data))]
## dataname <- substitute(data)
## }
## if (!missing(data)) {
## data <- datamat(do.call(datamat, as.list(vars[-1]), envir = parent.frame()),
## data)
## }
## else {
## data <- do.call(datamat, as.list(vars[-1]), envir = parent.frame())
## }
## if (is.null(dim(data)) && length(data) != 0) {
## cn <- as.character(vars)[2]
## }
## else {
## cn <- colnames(data)
## }
## if (is.null(tsp(data))) {
## if ((attr(mt, "response") + 1) %in% fnvar) {
## tspx <- tsp(eval(attr(mt, "variables")[[attr(mt,
## "response") + 1]]))
## }
## tspx <- tsp(data[, 1])
## }
## else {
## tspx <- tsp(data)
## }
## if (is.null(tspx)) {
## stop("Not time series data, use lm()")
## }
## tsdat <- match(c("trend", "season"), cn, 0L)
## if (tsdat[1] == 0) {
## trend <- 1:NROW(data)
## cn <- c(cn, "trend")
## data <- cbind(data, trend)
## }
## if (tsdat[2] == 0) {
## if (tsvar[2] != 0 && tspx[3] <= 1) {
## stop("Non-seasonal data cannot be modelled using a seasonal factor")
## }
## season <- as.factor(cycle(data[, 1]))
## cn <- c(cn, "season")
## data <- cbind(data, season)
## }
## colnames(data) <- cn
## if (!missing(subset)) {
## if (!is.logical(subset)) {
## stop("subset must be logical")
## }
## else if (NCOL(subset) > 1) {
## stop("subset must be a logical vector")
## }
## else if (NROW(subset) != NROW(data)) {
## stop("Subset must be the same length as the number of rows in the dataset")
## }
## warning("Subset has been assumed contiguous")
## timesx <- time(data[, 1])[subset]
## tspx <- recoverTSP(timesx)
## if (tspx[3] == 1 && tsdat[2] == 0 && tsvar[2] != 0) {
## stop("Non-seasonal data cannot be modelled using a seasonal factor")
## }
## data <- data[subset, ]
## }
## if (!is.null(lambda)) {
## resp_var <- deparse(attr(mt, "variables")[[attr(mt, "response") +
## 1]])
## data[, resp_var] <- BoxCox(data[, resp_var], lambda)
## lambda <- attr(data[, resp_var], "lambda")
## }
## if (tsdat[2] == 0 && tsvar[2] != 0) {
## data$season <- factor(data$season)
## }
## fit <- lm(formula, data = data, na.action = na.exclude, ...)
## fit$data <- data
## responsevar <- deparse(formula[[2]])
## fit$residuals <- ts(residuals(fit))
## fit$x <- fit$residuals
## fit$x[!is.na(fit$x)] <- model.frame(fit)[, responsevar]
## fit$fitted.values <- ts(fitted(fit))
## tsp(fit$residuals) <- tsp(fit$x) <- tsp(fit$fitted.values) <- tsp(data[,
## 1]) <- tspx
## fit$call <- cl
## fit$method <- "Linear regression model"
## if (exists("dataname")) {
## fit$call$data <- dataname
## }
## if (!is.null(lambda)) {
## attr(lambda, "biasadj") <- biasadj
## fit$lambda <- lambda
## fit$fitted.values <- InvBoxCox(fit$fitted.values, lambda,
## biasadj, var(fit$residuals))
## fit$x <- InvBoxCox(fit$x, lambda)
## }
## class(fit) <- c("tslm", class(fit))
## return(fit)
## })(formula = train ~ trend + season)
##
## Coefficients:
## (Intercept) trend season2 season3 season4 season5
## 200.25103 0.35725 -0.10725 0.10549 -1.08379 -0.90771
## season6 season7 season8 season9 season10 season11
## -0.58719 -0.74444 -0.77948 -1.03673 -0.44954 -0.08457
## season12
## 0.46929
##
##
## $train$partition_5$tslm$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Apr 2017 239.1797 225.2535 253.1059 217.7605 260.5989
## May 2017 239.7130 225.7868 253.6392 218.2938 261.1322
## Jun 2017 240.3908 226.4646 254.3170 218.9716 261.8100
## Jul 2017 240.5908 226.6646 254.5170 219.1716 262.0100
## Aug 2017 240.9130 226.9868 254.8392 219.4938 262.3322
## Sep 2017 241.0130 227.0868 254.9392 219.5938 262.4322
## Oct 2017 241.9575 228.0312 255.8837 220.5382 263.3767
## Nov 2017 242.6797 228.7535 256.6059 221.2605 264.0989
## Dec 2017 243.5908 229.6646 257.5170 222.1716 265.0100
## Jan 2018 243.4788 229.5796 257.3779 222.1012 264.8563
## Feb 2018 243.7288 229.8296 257.6279 222.3512 265.1063
## Mar 2018 244.2988 230.3996 258.1979 222.9212 265.6763
##
## $train$partition_5$tslm$parameters
## $train$partition_5$tslm$parameters$type
## [1] "train"
##
## $train$partition_5$tslm$parameters$model_id
## [1] "tslm"
##
## $train$partition_5$tslm$parameters$method
## [1] "tslm"
##
## $train$partition_5$tslm$parameters$horizon
## [1] 12
##
## $train$partition_5$tslm$parameters$partition
## [1] "partition_5"
##
##
##
## $train$partition_5$train
## Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
## 2008 200.1 199.5 199.4 198.9 199.0 200.2 198.6 200.0 200.3 201.2 201.6 201.5
## 2009 201.5 203.5 204.9 207.1 210.5 210.5 209.8 208.8 209.5 213.2 213.7 215.1
## 2010 218.7 219.8 220.5 223.8 222.8 223.8 221.7 222.3 220.8 219.4 220.1 220.6
## 2011 218.9 217.8 217.7 215.0 215.3 215.9 216.7 216.7 217.7 218.7 222.9 224.9
## 2012 222.2 220.7 220.0 218.7 217.0 215.9 215.8 214.1 212.3 213.9 214.6 213.6
## 2013 212.1 211.4 213.1 212.9 213.3 211.5 212.3 213.0 211.0 210.7 210.1 211.4
## 2014 210.0 209.7 208.8 208.8 208.8 210.6 211.9 212.8 212.5 214.8 215.3 217.5
## 2015 218.8 220.7 222.2 226.7 228.4 233.2 235.7 237.1 240.6 243.8 245.3 246.0
## 2016 246.3 247.7 247.6 247.8 249.4 249.0 249.9 250.5 251.5 249.0 247.6 248.8
## 2017 250.4 250.7 253.0
##
## $train$partition_5$test
## Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
## 2017 253.7 255.0 256.2 256.0 257.4 260.4 260.0 261.3 260.4
## 2018 261.6 260.8 259.8
##
##
## $train$partition_6
## $train$partition_6$ets1
## $train$partition_6$ets1$model
## ETS(M,Ad,N)
##
## Call:
## (function (y, model = "ZZZ", damped = NULL, alpha = NULL, beta = NULL,
##
## Call:
## gamma = NULL, phi = NULL, additive.only = FALSE, lambda = NULL,
##
## Call:
## biasadj = FALSE, lower = c(rep(1e-04, 3), 0.8), upper = c(rep(0.9999,
##
## Call:
## 3), 0.98), opt.crit = c("lik", "amse", "mse", "sigma",
##
## Call:
## "mae"), nmse = 3, bounds = c("both", "usual", "admissible"),
##
## Call:
## ic = c("aicc", "aic", "bic"), restrict = TRUE, allow.multiplicative.trend = FALSE,
##
## Call:
## use.initial.values = FALSE, na.action = c("na.contiguous",
##
## Call:
## "na.interp", "na.fail"), ...)
##
## Call:
## {
##
## Call:
## opt.crit <- match.arg(opt.crit)
##
## Call:
## bounds <- match.arg(bounds)
##
## Call:
## ic <- match.arg(ic)
##
## Call:
## if (!is.function(na.action)) {
##
## Call:
## na.fn_name <- match.arg(na.action)
##
## Call:
## na.action <- get(na.fn_name)
##
## Call:
## }
##
## Call:
## seriesname <- deparse(substitute(y))
##
## Call:
## if (any(class(y) %in% c("data.frame", "list", "matrix", "mts"))) {
##
## Call:
## stop("y should be a univariate time series")
##
## Call:
## }
##
## Call:
## y <- as.ts(y)
##
## Call:
## if (missing(model) && is.constant(y)) {
##
## Call:
## return(ses(y, alpha = 0.99999, initial = "simple")$model)
##
## Call:
## }
##
## Call:
## ny <- length(y)
##
## Call:
## y <- na.action(y)
##
## Call:
## if (ny != length(y) && na.fn_name == "na.contiguous") {
##
## Call:
## warning("Missing values encountered. Using longest contiguous portion of time series")
##
## Call:
## ny <- length(y)
##
## Call:
## }
##
## Call:
## orig.y <- y
##
## Call:
## if (identical(class(model), "ets") && is.null(lambda)) {
##
## Call:
## lambda <- model$lambda
##
## Call:
## }
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## y <- BoxCox(y, lambda)
##
## Call:
## lambda <- attr(y, "lambda")
##
## Call:
## additive.only <- TRUE
##
## Call:
## }
##
## Call:
## if (nmse < 1 || nmse > 30) {
##
## Call:
## stop("nmse out of range")
##
## Call:
## }
##
## Call:
## m <- frequency(y)
##
## Call:
## if (any(upper < lower)) {
##
## Call:
## stop("Lower limits must be less than upper limits")
##
## Call:
## }
##
## Call:
## if (class(model) == "ets") {
##
## Call:
## alpha <- max(model$par["alpha"], 1e-10)
##
## Call:
## beta <- model$par["beta"]
##
## Call:
## if (is.na(beta)) {
##
## Call:
## beta <- NULL
##
## Call:
## }
##
## Call:
## gamma <- model$par["gamma"]
##
## Call:
## if (is.na(gamma)) {
##
## Call:
## gamma <- NULL
##
## Call:
## }
##
## Call:
## phi <- model$par["phi"]
##
## Call:
## if (is.na(phi)) {
##
## Call:
## phi <- NULL
##
## Call:
## }
##
## Call:
## modelcomponents <- paste(model$components[1], model$components[2],
##
## Call:
## model$components[3], sep = "")
##
## Call:
## damped <- (model$components[4] == "TRUE")
##
## Call:
## if (use.initial.values) {
##
## Call:
## errortype <- substr(modelcomponents, 1, 1)
##
## Call:
## trendtype <- substr(modelcomponents, 2, 2)
##
## Call:
## seasontype <- substr(modelcomponents, 3, 3)
##
## Call:
## e <- pegelsresid.C(y, m, model$initstate, errortype,
##
## Call:
## trendtype, seasontype, damped, alpha, beta, gamma,
##
## Call:
## phi, nmse)
##
## Call:
## np <- length(model$par) + 1
##
## Call:
## model$loglik <- -0.5 * e$lik
##
## Call:
## model$aic <- e$lik + 2 * np
##
## Call:
## model$bic <- e$lik + log(ny) * np
##
## Call:
## model$aicc <- model$aic + 2 * np * (np + 1)/(ny -
##
## Call:
## np - 1)
##
## Call:
## model$mse <- e$amse[1]
##
## Call:
## model$amse <- mean(e$amse)
##
## Call:
## tsp.y <- tsp(y)
##
## Call:
## model$states <- ts(e$states, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1] - 1/tsp.y[3])
##
## Call:
## colnames(model$states)[1] <- "l"
##
## Call:
## if (trendtype != "N") {
##
## Call:
## colnames(model$states)[2] <- "b"
##
## Call:
## }
##
## Call:
## if (seasontype != "N") {
##
## Call:
## colnames(model$states)[(2 + (trendtype != "N")):ncol(model$states)] <- paste("s",
##
## Call:
## 1:m, sep = "")
##
## Call:
## }
##
## Call:
## if (errortype == "A") {
##
## Call:
## model$fitted <- ts(y - e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model$fitted <- ts(y/(1 + e$e), frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## model$residuals <- ts(e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## model$series <- seriesname
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda,
##
## Call:
## biasadj, var(model$residuals))
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(model)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model <- modelcomponents
##
## Call:
## if (missing(use.initial.values)) {
##
## Call:
## message("Model is being refit with current smoothing parameters but initial states are being re-estimated.\nSet 'use.initial.values=TRUE' if you want to re-use existing initial values.")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## errortype <- substr(model, 1, 1)
##
## Call:
## trendtype <- substr(model, 2, 2)
##
## Call:
## seasontype <- substr(model, 3, 3)
##
## Call:
## if (!is.element(errortype, c("M", "A", "Z"))) {
##
## Call:
## stop("Invalid error type")
##
## Call:
## }
##
## Call:
## if (!is.element(trendtype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid trend type")
##
## Call:
## }
##
## Call:
## if (!is.element(seasontype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid season type")
##
## Call:
## }
##
## Call:
## if (m < 1 || length(y) <= m) {
##
## Call:
## seasontype <- "N"
##
## Call:
## }
##
## Call:
## if (m == 1) {
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## stop("Nonseasonal data")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (m > 24) {
##
## Call:
## if (is.element(seasontype, c("A", "M"))) {
##
## Call:
## stop("Frequency too high")
##
## Call:
## }
##
## Call:
## else if (seasontype == "Z") {
##
## Call:
## warning("I can't handle data with frequency greater than 24. Seasonality will be ignored. Try stlf() if you need seasonal forecasts.")
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if ((errortype == "A" && (trendtype == "M" || seasontype ==
##
## Call:
## "M")) | (errortype == "M" && trendtype == "M" &&
##
## Call:
## seasontype == "A") || (additive.only && (errortype ==
##
## Call:
## "M" || trendtype == "M" || seasontype == "M"))) {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## data.positive <- (min(y) > 0)
##
## Call:
## if (!data.positive && errortype == "M") {
##
## Call:
## stop("Inappropriate model for data with negative or zero values")
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped && trendtype == "N") {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## n <- length(y)
##
## Call:
## npars <- 2L
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## npars <- npars + 2L
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## npars <- npars + m
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## npars <- npars + as.numeric(damped)
##
## Call:
## }
##
## Call:
## if (n <= npars + 4L) {
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped) {
##
## Call:
## warning("Not enough data to use damping")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = gamma, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), seasonal = ifelse(seasontype != "A",
##
## Call:
## "multiplicative", "additive"), lambda = lambda,
##
## Call:
## biasadj = biasadj, warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Seasonal component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Trend component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "N" && seasontype == "N") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, lambda = lambda, biasadj = biasadj,
##
## Call:
## warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## }
##
## Call:
## fit1 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## fit2 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if ("try-error" %in% class(fit1)) {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## else if (fit1$sigma2 < fit2$sigma2) {
##
## Call:
## fit <- fit1
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## if ("try-error" %in% class(fit))
##
## Call:
## stop("Unable to estimate a model.")
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## if (errortype == "Z") {
##
## Call:
## errortype <- c("A", "M")
##
## Call:
## }
##
## Call:
## if (trendtype == "Z") {
##
## Call:
## if (allow.multiplicative.trend) {
##
## Call:
## trendtype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## trendtype <- c("N", "A")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "Z") {
##
## Call:
## seasontype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## if (is.null(damped)) {
##
## Call:
## damped <- c(TRUE, FALSE)
##
## Call:
## }
##
## Call:
## best.ic <- Inf
##
## Call:
## for (i in 1:length(errortype)) {
##
## Call:
## for (j in 1:length(trendtype)) {
##
## Call:
## for (k in 1:length(seasontype)) {
##
## Call:
## for (l in 1:length(damped)) {
##
## Call:
## if (trendtype[j] == "N" && damped[l]) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if (errortype[i] == "A" && (trendtype[j] ==
##
## Call:
## "M" || seasontype[k] == "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (errortype[i] == "M" && trendtype[j] ==
##
## Call:
## "M" && seasontype[k] == "A") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (additive.only && (errortype[i] == "M" ||
##
## Call:
## trendtype[j] == "M" || seasontype[k] ==
##
## Call:
## "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (!data.positive && errortype[i] == "M") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## fit <- try(etsmodel(y, errortype[i], trendtype[j],
##
## Call:
## seasontype[k], damped[l], alpha, beta, gamma,
##
## Call:
## phi, lower = lower, upper = upper, opt.crit = opt.crit,
##
## Call:
## nmse = nmse, bounds = bounds, ...), silent = TRUE)
##
## Call:
## if (is.element("try-error", class(fit)))
##
## Call:
## fit.ic <- Inf
##
## Call:
## else fit.ic <- switch(ic, aic = fit$aic, bic = fit$bic,
##
## Call:
## aicc = fit$aicc)
##
## Call:
## if (!is.na(fit.ic)) {
##
## Call:
## if (fit.ic < best.ic) {
##
## Call:
## model <- fit
##
## Call:
## best.ic <- fit.ic
##
## Call:
## best.e <- errortype[i]
##
## Call:
## best.t <- trendtype[j]
##
## Call:
## best.s <- seasontype[k]
##
## Call:
## best.d <- damped[l]
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (best.ic == Inf) {
##
## Call:
## stop("No model able to be fitted")
##
## Call:
## }
##
## Call:
## model$m <- m
##
## Call:
## model$method <- paste("ETS(", best.e, ",", best.t, ifelse(best.d,
##
## Call:
## "d", ""), ",", best.s, ")", sep = "")
##
## Call:
## model$series <- seriesname
##
## Call:
## model$components <- c(best.e, best.t, best.s, best.d)
##
## Call:
## model$call <- match.call()
##
## Call:
## model$initstate <- model$states[1, ]
##
## Call:
## np <- length(model$par)
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda, biasadj,
##
## Call:
## model$sigma2)
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(structure(model, class = "ets"))
##
## Call:
## })(y = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6,
##
## Call:
## 200, 200.3, 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1,
##
## Call:
## 210.5, 210.5, 209.8, 208.8, 209.5, 213.2, 213.7, 215.1, 218.7,
##
## Call:
## 219.8, 220.5, 223.8, 222.8, 223.8, 221.7, 222.3, 220.8, 219.4,
##
## Call:
## 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7,
##
## Call:
## 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7,
##
## Call:
## 217, 215.9, 215.8, 214.1, 212.3, 213.9, 214.6, 213.6, 212.1,
##
## Call:
## 211.4, 213.1, 212.9, 213.3, 211.5, 212.3, 213, 211, 210.7, 210.1,
##
## Call:
## 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6, 211.9, 212.8,
##
## Call:
## 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4,
##
## Call:
## 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7,
##
## Call:
## 247.6, 247.8, 249.4, 249, 249.9, 250.5, 251.5, 249, 247.6, 248.8,
##
## Call:
## 250.4, 250.7, 253, 253.7, 255, 256.2), .Tsp = c(2008, 2017.41666666667,
##
## Call:
## 12), class = "ts"), opt.crit = "lik")
##
## Smoothing parameters:
## alpha = 0.9862
## beta = 0.2858
## phi = 0.8953
##
## Initial states:
## l = 200.4101
## b = -0.3652
##
## sigma: 0.0066
##
## AIC AICc BIC
## 630.9916 631.7767 647.4088
##
## $train$partition_6$ets1$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jul 2017 257.0002 254.8350 259.1654 253.6888 260.3116
## Aug 2017 257.7219 254.2654 261.1784 252.4357 263.0081
## Sep 2017 258.3681 253.6608 263.0754 251.1689 265.5672
## Oct 2017 258.9465 252.9928 264.9003 249.8410 268.0521
## Nov 2017 259.4645 252.2642 266.6647 248.4526 270.4763
## Dec 2017 259.9282 251.4837 268.3726 247.0135 272.8428
## Jan 2018 260.3433 250.6607 270.0259 245.5350 275.1516
## Feb 2018 260.7150 249.8037 271.6262 244.0277 277.4023
## Mar 2018 261.0477 248.9204 273.1750 242.5007 279.5947
## Apr 2018 261.3456 248.0174 274.6738 240.9618 281.7294
## May 2018 261.6123 247.1001 276.1246 239.4178 283.8069
## Jun 2018 261.8511 246.1732 277.5290 237.8738 285.8284
##
## $train$partition_6$ets1$parameters
## $train$partition_6$ets1$parameters$type
## [1] "train"
##
## $train$partition_6$ets1$parameters$model_id
## [1] "ets1"
##
## $train$partition_6$ets1$parameters$method
## [1] "ets"
##
## $train$partition_6$ets1$parameters$horizon
## [1] 12
##
## $train$partition_6$ets1$parameters$partition
## [1] "partition_6"
##
##
##
## $train$partition_6$ets2
## $train$partition_6$ets2$model
## ETS(A,Ad,N)
##
## Call:
## (function (y, model = "ZZZ", damped = NULL, alpha = NULL, beta = NULL,
##
## Call:
## gamma = NULL, phi = NULL, additive.only = FALSE, lambda = NULL,
##
## Call:
## biasadj = FALSE, lower = c(rep(1e-04, 3), 0.8), upper = c(rep(0.9999,
##
## Call:
## 3), 0.98), opt.crit = c("lik", "amse", "mse", "sigma",
##
## Call:
## "mae"), nmse = 3, bounds = c("both", "usual", "admissible"),
##
## Call:
## ic = c("aicc", "aic", "bic"), restrict = TRUE, allow.multiplicative.trend = FALSE,
##
## Call:
## use.initial.values = FALSE, na.action = c("na.contiguous",
##
## Call:
## "na.interp", "na.fail"), ...)
##
## Call:
## {
##
## Call:
## opt.crit <- match.arg(opt.crit)
##
## Call:
## bounds <- match.arg(bounds)
##
## Call:
## ic <- match.arg(ic)
##
## Call:
## if (!is.function(na.action)) {
##
## Call:
## na.fn_name <- match.arg(na.action)
##
## Call:
## na.action <- get(na.fn_name)
##
## Call:
## }
##
## Call:
## seriesname <- deparse(substitute(y))
##
## Call:
## if (any(class(y) %in% c("data.frame", "list", "matrix", "mts"))) {
##
## Call:
## stop("y should be a univariate time series")
##
## Call:
## }
##
## Call:
## y <- as.ts(y)
##
## Call:
## if (missing(model) && is.constant(y)) {
##
## Call:
## return(ses(y, alpha = 0.99999, initial = "simple")$model)
##
## Call:
## }
##
## Call:
## ny <- length(y)
##
## Call:
## y <- na.action(y)
##
## Call:
## if (ny != length(y) && na.fn_name == "na.contiguous") {
##
## Call:
## warning("Missing values encountered. Using longest contiguous portion of time series")
##
## Call:
## ny <- length(y)
##
## Call:
## }
##
## Call:
## orig.y <- y
##
## Call:
## if (identical(class(model), "ets") && is.null(lambda)) {
##
## Call:
## lambda <- model$lambda
##
## Call:
## }
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## y <- BoxCox(y, lambda)
##
## Call:
## lambda <- attr(y, "lambda")
##
## Call:
## additive.only <- TRUE
##
## Call:
## }
##
## Call:
## if (nmse < 1 || nmse > 30) {
##
## Call:
## stop("nmse out of range")
##
## Call:
## }
##
## Call:
## m <- frequency(y)
##
## Call:
## if (any(upper < lower)) {
##
## Call:
## stop("Lower limits must be less than upper limits")
##
## Call:
## }
##
## Call:
## if (class(model) == "ets") {
##
## Call:
## alpha <- max(model$par["alpha"], 1e-10)
##
## Call:
## beta <- model$par["beta"]
##
## Call:
## if (is.na(beta)) {
##
## Call:
## beta <- NULL
##
## Call:
## }
##
## Call:
## gamma <- model$par["gamma"]
##
## Call:
## if (is.na(gamma)) {
##
## Call:
## gamma <- NULL
##
## Call:
## }
##
## Call:
## phi <- model$par["phi"]
##
## Call:
## if (is.na(phi)) {
##
## Call:
## phi <- NULL
##
## Call:
## }
##
## Call:
## modelcomponents <- paste(model$components[1], model$components[2],
##
## Call:
## model$components[3], sep = "")
##
## Call:
## damped <- (model$components[4] == "TRUE")
##
## Call:
## if (use.initial.values) {
##
## Call:
## errortype <- substr(modelcomponents, 1, 1)
##
## Call:
## trendtype <- substr(modelcomponents, 2, 2)
##
## Call:
## seasontype <- substr(modelcomponents, 3, 3)
##
## Call:
## e <- pegelsresid.C(y, m, model$initstate, errortype,
##
## Call:
## trendtype, seasontype, damped, alpha, beta, gamma,
##
## Call:
## phi, nmse)
##
## Call:
## np <- length(model$par) + 1
##
## Call:
## model$loglik <- -0.5 * e$lik
##
## Call:
## model$aic <- e$lik + 2 * np
##
## Call:
## model$bic <- e$lik + log(ny) * np
##
## Call:
## model$aicc <- model$aic + 2 * np * (np + 1)/(ny -
##
## Call:
## np - 1)
##
## Call:
## model$mse <- e$amse[1]
##
## Call:
## model$amse <- mean(e$amse)
##
## Call:
## tsp.y <- tsp(y)
##
## Call:
## model$states <- ts(e$states, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1] - 1/tsp.y[3])
##
## Call:
## colnames(model$states)[1] <- "l"
##
## Call:
## if (trendtype != "N") {
##
## Call:
## colnames(model$states)[2] <- "b"
##
## Call:
## }
##
## Call:
## if (seasontype != "N") {
##
## Call:
## colnames(model$states)[(2 + (trendtype != "N")):ncol(model$states)] <- paste("s",
##
## Call:
## 1:m, sep = "")
##
## Call:
## }
##
## Call:
## if (errortype == "A") {
##
## Call:
## model$fitted <- ts(y - e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model$fitted <- ts(y/(1 + e$e), frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## model$residuals <- ts(e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## model$series <- seriesname
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda,
##
## Call:
## biasadj, var(model$residuals))
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(model)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model <- modelcomponents
##
## Call:
## if (missing(use.initial.values)) {
##
## Call:
## message("Model is being refit with current smoothing parameters but initial states are being re-estimated.\nSet 'use.initial.values=TRUE' if you want to re-use existing initial values.")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## errortype <- substr(model, 1, 1)
##
## Call:
## trendtype <- substr(model, 2, 2)
##
## Call:
## seasontype <- substr(model, 3, 3)
##
## Call:
## if (!is.element(errortype, c("M", "A", "Z"))) {
##
## Call:
## stop("Invalid error type")
##
## Call:
## }
##
## Call:
## if (!is.element(trendtype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid trend type")
##
## Call:
## }
##
## Call:
## if (!is.element(seasontype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid season type")
##
## Call:
## }
##
## Call:
## if (m < 1 || length(y) <= m) {
##
## Call:
## seasontype <- "N"
##
## Call:
## }
##
## Call:
## if (m == 1) {
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## stop("Nonseasonal data")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (m > 24) {
##
## Call:
## if (is.element(seasontype, c("A", "M"))) {
##
## Call:
## stop("Frequency too high")
##
## Call:
## }
##
## Call:
## else if (seasontype == "Z") {
##
## Call:
## warning("I can't handle data with frequency greater than 24. Seasonality will be ignored. Try stlf() if you need seasonal forecasts.")
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if ((errortype == "A" && (trendtype == "M" || seasontype ==
##
## Call:
## "M")) | (errortype == "M" && trendtype == "M" &&
##
## Call:
## seasontype == "A") || (additive.only && (errortype ==
##
## Call:
## "M" || trendtype == "M" || seasontype == "M"))) {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## data.positive <- (min(y) > 0)
##
## Call:
## if (!data.positive && errortype == "M") {
##
## Call:
## stop("Inappropriate model for data with negative or zero values")
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped && trendtype == "N") {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## n <- length(y)
##
## Call:
## npars <- 2L
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## npars <- npars + 2L
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## npars <- npars + m
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## npars <- npars + as.numeric(damped)
##
## Call:
## }
##
## Call:
## if (n <= npars + 4L) {
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped) {
##
## Call:
## warning("Not enough data to use damping")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = gamma, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), seasonal = ifelse(seasontype != "A",
##
## Call:
## "multiplicative", "additive"), lambda = lambda,
##
## Call:
## biasadj = biasadj, warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Seasonal component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Trend component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "N" && seasontype == "N") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, lambda = lambda, biasadj = biasadj,
##
## Call:
## warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## }
##
## Call:
## fit1 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## fit2 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if ("try-error" %in% class(fit1)) {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## else if (fit1$sigma2 < fit2$sigma2) {
##
## Call:
## fit <- fit1
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## if ("try-error" %in% class(fit))
##
## Call:
## stop("Unable to estimate a model.")
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## if (errortype == "Z") {
##
## Call:
## errortype <- c("A", "M")
##
## Call:
## }
##
## Call:
## if (trendtype == "Z") {
##
## Call:
## if (allow.multiplicative.trend) {
##
## Call:
## trendtype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## trendtype <- c("N", "A")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "Z") {
##
## Call:
## seasontype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## if (is.null(damped)) {
##
## Call:
## damped <- c(TRUE, FALSE)
##
## Call:
## }
##
## Call:
## best.ic <- Inf
##
## Call:
## for (i in 1:length(errortype)) {
##
## Call:
## for (j in 1:length(trendtype)) {
##
## Call:
## for (k in 1:length(seasontype)) {
##
## Call:
## for (l in 1:length(damped)) {
##
## Call:
## if (trendtype[j] == "N" && damped[l]) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if (errortype[i] == "A" && (trendtype[j] ==
##
## Call:
## "M" || seasontype[k] == "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (errortype[i] == "M" && trendtype[j] ==
##
## Call:
## "M" && seasontype[k] == "A") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (additive.only && (errortype[i] == "M" ||
##
## Call:
## trendtype[j] == "M" || seasontype[k] ==
##
## Call:
## "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (!data.positive && errortype[i] == "M") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## fit <- try(etsmodel(y, errortype[i], trendtype[j],
##
## Call:
## seasontype[k], damped[l], alpha, beta, gamma,
##
## Call:
## phi, lower = lower, upper = upper, opt.crit = opt.crit,
##
## Call:
## nmse = nmse, bounds = bounds, ...), silent = TRUE)
##
## Call:
## if (is.element("try-error", class(fit)))
##
## Call:
## fit.ic <- Inf
##
## Call:
## else fit.ic <- switch(ic, aic = fit$aic, bic = fit$bic,
##
## Call:
## aicc = fit$aicc)
##
## Call:
## if (!is.na(fit.ic)) {
##
## Call:
## if (fit.ic < best.ic) {
##
## Call:
## model <- fit
##
## Call:
## best.ic <- fit.ic
##
## Call:
## best.e <- errortype[i]
##
## Call:
## best.t <- trendtype[j]
##
## Call:
## best.s <- seasontype[k]
##
## Call:
## best.d <- damped[l]
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (best.ic == Inf) {
##
## Call:
## stop("No model able to be fitted")
##
## Call:
## }
##
## Call:
## model$m <- m
##
## Call:
## model$method <- paste("ETS(", best.e, ",", best.t, ifelse(best.d,
##
## Call:
## "d", ""), ",", best.s, ")", sep = "")
##
## Call:
## model$series <- seriesname
##
## Call:
## model$components <- c(best.e, best.t, best.s, best.d)
##
## Call:
## model$call <- match.call()
##
## Call:
## model$initstate <- model$states[1, ]
##
## Call:
## np <- length(model$par)
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda, biasadj,
##
## Call:
## model$sigma2)
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(structure(model, class = "ets"))
##
## Call:
## })(y = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6,
##
## Call:
## 200, 200.3, 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1,
##
## Call:
## 210.5, 210.5, 209.8, 208.8, 209.5, 213.2, 213.7, 215.1, 218.7,
##
## Call:
## 219.8, 220.5, 223.8, 222.8, 223.8, 221.7, 222.3, 220.8, 219.4,
##
## Call:
## 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7,
##
## Call:
## 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7,
##
## Call:
## 217, 215.9, 215.8, 214.1, 212.3, 213.9, 214.6, 213.6, 212.1,
##
## Call:
## 211.4, 213.1, 212.9, 213.3, 211.5, 212.3, 213, 211, 210.7, 210.1,
##
## Call:
## 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6, 211.9, 212.8,
##
## Call:
## 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4,
##
## Call:
## 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7,
##
## Call:
## 247.6, 247.8, 249.4, 249, 249.9, 250.5, 251.5, 249, 247.6, 248.8,
##
## Call:
## 250.4, 250.7, 253, 253.7, 255, 256.2), .Tsp = c(2008, 2017.41666666667,
##
## Call:
## 12), class = "ts"), opt.crit = "amse")
##
## Smoothing parameters:
## alpha = 0.9224
## beta = 0.3006
## phi = 0.8615
##
## Initial states:
## l = 200.0759
## b = -0.2935
##
## sigma: 1.4503
##
## AIC AICc BIC
## 631.5791 632.3642 647.9963
##
## $train$partition_6$ets2$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jul 2017 256.9457 255.0871 258.8044 254.1032 259.7883
## Aug 2017 257.6204 254.7435 260.4973 253.2205 262.0202
## Sep 2017 258.2016 254.3168 262.0864 252.2603 264.1429
## Oct 2017 258.7023 253.8136 263.5911 251.2256 266.1791
## Nov 2017 259.1337 253.2490 265.0185 250.1338 268.1337
## Dec 2017 259.5054 252.6375 266.3733 249.0018 270.0090
## Jan 2018 259.8256 251.9913 267.6599 247.8441 271.8071
## Feb 2018 260.1014 251.3204 268.8825 246.6720 273.5309
## Mar 2018 260.3391 250.6328 270.0453 245.4947 275.1835
## Apr 2018 260.5438 249.9351 271.1525 244.3192 276.7684
## May 2018 260.7202 249.2323 272.2081 243.1509 278.2895
## Jun 2018 260.8722 248.5284 273.2159 241.9941 279.7502
##
## $train$partition_6$ets2$parameters
## $train$partition_6$ets2$parameters$type
## [1] "train"
##
## $train$partition_6$ets2$parameters$model_id
## [1] "ets2"
##
## $train$partition_6$ets2$parameters$method
## [1] "ets"
##
## $train$partition_6$ets2$parameters$horizon
## [1] 12
##
## $train$partition_6$ets2$parameters$partition
## [1] "partition_6"
##
##
##
## $train$partition_6$arima1
## $train$partition_6$arima1$model
##
## Call:
## (function (x, order = c(0L, 0L, 0L), seasonal = list(order = c(0L, 0L, 0L),
## period = NA), xreg = NULL, include.mean = TRUE, transform.pars = TRUE, fixed = NULL,
## init = NULL, method = c("CSS-ML", "ML", "CSS"), n.cond, SSinit = c("Gardner1980",
## "Rossignol2011"), optim.method = "BFGS", optim.control = list(), kappa = 1e+06)
## {
## "%+%" <- function(a, b) .Call(C_TSconv, a, b)
## SSinit <- match.arg(SSinit)
## SS.G <- SSinit == "Gardner1980"
## upARIMA <- function(mod, phi, theta) {
## p <- length(phi)
## q <- length(theta)
## mod$phi <- phi
## mod$theta <- theta
## r <- max(p, q + 1L)
## if (p > 0)
## mod$T[1L:p, 1L] <- phi
## if (r > 1L)
## mod$Pn[1L:r, 1L:r] <- if (SS.G)
## .Call(C_getQ0, phi, theta)
## else .Call(C_getQ0bis, phi, theta, tol = 0)
## else mod$Pn[1L, 1L] <- if (p > 0)
## 1/(1 - phi^2)
## else 1
## mod$a[] <- 0
## mod
## }
## arimaSS <- function(y, mod) {
## .Call(C_ARIMA_Like, y, mod, 0L, TRUE)
## }
## armafn <- function(p, trans) {
## par <- coef
## par[mask] <- p
## trarma <- .Call(C_ARIMA_transPars, par, arma, trans)
## if (is.null(Z <- tryCatch(upARIMA(mod, trarma[[1L]], trarma[[2L]]),
## error = function(e) NULL)))
## return(.Machine$double.xmax)
## if (ncxreg > 0)
## x <- x - xreg %*% par[narma + (1L:ncxreg)]
## res <- .Call(C_ARIMA_Like, x, Z, 0L, FALSE)
## s2 <- res[1L]/res[3L]
## 0.5 * (log(s2) + res[2L]/res[3L])
## }
## armaCSS <- function(p) {
## par <- as.double(fixed)
## par[mask] <- p
## trarma <- .Call(C_ARIMA_transPars, par, arma, FALSE)
## if (ncxreg > 0)
## x <- x - xreg %*% par[narma + (1L:ncxreg)]
## res <- .Call(C_ARIMA_CSS, x, arma, trarma[[1L]], trarma[[2L]], as.integer(ncond),
## FALSE)
## 0.5 * log(res)
## }
## arCheck <- function(ar) {
## p <- max(which(c(1, -ar) != 0)) - 1
## if (!p)
## return(TRUE)
## all(Mod(polyroot(c(1, -ar[1L:p]))) > 1)
## }
## maInvert <- function(ma) {
## q <- length(ma)
## q0 <- max(which(c(1, ma) != 0)) - 1L
## if (!q0)
## return(ma)
## roots <- polyroot(c(1, ma[1L:q0]))
## ind <- Mod(roots) < 1
## if (all(!ind))
## return(ma)
## if (q0 == 1)
## return(c(1/ma[1L], rep.int(0, q - q0)))
## roots[ind] <- 1/roots[ind]
## x <- 1
## for (r in roots) x <- c(x, 0) - c(0, x)/r
## c(Re(x[-1L]), rep.int(0, q - q0))
## }
## series <- deparse1(substitute(x))
## if (NCOL(x) > 1L)
## stop("only implemented for univariate time series")
## method <- match.arg(method)
## x <- as.ts(x)
## if (!is.numeric(x))
## stop("'x' must be numeric")
## storage.mode(x) <- "double"
## dim(x) <- NULL
## n <- length(x)
## if (!missing(order))
## if (!is.numeric(order) || length(order) != 3L || any(order < 0))
## stop("'order' must be a non-negative numeric vector of length 3")
## if (!missing(seasonal))
## if (is.list(seasonal)) {
## if (is.null(seasonal$order))
## stop("'seasonal' must be a list with component 'order'")
## if (!is.numeric(seasonal$order) || length(seasonal$order) != 3L ||
## any(seasonal$order < 0L))
## stop("'seasonal$order' must be a non-negative numeric vector of length 3")
## }
## else if (is.numeric(order)) {
## if (length(order) == 3L)
## seasonal <- list(order = seasonal)
## else ("'seasonal' is of the wrong length")
## }
## else stop("'seasonal' must be a list with component 'order'")
## if (is.null(seasonal$period) || is.na(seasonal$period) || seasonal$period ==
## 0)
## seasonal$period <- frequency(x)
## arma <- as.integer(c(order[-2L], seasonal$order[-2L], seasonal$period, order[2L],
## seasonal$order[2L]))
## narma <- sum(arma[1L:4L])
## xtsp <- tsp(x)
## tsp(x) <- NULL
## Delta <- 1
## for (i in seq_len(order[2L])) Delta <- Delta %+% c(1, -1)
## for (i in seq_len(seasonal$order[2L])) Delta <- Delta %+% c(1, rep.int(0,
## seasonal$period - 1), -1)
## Delta <- -Delta[-1L]
## nd <- order[2L] + seasonal$order[2L]
## n.used <- sum(!is.na(x)) - length(Delta)
## if (is.null(xreg)) {
## ncxreg <- 0L
## }
## else {
## nmxreg <- deparse1(substitute(xreg))
## if (NROW(xreg) != n)
## stop("lengths of 'x' and 'xreg' do not match")
## ncxreg <- NCOL(xreg)
## xreg <- as.matrix(xreg)
## storage.mode(xreg) <- "double"
## }
## class(xreg) <- NULL
## if (ncxreg > 0L && is.null(colnames(xreg)))
## colnames(xreg) <- if (ncxreg == 1L)
## nmxreg
## else paste0(nmxreg, 1L:ncxreg)
## if (include.mean && (nd == 0L)) {
## xreg <- cbind(intercept = rep(1, n), xreg = xreg)
## ncxreg <- ncxreg + 1L
## }
## if (method == "CSS-ML") {
## anyna <- anyNA(x)
## if (ncxreg)
## anyna <- anyna || anyNA(xreg)
## if (anyna)
## method <- "ML"
## }
## if (method == "CSS" || method == "CSS-ML") {
## ncond <- order[2L] + seasonal$order[2L] * seasonal$period
## ncond1 <- order[1L] + seasonal$period * seasonal$order[1L]
## ncond <- ncond + if (!missing(n.cond))
## max(n.cond, ncond1)
## else ncond1
## }
## else ncond <- 0
## if (is.null(fixed))
## fixed <- rep(NA_real_, narma + ncxreg)
## else if (length(fixed) != narma + ncxreg)
## stop("wrong length for 'fixed'")
## mask <- is.na(fixed)
## no.optim <- !any(mask)
## if (no.optim)
## transform.pars <- FALSE
## if (transform.pars) {
## ind <- arma[1L] + arma[2L] + seq_len(arma[3L])
## if (any(!mask[seq_len(arma[1L])]) || any(!mask[ind])) {
## warning("some AR parameters were fixed: setting transform.pars = FALSE")
## transform.pars <- FALSE
## }
## }
## init0 <- rep.int(0, narma)
## parscale <- rep(1, narma)
## if (ncxreg) {
## cn <- colnames(xreg)
## orig.xreg <- (ncxreg == 1L) || any(!mask[narma + 1L:ncxreg])
## if (!orig.xreg) {
## S <- svd(na.omit(xreg))
## xreg <- xreg %*% S$v
## }
## dx <- x
## dxreg <- xreg
## if (order[2L] > 0L) {
## dx <- diff(dx, 1L, order[2L])
## dxreg <- diff(dxreg, 1L, order[2L])
## }
## if (seasonal$period > 1L && seasonal$order[2L] > 0) {
## dx <- diff(dx, seasonal$period, seasonal$order[2L])
## dxreg <- diff(dxreg, seasonal$period, seasonal$order[2L])
## }
## fit <- if (length(dx) > ncol(dxreg))
## lm(dx ~ dxreg - 1, na.action = na.omit)
## else list(rank = 0L)
## if (fit$rank == 0L) {
## fit <- lm(x ~ xreg - 1, na.action = na.omit)
## }
## isna <- is.na(x) | apply(xreg, 1L, anyNA)
## n.used <- sum(!isna) - length(Delta)
## init0 <- c(init0, coef(fit))
## ses <- summary(fit)$coefficients[, 2L]
## parscale <- c(parscale, 10 * ses)
## }
## if (n.used <= 0)
## stop("too few non-missing observations")
## if (!is.null(init)) {
## if (length(init) != length(init0))
## stop("'init' is of the wrong length")
## if (any(ind <- is.na(init)))
## init[ind] <- init0[ind]
## if (method == "ML") {
## if (arma[1L] > 0)
## if (!arCheck(init[1L:arma[1L]]))
## stop("non-stationary AR part")
## if (arma[3L] > 0)
## if (!arCheck(init[sum(arma[1L:2L]) + 1L:arma[3L]]))
## stop("non-stationary seasonal AR part")
## if (transform.pars)
## init <- .Call(C_ARIMA_Invtrans, as.double(init), arma)
## }
## }
## else init <- init0
## coef <- as.double(fixed)
## if (!("parscale" %in% names(optim.control)))
## optim.control$parscale <- parscale[mask]
## if (method == "CSS") {
## res <- if (no.optim)
## list(convergence = 0L, par = numeric(), value = armaCSS(numeric()))
## else optim(init[mask], armaCSS, method = optim.method, hessian = TRUE,
## control = optim.control)
## if (res$convergence > 0)
## warning(gettextf("possible convergence problem: optim gave code = %d",
## res$convergence), domain = NA)
## coef[mask] <- res$par
## trarma <- .Call(C_ARIMA_transPars, coef, arma, FALSE)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## if (ncxreg > 0)
## x <- x - xreg %*% coef[narma + (1L:ncxreg)]
## arimaSS(x, mod)
## val <- .Call(C_ARIMA_CSS, x, arma, trarma[[1L]], trarma[[2L]], as.integer(ncond),
## TRUE)
## sigma2 <- val[[1L]]
## var <- if (no.optim)
## numeric()
## else solve(res$hessian * n.used)
## }
## else {
## if (method == "CSS-ML") {
## res <- if (no.optim)
## list(convergence = 0L, par = numeric(), value = armaCSS(numeric()))
## else optim(init[mask], armaCSS, method = optim.method, hessian = FALSE,
## control = optim.control)
## if (res$convergence == 0)
## init[mask] <- res$par
## if (arma[1L] > 0)
## if (!arCheck(init[1L:arma[1L]]))
## stop("non-stationary AR part from CSS")
## if (arma[3L] > 0)
## if (!arCheck(init[sum(arma[1L:2L]) + 1L:arma[3L]]))
## stop("non-stationary seasonal AR part from CSS")
## ncond <- 0L
## }
## if (transform.pars) {
## init <- .Call(C_ARIMA_Invtrans, init, arma)
## if (arma[2L] > 0) {
## ind <- arma[1L] + 1L:arma[2L]
## init[ind] <- maInvert(init[ind])
## }
## if (arma[4L] > 0) {
## ind <- sum(arma[1L:3L]) + 1L:arma[4L]
## init[ind] <- maInvert(init[ind])
## }
## }
## trarma <- .Call(C_ARIMA_transPars, init, arma, transform.pars)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## res <- if (no.optim)
## list(convergence = 0, par = numeric(), value = armafn(numeric(),
## as.logical(transform.pars)))
## else optim(init[mask], armafn, method = optim.method, hessian = TRUE,
## control = optim.control, trans = as.logical(transform.pars))
## if (res$convergence > 0)
## warning(gettextf("possible convergence problem: optim gave code = %d",
## res$convergence), domain = NA)
## coef[mask] <- res$par
## if (transform.pars) {
## if (arma[2L] > 0L) {
## ind <- arma[1L] + 1L:arma[2L]
## if (all(mask[ind]))
## coef[ind] <- maInvert(coef[ind])
## }
## if (arma[4L] > 0L) {
## ind <- sum(arma[1L:3L]) + 1L:arma[4L]
## if (all(mask[ind]))
## coef[ind] <- maInvert(coef[ind])
## }
## if (any(coef[mask] != res$par)) {
## oldcode <- res$convergence
## res <- optim(coef[mask], armafn, method = optim.method, hessian = TRUE,
## control = list(maxit = 0L, parscale = optim.control$parscale),
## trans = TRUE)
## res$convergence <- oldcode
## coef[mask] <- res$par
## }
## A <- .Call(C_ARIMA_Gradtrans, as.double(coef), arma)
## A <- A[mask, mask]
## var <- crossprod(A, solve(res$hessian * n.used, A))
## coef <- .Call(C_ARIMA_undoPars, coef, arma)
## }
## else var <- if (no.optim)
## numeric()
## else solve(res$hessian * n.used)
## trarma <- .Call(C_ARIMA_transPars, coef, arma, FALSE)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## val <- if (ncxreg > 0L)
## arimaSS(x - xreg %*% coef[narma + (1L:ncxreg)], mod)
## else arimaSS(x, mod)
## sigma2 <- val[[1L]][1L]/n.used
## }
## value <- 2 * n.used * res$value + n.used + n.used * log(2 * pi)
## aic <- if (method != "CSS")
## value + 2 * sum(mask) + 2
## else NA
## nm <- NULL
## if (arma[1L] > 0L)
## nm <- c(nm, paste0("ar", 1L:arma[1L]))
## if (arma[2L] > 0L)
## nm <- c(nm, paste0("ma", 1L:arma[2L]))
## if (arma[3L] > 0L)
## nm <- c(nm, paste0("sar", 1L:arma[3L]))
## if (arma[4L] > 0L)
## nm <- c(nm, paste0("sma", 1L:arma[4L]))
## if (ncxreg > 0L) {
## nm <- c(nm, cn)
## if (!orig.xreg) {
## ind <- narma + 1L:ncxreg
## coef[ind] <- S$v %*% coef[ind]
## A <- diag(narma + ncxreg)
## A[ind, ind] <- S$v
## A <- A[mask, mask]
## var <- A %*% var %*% t(A)
## }
## }
## names(coef) <- nm
## if (!no.optim)
## dimnames(var) <- list(nm[mask], nm[mask])
## resid <- val[[2L]]
## tsp(resid) <- xtsp
## class(resid) <- "ts"
## structure(list(coef = coef, sigma2 = sigma2, var.coef = var, mask = mask,
## loglik = -0.5 * value, aic = aic, arma = arma, residuals = resid, call = match.call(),
## series = series, code = res$convergence, n.cond = ncond, nobs = n.used,
## model = mod), class = "Arima")
## })(x = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6, 200, 200.3,
## 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1, 210.5, 210.5, 209.8, 208.8,
## 209.5, 213.2, 213.7, 215.1, 218.7, 219.8, 220.5, 223.8, 222.8, 223.8, 221.7,
## 222.3, 220.8, 219.4, 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7,
## 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7, 217, 215.9, 215.8,
## 214.1, 212.3, 213.9, 214.6, 213.6, 212.1, 211.4, 213.1, 212.9, 213.3, 211.5,
## 212.3, 213, 211, 210.7, 210.1, 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6,
## 211.9, 212.8, 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4,
## 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7, 247.6, 247.8, 249.4,
## 249, 249.9, 250.5, 251.5, 249, 247.6, 248.8, 250.4, 250.7, 253, 253.7, 255,
## 256.2), .Tsp = c(2008, 2017.41666666667, 12), class = "ts"), order = c(2, 1,
## 0))
##
## Coefficients:
## ar1 ar2
## 0.3084 0.2191
## s.e. 0.0912 0.0912
##
## sigma^2 estimated as 2.112: log likelihood = -202.7, aic = 411.41
##
## $train$partition_6$arima1$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jul 2017 256.8548 254.9926 258.7171 254.0068 259.7029
## Aug 2017 257.3197 254.2530 260.3863 252.6296 262.0097
## Sep 2017 257.6065 253.3014 261.9116 251.0224 264.1906
## Oct 2017 257.7968 252.3554 263.2381 249.4750 266.1186
## Nov 2017 257.9183 251.4211 264.4154 247.9817 267.8548
## Dec 2017 257.9974 250.5275 265.4674 246.5731 269.4218
## Jan 2018 258.0485 249.6780 266.4189 245.2470 270.8499
## Feb 2018 258.0815 248.8746 267.2884 244.0008 272.1622
## Mar 2018 258.1029 248.1149 268.0909 242.8276 273.3782
## Apr 2018 258.1168 247.3957 268.8378 241.7203 274.5132
## May 2018 258.1257 246.7132 269.5382 240.6718 275.5796
## Jun 2018 258.1315 246.0639 270.1991 239.6756 276.5873
##
## $train$partition_6$arima1$parameters
## $train$partition_6$arima1$parameters$type
## [1] "train"
##
## $train$partition_6$arima1$parameters$model_id
## [1] "arima1"
##
## $train$partition_6$arima1$parameters$method
## [1] "arima"
##
## $train$partition_6$arima1$parameters$horizon
## [1] 12
##
## $train$partition_6$arima1$parameters$partition
## [1] "partition_6"
##
##
##
## $train$partition_6$arima2
## $train$partition_6$arima2$model
##
## Call:
## (function (x, order = c(0L, 0L, 0L), seasonal = list(order = c(0L, 0L, 0L),
## period = NA), xreg = NULL, include.mean = TRUE, transform.pars = TRUE, fixed = NULL,
## init = NULL, method = c("CSS-ML", "ML", "CSS"), n.cond, SSinit = c("Gardner1980",
## "Rossignol2011"), optim.method = "BFGS", optim.control = list(), kappa = 1e+06)
## {
## "%+%" <- function(a, b) .Call(C_TSconv, a, b)
## SSinit <- match.arg(SSinit)
## SS.G <- SSinit == "Gardner1980"
## upARIMA <- function(mod, phi, theta) {
## p <- length(phi)
## q <- length(theta)
## mod$phi <- phi
## mod$theta <- theta
## r <- max(p, q + 1L)
## if (p > 0)
## mod$T[1L:p, 1L] <- phi
## if (r > 1L)
## mod$Pn[1L:r, 1L:r] <- if (SS.G)
## .Call(C_getQ0, phi, theta)
## else .Call(C_getQ0bis, phi, theta, tol = 0)
## else mod$Pn[1L, 1L] <- if (p > 0)
## 1/(1 - phi^2)
## else 1
## mod$a[] <- 0
## mod
## }
## arimaSS <- function(y, mod) {
## .Call(C_ARIMA_Like, y, mod, 0L, TRUE)
## }
## armafn <- function(p, trans) {
## par <- coef
## par[mask] <- p
## trarma <- .Call(C_ARIMA_transPars, par, arma, trans)
## if (is.null(Z <- tryCatch(upARIMA(mod, trarma[[1L]], trarma[[2L]]),
## error = function(e) NULL)))
## return(.Machine$double.xmax)
## if (ncxreg > 0)
## x <- x - xreg %*% par[narma + (1L:ncxreg)]
## res <- .Call(C_ARIMA_Like, x, Z, 0L, FALSE)
## s2 <- res[1L]/res[3L]
## 0.5 * (log(s2) + res[2L]/res[3L])
## }
## armaCSS <- function(p) {
## par <- as.double(fixed)
## par[mask] <- p
## trarma <- .Call(C_ARIMA_transPars, par, arma, FALSE)
## if (ncxreg > 0)
## x <- x - xreg %*% par[narma + (1L:ncxreg)]
## res <- .Call(C_ARIMA_CSS, x, arma, trarma[[1L]], trarma[[2L]], as.integer(ncond),
## FALSE)
## 0.5 * log(res)
## }
## arCheck <- function(ar) {
## p <- max(which(c(1, -ar) != 0)) - 1
## if (!p)
## return(TRUE)
## all(Mod(polyroot(c(1, -ar[1L:p]))) > 1)
## }
## maInvert <- function(ma) {
## q <- length(ma)
## q0 <- max(which(c(1, ma) != 0)) - 1L
## if (!q0)
## return(ma)
## roots <- polyroot(c(1, ma[1L:q0]))
## ind <- Mod(roots) < 1
## if (all(!ind))
## return(ma)
## if (q0 == 1)
## return(c(1/ma[1L], rep.int(0, q - q0)))
## roots[ind] <- 1/roots[ind]
## x <- 1
## for (r in roots) x <- c(x, 0) - c(0, x)/r
## c(Re(x[-1L]), rep.int(0, q - q0))
## }
## series <- deparse1(substitute(x))
## if (NCOL(x) > 1L)
## stop("only implemented for univariate time series")
## method <- match.arg(method)
## x <- as.ts(x)
## if (!is.numeric(x))
## stop("'x' must be numeric")
## storage.mode(x) <- "double"
## dim(x) <- NULL
## n <- length(x)
## if (!missing(order))
## if (!is.numeric(order) || length(order) != 3L || any(order < 0))
## stop("'order' must be a non-negative numeric vector of length 3")
## if (!missing(seasonal))
## if (is.list(seasonal)) {
## if (is.null(seasonal$order))
## stop("'seasonal' must be a list with component 'order'")
## if (!is.numeric(seasonal$order) || length(seasonal$order) != 3L ||
## any(seasonal$order < 0L))
## stop("'seasonal$order' must be a non-negative numeric vector of length 3")
## }
## else if (is.numeric(order)) {
## if (length(order) == 3L)
## seasonal <- list(order = seasonal)
## else ("'seasonal' is of the wrong length")
## }
## else stop("'seasonal' must be a list with component 'order'")
## if (is.null(seasonal$period) || is.na(seasonal$period) || seasonal$period ==
## 0)
## seasonal$period <- frequency(x)
## arma <- as.integer(c(order[-2L], seasonal$order[-2L], seasonal$period, order[2L],
## seasonal$order[2L]))
## narma <- sum(arma[1L:4L])
## xtsp <- tsp(x)
## tsp(x) <- NULL
## Delta <- 1
## for (i in seq_len(order[2L])) Delta <- Delta %+% c(1, -1)
## for (i in seq_len(seasonal$order[2L])) Delta <- Delta %+% c(1, rep.int(0,
## seasonal$period - 1), -1)
## Delta <- -Delta[-1L]
## nd <- order[2L] + seasonal$order[2L]
## n.used <- sum(!is.na(x)) - length(Delta)
## if (is.null(xreg)) {
## ncxreg <- 0L
## }
## else {
## nmxreg <- deparse1(substitute(xreg))
## if (NROW(xreg) != n)
## stop("lengths of 'x' and 'xreg' do not match")
## ncxreg <- NCOL(xreg)
## xreg <- as.matrix(xreg)
## storage.mode(xreg) <- "double"
## }
## class(xreg) <- NULL
## if (ncxreg > 0L && is.null(colnames(xreg)))
## colnames(xreg) <- if (ncxreg == 1L)
## nmxreg
## else paste0(nmxreg, 1L:ncxreg)
## if (include.mean && (nd == 0L)) {
## xreg <- cbind(intercept = rep(1, n), xreg = xreg)
## ncxreg <- ncxreg + 1L
## }
## if (method == "CSS-ML") {
## anyna <- anyNA(x)
## if (ncxreg)
## anyna <- anyna || anyNA(xreg)
## if (anyna)
## method <- "ML"
## }
## if (method == "CSS" || method == "CSS-ML") {
## ncond <- order[2L] + seasonal$order[2L] * seasonal$period
## ncond1 <- order[1L] + seasonal$period * seasonal$order[1L]
## ncond <- ncond + if (!missing(n.cond))
## max(n.cond, ncond1)
## else ncond1
## }
## else ncond <- 0
## if (is.null(fixed))
## fixed <- rep(NA_real_, narma + ncxreg)
## else if (length(fixed) != narma + ncxreg)
## stop("wrong length for 'fixed'")
## mask <- is.na(fixed)
## no.optim <- !any(mask)
## if (no.optim)
## transform.pars <- FALSE
## if (transform.pars) {
## ind <- arma[1L] + arma[2L] + seq_len(arma[3L])
## if (any(!mask[seq_len(arma[1L])]) || any(!mask[ind])) {
## warning("some AR parameters were fixed: setting transform.pars = FALSE")
## transform.pars <- FALSE
## }
## }
## init0 <- rep.int(0, narma)
## parscale <- rep(1, narma)
## if (ncxreg) {
## cn <- colnames(xreg)
## orig.xreg <- (ncxreg == 1L) || any(!mask[narma + 1L:ncxreg])
## if (!orig.xreg) {
## S <- svd(na.omit(xreg))
## xreg <- xreg %*% S$v
## }
## dx <- x
## dxreg <- xreg
## if (order[2L] > 0L) {
## dx <- diff(dx, 1L, order[2L])
## dxreg <- diff(dxreg, 1L, order[2L])
## }
## if (seasonal$period > 1L && seasonal$order[2L] > 0) {
## dx <- diff(dx, seasonal$period, seasonal$order[2L])
## dxreg <- diff(dxreg, seasonal$period, seasonal$order[2L])
## }
## fit <- if (length(dx) > ncol(dxreg))
## lm(dx ~ dxreg - 1, na.action = na.omit)
## else list(rank = 0L)
## if (fit$rank == 0L) {
## fit <- lm(x ~ xreg - 1, na.action = na.omit)
## }
## isna <- is.na(x) | apply(xreg, 1L, anyNA)
## n.used <- sum(!isna) - length(Delta)
## init0 <- c(init0, coef(fit))
## ses <- summary(fit)$coefficients[, 2L]
## parscale <- c(parscale, 10 * ses)
## }
## if (n.used <= 0)
## stop("too few non-missing observations")
## if (!is.null(init)) {
## if (length(init) != length(init0))
## stop("'init' is of the wrong length")
## if (any(ind <- is.na(init)))
## init[ind] <- init0[ind]
## if (method == "ML") {
## if (arma[1L] > 0)
## if (!arCheck(init[1L:arma[1L]]))
## stop("non-stationary AR part")
## if (arma[3L] > 0)
## if (!arCheck(init[sum(arma[1L:2L]) + 1L:arma[3L]]))
## stop("non-stationary seasonal AR part")
## if (transform.pars)
## init <- .Call(C_ARIMA_Invtrans, as.double(init), arma)
## }
## }
## else init <- init0
## coef <- as.double(fixed)
## if (!("parscale" %in% names(optim.control)))
## optim.control$parscale <- parscale[mask]
## if (method == "CSS") {
## res <- if (no.optim)
## list(convergence = 0L, par = numeric(), value = armaCSS(numeric()))
## else optim(init[mask], armaCSS, method = optim.method, hessian = TRUE,
## control = optim.control)
## if (res$convergence > 0)
## warning(gettextf("possible convergence problem: optim gave code = %d",
## res$convergence), domain = NA)
## coef[mask] <- res$par
## trarma <- .Call(C_ARIMA_transPars, coef, arma, FALSE)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## if (ncxreg > 0)
## x <- x - xreg %*% coef[narma + (1L:ncxreg)]
## arimaSS(x, mod)
## val <- .Call(C_ARIMA_CSS, x, arma, trarma[[1L]], trarma[[2L]], as.integer(ncond),
## TRUE)
## sigma2 <- val[[1L]]
## var <- if (no.optim)
## numeric()
## else solve(res$hessian * n.used)
## }
## else {
## if (method == "CSS-ML") {
## res <- if (no.optim)
## list(convergence = 0L, par = numeric(), value = armaCSS(numeric()))
## else optim(init[mask], armaCSS, method = optim.method, hessian = FALSE,
## control = optim.control)
## if (res$convergence == 0)
## init[mask] <- res$par
## if (arma[1L] > 0)
## if (!arCheck(init[1L:arma[1L]]))
## stop("non-stationary AR part from CSS")
## if (arma[3L] > 0)
## if (!arCheck(init[sum(arma[1L:2L]) + 1L:arma[3L]]))
## stop("non-stationary seasonal AR part from CSS")
## ncond <- 0L
## }
## if (transform.pars) {
## init <- .Call(C_ARIMA_Invtrans, init, arma)
## if (arma[2L] > 0) {
## ind <- arma[1L] + 1L:arma[2L]
## init[ind] <- maInvert(init[ind])
## }
## if (arma[4L] > 0) {
## ind <- sum(arma[1L:3L]) + 1L:arma[4L]
## init[ind] <- maInvert(init[ind])
## }
## }
## trarma <- .Call(C_ARIMA_transPars, init, arma, transform.pars)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## res <- if (no.optim)
## list(convergence = 0, par = numeric(), value = armafn(numeric(),
## as.logical(transform.pars)))
## else optim(init[mask], armafn, method = optim.method, hessian = TRUE,
## control = optim.control, trans = as.logical(transform.pars))
## if (res$convergence > 0)
## warning(gettextf("possible convergence problem: optim gave code = %d",
## res$convergence), domain = NA)
## coef[mask] <- res$par
## if (transform.pars) {
## if (arma[2L] > 0L) {
## ind <- arma[1L] + 1L:arma[2L]
## if (all(mask[ind]))
## coef[ind] <- maInvert(coef[ind])
## }
## if (arma[4L] > 0L) {
## ind <- sum(arma[1L:3L]) + 1L:arma[4L]
## if (all(mask[ind]))
## coef[ind] <- maInvert(coef[ind])
## }
## if (any(coef[mask] != res$par)) {
## oldcode <- res$convergence
## res <- optim(coef[mask], armafn, method = optim.method, hessian = TRUE,
## control = list(maxit = 0L, parscale = optim.control$parscale),
## trans = TRUE)
## res$convergence <- oldcode
## coef[mask] <- res$par
## }
## A <- .Call(C_ARIMA_Gradtrans, as.double(coef), arma)
## A <- A[mask, mask]
## var <- crossprod(A, solve(res$hessian * n.used, A))
## coef <- .Call(C_ARIMA_undoPars, coef, arma)
## }
## else var <- if (no.optim)
## numeric()
## else solve(res$hessian * n.used)
## trarma <- .Call(C_ARIMA_transPars, coef, arma, FALSE)
## mod <- makeARIMA(trarma[[1L]], trarma[[2L]], Delta, kappa, SSinit)
## val <- if (ncxreg > 0L)
## arimaSS(x - xreg %*% coef[narma + (1L:ncxreg)], mod)
## else arimaSS(x, mod)
## sigma2 <- val[[1L]][1L]/n.used
## }
## value <- 2 * n.used * res$value + n.used + n.used * log(2 * pi)
## aic <- if (method != "CSS")
## value + 2 * sum(mask) + 2
## else NA
## nm <- NULL
## if (arma[1L] > 0L)
## nm <- c(nm, paste0("ar", 1L:arma[1L]))
## if (arma[2L] > 0L)
## nm <- c(nm, paste0("ma", 1L:arma[2L]))
## if (arma[3L] > 0L)
## nm <- c(nm, paste0("sar", 1L:arma[3L]))
## if (arma[4L] > 0L)
## nm <- c(nm, paste0("sma", 1L:arma[4L]))
## if (ncxreg > 0L) {
## nm <- c(nm, cn)
## if (!orig.xreg) {
## ind <- narma + 1L:ncxreg
## coef[ind] <- S$v %*% coef[ind]
## A <- diag(narma + ncxreg)
## A[ind, ind] <- S$v
## A <- A[mask, mask]
## var <- A %*% var %*% t(A)
## }
## }
## names(coef) <- nm
## if (!no.optim)
## dimnames(var) <- list(nm[mask], nm[mask])
## resid <- val[[2L]]
## tsp(resid) <- xtsp
## class(resid) <- "ts"
## structure(list(coef = coef, sigma2 = sigma2, var.coef = var, mask = mask,
## loglik = -0.5 * value, aic = aic, arma = arma, residuals = resid, call = match.call(),
## series = series, code = res$convergence, n.cond = ncond, nobs = n.used,
## model = mod), class = "Arima")
## })(x = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6, 200, 200.3,
## 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1, 210.5, 210.5, 209.8, 208.8,
## 209.5, 213.2, 213.7, 215.1, 218.7, 219.8, 220.5, 223.8, 222.8, 223.8, 221.7,
## 222.3, 220.8, 219.4, 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7,
## 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7, 217, 215.9, 215.8,
## 214.1, 212.3, 213.9, 214.6, 213.6, 212.1, 211.4, 213.1, 212.9, 213.3, 211.5,
## 212.3, 213, 211, 210.7, 210.1, 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6,
## 211.9, 212.8, 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4,
## 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7, 247.6, 247.8, 249.4,
## 249, 249.9, 250.5, 251.5, 249, 247.6, 248.8, 250.4, 250.7, 253, 253.7, 255,
## 256.2), .Tsp = c(2008, 2017.41666666667, 12), class = "ts"), order = c(2, 1,
## 2), seasonal = list(order = c(1, 1, 1)))
##
## Coefficients:
## ar1 ar2 ma1 ma2 sar1 sma1
## 0.0185 0.7230 0.2177 -0.5046 0.0097 -1.0000
## s.e. 0.4506 0.3924 0.4634 0.3119 0.1125 0.1727
##
## sigma^2 estimated as 2.105: log likelihood = -194.24, aic = 402.48
##
## $train$partition_6$arima2$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jul 2017 256.8129 254.8533 258.7724 253.8160 259.8098
## Aug 2017 257.4235 254.3080 260.5389 252.6588 262.1882
## Sep 2017 257.8180 253.5904 262.0456 251.3525 264.2836
## Oct 2017 258.9192 253.6174 264.2209 250.8109 267.0275
## Nov 2017 259.8070 253.4434 266.1706 250.0748 269.5393
## Dec 2017 260.8408 253.4438 268.2378 249.5281 272.1535
## Jan 2018 260.9139 252.5023 269.3254 248.0495 273.7782
## Feb 2018 261.2794 251.8873 270.6715 246.9154 275.6434
## Mar 2018 261.9808 251.6297 272.3320 246.1501 277.8116
## Apr 2018 262.6804 251.3981 273.9628 245.4256 279.9353
## May 2018 263.3737 251.1839 275.5635 244.7310 282.0163
## Jun 2018 264.1600 251.0899 277.2302 244.1710 284.1491
##
## $train$partition_6$arima2$parameters
## $train$partition_6$arima2$parameters$type
## [1] "train"
##
## $train$partition_6$arima2$parameters$model_id
## [1] "arima2"
##
## $train$partition_6$arima2$parameters$method
## [1] "arima"
##
## $train$partition_6$arima2$parameters$horizon
## [1] 12
##
## $train$partition_6$arima2$parameters$partition
## [1] "partition_6"
##
##
##
## $train$partition_6$hw
## $train$partition_6$hw$model
## Holt-Winters exponential smoothing with trend and additive seasonal component.
##
## Call:
## (function (x, alpha = NULL, beta = NULL, gamma = NULL, seasonal = c("additive", "multiplicative"), start.periods = 2, l.start = NULL, b.start = NULL, s.start = NULL, optim.start = c(alpha = 0.3, beta = 0.1, gamma = 0.1), optim.control = list()) { x <- as.ts(x) seasonal <- match.arg(seasonal) f <- frequency(x) if (!is.null(alpha) && (alpha == 0)) stop("cannot fit models without level ('alpha' must not be 0 or FALSE)") if (!is.null(abg <- c(alpha, beta, gamma)) && any(abg < 0 | abg > 1)) stop("'alpha', 'beta' and 'gamma' must be within the unit interval") if (is.null(gamma) || gamma > 0) { if (seasonal == "multiplicative" && any(x == 0)) stop("data must be non-zero for multiplicative Holt-Winters") if (start.periods < 2) stop("need at least 2 periods to compute seasonal start values") } if (!is.null(gamma) && is.logical(gamma) && !gamma) { expsmooth <- !is.null(beta) && is.logical(beta) && !beta if (is.null(l.start)) l.start <- if (expsmooth) x[1L] else x[2L] if (is.null(b.start)) if (is.null(beta) || !is.logical(beta) || beta) b.start <- x[2L] - x[1L] start.time <- 3 - expsmooth s.start <- 0 } else { start.time <- f + 1 wind <- start.periods * f st <- decompose(ts(x[1L:wind], start = start(x), frequency = f), seasonal) if (is.null(l.start) || is.null(b.start)) { dat <- na.omit(st$trend) cf <- coef(.lm.fit(x = cbind(1, seq_along(dat)), y = dat)) if (is.null(l.start)) l.start <- cf[1L] if (is.null(b.start)) b.start <- cf[2L] } if (is.null(s.start)) s.start <- st$figure } lenx <- as.integer(length(x)) if (is.na(lenx)) stop("invalid length(x)") len <- lenx - start.time + 1 hw <- function(alpha, beta, gamma) .C(C_HoltWinters, as.double(x), lenx, as.double(max(min(alpha, 1), 0)), as.double(max(min(beta, 1), 0)), as.double(max(min(gamma, 1), 0)), as.integer(start.time), as.integer(!+(seasonal == "multiplicative")), as.integer(f), as.integer(!is.logical(beta) || beta), as.integer(!is.logical(gamma) || gamma), a = as.double(l.start), b = as.double(b.start), s = as.double(s.start), SSE = as.double(0), level = double(len + 1L), trend = double(len + 1L), seasonal = double(len + f)) if (is.null(gamma)) { if (is.null(alpha)) { if (is.null(beta)) { error <- function(p) hw(p[1L], p[2L], p[3L])$SSE sol <- optim(optim.start, error, method = "L-BFGS-B", lower = c(0, 0, 0), upper = c(1, 1, 1), control = optim.control) if (sol$convergence || any(sol$par < 0 | sol$par > 1)) { if (sol$convergence > 50) { warning(gettextf("optimization difficulties: %s", sol$message), domain = NA) } else stop("optimization failure") } alpha <- sol$par[1L] beta <- sol$par[2L] gamma <- sol$par[3L] } else { error <- function(p) hw(p[1L], beta, p[2L])$SSE sol <- optim(c(optim.start["alpha"], optim.start["gamma"]), error, method = "L-BFGS-B", lower = c(0, 0), upper = c(1, 1), control = optim.control) if (sol$convergence || any(sol$par < 0 | sol$par > 1)) { if (sol$convergence > 50) { warning(gettextf("optimization difficulties: %s", sol$message), domain = NA) } else stop("optimization failure") } alpha <- sol$par[1L] gamma <- sol$par[2L] } } else { if (is.null(beta)) { error <- function(p) hw(alpha, p[1L], p[2L])$SSE sol <- optim(c(optim.start["beta"], optim.start["gamma"]), error, method = "L-BFGS-B", lower = c(0, 0), upper = c(1, 1), control = optim.control) if (sol$convergence || any(sol$par < 0 | sol$par > 1)) { if (sol$convergence > 50) { warning(gettextf("optimization difficulties: %s", sol$message), domain = NA) } else stop("optimization failure") } beta <- sol$par[1L] gamma <- sol$par[2L] } else { error <- function(p) hw(alpha, beta, p)$SSE gamma <- optimize(error, lower = 0, upper = 1)$minimum } } } else { if (is.null(alpha)) { if (is.null(beta)) { error <- function(p) hw(p[1L], p[2L], gamma)$SSE sol <- optim(c(optim.start["alpha"], optim.start["beta"]), error, method = "L-BFGS-B", lower = c(0, 0), upper = c(1, 1), control = optim.control) if (sol$convergence || any(sol$par < 0 | sol$par > 1)) { if (sol$convergence > 50) { warning(gettextf("optimization difficulties: %s", sol$message), domain = NA) } else stop("optimization failure") } alpha <- sol$par[1L] beta <- sol$par[2L] } else { error <- function(p) hw(p, beta, gamma)$SSE alpha <- optimize(error, lower = 0, upper = 1)$minimum } } else { if (is.null(beta)) { error <- function(p) hw(alpha, p, gamma)$SSE beta <- optimize(error, lower = 0, upper = 1)$minimum } } } final.fit <- hw(alpha, beta, gamma) fitted <- ts(cbind(xhat = final.fit$level[-len - 1], level = final.fit$level[-len - 1], trend = if (!is.logical(beta) || beta) final.fit$trend[-len - 1], season = if (!is.logical(gamma) || gamma) final.fit$seasonal[1L:len]), start = start(lag(x, k = 1 - start.time)), frequency = frequency(x)) if (!is.logical(beta) || beta) fitted[, 1] <- fitted[, 1] + fitted[, "trend"] if (!is.logical(gamma) || gamma) fitted[, 1] <- if (seasonal == "multiplicative") fitted[, 1] * fitted[, "season"] else fitted[, 1] + fitted[, "season"] structure(list(fitted = fitted, x = x, alpha = alpha, beta = beta, gamma = gamma, coefficients = c(a = final.fit$level[len + 1], b = if (!is.logical(beta) || beta) final.fit$trend[len + 1], s = if (!is.logical(gamma) || gamma) final.fit$seasonal[len + 1L:f]), seasonal = seasonal, SSE = final.fit$SSE, call = match.call()), class = "HoltWinters")})(x = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6, 200, 200.3, 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1, 210.5, 210.5, 209.8, 208.8, 209.5, 213.2, 213.7, 215.1, 218.7, 219.8, 220.5, 223.8, 222.8, 223.8, 221.7, 222.3, 220.8, 219.4, 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7, 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7, 217, 215.9, 215.8, 214.1, 212.3, 213.9, 214.6, 213.6, 212.1, 211.4, 213.1, 212.9, 213.3, 211.5, 212.3, 213, 211, 210.7, 210.1, 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6, 211.9, 212.8, 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4, 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7, 247.6, 247.8, 249.4, 249, 249.9, 250.5, 251.5, 249, 247.6, 248.8, 250.4, 250.7, 253, 253.7, 255, 256.2), .Tsp = c(2008, 2017.41666666667, 12), class = "ts"))
##
## Smoothing parameters:
## alpha: 0.6051505
## beta : 0.3454868
## gamma: 1
##
## Coefficients:
## [,1]
## a 257.37495939
## b 1.29555700
## s1 0.31824313
## s2 0.89281474
## s3 1.39401041
## s4 0.23043665
## s5 -0.07810873
## s6 0.98667937
## s7 1.11396473
## s8 0.21431241
## s9 -0.27079995
## s10 -1.31759986
## s11 -1.34794354
## s12 -1.17495939
##
## $train$partition_6$hw$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jul 2017 258.9888 256.5111 261.4664 255.1996 262.7780
## Aug 2017 260.8589 257.6638 264.0539 255.9725 265.7453
## Sep 2017 262.6556 258.5769 266.7344 256.4177 268.8936
## Oct 2017 262.7876 257.6926 267.8826 254.9955 270.5798
## Nov 2017 263.7746 257.5526 269.9967 254.2589 273.2904
## Dec 2017 266.1350 258.6894 273.5805 254.7480 277.5220
## Jan 2018 267.5578 258.8020 276.3136 254.1670 280.9486
## Feb 2018 267.9537 257.8081 278.0993 252.4374 283.4701
## Mar 2018 268.7642 257.1547 280.3737 251.0090 286.5194
## Apr 2018 269.0129 255.8698 282.1561 248.9122 289.1136
## May 2018 270.2781 255.5351 285.0211 247.7307 292.8256
## Jun 2018 271.7467 255.3407 288.1527 246.6558 296.8375
##
## $train$partition_6$hw$parameters
## $train$partition_6$hw$parameters$type
## [1] "train"
##
## $train$partition_6$hw$parameters$model_id
## [1] "hw"
##
## $train$partition_6$hw$parameters$method
## [1] "HoltWinters"
##
## $train$partition_6$hw$parameters$horizon
## [1] 12
##
## $train$partition_6$hw$parameters$partition
## [1] "partition_6"
##
##
##
## $train$partition_6$tslm
## $train$partition_6$tslm$model
##
## Call:
## (function (formula, data, subset, lambda = NULL, biasadj = FALSE,
## ...)
## {
## cl <- match.call()
## if (!("formula" %in% class(formula))) {
## formula <- stats::as.formula(formula)
## }
## if (missing(data)) {
## mt <- try(terms(formula))
## if (is.element("try-error", class(mt))) {
## stop("Cannot extract terms from formula, please provide data argument.")
## }
## }
## else {
## mt <- terms(formula, data = data)
## }
## vars <- attr(mt, "variables")
## tsvar <- match(c("trend", "season"), as.character(vars),
## 0L)
## fnvar <- NULL
## for (i in 2:length(vars)) {
## term <- vars[[i]]
## if (!is.symbol(term)) {
## if (typeof(eval(term[[1]])) == "closure") {
## fnvar <- c(fnvar, i)
## }
## }
## }
## attr(formula, ".Environment") <- environment()
## formula[[2]] <- as.symbol(deparse(formula[[2]]))
## if (sum(c(tsvar, fnvar)) > 0) {
## rmvar <- c(tsvar, fnvar)
## rmvar <- rmvar[rmvar != attr(mt, "response") + 1]
## if (any(rmvar != 0)) {
## vars <- vars[-rmvar]
## }
## }
## if (!missing(data)) {
## vars <- vars[c(TRUE, !as.character(vars[-1]) %in% colnames(data))]
## dataname <- substitute(data)
## }
## if (!missing(data)) {
## data <- datamat(do.call(datamat, as.list(vars[-1]), envir = parent.frame()),
## data)
## }
## else {
## data <- do.call(datamat, as.list(vars[-1]), envir = parent.frame())
## }
## if (is.null(dim(data)) && length(data) != 0) {
## cn <- as.character(vars)[2]
## }
## else {
## cn <- colnames(data)
## }
## if (is.null(tsp(data))) {
## if ((attr(mt, "response") + 1) %in% fnvar) {
## tspx <- tsp(eval(attr(mt, "variables")[[attr(mt,
## "response") + 1]]))
## }
## tspx <- tsp(data[, 1])
## }
## else {
## tspx <- tsp(data)
## }
## if (is.null(tspx)) {
## stop("Not time series data, use lm()")
## }
## tsdat <- match(c("trend", "season"), cn, 0L)
## if (tsdat[1] == 0) {
## trend <- 1:NROW(data)
## cn <- c(cn, "trend")
## data <- cbind(data, trend)
## }
## if (tsdat[2] == 0) {
## if (tsvar[2] != 0 && tspx[3] <= 1) {
## stop("Non-seasonal data cannot be modelled using a seasonal factor")
## }
## season <- as.factor(cycle(data[, 1]))
## cn <- c(cn, "season")
## data <- cbind(data, season)
## }
## colnames(data) <- cn
## if (!missing(subset)) {
## if (!is.logical(subset)) {
## stop("subset must be logical")
## }
## else if (NCOL(subset) > 1) {
## stop("subset must be a logical vector")
## }
## else if (NROW(subset) != NROW(data)) {
## stop("Subset must be the same length as the number of rows in the dataset")
## }
## warning("Subset has been assumed contiguous")
## timesx <- time(data[, 1])[subset]
## tspx <- recoverTSP(timesx)
## if (tspx[3] == 1 && tsdat[2] == 0 && tsvar[2] != 0) {
## stop("Non-seasonal data cannot be modelled using a seasonal factor")
## }
## data <- data[subset, ]
## }
## if (!is.null(lambda)) {
## resp_var <- deparse(attr(mt, "variables")[[attr(mt, "response") +
## 1]])
## data[, resp_var] <- BoxCox(data[, resp_var], lambda)
## lambda <- attr(data[, resp_var], "lambda")
## }
## if (tsdat[2] == 0 && tsvar[2] != 0) {
## data$season <- factor(data$season)
## }
## fit <- lm(formula, data = data, na.action = na.exclude, ...)
## fit$data <- data
## responsevar <- deparse(formula[[2]])
## fit$residuals <- ts(residuals(fit))
## fit$x <- fit$residuals
## fit$x[!is.na(fit$x)] <- model.frame(fit)[, responsevar]
## fit$fitted.values <- ts(fitted(fit))
## tsp(fit$residuals) <- tsp(fit$x) <- tsp(fit$fitted.values) <- tsp(data[,
## 1]) <- tspx
## fit$call <- cl
## fit$method <- "Linear regression model"
## if (exists("dataname")) {
## fit$call$data <- dataname
## }
## if (!is.null(lambda)) {
## attr(lambda, "biasadj") <- biasadj
## fit$lambda <- lambda
## fit$fitted.values <- InvBoxCox(fit$fitted.values, lambda,
## biasadj, var(fit$residuals))
## fit$x <- InvBoxCox(fit$x, lambda)
## }
## class(fit) <- c("tslm", class(fit))
## return(fit)
## })(formula = train ~ trend + season)
##
## Coefficients:
## (Intercept) trend season2 season3 season4 season5
## 199.15063 0.37726 -0.12726 0.06548 0.30822 0.54096
## season6 season7 season8 season9 season10 season11
## 0.89369 -0.74444 -0.79948 -1.07674 -0.50956 -0.16460
## season12
## 0.36925
##
##
## $train$partition_6$tslm$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jul 2017 241.7912 227.7019 255.8805 220.1249 263.4576
## Aug 2017 242.1135 228.0242 256.2027 220.4471 263.7798
## Sep 2017 242.2135 228.1242 256.3027 220.5471 263.8798
## Oct 2017 243.1579 229.0686 257.2472 221.4916 264.8242
## Nov 2017 243.8801 229.7908 257.9694 222.2138 265.5465
## Dec 2017 244.7912 230.7019 258.8805 223.1249 266.4576
## Jan 2018 244.7992 230.7407 258.8578 223.1802 266.4183
## Feb 2018 245.0492 230.9907 259.1078 223.4302 266.6683
## Mar 2018 245.6192 231.5607 259.6778 224.0002 267.2383
## Apr 2018 246.2392 232.1807 260.2978 224.6202 267.8583
## May 2018 246.8492 232.7907 260.9078 225.2302 268.4683
## Jun 2018 247.5792 233.5207 261.6378 225.9602 269.1983
##
## $train$partition_6$tslm$parameters
## $train$partition_6$tslm$parameters$type
## [1] "train"
##
## $train$partition_6$tslm$parameters$model_id
## [1] "tslm"
##
## $train$partition_6$tslm$parameters$method
## [1] "tslm"
##
## $train$partition_6$tslm$parameters$horizon
## [1] 12
##
## $train$partition_6$tslm$parameters$partition
## [1] "partition_6"
##
##
##
## $train$partition_6$train
## Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
## 2008 200.1 199.5 199.4 198.9 199.0 200.2 198.6 200.0 200.3 201.2 201.6 201.5
## 2009 201.5 203.5 204.9 207.1 210.5 210.5 209.8 208.8 209.5 213.2 213.7 215.1
## 2010 218.7 219.8 220.5 223.8 222.8 223.8 221.7 222.3 220.8 219.4 220.1 220.6
## 2011 218.9 217.8 217.7 215.0 215.3 215.9 216.7 216.7 217.7 218.7 222.9 224.9
## 2012 222.2 220.7 220.0 218.7 217.0 215.9 215.8 214.1 212.3 213.9 214.6 213.6
## 2013 212.1 211.4 213.1 212.9 213.3 211.5 212.3 213.0 211.0 210.7 210.1 211.4
## 2014 210.0 209.7 208.8 208.8 208.8 210.6 211.9 212.8 212.5 214.8 215.3 217.5
## 2015 218.8 220.7 222.2 226.7 228.4 233.2 235.7 237.1 240.6 243.8 245.3 246.0
## 2016 246.3 247.7 247.6 247.8 249.4 249.0 249.9 250.5 251.5 249.0 247.6 248.8
## 2017 250.4 250.7 253.0 253.7 255.0 256.2
##
## $train$partition_6$test
## Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
## 2017 256.0 257.4 260.4 260.0 261.3 260.4
## 2018 261.6 260.8 259.8 259.0 258.9 257.4
##
##
##
## $forecast
## $forecast$ets1
## $forecast$ets1$model
## ETS(M,Ad,N)
##
## Call:
## (function (y, model = "ZZZ", damped = NULL, alpha = NULL, beta = NULL,
##
## Call:
## gamma = NULL, phi = NULL, additive.only = FALSE, lambda = NULL,
##
## Call:
## biasadj = FALSE, lower = c(rep(1e-04, 3), 0.8), upper = c(rep(0.9999,
##
## Call:
## 3), 0.98), opt.crit = c("lik", "amse", "mse", "sigma",
##
## Call:
## "mae"), nmse = 3, bounds = c("both", "usual", "admissible"),
##
## Call:
## ic = c("aicc", "aic", "bic"), restrict = TRUE, allow.multiplicative.trend = FALSE,
##
## Call:
## use.initial.values = FALSE, na.action = c("na.contiguous",
##
## Call:
## "na.interp", "na.fail"), ...)
##
## Call:
## {
##
## Call:
## opt.crit <- match.arg(opt.crit)
##
## Call:
## bounds <- match.arg(bounds)
##
## Call:
## ic <- match.arg(ic)
##
## Call:
## if (!is.function(na.action)) {
##
## Call:
## na.fn_name <- match.arg(na.action)
##
## Call:
## na.action <- get(na.fn_name)
##
## Call:
## }
##
## Call:
## seriesname <- deparse(substitute(y))
##
## Call:
## if (any(class(y) %in% c("data.frame", "list", "matrix", "mts"))) {
##
## Call:
## stop("y should be a univariate time series")
##
## Call:
## }
##
## Call:
## y <- as.ts(y)
##
## Call:
## if (missing(model) && is.constant(y)) {
##
## Call:
## return(ses(y, alpha = 0.99999, initial = "simple")$model)
##
## Call:
## }
##
## Call:
## ny <- length(y)
##
## Call:
## y <- na.action(y)
##
## Call:
## if (ny != length(y) && na.fn_name == "na.contiguous") {
##
## Call:
## warning("Missing values encountered. Using longest contiguous portion of time series")
##
## Call:
## ny <- length(y)
##
## Call:
## }
##
## Call:
## orig.y <- y
##
## Call:
## if (identical(class(model), "ets") && is.null(lambda)) {
##
## Call:
## lambda <- model$lambda
##
## Call:
## }
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## y <- BoxCox(y, lambda)
##
## Call:
## lambda <- attr(y, "lambda")
##
## Call:
## additive.only <- TRUE
##
## Call:
## }
##
## Call:
## if (nmse < 1 || nmse > 30) {
##
## Call:
## stop("nmse out of range")
##
## Call:
## }
##
## Call:
## m <- frequency(y)
##
## Call:
## if (any(upper < lower)) {
##
## Call:
## stop("Lower limits must be less than upper limits")
##
## Call:
## }
##
## Call:
## if (class(model) == "ets") {
##
## Call:
## alpha <- max(model$par["alpha"], 1e-10)
##
## Call:
## beta <- model$par["beta"]
##
## Call:
## if (is.na(beta)) {
##
## Call:
## beta <- NULL
##
## Call:
## }
##
## Call:
## gamma <- model$par["gamma"]
##
## Call:
## if (is.na(gamma)) {
##
## Call:
## gamma <- NULL
##
## Call:
## }
##
## Call:
## phi <- model$par["phi"]
##
## Call:
## if (is.na(phi)) {
##
## Call:
## phi <- NULL
##
## Call:
## }
##
## Call:
## modelcomponents <- paste(model$components[1], model$components[2],
##
## Call:
## model$components[3], sep = "")
##
## Call:
## damped <- (model$components[4] == "TRUE")
##
## Call:
## if (use.initial.values) {
##
## Call:
## errortype <- substr(modelcomponents, 1, 1)
##
## Call:
## trendtype <- substr(modelcomponents, 2, 2)
##
## Call:
## seasontype <- substr(modelcomponents, 3, 3)
##
## Call:
## e <- pegelsresid.C(y, m, model$initstate, errortype,
##
## Call:
## trendtype, seasontype, damped, alpha, beta, gamma,
##
## Call:
## phi, nmse)
##
## Call:
## np <- length(model$par) + 1
##
## Call:
## model$loglik <- -0.5 * e$lik
##
## Call:
## model$aic <- e$lik + 2 * np
##
## Call:
## model$bic <- e$lik + log(ny) * np
##
## Call:
## model$aicc <- model$aic + 2 * np * (np + 1)/(ny -
##
## Call:
## np - 1)
##
## Call:
## model$mse <- e$amse[1]
##
## Call:
## model$amse <- mean(e$amse)
##
## Call:
## tsp.y <- tsp(y)
##
## Call:
## model$states <- ts(e$states, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1] - 1/tsp.y[3])
##
## Call:
## colnames(model$states)[1] <- "l"
##
## Call:
## if (trendtype != "N") {
##
## Call:
## colnames(model$states)[2] <- "b"
##
## Call:
## }
##
## Call:
## if (seasontype != "N") {
##
## Call:
## colnames(model$states)[(2 + (trendtype != "N")):ncol(model$states)] <- paste("s",
##
## Call:
## 1:m, sep = "")
##
## Call:
## }
##
## Call:
## if (errortype == "A") {
##
## Call:
## model$fitted <- ts(y - e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model$fitted <- ts(y/(1 + e$e), frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## model$residuals <- ts(e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## model$series <- seriesname
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda,
##
## Call:
## biasadj, var(model$residuals))
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(model)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model <- modelcomponents
##
## Call:
## if (missing(use.initial.values)) {
##
## Call:
## message("Model is being refit with current smoothing parameters but initial states are being re-estimated.\nSet 'use.initial.values=TRUE' if you want to re-use existing initial values.")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## errortype <- substr(model, 1, 1)
##
## Call:
## trendtype <- substr(model, 2, 2)
##
## Call:
## seasontype <- substr(model, 3, 3)
##
## Call:
## if (!is.element(errortype, c("M", "A", "Z"))) {
##
## Call:
## stop("Invalid error type")
##
## Call:
## }
##
## Call:
## if (!is.element(trendtype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid trend type")
##
## Call:
## }
##
## Call:
## if (!is.element(seasontype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid season type")
##
## Call:
## }
##
## Call:
## if (m < 1 || length(y) <= m) {
##
## Call:
## seasontype <- "N"
##
## Call:
## }
##
## Call:
## if (m == 1) {
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## stop("Nonseasonal data")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (m > 24) {
##
## Call:
## if (is.element(seasontype, c("A", "M"))) {
##
## Call:
## stop("Frequency too high")
##
## Call:
## }
##
## Call:
## else if (seasontype == "Z") {
##
## Call:
## warning("I can't handle data with frequency greater than 24. Seasonality will be ignored. Try stlf() if you need seasonal forecasts.")
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if ((errortype == "A" && (trendtype == "M" || seasontype ==
##
## Call:
## "M")) | (errortype == "M" && trendtype == "M" &&
##
## Call:
## seasontype == "A") || (additive.only && (errortype ==
##
## Call:
## "M" || trendtype == "M" || seasontype == "M"))) {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## data.positive <- (min(y) > 0)
##
## Call:
## if (!data.positive && errortype == "M") {
##
## Call:
## stop("Inappropriate model for data with negative or zero values")
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped && trendtype == "N") {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## n <- length(y)
##
## Call:
## npars <- 2L
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## npars <- npars + 2L
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## npars <- npars + m
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## npars <- npars + as.numeric(damped)
##
## Call:
## }
##
## Call:
## if (n <= npars + 4L) {
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped) {
##
## Call:
## warning("Not enough data to use damping")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = gamma, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), seasonal = ifelse(seasontype != "A",
##
## Call:
## "multiplicative", "additive"), lambda = lambda,
##
## Call:
## biasadj = biasadj, warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Seasonal component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Trend component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "N" && seasontype == "N") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, lambda = lambda, biasadj = biasadj,
##
## Call:
## warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## }
##
## Call:
## fit1 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## fit2 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if ("try-error" %in% class(fit1)) {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## else if (fit1$sigma2 < fit2$sigma2) {
##
## Call:
## fit <- fit1
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## if ("try-error" %in% class(fit))
##
## Call:
## stop("Unable to estimate a model.")
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## if (errortype == "Z") {
##
## Call:
## errortype <- c("A", "M")
##
## Call:
## }
##
## Call:
## if (trendtype == "Z") {
##
## Call:
## if (allow.multiplicative.trend) {
##
## Call:
## trendtype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## trendtype <- c("N", "A")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "Z") {
##
## Call:
## seasontype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## if (is.null(damped)) {
##
## Call:
## damped <- c(TRUE, FALSE)
##
## Call:
## }
##
## Call:
## best.ic <- Inf
##
## Call:
## for (i in 1:length(errortype)) {
##
## Call:
## for (j in 1:length(trendtype)) {
##
## Call:
## for (k in 1:length(seasontype)) {
##
## Call:
## for (l in 1:length(damped)) {
##
## Call:
## if (trendtype[j] == "N" && damped[l]) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if (errortype[i] == "A" && (trendtype[j] ==
##
## Call:
## "M" || seasontype[k] == "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (errortype[i] == "M" && trendtype[j] ==
##
## Call:
## "M" && seasontype[k] == "A") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (additive.only && (errortype[i] == "M" ||
##
## Call:
## trendtype[j] == "M" || seasontype[k] ==
##
## Call:
## "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (!data.positive && errortype[i] == "M") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## fit <- try(etsmodel(y, errortype[i], trendtype[j],
##
## Call:
## seasontype[k], damped[l], alpha, beta, gamma,
##
## Call:
## phi, lower = lower, upper = upper, opt.crit = opt.crit,
##
## Call:
## nmse = nmse, bounds = bounds, ...), silent = TRUE)
##
## Call:
## if (is.element("try-error", class(fit)))
##
## Call:
## fit.ic <- Inf
##
## Call:
## else fit.ic <- switch(ic, aic = fit$aic, bic = fit$bic,
##
## Call:
## aicc = fit$aicc)
##
## Call:
## if (!is.na(fit.ic)) {
##
## Call:
## if (fit.ic < best.ic) {
##
## Call:
## model <- fit
##
## Call:
## best.ic <- fit.ic
##
## Call:
## best.e <- errortype[i]
##
## Call:
## best.t <- trendtype[j]
##
## Call:
## best.s <- seasontype[k]
##
## Call:
## best.d <- damped[l]
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (best.ic == Inf) {
##
## Call:
## stop("No model able to be fitted")
##
## Call:
## }
##
## Call:
## model$m <- m
##
## Call:
## model$method <- paste("ETS(", best.e, ",", best.t, ifelse(best.d,
##
## Call:
## "d", ""), ",", best.s, ")", sep = "")
##
## Call:
## model$series <- seriesname
##
## Call:
## model$components <- c(best.e, best.t, best.s, best.d)
##
## Call:
## model$call <- match.call()
##
## Call:
## model$initstate <- model$states[1, ]
##
## Call:
## np <- length(model$par)
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda, biasadj,
##
## Call:
## model$sigma2)
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(structure(model, class = "ets"))
##
## Call:
## })(y = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6,
##
## Call:
## 200, 200.3, 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1,
##
## Call:
## 210.5, 210.5, 209.8, 208.8, 209.5, 213.2, 213.7, 215.1, 218.7,
##
## Call:
## 219.8, 220.5, 223.8, 222.8, 223.8, 221.7, 222.3, 220.8, 219.4,
##
## Call:
## 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7,
##
## Call:
## 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7,
##
## Call:
## 217, 215.9, 215.8, 214.1, 212.3, 213.9, 214.6, 213.6, 212.1,
##
## Call:
## 211.4, 213.1, 212.9, 213.3, 211.5, 212.3, 213, 211, 210.7, 210.1,
##
## Call:
## 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6, 211.9, 212.8,
##
## Call:
## 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4,
##
## Call:
## 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7,
##
## Call:
## 247.6), .Tsp = c(2008, 2016.16666666667, 12), class = "ts"),
##
## Call:
## opt.crit = "lik")
##
## Smoothing parameters:
## alpha = 0.9679
## beta = 0.3025
## phi = 0.892
##
## Initial states:
## l = 200.4285
## b = -0.3917
##
## sigma: 0.0068
##
## AIC AICc BIC
## 537.1874 538.1004 552.7581
##
## $forecast$ets1$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Apr 2016 248.1715 246.0142 250.3288 244.8722 251.4709
## May 2016 248.6530 245.2176 252.0883 243.3991 253.9068
## Jun 2016 249.0824 244.3902 253.7746 241.9063 256.2585
## Jul 2016 249.4655 243.5126 255.4183 240.3614 258.5695
## Aug 2016 249.8071 242.5899 257.0243 238.7694 260.8448
## Sep 2016 250.1119 241.6311 258.5927 237.1416 263.0821
## Oct 2016 250.3837 240.6450 260.1224 235.4896 265.2778
## Nov 2016 250.6262 239.6395 261.6128 233.8236 267.4288
## Dec 2016 250.8424 238.6214 263.0635 232.1520 269.5329
## Jan 2017 251.0353 237.5961 264.4745 230.4818 271.5888
## Feb 2017 251.2074 236.5683 265.8465 228.8188 273.5960
## Mar 2017 251.3609 235.5417 267.1801 227.1675 275.5542
##
## $forecast$ets1$parameters
## $forecast$ets1$parameters$type
## [1] "train"
##
## $forecast$ets1$parameters$model_id
## [1] "ets1"
##
## $forecast$ets1$parameters$method
## [1] "ets"
##
## $forecast$ets1$parameters$horizon
## [1] 12
##
## $forecast$ets1$parameters$partition
## [1] "partition_1"
##
##
##
## $forecast$ets1
## $forecast$ets1$model
## ETS(M,Ad,N)
##
## Call:
## (function (y, model = "ZZZ", damped = NULL, alpha = NULL, beta = NULL,
##
## Call:
## gamma = NULL, phi = NULL, additive.only = FALSE, lambda = NULL,
##
## Call:
## biasadj = FALSE, lower = c(rep(1e-04, 3), 0.8), upper = c(rep(0.9999,
##
## Call:
## 3), 0.98), opt.crit = c("lik", "amse", "mse", "sigma",
##
## Call:
## "mae"), nmse = 3, bounds = c("both", "usual", "admissible"),
##
## Call:
## ic = c("aicc", "aic", "bic"), restrict = TRUE, allow.multiplicative.trend = FALSE,
##
## Call:
## use.initial.values = FALSE, na.action = c("na.contiguous",
##
## Call:
## "na.interp", "na.fail"), ...)
##
## Call:
## {
##
## Call:
## opt.crit <- match.arg(opt.crit)
##
## Call:
## bounds <- match.arg(bounds)
##
## Call:
## ic <- match.arg(ic)
##
## Call:
## if (!is.function(na.action)) {
##
## Call:
## na.fn_name <- match.arg(na.action)
##
## Call:
## na.action <- get(na.fn_name)
##
## Call:
## }
##
## Call:
## seriesname <- deparse(substitute(y))
##
## Call:
## if (any(class(y) %in% c("data.frame", "list", "matrix", "mts"))) {
##
## Call:
## stop("y should be a univariate time series")
##
## Call:
## }
##
## Call:
## y <- as.ts(y)
##
## Call:
## if (missing(model) && is.constant(y)) {
##
## Call:
## return(ses(y, alpha = 0.99999, initial = "simple")$model)
##
## Call:
## }
##
## Call:
## ny <- length(y)
##
## Call:
## y <- na.action(y)
##
## Call:
## if (ny != length(y) && na.fn_name == "na.contiguous") {
##
## Call:
## warning("Missing values encountered. Using longest contiguous portion of time series")
##
## Call:
## ny <- length(y)
##
## Call:
## }
##
## Call:
## orig.y <- y
##
## Call:
## if (identical(class(model), "ets") && is.null(lambda)) {
##
## Call:
## lambda <- model$lambda
##
## Call:
## }
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## y <- BoxCox(y, lambda)
##
## Call:
## lambda <- attr(y, "lambda")
##
## Call:
## additive.only <- TRUE
##
## Call:
## }
##
## Call:
## if (nmse < 1 || nmse > 30) {
##
## Call:
## stop("nmse out of range")
##
## Call:
## }
##
## Call:
## m <- frequency(y)
##
## Call:
## if (any(upper < lower)) {
##
## Call:
## stop("Lower limits must be less than upper limits")
##
## Call:
## }
##
## Call:
## if (class(model) == "ets") {
##
## Call:
## alpha <- max(model$par["alpha"], 1e-10)
##
## Call:
## beta <- model$par["beta"]
##
## Call:
## if (is.na(beta)) {
##
## Call:
## beta <- NULL
##
## Call:
## }
##
## Call:
## gamma <- model$par["gamma"]
##
## Call:
## if (is.na(gamma)) {
##
## Call:
## gamma <- NULL
##
## Call:
## }
##
## Call:
## phi <- model$par["phi"]
##
## Call:
## if (is.na(phi)) {
##
## Call:
## phi <- NULL
##
## Call:
## }
##
## Call:
## modelcomponents <- paste(model$components[1], model$components[2],
##
## Call:
## model$components[3], sep = "")
##
## Call:
## damped <- (model$components[4] == "TRUE")
##
## Call:
## if (use.initial.values) {
##
## Call:
## errortype <- substr(modelcomponents, 1, 1)
##
## Call:
## trendtype <- substr(modelcomponents, 2, 2)
##
## Call:
## seasontype <- substr(modelcomponents, 3, 3)
##
## Call:
## e <- pegelsresid.C(y, m, model$initstate, errortype,
##
## Call:
## trendtype, seasontype, damped, alpha, beta, gamma,
##
## Call:
## phi, nmse)
##
## Call:
## np <- length(model$par) + 1
##
## Call:
## model$loglik <- -0.5 * e$lik
##
## Call:
## model$aic <- e$lik + 2 * np
##
## Call:
## model$bic <- e$lik + log(ny) * np
##
## Call:
## model$aicc <- model$aic + 2 * np * (np + 1)/(ny -
##
## Call:
## np - 1)
##
## Call:
## model$mse <- e$amse[1]
##
## Call:
## model$amse <- mean(e$amse)
##
## Call:
## tsp.y <- tsp(y)
##
## Call:
## model$states <- ts(e$states, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1] - 1/tsp.y[3])
##
## Call:
## colnames(model$states)[1] <- "l"
##
## Call:
## if (trendtype != "N") {
##
## Call:
## colnames(model$states)[2] <- "b"
##
## Call:
## }
##
## Call:
## if (seasontype != "N") {
##
## Call:
## colnames(model$states)[(2 + (trendtype != "N")):ncol(model$states)] <- paste("s",
##
## Call:
## 1:m, sep = "")
##
## Call:
## }
##
## Call:
## if (errortype == "A") {
##
## Call:
## model$fitted <- ts(y - e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model$fitted <- ts(y/(1 + e$e), frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## model$residuals <- ts(e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## model$series <- seriesname
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda,
##
## Call:
## biasadj, var(model$residuals))
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(model)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model <- modelcomponents
##
## Call:
## if (missing(use.initial.values)) {
##
## Call:
## message("Model is being refit with current smoothing parameters but initial states are being re-estimated.\nSet 'use.initial.values=TRUE' if you want to re-use existing initial values.")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## errortype <- substr(model, 1, 1)
##
## Call:
## trendtype <- substr(model, 2, 2)
##
## Call:
## seasontype <- substr(model, 3, 3)
##
## Call:
## if (!is.element(errortype, c("M", "A", "Z"))) {
##
## Call:
## stop("Invalid error type")
##
## Call:
## }
##
## Call:
## if (!is.element(trendtype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid trend type")
##
## Call:
## }
##
## Call:
## if (!is.element(seasontype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid season type")
##
## Call:
## }
##
## Call:
## if (m < 1 || length(y) <= m) {
##
## Call:
## seasontype <- "N"
##
## Call:
## }
##
## Call:
## if (m == 1) {
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## stop("Nonseasonal data")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (m > 24) {
##
## Call:
## if (is.element(seasontype, c("A", "M"))) {
##
## Call:
## stop("Frequency too high")
##
## Call:
## }
##
## Call:
## else if (seasontype == "Z") {
##
## Call:
## warning("I can't handle data with frequency greater than 24. Seasonality will be ignored. Try stlf() if you need seasonal forecasts.")
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if ((errortype == "A" && (trendtype == "M" || seasontype ==
##
## Call:
## "M")) | (errortype == "M" && trendtype == "M" &&
##
## Call:
## seasontype == "A") || (additive.only && (errortype ==
##
## Call:
## "M" || trendtype == "M" || seasontype == "M"))) {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## data.positive <- (min(y) > 0)
##
## Call:
## if (!data.positive && errortype == "M") {
##
## Call:
## stop("Inappropriate model for data with negative or zero values")
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped && trendtype == "N") {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## n <- length(y)
##
## Call:
## npars <- 2L
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## npars <- npars + 2L
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## npars <- npars + m
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## npars <- npars + as.numeric(damped)
##
## Call:
## }
##
## Call:
## if (n <= npars + 4L) {
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped) {
##
## Call:
## warning("Not enough data to use damping")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = gamma, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), seasonal = ifelse(seasontype != "A",
##
## Call:
## "multiplicative", "additive"), lambda = lambda,
##
## Call:
## biasadj = biasadj, warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Seasonal component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Trend component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "N" && seasontype == "N") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, lambda = lambda, biasadj = biasadj,
##
## Call:
## warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## }
##
## Call:
## fit1 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## fit2 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if ("try-error" %in% class(fit1)) {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## else if (fit1$sigma2 < fit2$sigma2) {
##
## Call:
## fit <- fit1
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## if ("try-error" %in% class(fit))
##
## Call:
## stop("Unable to estimate a model.")
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## if (errortype == "Z") {
##
## Call:
## errortype <- c("A", "M")
##
## Call:
## }
##
## Call:
## if (trendtype == "Z") {
##
## Call:
## if (allow.multiplicative.trend) {
##
## Call:
## trendtype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## trendtype <- c("N", "A")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "Z") {
##
## Call:
## seasontype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## if (is.null(damped)) {
##
## Call:
## damped <- c(TRUE, FALSE)
##
## Call:
## }
##
## Call:
## best.ic <- Inf
##
## Call:
## for (i in 1:length(errortype)) {
##
## Call:
## for (j in 1:length(trendtype)) {
##
## Call:
## for (k in 1:length(seasontype)) {
##
## Call:
## for (l in 1:length(damped)) {
##
## Call:
## if (trendtype[j] == "N" && damped[l]) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if (errortype[i] == "A" && (trendtype[j] ==
##
## Call:
## "M" || seasontype[k] == "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (errortype[i] == "M" && trendtype[j] ==
##
## Call:
## "M" && seasontype[k] == "A") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (additive.only && (errortype[i] == "M" ||
##
## Call:
## trendtype[j] == "M" || seasontype[k] ==
##
## Call:
## "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (!data.positive && errortype[i] == "M") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## fit <- try(etsmodel(y, errortype[i], trendtype[j],
##
## Call:
## seasontype[k], damped[l], alpha, beta, gamma,
##
## Call:
## phi, lower = lower, upper = upper, opt.crit = opt.crit,
##
## Call:
## nmse = nmse, bounds = bounds, ...), silent = TRUE)
##
## Call:
## if (is.element("try-error", class(fit)))
##
## Call:
## fit.ic <- Inf
##
## Call:
## else fit.ic <- switch(ic, aic = fit$aic, bic = fit$bic,
##
## Call:
## aicc = fit$aicc)
##
## Call:
## if (!is.na(fit.ic)) {
##
## Call:
## if (fit.ic < best.ic) {
##
## Call:
## model <- fit
##
## Call:
## best.ic <- fit.ic
##
## Call:
## best.e <- errortype[i]
##
## Call:
## best.t <- trendtype[j]
##
## Call:
## best.s <- seasontype[k]
##
## Call:
## best.d <- damped[l]
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (best.ic == Inf) {
##
## Call:
## stop("No model able to be fitted")
##
## Call:
## }
##
## Call:
## model$m <- m
##
## Call:
## model$method <- paste("ETS(", best.e, ",", best.t, ifelse(best.d,
##
## Call:
## "d", ""), ",", best.s, ")", sep = "")
##
## Call:
## model$series <- seriesname
##
## Call:
## model$components <- c(best.e, best.t, best.s, best.d)
##
## Call:
## model$call <- match.call()
##
## Call:
## model$initstate <- model$states[1, ]
##
## Call:
## np <- length(model$par)
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda, biasadj,
##
## Call:
## model$sigma2)
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(structure(model, class = "ets"))
##
## Call:
## })(y = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6,
##
## Call:
## 200, 200.3, 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1,
##
## Call:
## 210.5, 210.5, 209.8, 208.8, 209.5, 213.2, 213.7, 215.1, 218.7,
##
## Call:
## 219.8, 220.5, 223.8, 222.8, 223.8, 221.7, 222.3, 220.8, 219.4,
##
## Call:
## 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7,
##
## Call:
## 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7,
##
## Call:
## 217, 215.9, 215.8, 214.1, 212.3, 213.9, 214.6, 213.6, 212.1,
##
## Call:
## 211.4, 213.1, 212.9, 213.3, 211.5, 212.3, 213, 211, 210.7, 210.1,
##
## Call:
## 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6, 211.9, 212.8,
##
## Call:
## 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4,
##
## Call:
## 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7,
##
## Call:
## 247.6, 247.8, 249.4, 249), .Tsp = c(2008, 2016.41666666667, 12
##
## Call:
## ), class = "ts"), opt.crit = "lik")
##
## Smoothing parameters:
## alpha = 0.9639
## beta = 0.301
## phi = 0.8916
##
## Initial states:
## l = 200.4239
## b = -0.3952
##
## sigma: 0.0067
##
## AIC AICc BIC
## 554.9579 555.8421 570.7077
##
## $forecast$ets1$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jul 2016 249.3543 247.2100 251.4986 246.0748 252.6338
## Aug 2016 249.6374 246.2329 253.0418 244.4307 254.8441
## Sep 2016 249.8897 245.2451 254.5343 242.7864 256.9930
## Oct 2016 250.1147 244.2265 256.0028 241.1095 259.1198
## Nov 2016 250.3153 243.1804 257.4502 239.4034 261.2272
## Dec 2016 250.4941 242.1137 258.8745 237.6774 263.3108
## Jan 2017 250.6536 241.0339 260.2732 235.9416 265.3655
## Feb 2017 250.7957 239.9473 261.6441 234.2045 267.3869
## Mar 2017 250.9224 238.8592 262.9857 232.4732 269.3717
## Apr 2017 251.0354 237.7738 264.2971 230.7536 271.3173
## May 2017 251.1362 236.6948 265.5776 229.0500 273.2224
## Jun 2017 251.2260 235.6248 266.8272 227.3660 275.0860
##
## $forecast$ets1$parameters
## $forecast$ets1$parameters$type
## [1] "train"
##
## $forecast$ets1$parameters$model_id
## [1] "ets1"
##
## $forecast$ets1$parameters$method
## [1] "ets"
##
## $forecast$ets1$parameters$horizon
## [1] 12
##
## $forecast$ets1$parameters$partition
## [1] "partition_2"
##
##
##
## $forecast$ets1
## $forecast$ets1$model
## ETS(A,Ad,N)
##
## Call:
## (function (y, model = "ZZZ", damped = NULL, alpha = NULL, beta = NULL,
##
## Call:
## gamma = NULL, phi = NULL, additive.only = FALSE, lambda = NULL,
##
## Call:
## biasadj = FALSE, lower = c(rep(1e-04, 3), 0.8), upper = c(rep(0.9999,
##
## Call:
## 3), 0.98), opt.crit = c("lik", "amse", "mse", "sigma",
##
## Call:
## "mae"), nmse = 3, bounds = c("both", "usual", "admissible"),
##
## Call:
## ic = c("aicc", "aic", "bic"), restrict = TRUE, allow.multiplicative.trend = FALSE,
##
## Call:
## use.initial.values = FALSE, na.action = c("na.contiguous",
##
## Call:
## "na.interp", "na.fail"), ...)
##
## Call:
## {
##
## Call:
## opt.crit <- match.arg(opt.crit)
##
## Call:
## bounds <- match.arg(bounds)
##
## Call:
## ic <- match.arg(ic)
##
## Call:
## if (!is.function(na.action)) {
##
## Call:
## na.fn_name <- match.arg(na.action)
##
## Call:
## na.action <- get(na.fn_name)
##
## Call:
## }
##
## Call:
## seriesname <- deparse(substitute(y))
##
## Call:
## if (any(class(y) %in% c("data.frame", "list", "matrix", "mts"))) {
##
## Call:
## stop("y should be a univariate time series")
##
## Call:
## }
##
## Call:
## y <- as.ts(y)
##
## Call:
## if (missing(model) && is.constant(y)) {
##
## Call:
## return(ses(y, alpha = 0.99999, initial = "simple")$model)
##
## Call:
## }
##
## Call:
## ny <- length(y)
##
## Call:
## y <- na.action(y)
##
## Call:
## if (ny != length(y) && na.fn_name == "na.contiguous") {
##
## Call:
## warning("Missing values encountered. Using longest contiguous portion of time series")
##
## Call:
## ny <- length(y)
##
## Call:
## }
##
## Call:
## orig.y <- y
##
## Call:
## if (identical(class(model), "ets") && is.null(lambda)) {
##
## Call:
## lambda <- model$lambda
##
## Call:
## }
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## y <- BoxCox(y, lambda)
##
## Call:
## lambda <- attr(y, "lambda")
##
## Call:
## additive.only <- TRUE
##
## Call:
## }
##
## Call:
## if (nmse < 1 || nmse > 30) {
##
## Call:
## stop("nmse out of range")
##
## Call:
## }
##
## Call:
## m <- frequency(y)
##
## Call:
## if (any(upper < lower)) {
##
## Call:
## stop("Lower limits must be less than upper limits")
##
## Call:
## }
##
## Call:
## if (class(model) == "ets") {
##
## Call:
## alpha <- max(model$par["alpha"], 1e-10)
##
## Call:
## beta <- model$par["beta"]
##
## Call:
## if (is.na(beta)) {
##
## Call:
## beta <- NULL
##
## Call:
## }
##
## Call:
## gamma <- model$par["gamma"]
##
## Call:
## if (is.na(gamma)) {
##
## Call:
## gamma <- NULL
##
## Call:
## }
##
## Call:
## phi <- model$par["phi"]
##
## Call:
## if (is.na(phi)) {
##
## Call:
## phi <- NULL
##
## Call:
## }
##
## Call:
## modelcomponents <- paste(model$components[1], model$components[2],
##
## Call:
## model$components[3], sep = "")
##
## Call:
## damped <- (model$components[4] == "TRUE")
##
## Call:
## if (use.initial.values) {
##
## Call:
## errortype <- substr(modelcomponents, 1, 1)
##
## Call:
## trendtype <- substr(modelcomponents, 2, 2)
##
## Call:
## seasontype <- substr(modelcomponents, 3, 3)
##
## Call:
## e <- pegelsresid.C(y, m, model$initstate, errortype,
##
## Call:
## trendtype, seasontype, damped, alpha, beta, gamma,
##
## Call:
## phi, nmse)
##
## Call:
## np <- length(model$par) + 1
##
## Call:
## model$loglik <- -0.5 * e$lik
##
## Call:
## model$aic <- e$lik + 2 * np
##
## Call:
## model$bic <- e$lik + log(ny) * np
##
## Call:
## model$aicc <- model$aic + 2 * np * (np + 1)/(ny -
##
## Call:
## np - 1)
##
## Call:
## model$mse <- e$amse[1]
##
## Call:
## model$amse <- mean(e$amse)
##
## Call:
## tsp.y <- tsp(y)
##
## Call:
## model$states <- ts(e$states, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1] - 1/tsp.y[3])
##
## Call:
## colnames(model$states)[1] <- "l"
##
## Call:
## if (trendtype != "N") {
##
## Call:
## colnames(model$states)[2] <- "b"
##
## Call:
## }
##
## Call:
## if (seasontype != "N") {
##
## Call:
## colnames(model$states)[(2 + (trendtype != "N")):ncol(model$states)] <- paste("s",
##
## Call:
## 1:m, sep = "")
##
## Call:
## }
##
## Call:
## if (errortype == "A") {
##
## Call:
## model$fitted <- ts(y - e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model$fitted <- ts(y/(1 + e$e), frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## model$residuals <- ts(e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## model$series <- seriesname
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda,
##
## Call:
## biasadj, var(model$residuals))
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(model)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model <- modelcomponents
##
## Call:
## if (missing(use.initial.values)) {
##
## Call:
## message("Model is being refit with current smoothing parameters but initial states are being re-estimated.\nSet 'use.initial.values=TRUE' if you want to re-use existing initial values.")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## errortype <- substr(model, 1, 1)
##
## Call:
## trendtype <- substr(model, 2, 2)
##
## Call:
## seasontype <- substr(model, 3, 3)
##
## Call:
## if (!is.element(errortype, c("M", "A", "Z"))) {
##
## Call:
## stop("Invalid error type")
##
## Call:
## }
##
## Call:
## if (!is.element(trendtype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid trend type")
##
## Call:
## }
##
## Call:
## if (!is.element(seasontype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid season type")
##
## Call:
## }
##
## Call:
## if (m < 1 || length(y) <= m) {
##
## Call:
## seasontype <- "N"
##
## Call:
## }
##
## Call:
## if (m == 1) {
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## stop("Nonseasonal data")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (m > 24) {
##
## Call:
## if (is.element(seasontype, c("A", "M"))) {
##
## Call:
## stop("Frequency too high")
##
## Call:
## }
##
## Call:
## else if (seasontype == "Z") {
##
## Call:
## warning("I can't handle data with frequency greater than 24. Seasonality will be ignored. Try stlf() if you need seasonal forecasts.")
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if ((errortype == "A" && (trendtype == "M" || seasontype ==
##
## Call:
## "M")) | (errortype == "M" && trendtype == "M" &&
##
## Call:
## seasontype == "A") || (additive.only && (errortype ==
##
## Call:
## "M" || trendtype == "M" || seasontype == "M"))) {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## data.positive <- (min(y) > 0)
##
## Call:
## if (!data.positive && errortype == "M") {
##
## Call:
## stop("Inappropriate model for data with negative or zero values")
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped && trendtype == "N") {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## n <- length(y)
##
## Call:
## npars <- 2L
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## npars <- npars + 2L
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## npars <- npars + m
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## npars <- npars + as.numeric(damped)
##
## Call:
## }
##
## Call:
## if (n <= npars + 4L) {
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped) {
##
## Call:
## warning("Not enough data to use damping")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = gamma, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), seasonal = ifelse(seasontype != "A",
##
## Call:
## "multiplicative", "additive"), lambda = lambda,
##
## Call:
## biasadj = biasadj, warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Seasonal component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Trend component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "N" && seasontype == "N") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, lambda = lambda, biasadj = biasadj,
##
## Call:
## warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## }
##
## Call:
## fit1 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## fit2 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if ("try-error" %in% class(fit1)) {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## else if (fit1$sigma2 < fit2$sigma2) {
##
## Call:
## fit <- fit1
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## if ("try-error" %in% class(fit))
##
## Call:
## stop("Unable to estimate a model.")
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## if (errortype == "Z") {
##
## Call:
## errortype <- c("A", "M")
##
## Call:
## }
##
## Call:
## if (trendtype == "Z") {
##
## Call:
## if (allow.multiplicative.trend) {
##
## Call:
## trendtype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## trendtype <- c("N", "A")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "Z") {
##
## Call:
## seasontype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## if (is.null(damped)) {
##
## Call:
## damped <- c(TRUE, FALSE)
##
## Call:
## }
##
## Call:
## best.ic <- Inf
##
## Call:
## for (i in 1:length(errortype)) {
##
## Call:
## for (j in 1:length(trendtype)) {
##
## Call:
## for (k in 1:length(seasontype)) {
##
## Call:
## for (l in 1:length(damped)) {
##
## Call:
## if (trendtype[j] == "N" && damped[l]) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if (errortype[i] == "A" && (trendtype[j] ==
##
## Call:
## "M" || seasontype[k] == "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (errortype[i] == "M" && trendtype[j] ==
##
## Call:
## "M" && seasontype[k] == "A") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (additive.only && (errortype[i] == "M" ||
##
## Call:
## trendtype[j] == "M" || seasontype[k] ==
##
## Call:
## "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (!data.positive && errortype[i] == "M") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## fit <- try(etsmodel(y, errortype[i], trendtype[j],
##
## Call:
## seasontype[k], damped[l], alpha, beta, gamma,
##
## Call:
## phi, lower = lower, upper = upper, opt.crit = opt.crit,
##
## Call:
## nmse = nmse, bounds = bounds, ...), silent = TRUE)
##
## Call:
## if (is.element("try-error", class(fit)))
##
## Call:
## fit.ic <- Inf
##
## Call:
## else fit.ic <- switch(ic, aic = fit$aic, bic = fit$bic,
##
## Call:
## aicc = fit$aicc)
##
## Call:
## if (!is.na(fit.ic)) {
##
## Call:
## if (fit.ic < best.ic) {
##
## Call:
## model <- fit
##
## Call:
## best.ic <- fit.ic
##
## Call:
## best.e <- errortype[i]
##
## Call:
## best.t <- trendtype[j]
##
## Call:
## best.s <- seasontype[k]
##
## Call:
## best.d <- damped[l]
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (best.ic == Inf) {
##
## Call:
## stop("No model able to be fitted")
##
## Call:
## }
##
## Call:
## model$m <- m
##
## Call:
## model$method <- paste("ETS(", best.e, ",", best.t, ifelse(best.d,
##
## Call:
## "d", ""), ",", best.s, ")", sep = "")
##
## Call:
## model$series <- seriesname
##
## Call:
## model$components <- c(best.e, best.t, best.s, best.d)
##
## Call:
## model$call <- match.call()
##
## Call:
## model$initstate <- model$states[1, ]
##
## Call:
## np <- length(model$par)
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda, biasadj,
##
## Call:
## model$sigma2)
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(structure(model, class = "ets"))
##
## Call:
## })(y = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6,
##
## Call:
## 200, 200.3, 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1,
##
## Call:
## 210.5, 210.5, 209.8, 208.8, 209.5, 213.2, 213.7, 215.1, 218.7,
##
## Call:
## 219.8, 220.5, 223.8, 222.8, 223.8, 221.7, 222.3, 220.8, 219.4,
##
## Call:
## 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7,
##
## Call:
## 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7,
##
## Call:
## 217, 215.9, 215.8, 214.1, 212.3, 213.9, 214.6, 213.6, 212.1,
##
## Call:
## 211.4, 213.1, 212.9, 213.3, 211.5, 212.3, 213, 211, 210.7, 210.1,
##
## Call:
## 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6, 211.9, 212.8,
##
## Call:
## 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4,
##
## Call:
## 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7,
##
## Call:
## 247.6, 247.8, 249.4, 249, 249.9, 250.5, 251.5), .Tsp = c(2008,
##
## Call:
## 2016.66666666667, 12), class = "ts"), opt.crit = "lik")
##
## Smoothing parameters:
## alpha = 0.9606
## beta = 0.3027
## phi = 0.8931
##
## Initial states:
## l = 200.4219
## b = -0.3783
##
## sigma: 1.4394
##
## AIC AICc BIC
## 572.0348 572.8919 587.9585
##
## $forecast$ets1$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Oct 2016 252.0217 250.1770 253.8664 249.2005 254.8429
## Nov 2016 252.5077 249.5821 255.4333 248.0334 256.9820
## Dec 2016 252.9417 248.9497 256.9337 246.8364 259.0469
## Jan 2017 253.3293 248.2665 258.3921 245.5864 261.0721
## Feb 2017 253.6754 247.5382 259.8126 244.2894 263.0615
## Mar 2017 253.9846 246.7734 261.1957 242.9561 265.0130
## Apr 2017 254.2606 245.9805 262.5408 241.5973 266.9240
## May 2017 254.5072 245.1667 263.8476 240.2222 268.7922
## Jun 2017 254.7274 244.3384 265.1164 238.8388 270.6160
## Jul 2017 254.9240 243.5006 266.3474 237.4534 272.3947
## Aug 2017 255.0996 242.6576 267.5416 236.0712 274.1280
## Sep 2017 255.2564 241.8131 268.6998 234.6966 275.8163
##
## $forecast$ets1$parameters
## $forecast$ets1$parameters$type
## [1] "train"
##
## $forecast$ets1$parameters$model_id
## [1] "ets1"
##
## $forecast$ets1$parameters$method
## [1] "ets"
##
## $forecast$ets1$parameters$horizon
## [1] 12
##
## $forecast$ets1$parameters$partition
## [1] "partition_3"
##
##
##
## $forecast$ets1
## $forecast$ets1$model
## ETS(M,Ad,N)
##
## Call:
## (function (y, model = "ZZZ", damped = NULL, alpha = NULL, beta = NULL,
##
## Call:
## gamma = NULL, phi = NULL, additive.only = FALSE, lambda = NULL,
##
## Call:
## biasadj = FALSE, lower = c(rep(1e-04, 3), 0.8), upper = c(rep(0.9999,
##
## Call:
## 3), 0.98), opt.crit = c("lik", "amse", "mse", "sigma",
##
## Call:
## "mae"), nmse = 3, bounds = c("both", "usual", "admissible"),
##
## Call:
## ic = c("aicc", "aic", "bic"), restrict = TRUE, allow.multiplicative.trend = FALSE,
##
## Call:
## use.initial.values = FALSE, na.action = c("na.contiguous",
##
## Call:
## "na.interp", "na.fail"), ...)
##
## Call:
## {
##
## Call:
## opt.crit <- match.arg(opt.crit)
##
## Call:
## bounds <- match.arg(bounds)
##
## Call:
## ic <- match.arg(ic)
##
## Call:
## if (!is.function(na.action)) {
##
## Call:
## na.fn_name <- match.arg(na.action)
##
## Call:
## na.action <- get(na.fn_name)
##
## Call:
## }
##
## Call:
## seriesname <- deparse(substitute(y))
##
## Call:
## if (any(class(y) %in% c("data.frame", "list", "matrix", "mts"))) {
##
## Call:
## stop("y should be a univariate time series")
##
## Call:
## }
##
## Call:
## y <- as.ts(y)
##
## Call:
## if (missing(model) && is.constant(y)) {
##
## Call:
## return(ses(y, alpha = 0.99999, initial = "simple")$model)
##
## Call:
## }
##
## Call:
## ny <- length(y)
##
## Call:
## y <- na.action(y)
##
## Call:
## if (ny != length(y) && na.fn_name == "na.contiguous") {
##
## Call:
## warning("Missing values encountered. Using longest contiguous portion of time series")
##
## Call:
## ny <- length(y)
##
## Call:
## }
##
## Call:
## orig.y <- y
##
## Call:
## if (identical(class(model), "ets") && is.null(lambda)) {
##
## Call:
## lambda <- model$lambda
##
## Call:
## }
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## y <- BoxCox(y, lambda)
##
## Call:
## lambda <- attr(y, "lambda")
##
## Call:
## additive.only <- TRUE
##
## Call:
## }
##
## Call:
## if (nmse < 1 || nmse > 30) {
##
## Call:
## stop("nmse out of range")
##
## Call:
## }
##
## Call:
## m <- frequency(y)
##
## Call:
## if (any(upper < lower)) {
##
## Call:
## stop("Lower limits must be less than upper limits")
##
## Call:
## }
##
## Call:
## if (class(model) == "ets") {
##
## Call:
## alpha <- max(model$par["alpha"], 1e-10)
##
## Call:
## beta <- model$par["beta"]
##
## Call:
## if (is.na(beta)) {
##
## Call:
## beta <- NULL
##
## Call:
## }
##
## Call:
## gamma <- model$par["gamma"]
##
## Call:
## if (is.na(gamma)) {
##
## Call:
## gamma <- NULL
##
## Call:
## }
##
## Call:
## phi <- model$par["phi"]
##
## Call:
## if (is.na(phi)) {
##
## Call:
## phi <- NULL
##
## Call:
## }
##
## Call:
## modelcomponents <- paste(model$components[1], model$components[2],
##
## Call:
## model$components[3], sep = "")
##
## Call:
## damped <- (model$components[4] == "TRUE")
##
## Call:
## if (use.initial.values) {
##
## Call:
## errortype <- substr(modelcomponents, 1, 1)
##
## Call:
## trendtype <- substr(modelcomponents, 2, 2)
##
## Call:
## seasontype <- substr(modelcomponents, 3, 3)
##
## Call:
## e <- pegelsresid.C(y, m, model$initstate, errortype,
##
## Call:
## trendtype, seasontype, damped, alpha, beta, gamma,
##
## Call:
## phi, nmse)
##
## Call:
## np <- length(model$par) + 1
##
## Call:
## model$loglik <- -0.5 * e$lik
##
## Call:
## model$aic <- e$lik + 2 * np
##
## Call:
## model$bic <- e$lik + log(ny) * np
##
## Call:
## model$aicc <- model$aic + 2 * np * (np + 1)/(ny -
##
## Call:
## np - 1)
##
## Call:
## model$mse <- e$amse[1]
##
## Call:
## model$amse <- mean(e$amse)
##
## Call:
## tsp.y <- tsp(y)
##
## Call:
## model$states <- ts(e$states, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1] - 1/tsp.y[3])
##
## Call:
## colnames(model$states)[1] <- "l"
##
## Call:
## if (trendtype != "N") {
##
## Call:
## colnames(model$states)[2] <- "b"
##
## Call:
## }
##
## Call:
## if (seasontype != "N") {
##
## Call:
## colnames(model$states)[(2 + (trendtype != "N")):ncol(model$states)] <- paste("s",
##
## Call:
## 1:m, sep = "")
##
## Call:
## }
##
## Call:
## if (errortype == "A") {
##
## Call:
## model$fitted <- ts(y - e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model$fitted <- ts(y/(1 + e$e), frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## model$residuals <- ts(e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## model$series <- seriesname
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda,
##
## Call:
## biasadj, var(model$residuals))
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(model)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model <- modelcomponents
##
## Call:
## if (missing(use.initial.values)) {
##
## Call:
## message("Model is being refit with current smoothing parameters but initial states are being re-estimated.\nSet 'use.initial.values=TRUE' if you want to re-use existing initial values.")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## errortype <- substr(model, 1, 1)
##
## Call:
## trendtype <- substr(model, 2, 2)
##
## Call:
## seasontype <- substr(model, 3, 3)
##
## Call:
## if (!is.element(errortype, c("M", "A", "Z"))) {
##
## Call:
## stop("Invalid error type")
##
## Call:
## }
##
## Call:
## if (!is.element(trendtype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid trend type")
##
## Call:
## }
##
## Call:
## if (!is.element(seasontype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid season type")
##
## Call:
## }
##
## Call:
## if (m < 1 || length(y) <= m) {
##
## Call:
## seasontype <- "N"
##
## Call:
## }
##
## Call:
## if (m == 1) {
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## stop("Nonseasonal data")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (m > 24) {
##
## Call:
## if (is.element(seasontype, c("A", "M"))) {
##
## Call:
## stop("Frequency too high")
##
## Call:
## }
##
## Call:
## else if (seasontype == "Z") {
##
## Call:
## warning("I can't handle data with frequency greater than 24. Seasonality will be ignored. Try stlf() if you need seasonal forecasts.")
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if ((errortype == "A" && (trendtype == "M" || seasontype ==
##
## Call:
## "M")) | (errortype == "M" && trendtype == "M" &&
##
## Call:
## seasontype == "A") || (additive.only && (errortype ==
##
## Call:
## "M" || trendtype == "M" || seasontype == "M"))) {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## data.positive <- (min(y) > 0)
##
## Call:
## if (!data.positive && errortype == "M") {
##
## Call:
## stop("Inappropriate model for data with negative or zero values")
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped && trendtype == "N") {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## n <- length(y)
##
## Call:
## npars <- 2L
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## npars <- npars + 2L
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## npars <- npars + m
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## npars <- npars + as.numeric(damped)
##
## Call:
## }
##
## Call:
## if (n <= npars + 4L) {
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped) {
##
## Call:
## warning("Not enough data to use damping")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = gamma, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), seasonal = ifelse(seasontype != "A",
##
## Call:
## "multiplicative", "additive"), lambda = lambda,
##
## Call:
## biasadj = biasadj, warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Seasonal component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Trend component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "N" && seasontype == "N") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, lambda = lambda, biasadj = biasadj,
##
## Call:
## warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## }
##
## Call:
## fit1 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## fit2 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if ("try-error" %in% class(fit1)) {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## else if (fit1$sigma2 < fit2$sigma2) {
##
## Call:
## fit <- fit1
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## if ("try-error" %in% class(fit))
##
## Call:
## stop("Unable to estimate a model.")
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## if (errortype == "Z") {
##
## Call:
## errortype <- c("A", "M")
##
## Call:
## }
##
## Call:
## if (trendtype == "Z") {
##
## Call:
## if (allow.multiplicative.trend) {
##
## Call:
## trendtype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## trendtype <- c("N", "A")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "Z") {
##
## Call:
## seasontype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## if (is.null(damped)) {
##
## Call:
## damped <- c(TRUE, FALSE)
##
## Call:
## }
##
## Call:
## best.ic <- Inf
##
## Call:
## for (i in 1:length(errortype)) {
##
## Call:
## for (j in 1:length(trendtype)) {
##
## Call:
## for (k in 1:length(seasontype)) {
##
## Call:
## for (l in 1:length(damped)) {
##
## Call:
## if (trendtype[j] == "N" && damped[l]) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if (errortype[i] == "A" && (trendtype[j] ==
##
## Call:
## "M" || seasontype[k] == "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (errortype[i] == "M" && trendtype[j] ==
##
## Call:
## "M" && seasontype[k] == "A") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (additive.only && (errortype[i] == "M" ||
##
## Call:
## trendtype[j] == "M" || seasontype[k] ==
##
## Call:
## "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (!data.positive && errortype[i] == "M") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## fit <- try(etsmodel(y, errortype[i], trendtype[j],
##
## Call:
## seasontype[k], damped[l], alpha, beta, gamma,
##
## Call:
## phi, lower = lower, upper = upper, opt.crit = opt.crit,
##
## Call:
## nmse = nmse, bounds = bounds, ...), silent = TRUE)
##
## Call:
## if (is.element("try-error", class(fit)))
##
## Call:
## fit.ic <- Inf
##
## Call:
## else fit.ic <- switch(ic, aic = fit$aic, bic = fit$bic,
##
## Call:
## aicc = fit$aicc)
##
## Call:
## if (!is.na(fit.ic)) {
##
## Call:
## if (fit.ic < best.ic) {
##
## Call:
## model <- fit
##
## Call:
## best.ic <- fit.ic
##
## Call:
## best.e <- errortype[i]
##
## Call:
## best.t <- trendtype[j]
##
## Call:
## best.s <- seasontype[k]
##
## Call:
## best.d <- damped[l]
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (best.ic == Inf) {
##
## Call:
## stop("No model able to be fitted")
##
## Call:
## }
##
## Call:
## model$m <- m
##
## Call:
## model$method <- paste("ETS(", best.e, ",", best.t, ifelse(best.d,
##
## Call:
## "d", ""), ",", best.s, ")", sep = "")
##
## Call:
## model$series <- seriesname
##
## Call:
## model$components <- c(best.e, best.t, best.s, best.d)
##
## Call:
## model$call <- match.call()
##
## Call:
## model$initstate <- model$states[1, ]
##
## Call:
## np <- length(model$par)
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda, biasadj,
##
## Call:
## model$sigma2)
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(structure(model, class = "ets"))
##
## Call:
## })(y = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6,
##
## Call:
## 200, 200.3, 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1,
##
## Call:
## 210.5, 210.5, 209.8, 208.8, 209.5, 213.2, 213.7, 215.1, 218.7,
##
## Call:
## 219.8, 220.5, 223.8, 222.8, 223.8, 221.7, 222.3, 220.8, 219.4,
##
## Call:
## 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7,
##
## Call:
## 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7,
##
## Call:
## 217, 215.9, 215.8, 214.1, 212.3, 213.9, 214.6, 213.6, 212.1,
##
## Call:
## 211.4, 213.1, 212.9, 213.3, 211.5, 212.3, 213, 211, 210.7, 210.1,
##
## Call:
## 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6, 211.9, 212.8,
##
## Call:
## 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4,
##
## Call:
## 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7,
##
## Call:
## 247.6, 247.8, 249.4, 249, 249.9, 250.5, 251.5, 249, 247.6, 248.8
##
## Call:
## ), .Tsp = c(2008, 2016.91666666667, 12), class = "ts"), opt.crit = "lik")
##
## Smoothing parameters:
## alpha = 0.9771
## beta = 0.2848
## phi = 0.8921
##
## Initial states:
## l = 200.4124
## b = -0.3724
##
## sigma: 0.0067
##
## AIC AICc BIC
## 594.0654 594.8971 610.1582
##
## $forecast$ets1$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jan 2017 248.7006 246.5719 250.8293 245.4451 251.9562
## Feb 2017 248.6474 245.2712 252.0236 243.4840 253.8108
## Mar 2017 248.6000 244.0146 253.1853 241.5872 255.6127
## Apr 2017 248.5576 242.7691 254.3461 239.7049 257.4103
## May 2017 248.5198 241.5308 255.5088 237.8311 259.2085
## Jun 2017 248.4861 240.3018 256.6704 235.9693 261.0029
## Jul 2017 248.4561 239.0852 257.8269 234.1245 262.7876
## Aug 2017 248.4292 237.8839 258.9746 232.3015 264.5569
## Sep 2017 248.4053 236.7005 260.1102 230.5043 266.3063
## Oct 2017 248.3840 235.5367 261.2312 228.7358 268.0322
## Nov 2017 248.3649 234.3940 262.3359 226.9982 269.7316
## Dec 2017 248.3479 233.2732 263.4226 225.2932 271.4027
##
## $forecast$ets1$parameters
## $forecast$ets1$parameters$type
## [1] "train"
##
## $forecast$ets1$parameters$model_id
## [1] "ets1"
##
## $forecast$ets1$parameters$method
## [1] "ets"
##
## $forecast$ets1$parameters$horizon
## [1] 12
##
## $forecast$ets1$parameters$partition
## [1] "partition_4"
##
##
##
## $forecast$ets1
## $forecast$ets1$model
## ETS(M,Ad,N)
##
## Call:
## (function (y, model = "ZZZ", damped = NULL, alpha = NULL, beta = NULL,
##
## Call:
## gamma = NULL, phi = NULL, additive.only = FALSE, lambda = NULL,
##
## Call:
## biasadj = FALSE, lower = c(rep(1e-04, 3), 0.8), upper = c(rep(0.9999,
##
## Call:
## 3), 0.98), opt.crit = c("lik", "amse", "mse", "sigma",
##
## Call:
## "mae"), nmse = 3, bounds = c("both", "usual", "admissible"),
##
## Call:
## ic = c("aicc", "aic", "bic"), restrict = TRUE, allow.multiplicative.trend = FALSE,
##
## Call:
## use.initial.values = FALSE, na.action = c("na.contiguous",
##
## Call:
## "na.interp", "na.fail"), ...)
##
## Call:
## {
##
## Call:
## opt.crit <- match.arg(opt.crit)
##
## Call:
## bounds <- match.arg(bounds)
##
## Call:
## ic <- match.arg(ic)
##
## Call:
## if (!is.function(na.action)) {
##
## Call:
## na.fn_name <- match.arg(na.action)
##
## Call:
## na.action <- get(na.fn_name)
##
## Call:
## }
##
## Call:
## seriesname <- deparse(substitute(y))
##
## Call:
## if (any(class(y) %in% c("data.frame", "list", "matrix", "mts"))) {
##
## Call:
## stop("y should be a univariate time series")
##
## Call:
## }
##
## Call:
## y <- as.ts(y)
##
## Call:
## if (missing(model) && is.constant(y)) {
##
## Call:
## return(ses(y, alpha = 0.99999, initial = "simple")$model)
##
## Call:
## }
##
## Call:
## ny <- length(y)
##
## Call:
## y <- na.action(y)
##
## Call:
## if (ny != length(y) && na.fn_name == "na.contiguous") {
##
## Call:
## warning("Missing values encountered. Using longest contiguous portion of time series")
##
## Call:
## ny <- length(y)
##
## Call:
## }
##
## Call:
## orig.y <- y
##
## Call:
## if (identical(class(model), "ets") && is.null(lambda)) {
##
## Call:
## lambda <- model$lambda
##
## Call:
## }
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## y <- BoxCox(y, lambda)
##
## Call:
## lambda <- attr(y, "lambda")
##
## Call:
## additive.only <- TRUE
##
## Call:
## }
##
## Call:
## if (nmse < 1 || nmse > 30) {
##
## Call:
## stop("nmse out of range")
##
## Call:
## }
##
## Call:
## m <- frequency(y)
##
## Call:
## if (any(upper < lower)) {
##
## Call:
## stop("Lower limits must be less than upper limits")
##
## Call:
## }
##
## Call:
## if (class(model) == "ets") {
##
## Call:
## alpha <- max(model$par["alpha"], 1e-10)
##
## Call:
## beta <- model$par["beta"]
##
## Call:
## if (is.na(beta)) {
##
## Call:
## beta <- NULL
##
## Call:
## }
##
## Call:
## gamma <- model$par["gamma"]
##
## Call:
## if (is.na(gamma)) {
##
## Call:
## gamma <- NULL
##
## Call:
## }
##
## Call:
## phi <- model$par["phi"]
##
## Call:
## if (is.na(phi)) {
##
## Call:
## phi <- NULL
##
## Call:
## }
##
## Call:
## modelcomponents <- paste(model$components[1], model$components[2],
##
## Call:
## model$components[3], sep = "")
##
## Call:
## damped <- (model$components[4] == "TRUE")
##
## Call:
## if (use.initial.values) {
##
## Call:
## errortype <- substr(modelcomponents, 1, 1)
##
## Call:
## trendtype <- substr(modelcomponents, 2, 2)
##
## Call:
## seasontype <- substr(modelcomponents, 3, 3)
##
## Call:
## e <- pegelsresid.C(y, m, model$initstate, errortype,
##
## Call:
## trendtype, seasontype, damped, alpha, beta, gamma,
##
## Call:
## phi, nmse)
##
## Call:
## np <- length(model$par) + 1
##
## Call:
## model$loglik <- -0.5 * e$lik
##
## Call:
## model$aic <- e$lik + 2 * np
##
## Call:
## model$bic <- e$lik + log(ny) * np
##
## Call:
## model$aicc <- model$aic + 2 * np * (np + 1)/(ny -
##
## Call:
## np - 1)
##
## Call:
## model$mse <- e$amse[1]
##
## Call:
## model$amse <- mean(e$amse)
##
## Call:
## tsp.y <- tsp(y)
##
## Call:
## model$states <- ts(e$states, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1] - 1/tsp.y[3])
##
## Call:
## colnames(model$states)[1] <- "l"
##
## Call:
## if (trendtype != "N") {
##
## Call:
## colnames(model$states)[2] <- "b"
##
## Call:
## }
##
## Call:
## if (seasontype != "N") {
##
## Call:
## colnames(model$states)[(2 + (trendtype != "N")):ncol(model$states)] <- paste("s",
##
## Call:
## 1:m, sep = "")
##
## Call:
## }
##
## Call:
## if (errortype == "A") {
##
## Call:
## model$fitted <- ts(y - e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model$fitted <- ts(y/(1 + e$e), frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## model$residuals <- ts(e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## model$series <- seriesname
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda,
##
## Call:
## biasadj, var(model$residuals))
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(model)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model <- modelcomponents
##
## Call:
## if (missing(use.initial.values)) {
##
## Call:
## message("Model is being refit with current smoothing parameters but initial states are being re-estimated.\nSet 'use.initial.values=TRUE' if you want to re-use existing initial values.")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## errortype <- substr(model, 1, 1)
##
## Call:
## trendtype <- substr(model, 2, 2)
##
## Call:
## seasontype <- substr(model, 3, 3)
##
## Call:
## if (!is.element(errortype, c("M", "A", "Z"))) {
##
## Call:
## stop("Invalid error type")
##
## Call:
## }
##
## Call:
## if (!is.element(trendtype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid trend type")
##
## Call:
## }
##
## Call:
## if (!is.element(seasontype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid season type")
##
## Call:
## }
##
## Call:
## if (m < 1 || length(y) <= m) {
##
## Call:
## seasontype <- "N"
##
## Call:
## }
##
## Call:
## if (m == 1) {
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## stop("Nonseasonal data")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (m > 24) {
##
## Call:
## if (is.element(seasontype, c("A", "M"))) {
##
## Call:
## stop("Frequency too high")
##
## Call:
## }
##
## Call:
## else if (seasontype == "Z") {
##
## Call:
## warning("I can't handle data with frequency greater than 24. Seasonality will be ignored. Try stlf() if you need seasonal forecasts.")
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if ((errortype == "A" && (trendtype == "M" || seasontype ==
##
## Call:
## "M")) | (errortype == "M" && trendtype == "M" &&
##
## Call:
## seasontype == "A") || (additive.only && (errortype ==
##
## Call:
## "M" || trendtype == "M" || seasontype == "M"))) {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## data.positive <- (min(y) > 0)
##
## Call:
## if (!data.positive && errortype == "M") {
##
## Call:
## stop("Inappropriate model for data with negative or zero values")
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped && trendtype == "N") {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## n <- length(y)
##
## Call:
## npars <- 2L
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## npars <- npars + 2L
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## npars <- npars + m
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## npars <- npars + as.numeric(damped)
##
## Call:
## }
##
## Call:
## if (n <= npars + 4L) {
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped) {
##
## Call:
## warning("Not enough data to use damping")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = gamma, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), seasonal = ifelse(seasontype != "A",
##
## Call:
## "multiplicative", "additive"), lambda = lambda,
##
## Call:
## biasadj = biasadj, warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Seasonal component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Trend component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "N" && seasontype == "N") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, lambda = lambda, biasadj = biasadj,
##
## Call:
## warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## }
##
## Call:
## fit1 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## fit2 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if ("try-error" %in% class(fit1)) {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## else if (fit1$sigma2 < fit2$sigma2) {
##
## Call:
## fit <- fit1
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## if ("try-error" %in% class(fit))
##
## Call:
## stop("Unable to estimate a model.")
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## if (errortype == "Z") {
##
## Call:
## errortype <- c("A", "M")
##
## Call:
## }
##
## Call:
## if (trendtype == "Z") {
##
## Call:
## if (allow.multiplicative.trend) {
##
## Call:
## trendtype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## trendtype <- c("N", "A")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "Z") {
##
## Call:
## seasontype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## if (is.null(damped)) {
##
## Call:
## damped <- c(TRUE, FALSE)
##
## Call:
## }
##
## Call:
## best.ic <- Inf
##
## Call:
## for (i in 1:length(errortype)) {
##
## Call:
## for (j in 1:length(trendtype)) {
##
## Call:
## for (k in 1:length(seasontype)) {
##
## Call:
## for (l in 1:length(damped)) {
##
## Call:
## if (trendtype[j] == "N" && damped[l]) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if (errortype[i] == "A" && (trendtype[j] ==
##
## Call:
## "M" || seasontype[k] == "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (errortype[i] == "M" && trendtype[j] ==
##
## Call:
## "M" && seasontype[k] == "A") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (additive.only && (errortype[i] == "M" ||
##
## Call:
## trendtype[j] == "M" || seasontype[k] ==
##
## Call:
## "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (!data.positive && errortype[i] == "M") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## fit <- try(etsmodel(y, errortype[i], trendtype[j],
##
## Call:
## seasontype[k], damped[l], alpha, beta, gamma,
##
## Call:
## phi, lower = lower, upper = upper, opt.crit = opt.crit,
##
## Call:
## nmse = nmse, bounds = bounds, ...), silent = TRUE)
##
## Call:
## if (is.element("try-error", class(fit)))
##
## Call:
## fit.ic <- Inf
##
## Call:
## else fit.ic <- switch(ic, aic = fit$aic, bic = fit$bic,
##
## Call:
## aicc = fit$aicc)
##
## Call:
## if (!is.na(fit.ic)) {
##
## Call:
## if (fit.ic < best.ic) {
##
## Call:
## model <- fit
##
## Call:
## best.ic <- fit.ic
##
## Call:
## best.e <- errortype[i]
##
## Call:
## best.t <- trendtype[j]
##
## Call:
## best.s <- seasontype[k]
##
## Call:
## best.d <- damped[l]
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (best.ic == Inf) {
##
## Call:
## stop("No model able to be fitted")
##
## Call:
## }
##
## Call:
## model$m <- m
##
## Call:
## model$method <- paste("ETS(", best.e, ",", best.t, ifelse(best.d,
##
## Call:
## "d", ""), ",", best.s, ")", sep = "")
##
## Call:
## model$series <- seriesname
##
## Call:
## model$components <- c(best.e, best.t, best.s, best.d)
##
## Call:
## model$call <- match.call()
##
## Call:
## model$initstate <- model$states[1, ]
##
## Call:
## np <- length(model$par)
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda, biasadj,
##
## Call:
## model$sigma2)
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(structure(model, class = "ets"))
##
## Call:
## })(y = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6,
##
## Call:
## 200, 200.3, 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1,
##
## Call:
## 210.5, 210.5, 209.8, 208.8, 209.5, 213.2, 213.7, 215.1, 218.7,
##
## Call:
## 219.8, 220.5, 223.8, 222.8, 223.8, 221.7, 222.3, 220.8, 219.4,
##
## Call:
## 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7,
##
## Call:
## 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7,
##
## Call:
## 217, 215.9, 215.8, 214.1, 212.3, 213.9, 214.6, 213.6, 212.1,
##
## Call:
## 211.4, 213.1, 212.9, 213.3, 211.5, 212.3, 213, 211, 210.7, 210.1,
##
## Call:
## 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6, 211.9, 212.8,
##
## Call:
## 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4,
##
## Call:
## 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7,
##
## Call:
## 247.6, 247.8, 249.4, 249, 249.9, 250.5, 251.5, 249, 247.6, 248.8,
##
## Call:
## 250.4, 250.7, 253), .Tsp = c(2008, 2017.16666666667, 12), class = "ts"),
##
## Call:
## opt.crit = "lik")
##
## Smoothing parameters:
## alpha = 0.9907
## beta = 0.2815
## phi = 0.8948
##
## Initial states:
## l = 200.4079
## b = -0.3587
##
## sigma: 0.0067
##
## AIC AICc BIC
## 613.6217 614.4294 629.8789
##
## $forecast$ets1$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Apr 2017 253.7668 251.6008 255.9328 250.4541 257.0795
## May 2017 254.4695 251.0109 257.9281 249.1800 259.7590
## Jun 2017 255.0983 250.3933 259.8033 247.9026 262.2940
## Jul 2017 255.6610 249.7169 261.6050 246.5703 264.7516
## Aug 2017 256.1645 248.9832 263.3457 245.1817 267.1472
## Sep 2017 256.6150 248.2003 265.0298 243.7458 269.4843
## Oct 2017 257.0182 247.3769 266.6595 242.2731 271.7633
## Nov 2017 257.3789 246.5213 268.2366 240.7737 273.9842
## Dec 2017 257.7018 245.6410 269.7626 239.2564 276.1472
## Jan 2018 257.9907 244.7421 271.2393 237.7287 278.2527
## Feb 2018 258.2492 243.8300 272.6684 236.1969 280.3014
## Mar 2018 258.4805 242.9093 274.0517 234.6664 282.2946
##
## $forecast$ets1$parameters
## $forecast$ets1$parameters$type
## [1] "train"
##
## $forecast$ets1$parameters$model_id
## [1] "ets1"
##
## $forecast$ets1$parameters$method
## [1] "ets"
##
## $forecast$ets1$parameters$horizon
## [1] 12
##
## $forecast$ets1$parameters$partition
## [1] "partition_5"
##
##
##
## $forecast$ets1
## $forecast$ets1$model
## ETS(M,Ad,N)
##
## Call:
## (function (y, model = "ZZZ", damped = NULL, alpha = NULL, beta = NULL,
##
## Call:
## gamma = NULL, phi = NULL, additive.only = FALSE, lambda = NULL,
##
## Call:
## biasadj = FALSE, lower = c(rep(1e-04, 3), 0.8), upper = c(rep(0.9999,
##
## Call:
## 3), 0.98), opt.crit = c("lik", "amse", "mse", "sigma",
##
## Call:
## "mae"), nmse = 3, bounds = c("both", "usual", "admissible"),
##
## Call:
## ic = c("aicc", "aic", "bic"), restrict = TRUE, allow.multiplicative.trend = FALSE,
##
## Call:
## use.initial.values = FALSE, na.action = c("na.contiguous",
##
## Call:
## "na.interp", "na.fail"), ...)
##
## Call:
## {
##
## Call:
## opt.crit <- match.arg(opt.crit)
##
## Call:
## bounds <- match.arg(bounds)
##
## Call:
## ic <- match.arg(ic)
##
## Call:
## if (!is.function(na.action)) {
##
## Call:
## na.fn_name <- match.arg(na.action)
##
## Call:
## na.action <- get(na.fn_name)
##
## Call:
## }
##
## Call:
## seriesname <- deparse(substitute(y))
##
## Call:
## if (any(class(y) %in% c("data.frame", "list", "matrix", "mts"))) {
##
## Call:
## stop("y should be a univariate time series")
##
## Call:
## }
##
## Call:
## y <- as.ts(y)
##
## Call:
## if (missing(model) && is.constant(y)) {
##
## Call:
## return(ses(y, alpha = 0.99999, initial = "simple")$model)
##
## Call:
## }
##
## Call:
## ny <- length(y)
##
## Call:
## y <- na.action(y)
##
## Call:
## if (ny != length(y) && na.fn_name == "na.contiguous") {
##
## Call:
## warning("Missing values encountered. Using longest contiguous portion of time series")
##
## Call:
## ny <- length(y)
##
## Call:
## }
##
## Call:
## orig.y <- y
##
## Call:
## if (identical(class(model), "ets") && is.null(lambda)) {
##
## Call:
## lambda <- model$lambda
##
## Call:
## }
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## y <- BoxCox(y, lambda)
##
## Call:
## lambda <- attr(y, "lambda")
##
## Call:
## additive.only <- TRUE
##
## Call:
## }
##
## Call:
## if (nmse < 1 || nmse > 30) {
##
## Call:
## stop("nmse out of range")
##
## Call:
## }
##
## Call:
## m <- frequency(y)
##
## Call:
## if (any(upper < lower)) {
##
## Call:
## stop("Lower limits must be less than upper limits")
##
## Call:
## }
##
## Call:
## if (class(model) == "ets") {
##
## Call:
## alpha <- max(model$par["alpha"], 1e-10)
##
## Call:
## beta <- model$par["beta"]
##
## Call:
## if (is.na(beta)) {
##
## Call:
## beta <- NULL
##
## Call:
## }
##
## Call:
## gamma <- model$par["gamma"]
##
## Call:
## if (is.na(gamma)) {
##
## Call:
## gamma <- NULL
##
## Call:
## }
##
## Call:
## phi <- model$par["phi"]
##
## Call:
## if (is.na(phi)) {
##
## Call:
## phi <- NULL
##
## Call:
## }
##
## Call:
## modelcomponents <- paste(model$components[1], model$components[2],
##
## Call:
## model$components[3], sep = "")
##
## Call:
## damped <- (model$components[4] == "TRUE")
##
## Call:
## if (use.initial.values) {
##
## Call:
## errortype <- substr(modelcomponents, 1, 1)
##
## Call:
## trendtype <- substr(modelcomponents, 2, 2)
##
## Call:
## seasontype <- substr(modelcomponents, 3, 3)
##
## Call:
## e <- pegelsresid.C(y, m, model$initstate, errortype,
##
## Call:
## trendtype, seasontype, damped, alpha, beta, gamma,
##
## Call:
## phi, nmse)
##
## Call:
## np <- length(model$par) + 1
##
## Call:
## model$loglik <- -0.5 * e$lik
##
## Call:
## model$aic <- e$lik + 2 * np
##
## Call:
## model$bic <- e$lik + log(ny) * np
##
## Call:
## model$aicc <- model$aic + 2 * np * (np + 1)/(ny -
##
## Call:
## np - 1)
##
## Call:
## model$mse <- e$amse[1]
##
## Call:
## model$amse <- mean(e$amse)
##
## Call:
## tsp.y <- tsp(y)
##
## Call:
## model$states <- ts(e$states, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1] - 1/tsp.y[3])
##
## Call:
## colnames(model$states)[1] <- "l"
##
## Call:
## if (trendtype != "N") {
##
## Call:
## colnames(model$states)[2] <- "b"
##
## Call:
## }
##
## Call:
## if (seasontype != "N") {
##
## Call:
## colnames(model$states)[(2 + (trendtype != "N")):ncol(model$states)] <- paste("s",
##
## Call:
## 1:m, sep = "")
##
## Call:
## }
##
## Call:
## if (errortype == "A") {
##
## Call:
## model$fitted <- ts(y - e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model$fitted <- ts(y/(1 + e$e), frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## }
##
## Call:
## model$residuals <- ts(e$e, frequency = tsp.y[3],
##
## Call:
## start = tsp.y[1])
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## model$series <- seriesname
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda,
##
## Call:
## biasadj, var(model$residuals))
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(model)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## model <- modelcomponents
##
## Call:
## if (missing(use.initial.values)) {
##
## Call:
## message("Model is being refit with current smoothing parameters but initial states are being re-estimated.\nSet 'use.initial.values=TRUE' if you want to re-use existing initial values.")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## errortype <- substr(model, 1, 1)
##
## Call:
## trendtype <- substr(model, 2, 2)
##
## Call:
## seasontype <- substr(model, 3, 3)
##
## Call:
## if (!is.element(errortype, c("M", "A", "Z"))) {
##
## Call:
## stop("Invalid error type")
##
## Call:
## }
##
## Call:
## if (!is.element(trendtype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid trend type")
##
## Call:
## }
##
## Call:
## if (!is.element(seasontype, c("N", "A", "M", "Z"))) {
##
## Call:
## stop("Invalid season type")
##
## Call:
## }
##
## Call:
## if (m < 1 || length(y) <= m) {
##
## Call:
## seasontype <- "N"
##
## Call:
## }
##
## Call:
## if (m == 1) {
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## stop("Nonseasonal data")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (m > 24) {
##
## Call:
## if (is.element(seasontype, c("A", "M"))) {
##
## Call:
## stop("Frequency too high")
##
## Call:
## }
##
## Call:
## else if (seasontype == "Z") {
##
## Call:
## warning("I can't handle data with frequency greater than 24. Seasonality will be ignored. Try stlf() if you need seasonal forecasts.")
##
## Call:
## substr(model, 3, 3) <- seasontype <- "N"
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if ((errortype == "A" && (trendtype == "M" || seasontype ==
##
## Call:
## "M")) | (errortype == "M" && trendtype == "M" &&
##
## Call:
## seasontype == "A") || (additive.only && (errortype ==
##
## Call:
## "M" || trendtype == "M" || seasontype == "M"))) {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## data.positive <- (min(y) > 0)
##
## Call:
## if (!data.positive && errortype == "M") {
##
## Call:
## stop("Inappropriate model for data with negative or zero values")
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped && trendtype == "N") {
##
## Call:
## stop("Forbidden model combination")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## n <- length(y)
##
## Call:
## npars <- 2L
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## npars <- npars + 2L
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## npars <- npars + m
##
## Call:
## }
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## npars <- npars + as.numeric(damped)
##
## Call:
## }
##
## Call:
## if (n <= npars + 4L) {
##
## Call:
## if (!is.null(damped)) {
##
## Call:
## if (damped) {
##
## Call:
## warning("Not enough data to use damping")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "A" || seasontype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = gamma, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), seasonal = ifelse(seasontype != "A",
##
## Call:
## "multiplicative", "additive"), lambda = lambda,
##
## Call:
## biasadj = biasadj, warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Seasonal component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "A" || trendtype == "M") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## warning("Trend component could not be estimated")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (trendtype == "N" && seasontype == "N") {
##
## Call:
## fit <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, lambda = lambda, biasadj = biasadj,
##
## Call:
## warnings = FALSE), silent = TRUE)
##
## Call:
## if (!("try-error" %in% class(fit))) {
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## }
##
## Call:
## fit1 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = beta,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## fit2 <- try(HoltWintersZZ(orig.y, alpha = alpha, beta = FALSE,
##
## Call:
## gamma = FALSE, phi = phi, exponential = (trendtype ==
##
## Call:
## "M"), lambda = lambda, biasadj = biasadj, warnings = FALSE),
##
## Call:
## silent = TRUE)
##
## Call:
## if ("try-error" %in% class(fit1)) {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## else if (fit1$sigma2 < fit2$sigma2) {
##
## Call:
## fit <- fit1
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## fit <- fit2
##
## Call:
## }
##
## Call:
## if ("try-error" %in% class(fit))
##
## Call:
## stop("Unable to estimate a model.")
##
## Call:
## fit$call <- match.call()
##
## Call:
## fit$method <- as.character(fit)
##
## Call:
## fit$series <- deparse(substitute(y))
##
## Call:
## return(fit)
##
## Call:
## }
##
## Call:
## if (errortype == "Z") {
##
## Call:
## errortype <- c("A", "M")
##
## Call:
## }
##
## Call:
## if (trendtype == "Z") {
##
## Call:
## if (allow.multiplicative.trend) {
##
## Call:
## trendtype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## else {
##
## Call:
## trendtype <- c("N", "A")
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (seasontype == "Z") {
##
## Call:
## seasontype <- c("N", "A", "M")
##
## Call:
## }
##
## Call:
## if (is.null(damped)) {
##
## Call:
## damped <- c(TRUE, FALSE)
##
## Call:
## }
##
## Call:
## best.ic <- Inf
##
## Call:
## for (i in 1:length(errortype)) {
##
## Call:
## for (j in 1:length(trendtype)) {
##
## Call:
## for (k in 1:length(seasontype)) {
##
## Call:
## for (l in 1:length(damped)) {
##
## Call:
## if (trendtype[j] == "N" && damped[l]) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (restrict) {
##
## Call:
## if (errortype[i] == "A" && (trendtype[j] ==
##
## Call:
## "M" || seasontype[k] == "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (errortype[i] == "M" && trendtype[j] ==
##
## Call:
## "M" && seasontype[k] == "A") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## if (additive.only && (errortype[i] == "M" ||
##
## Call:
## trendtype[j] == "M" || seasontype[k] ==
##
## Call:
## "M")) {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (!data.positive && errortype[i] == "M") {
##
## Call:
## next
##
## Call:
## }
##
## Call:
## fit <- try(etsmodel(y, errortype[i], trendtype[j],
##
## Call:
## seasontype[k], damped[l], alpha, beta, gamma,
##
## Call:
## phi, lower = lower, upper = upper, opt.crit = opt.crit,
##
## Call:
## nmse = nmse, bounds = bounds, ...), silent = TRUE)
##
## Call:
## if (is.element("try-error", class(fit)))
##
## Call:
## fit.ic <- Inf
##
## Call:
## else fit.ic <- switch(ic, aic = fit$aic, bic = fit$bic,
##
## Call:
## aicc = fit$aicc)
##
## Call:
## if (!is.na(fit.ic)) {
##
## Call:
## if (fit.ic < best.ic) {
##
## Call:
## model <- fit
##
## Call:
## best.ic <- fit.ic
##
## Call:
## best.e <- errortype[i]
##
## Call:
## best.t <- trendtype[j]
##
## Call:
## best.s <- seasontype[k]
##
## Call:
## best.d <- damped[l]
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## }
##
## Call:
## if (best.ic == Inf) {
##
## Call:
## stop("No model able to be fitted")
##
## Call:
## }
##
## Call:
## model$m <- m
##
## Call:
## model$method <- paste("ETS(", best.e, ",", best.t, ifelse(best.d,
##
## Call:
## "d", ""), ",", best.s, ")", sep = "")
##
## Call:
## model$series <- seriesname
##
## Call:
## model$components <- c(best.e, best.t, best.s, best.d)
##
## Call:
## model$call <- match.call()
##
## Call:
## model$initstate <- model$states[1, ]
##
## Call:
## np <- length(model$par)
##
## Call:
## model$sigma2 <- sum(model$residuals^2, na.rm = TRUE)/(ny -
##
## Call:
## np)
##
## Call:
## model$x <- orig.y
##
## Call:
## if (!is.null(lambda)) {
##
## Call:
## model$fitted <- InvBoxCox(model$fitted, lambda, biasadj,
##
## Call:
## model$sigma2)
##
## Call:
## attr(lambda, "biasadj") <- biasadj
##
## Call:
## }
##
## Call:
## model$lambda <- lambda
##
## Call:
## return(structure(model, class = "ets"))
##
## Call:
## })(y = structure(c(200.1, 199.5, 199.4, 198.9, 199, 200.2, 198.6,
##
## Call:
## 200, 200.3, 201.2, 201.6, 201.5, 201.5, 203.5, 204.9, 207.1,
##
## Call:
## 210.5, 210.5, 209.8, 208.8, 209.5, 213.2, 213.7, 215.1, 218.7,
##
## Call:
## 219.8, 220.5, 223.8, 222.8, 223.8, 221.7, 222.3, 220.8, 219.4,
##
## Call:
## 220.1, 220.6, 218.9, 217.8, 217.7, 215, 215.3, 215.9, 216.7,
##
## Call:
## 216.7, 217.7, 218.7, 222.9, 224.9, 222.2, 220.7, 220, 218.7,
##
## Call:
## 217, 215.9, 215.8, 214.1, 212.3, 213.9, 214.6, 213.6, 212.1,
##
## Call:
## 211.4, 213.1, 212.9, 213.3, 211.5, 212.3, 213, 211, 210.7, 210.1,
##
## Call:
## 211.4, 210, 209.7, 208.8, 208.8, 208.8, 210.6, 211.9, 212.8,
##
## Call:
## 212.5, 214.8, 215.3, 217.5, 218.8, 220.7, 222.2, 226.7, 228.4,
##
## Call:
## 233.2, 235.7, 237.1, 240.6, 243.8, 245.3, 246, 246.3, 247.7,
##
## Call:
## 247.6, 247.8, 249.4, 249, 249.9, 250.5, 251.5, 249, 247.6, 248.8,
##
## Call:
## 250.4, 250.7, 253, 253.7, 255, 256.2), .Tsp = c(2008, 2017.41666666667,
##
## Call:
## 12), class = "ts"), opt.crit = "lik")
##
## Smoothing parameters:
## alpha = 0.9862
## beta = 0.2858
## phi = 0.8953
##
## Initial states:
## l = 200.4101
## b = -0.3652
##
## sigma: 0.0066
##
## AIC AICc BIC
## 630.9916 631.7767 647.4088
##
## $forecast$ets1$forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jul 2017 257.0002 254.8350 259.1654 253.6888 260.3116
## Aug 2017 257.7219 254.2654 261.1784 252.4357 263.0081
## Sep 2017 258.3681 253.6608 263.0754 251.1689 265.5672
## Oct 2017 258.9465 252.9928 264.9003 249.8410 268.0521
## Nov 2017 259.4645 252.2642 266.6647 248.4526 270.4763
## Dec 2017 259.9282 251.4837 268.3726 247.0135 272.8428
## Jan 2018 260.3433 250.6607 270.0259 245.5350 275.1516
## Feb 2018 260.7150 249.8037 271.6262 244.0277 277.4023
## Mar 2018 261.0477 248.9204 273.1750 242.5007 279.5947
## Apr 2018 261.3456 248.0174 274.6738 240.9618 281.7294
## May 2018 261.6123 247.1001 276.1246 239.4178 283.8069
## Jun 2018 261.8511 246.1732 277.5290 237.8738 285.8284
##
## $forecast$ets1$parameters
## $forecast$ets1$parameters$type
## [1] "train"
##
## $forecast$ets1$parameters$model_id
## [1] "ets1"
##
## $forecast$ets1$parameters$method
## [1] "ets"
##
## $forecast$ets1$parameters$horizon
## [1] 12
##
## $forecast$ets1$parameters$partition
## [1] "partition_6"
##
##
##
## $forecast$train
## Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
## 2008 200.1 199.5 199.4 198.9 199.0 200.2 198.6 200.0 200.3 201.2 201.6 201.5
## 2009 201.5 203.5 204.9 207.1 210.5 210.5 209.8 208.8 209.5 213.2 213.7 215.1
## 2010 218.7 219.8 220.5 223.8 222.8 223.8 221.7 222.3 220.8 219.4 220.1 220.6
## 2011 218.9 217.8 217.7 215.0 215.3 215.9 216.7 216.7 217.7 218.7 222.9 224.9
## 2012 222.2 220.7 220.0 218.7 217.0 215.9 215.8 214.1 212.3 213.9 214.6 213.6
## 2013 212.1 211.4 213.1 212.9 213.3 211.5 212.3 213.0 211.0 210.7 210.1 211.4
## 2014 210.0 209.7 208.8 208.8 208.8 210.6 211.9 212.8 212.5 214.8 215.3 217.5
## 2015 218.8 220.7 222.2 226.7 228.4 233.2 235.7 237.1 240.6 243.8 245.3 246.0
## 2016 246.3 247.7 247.6 247.8 249.4 249.0 249.9 250.5 251.5 249.0 247.6 248.8
## 2017 250.4 250.7 253.0 253.7 255.0 256.2 256.0 257.4 260.4 260.0 261.3 260.4
## 2018 261.6 260.8 259.8 259.0 258.9 257.4
##
##
## $input
## Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
## 2008 200.1 199.5 199.4 198.9 199.0 200.2 198.6 200.0 200.3 201.2 201.6 201.5
## 2009 201.5 203.5 204.9 207.1 210.5 210.5 209.8 208.8 209.5 213.2 213.7 215.1
## 2010 218.7 219.8 220.5 223.8 222.8 223.8 221.7 222.3 220.8 219.4 220.1 220.6
## 2011 218.9 217.8 217.7 215.0 215.3 215.9 216.7 216.7 217.7 218.7 222.9 224.9
## 2012 222.2 220.7 220.0 218.7 217.0 215.9 215.8 214.1 212.3 213.9 214.6 213.6
## 2013 212.1 211.4 213.1 212.9 213.3 211.5 212.3 213.0 211.0 210.7 210.1 211.4
## 2014 210.0 209.7 208.8 208.8 208.8 210.6 211.9 212.8 212.5 214.8 215.3 217.5
## 2015 218.8 220.7 222.2 226.7 228.4 233.2 235.7 237.1 240.6 243.8 245.3 246.0
## 2016 246.3 247.7 247.6 247.8 249.4 249.0 249.9 250.5 251.5 249.0 247.6 248.8
## 2017 250.4 250.7 253.0 253.7 255.0 256.2 256.0 257.4 260.4 260.0 261.3 260.4
## 2018 261.6 260.8 259.8 259.0 258.9 257.4
##
## $error_summary
## $error_summary$ets1
## partition model_id mape rmse coverage_80% coverage_95%
## coverage...1 1 ets1 0.004323160 1.350628 1.0000000 1.0000000
## coverage...2 2 ets1 0.007413168 2.350173 1.0000000 1.0000000
## coverage...3 3 ets1 0.009903703 2.949636 0.7500000 0.8333333
## coverage...4 4 ets1 0.029916799 8.578855 0.9166667 1.0000000
## coverage...5 5 ets1 0.007733077 2.420206 1.0000000 1.0000000
## coverage...6 6 ets1 0.006050590 1.952536 1.0000000 1.0000000
##
## $error_summary$ets2
## partition model_id mape rmse coverage_80% coverage_95%
## coverage...1 1 ets2 0.004253452 1.326931 1.0000000 1.0000000
## coverage...2 2 ets2 0.007827058 2.551390 1.0000000 1.0000000
## coverage...3 3 ets2 0.010347653 3.076544 0.7500000 0.8333333
## coverage...4 4 ets2 0.031485408 8.970932 0.4166667 1.0000000
## coverage...5 5 ets2 0.009432341 2.884035 1.0000000 1.0000000
## coverage...6 6 ets2 0.005643881 1.698832 1.0000000 1.0000000
##
## $error_summary$arima1
## partition model_id mape rmse coverage_80% coverage_95%
## coverage...1 1 arima1 0.007125435 2.202648 1.0000000 1.0000000
## coverage...2 2 arima1 0.009729694 3.215725 1.0000000 1.0000000
## coverage...3 3 arima1 0.012079357 3.571395 0.8333333 0.8333333
## coverage...4 4 arima1 0.026661730 7.718076 0.8333333 1.0000000
## coverage...5 5 arima1 0.012879446 3.964917 1.0000000 1.0000000
## coverage...6 6 arima1 0.007066369 2.148684 1.0000000 1.0000000
##
## $error_summary$arima2
## partition model_id mape rmse coverage_80% coverage_95%
## coverage...1 1 arima2 0.012001555 3.800146 1.00 1.00
## coverage...2 2 arima2 0.006987452 1.975162 1.00 1.00
## coverage...3 3 arima2 0.015256529 4.234850 0.75 0.75
## coverage...4 4 arima2 0.030192536 8.369690 0.50 1.00
## coverage...5 5 arima2 0.003336529 1.216178 1.00 1.00
## coverage...6 6 arima2 0.007946088 2.823021 1.00 1.00
##
## $error_summary$hw
## partition model_id mape rmse coverage_80% coverage_95%
## coverage...1 1 hw 0.01711764 4.717594 0.7500000 1.0000000
## coverage...2 2 hw 0.01579979 4.646143 0.8333333 1.0000000
## coverage...3 3 hw 0.01561113 4.289521 0.8333333 0.9166667
## coverage...4 4 hw 0.04726255 13.096802 0.0000000 0.6666667
## coverage...5 5 hw 0.01522481 4.942362 1.0000000 1.0000000
## coverage...6 6 hw 0.02492035 7.501918 0.8333333 1.0000000
##
## $error_summary$tslm
## partition model_id mape rmse coverage_80% coverage_95%
## coverage...1 1 tslm 0.07778846 19.52914 0.0000000 0.4166667
## coverage...2 2 tslm 0.07060655 17.87458 0.0000000 1.0000000
## coverage...3 3 tslm 0.06488186 16.65382 0.1666667 0.9166667
## coverage...4 4 tslm 0.06642795 17.17469 0.1666667 1.0000000
## coverage...5 5 tslm 0.06476541 16.81883 0.0000000 1.0000000
## coverage...6 6 tslm 0.05744056 15.09142 0.2500000 1.0000000
##
##
## $leaderboard
## # A tibble: 6 x 7
## model_id model notes avg_mape avg_rmse `avg_coverage_80%` `avg_coverage_95%`
## <chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 ets1 ets ETS ~ 0.0109 3.27 0.944 0.972
## 2 ets2 ets ETS ~ 0.0115 3.42 0.861 0.972
## 3 arima1 arima ARIM~ 0.0126 3.80 0.944 0.972
## 4 arima2 arima SARI~ 0.0126 3.74 0.875 0.958
## 5 hw HoltWi~ Holt~ 0.0227 6.53 0.708 0.931
## 6 tslm tslm tslm~ 0.0670 17.2 0.0972 0.889
##
## $parameters
## $parameters$methods
## $parameters$methods$ets1
## $parameters$methods$ets1$method
## [1] "ets"
##
## $parameters$methods$ets1$method_arg
## $parameters$methods$ets1$method_arg$opt.crit
## [1] "lik"
##
##
## $parameters$methods$ets1$notes
## [1] "ETS model with opt.crit = lik"
##
##
## $parameters$methods$ets2
## $parameters$methods$ets2$method
## [1] "ets"
##
## $parameters$methods$ets2$method_arg
## $parameters$methods$ets2$method_arg$opt.crit
## [1] "amse"
##
##
## $parameters$methods$ets2$notes
## [1] "ETS model with opt.crit = amse"
##
##
## $parameters$methods$arima1
## $parameters$methods$arima1$method
## [1] "arima"
##
## $parameters$methods$arima1$method_arg
## $parameters$methods$arima1$method_arg$order
## [1] 2 1 0
##
##
## $parameters$methods$arima1$notes
## [1] "ARIMA(2,1,0)"
##
##
## $parameters$methods$arima2
## $parameters$methods$arima2$method
## [1] "arima"
##
## $parameters$methods$arima2$method_arg
## $parameters$methods$arima2$method_arg$order
## [1] 2 1 2
##
## $parameters$methods$arima2$method_arg$seasonal
## $parameters$methods$arima2$method_arg$seasonal$order
## [1] 1 1 1
##
##
##
## $parameters$methods$arima2$notes
## [1] "SARIMA(2,1,2)(1,1,1)"
##
##
## $parameters$methods$hw
## $parameters$methods$hw$method
## [1] "HoltWinters"
##
## $parameters$methods$hw$method_arg
## NULL
##
## $parameters$methods$hw$notes
## [1] "HoltWinters Model"
##
##
## $parameters$methods$tslm
## $parameters$methods$tslm$method
## [1] "tslm"
##
## $parameters$methods$tslm$method_arg
## $parameters$methods$tslm$method_arg$formula
## input ~ trend + season
##
##
## $parameters$methods$tslm$notes
## [1] "tslm model with trend and seasonal components"
##
##
##
## $parameters$train_method
## $parameters$train_method$partitions
## [1] 6
##
## $parameters$train_method$sample.out
## [1] 12
##
## $parameters$train_method$space
## [1] 3
##
##
## $parameters$horizon
## [1] 12
##
## $parameters$xreg
## NULL
##
## $parameters$error_metric
## [1] "MAPE"
##
## $parameters$level
## [1] 80 95
##
##
## attr(,"class")
## [1] "train_model"#Visualizing the models' performance
plot_error(md)plot_model(md)Time Series Project
Individual Assignment
Due Date: 15/07/2023
You are given monthly inflation rate data for Somaliland from December 2012 to February 2023. Your task is to select the most appropriate time series model from a set of models including SARIMA, SETAR, ETS, BATS, WARIMA, TBATS, ARFIMA, and Theta models. Answer the following 20 questions:
- Load the data into R software
- Select the variable of interest from the dataset.
- Compute descriptive statistics of the variable, including measures of central tendency and dispersion.
- Check for missing values in the dataset.
- Determine whether the selected variable is a time series data or not.
- Convert the selected variable into a time series data format in R software.
- Plot the time series data to visualize the pattern of inflation rate over time.
- Decompose the time series data into trend, seasonal, and residual components using both additive and multiplicative models.
- Check the stationarity of the data using the Augmented Dickey-Fuller (ADF) and Phillips-Perron (PP) tests.
- Difference the time series data to make it stationary.
- Check the stationarity of the differenced time series data using the ADF and PP tests.
- Check the number of differencing in the data set.
- Identify the values of the p, d, and q
- Model the stationary time series data using ARIMA model based on your values in question (m)
- Model the stationary time series data using the auto.arima function in R software.
- Model the stationary time series data using other competitive models, such as SETAR, ETS, BATS, WARIMA, TBATS, ARFIMA, and Theta models, in R software.
- Compare the models using information criteria, such as AIC, BIC, and HQ.
- Forecast the inflation rate data using the auto.arima function and other competitive models in R software.
- Compare the forecasting accuracy of the models using metrics such as RMSE, MAE, and FPE.
- Conclude and provide interpretations based on your model selection and forecasting results.
Note: You are required to show all your R code and output for each question, and clearly explain your decisions and interpretations.
Thanks for your attention