## Warning: package 'TSstudio' was built under R version 4.2.3
data("Coffee_Prices")
ts_info(Coffee_Prices)
## The Coffee_Prices series is a mts object with 2 variables and 701 observations
## Frequency: 12
## Start time: 1960 1
## End time: 2018 5
## Robusta Arabica
## [1,] 0.6968643 0.9409
## [2,] 0.6887074 0.9469
## [3,] 0.6887074 0.9281
## [4,] 0.6845187 0.9303
## [5,] 0.6906915 0.9200
## [6,] 0.6968643 0.9123
robusta <- Coffee_Prices[,1]
library(plotly)
## Loading required package: ggplot2
##
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
ts_plot(robusta,
title = "The Robusta Coffee Monthly Prices",
Ytitle = "Price in USD",
Xtitle = "Year")
library(tidyr)
sma_forecast <- function(df, h, m, w = NULL){
# Manejo de errores
if(h > nrow(df)){
stop("La longitud del horizonte de pronóstico debe ser menor que la longitud de la serie")
}
if(m > nrow(df)){
stop("La longitud de la ventana móvil debe ser menor que la longitud de la serie")
}
if(!is.null(w)){
if(length(w) != m){
stop("El argumento weight no coincide con la longitud de la ventana móvil")
} else if(sum(w) != 1){
stop("La suma de los pesos promedio es diferente de 1")
}
}
# Configuración de los pesos promedio
if(is.null(w)){
w <- rep(1/m, m)
}
# Configuración del marco de datos
#---------------------------------
# Cambio del nombre de la columna del objeto de fecha
names(df)[1] <- "date"
# Establecer la partición de entrenamiento y prueba
# según el horizonte de pronóstico
df$type <- c(rep("train", nrow(df) - h),
rep("test", h))
# Expandir la tabla por el tipo de partición
df1 <- df %>% spread(key = type, value = y)
# Crear la variable objetivo
df1$yhat <- df1$train
# Calcular la media móvil simple
for(i in (nrow(df1) - h + 1):nrow(df1)){
r <- (i-m):(i-1)
df1$yhat[i] <- sum(df1$yhat[r] * w)
}
# Eliminar los valores reales de la variable yhat
# que se utilizaron para la ventana móvil
df1$yhat <- ifelse(is.na(df1$test), NA, df1$yhat)
df1$y <- ifelse(is.na(df1$test), df1$train, df1$test)
return(df1)
}
# Convertir la serie temporal en un objeto compatible con Prophet
robusta_df <- ts_to_prophet(robusta)
# Calcular las predicciones para diferentes valores de m
robusta_fc_m1 <- sma_forecast(robusta_df, h = 24, m = 1)
robusta_fc_m6 <- sma_forecast(robusta_df, h = 24, m = 6)
robusta_fc_m12 <- sma_forecast(robusta_df, h = 24, m = 12)
robusta_fc_m24 <- sma_forecast(robusta_df, h = 24, m = 24)
robusta_fc_m36 <- sma_forecast(robusta_df, h = 24, m = 36)
# -------- Code Chank 6 --------
library(plotly)
plot_ly(data = robusta_df[650:nrow(robusta_df),], x = ~ ds, y = ~ y,
type = "scatter", mode = "lines",
name = "Actual") %>%
add_lines(x = robusta_fc_m1$date, y = robusta_fc_m1$yhat,
name = "SMA - 1", line = list(dash = "dash")) %>%
add_lines(x = robusta_fc_m6$date, y = robusta_fc_m6$yhat,
name = "SMA - 6", line = list(dash = "dash")) %>%
add_lines(x = robusta_fc_m12$date, y = robusta_fc_m12$yhat,
name = "SMA - 12", line = list(dash = "dash")) %>%
add_lines(x = robusta_fc_m24$date, y = robusta_fc_m24$yhat,
name = "SMA - 24", line = list(dash = "dash")) %>%
add_lines(x = robusta_fc_m36$date, y = robusta_fc_m36$yhat,
name = "SMA - 36", line = list(dash = "dash")) %>%
layout(title = "Forecasting the Robusta Coffee Monthly Prices",
xaxis = list(title = ""),
yaxis = list(title = "USD per Kg."))
# -------- Code Chank 7 --------
data(USgas)
USgas_df <- ts_to_prophet(USgas)
# -------- Code Chank 8 --------
USgas_fc_m12a <- sma_forecast(USgas_df,
h = 24,
m = 12,
w = c(1, rep(0,11)))
USgas_fc_m12b <- sma_forecast(USgas_df,
h = 24,
m = 12,
w = c(0.8, rep(0,10), 0.2))
# -------- Code Chank 9 --------
plot_ly(data = USgas_df[190:nrow(USgas_df),], x = ~ ds, y = ~ y,
type = "scatter", mode = "lines",
name = "Actual") %>%
add_lines(x = USgas_fc_m12a$date, y = USgas_fc_m12a$yhat,
name = "WMA - Seasonal Lag", line = list(dash = "dash")) %>%
add_lines(x = USgas_fc_m12b$date, y = USgas_fc_m12b$yhat,
name = "WMA - 12 (0.2/0.8)", line = list(dash = "dash")) %>%
layout(title = "Forecasting the Monthly Consumption of Natural Gas in the US",
xaxis = list(title = ""),
yaxis = list(title = "Billion Cubic Feet"))
# -------- Code Chank 10 --------
alpha_df <- data.frame(index = seq(from = 1, to = 15, by = 1),
power = seq(from = 14, to = 0, by = -1))
alpha_df$alpha_0.01 <- 0.01 * (1 - 0.01) ^ alpha_df$power
alpha_df$alpha_0.2 <- 0.2 * (1 - 0.2) ^ alpha_df$power
alpha_df$alpha_0.4 <- 0.4 * (1 - 0.4) ^ alpha_df$power
alpha_df$alpha_0.6 <- 0.6 * (1 - 0.6) ^ alpha_df$power
alpha_df$alpha_0.8 <- 0.8 * (1 - 0.8) ^ alpha_df$power
alpha_df$alpha_1 <- 1 * (1 - 1) ^ alpha_df$power
plot_ly(data = alpha_df) %>%
add_lines(x = ~ index, y = ~ alpha_0.01, name = "alpha = 0.01") %>%
add_lines(x = ~ index, y = ~ alpha_0.2, name = "alpha = 0.2") %>%
add_lines(x = ~ index, y = ~ alpha_0.4, name = "alpha = 0.4") %>%
add_lines(x = ~ index, y = ~ alpha_0.6, name = "alpha = 0.6") %>%
add_lines(x = ~ index, y = ~ alpha_0.8, name = "alpha = 0.8") %>%
add_lines(x = ~ index, y = ~ alpha_1, name = "alpha = 1") %>%
layout(title = "Decay Rate of the SES Weights",
xaxis = list(title = "Index"),
yaxis = list(title = "Weight"))
# -------- Code Chank 11 --------
library(forecast)
## Warning: package 'forecast' was built under R version 4.2.3
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
robusta_par <- ts_split(robusta, sample.out = 12)
train <- robusta_par$train
test <- robusta_par$test
fc_ses <- ses(train, h = 12, initial = "optimal")
fc_ses$model
## Simple exponential smoothing
##
## Call:
## ses(y = train, h = 12, initial = "optimal")
##
## Smoothing parameters:
## alpha = 0.9999
##
## Initial states:
## l = 0.6957
##
## sigma: 0.161
##
## AIC AICc BIC
## 1989.646 1989.681 2003.252
# -------- Code Chank 12 --------
test_forecast(actual = robusta,
forecast.obj = fc_ses,
test = test) %>%
layout(title = "Robusta Coffee Prices Forecast vs. Actual",
xaxis = list(range = c(2010, max(time(robusta)))),
yaxis = list(range = c(1, 3)))
plot_forecast(fc_ses) %>%
add_lines(x = time(test) + deltat(test),
y = as.numeric(test),
name = "Testing Partition") %>%
layout(title = "Robusta Coffee Prices Forecast vs. Actual",
xaxis = list(range = c(2010, max(time(robusta)) +
deltat(robusta))),
yaxis = list(range = c(0, 4)))
robusta_par1 <- ts_split(robusta, sample.out = 24)
train1 <- robusta_par1$train
test1 <- ts_split(robusta_par1$test, sample.out = 12)$train
robusta_par2 <- ts_split(robusta, sample.out = 12)
train2 <- robusta_par2$train
valid <- robusta_par2$test
# -------- Code Chank 15 --------
alpha <- seq(from = 0, to = 1, by = 0.01)
# -------- Code Chank 16 --------
alpha[1] <- 0.001
# -------- Code Chank 17 --------
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
ses_grid <- lapply(alpha, function(i){
md1 <- md_accuracy1 <- md2 <- md_accuracy2 <- results <- NULL
md1 <- ses(train1, h = 12, alpha = i, initial = "simple")
md_accuracy1 <- accuracy(md1, test1)
md2 <- ses(train2, h = 12, alpha = i, initial = "simple")
md_accuracy2 <- accuracy(md2, valid)
resutls <- data.frame(alpha = i,
train = md_accuracy1[9],
test = md_accuracy1[10],
valid = md_accuracy2[10])
}) %>% bind_rows()
# -------- Code Chank 18 --------
plot_ly(data = ses_grid, x = ~ alpha, y = ~ train,
line = list(color = 'rgb(205, 12, 24)'),
type = "scatter",
mode = "lines",
name = "Training") %>%
add_lines(x = ~ alpha, y = ~ test, line = list(color = "rgb(22, 96, 167)", dash = "dash"), name= "Testing") %>%
add_lines(x = ~ alpha, y = ~ valid, line = list(color = "green", dash = "dot"), name = "Validation") %>%
layout(title = "SES Model Grid Search Results",
yaxis = list(title = "MAPE (%)"))
## Warning: package 'Quandl' was built under R version 4.2.3
## Loading required package: xts
## Warning: package 'xts' was built under R version 4.2.3
## Loading required package: zoo
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
##
## ######################### Warning from 'xts' package ##########################
## # #
## # The dplyr lag() function breaks how base R's lag() function is supposed to #
## # work, which breaks lag(my_xts). Calls to lag(my_xts) that you type or #
## # source() into this session won't work correctly. #
## # #
## # Use stats::lag() to make sure you're not using dplyr::lag(), or you can add #
## # conflictRules('dplyr', exclude = 'lag') to your .Rprofile to stop #
## # dplyr from breaking base R's lag() function. #
## # #
## # Code in packages is not affected. It's protected by R's namespace mechanism #
## # Set `options(xts.warn_dplyr_breaks_lag = FALSE)` to suppress this warning. #
## # #
## ###############################################################################
##
## Attaching package: 'xts'
## The following objects are masked from 'package:dplyr':
##
## first, last
gdp <- Quandl("FRED/GDP", start_date = "2010-01-01", type = "ts")
ts_info(gdp)
## The gdp series is a ts object with 1 variable and 48 observations
## Frequency: 4
## Start time: 2010 1
## End time: 2021 4
ts_plot(gdp,
title = "Gross Domestic Product",
Ytitle = "Billions of Dollars",
Xtitle = "Source: U.S. Bureau of Economic Analysis / fred.stlouisfed.org")
gdp_par <- ts_split(gdp, sample.out = 8)
train <- gdp_par$train
test <- gdp_par$test
fc_holt <- holt(train, h = 8, initial = "optimal")
fc_holt$model
## Holt's method
##
## Call:
## holt(y = train, h = 8, initial = "optimal")
##
## Smoothing parameters:
## alpha = 0.9985
## beta = 0.0941
##
## Initial states:
## l = 14603.0487
## b = 161.9411
##
## sigma: 80.9869
##
## AIC AICc BIC
## 504.8838 506.6485 513.3282
## ME RMSE MAE MPE MAPE MASE
## Training set 10.99164 76.83093 61.7626 0.05241543 0.3460477 0.08790283
## Test set -665.87355 1141.19097 854.8069 -3.29699460 4.0874667 1.21659297
## ACF1 Theil's U
## Training set 0.0192117 NA
## Test set 0.2975704 1.08055
test_forecast(gdp, forecast.obj = fc_holt, test = test)
fc_holt_exp <- holt(train,
h = 8,
beta = 0.75 ,
initial = "optimal",
exponential = TRUE)
fc_holt_exp$model
## Holt's method with exponential trend
##
## Call:
## holt(y = train, h = 8, initial = "optimal", exponential = TRUE,
##
## Call:
## beta = 0.75)
##
## Smoothing parameters:
## alpha = 0.781
## beta = 0.75
##
## Initial states:
## l = 14572.2291
## b = 1.0142
##
## sigma: 0.0053
##
## AIC AICc BIC
## 515.9291 517.0720 522.6847
accuracy(fc_holt_exp, test)
## ME RMSE MAE MPE MAPE MASE
## Training set -2.792636 90.20753 74.14323 -0.01756593 0.4165413 0.1055234
## Test set -703.014806 1151.21262 858.97402 -3.46212317 4.1130726 1.2225238
## ACF1 Theil's U
## Training set -0.1541725 NA
## Test set 0.2834645 1.090637
test_forecast(gdp, forecast.obj = fc_holt, test = test)
data(USgas)
decompose(USgas) %>% plot()
USgas_par <- ts_split(USgas, 12)
train <- USgas_par$train
test <- USgas_par$test
md_hw <- HoltWinters(train)
md_hw
## Holt-Winters exponential smoothing with trend and additive seasonal component.
##
## Call:
## HoltWinters(x = train)
##
## Smoothing parameters:
## alpha: 0.371213
## beta : 0
## gamma: 0.4422456
##
## Coefficients:
## [,1]
## a 2491.9930104
## b -0.1287005
## s1 32.0972651
## s2 597.1088003
## s3 834.9628439
## s4 353.8593860
## s5 318.1927058
## s6 -173.0721496
## s7 -346.6229990
## s8 -329.7169608
## s9 -112.1664217
## s10 -140.3186476
## s11 -324.5343787
## s12 -243.9334551
# -------- Code Chank 31 --------
fc_hw <- forecast(md_hw, h = 12)
accuracy(fc_hw, test)
## ME RMSE MAE MPE MAPE MASE
## Training set 7.828361 115.2062 87.67420 0.2991952 4.248131 0.7614222
## Test set 51.013877 115.1555 98.06531 1.7994297 3.766099 0.8516656
## ACF1 Theil's U
## Training set 0.21911103 NA
## Test set -0.01991923 0.3652142
test_forecast(actual = USgas,
forecast.obj = fc_hw,
test = test)
shallow_grid <- ts_grid(train,
model = "HoltWinters",
periods = 6,
window_space = 6,
window_test = 12,
hyper_params = list(alpha = seq(0.1,0.1),
beta = seq(0.1,0.1),
gamma = seq(0.1,0.1)),
parallel = TRUE,
n.cores = 8)
## Warning: Strategy 'multiprocess' is deprecated in future (>= 1.20.0)
## [2020-10-30]. Instead, explicitly specify either 'multisession' (recommended)
## or 'multicore'. In the current R session, 'multiprocess' equals 'multisession'.
## Warning: Detected creation of a 'multiprocess' future. Strategy 'multiprocess'
## is deprecated in future (>= 1.20.0) [2020-10-30]. Instead, explicitly specify
## either 'multisession' (recommended) or 'multicore'. In the current R session,
## 'multiprocess' equals 'multisession'.
## Warning: Detected creation of a 'multiprocess' future. Strategy 'multiprocess'
## is deprecated in future (>= 1.20.0) [2020-10-30]. Instead, explicitly specify
## either 'multisession' (recommended) or 'multicore'. In the current R session,
## 'multiprocess' equals 'multisession'.
## Warning: Detected creation of a 'multiprocess' future. Strategy 'multiprocess'
## is deprecated in future (>= 1.20.0) [2020-10-30]. Instead, explicitly specify
## either 'multisession' (recommended) or 'multicore'. In the current R session,
## 'multiprocess' equals 'multisession'.
## Warning: Detected creation of a 'multiprocess' future. Strategy 'multiprocess'
## is deprecated in future (>= 1.20.0) [2020-10-30]. Instead, explicitly specify
## either 'multisession' (recommended) or 'multicore'. In the current R session,
## 'multiprocess' equals 'multisession'.
## Warning: Detected creation of a 'multiprocess' future. Strategy 'multiprocess'
## is deprecated in future (>= 1.20.0) [2020-10-30]. Instead, explicitly specify
## either 'multisession' (recommended) or 'multicore'. In the current R session,
## 'multiprocess' equals 'multisession'.
## Warning: Detected creation of a 'multiprocess' future. Strategy 'multiprocess'
## is deprecated in future (>= 1.20.0) [2020-10-30]. Instead, explicitly specify
## either 'multisession' (recommended) or 'multicore'. In the current R session,
## 'multiprocess' equals 'multisession'.
## Warning: Detected creation of a 'multiprocess' future. Strategy 'multiprocess'
## is deprecated in future (>= 1.20.0) [2020-10-30]. Instead, explicitly specify
## either 'multisession' (recommended) or 'multicore'. In the current R session,
## 'multiprocess' equals 'multisession'.
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
fc_hw <- forecast(md_hw, h = 12)
accuracy(fc_hw, test)
## ME RMSE MAE MPE MAPE MASE
## Training set 7.828361 115.2062 87.67420 0.2991952 4.248131 0.7614222
## Test set 51.013877 115.1555 98.06531 1.7994297 3.766099 0.8516656
## ACF1 Theil's U
## Training set 0.21911103 NA
## Test set -0.01991923 0.3652142
test_forecast(actual = USgas,
forecast.obj = fc_hw,
test = test)
shallow_grid <- ts_grid(train,
model = "HoltWinters",
periods = 6,
window_space = 6,
window_test = 12,
hyper_params = list(alpha = seq(0.1,0.1),
beta = seq(0.1,0.1),
gamma = seq(0.1,0.1)),
parallel = TRUE,
n.cores = 8)
## Warning: Strategy 'multiprocess' is deprecated in future (>= 1.20.0)
## [2020-10-30]. Instead, explicitly specify either 'multisession' (recommended)
## or 'multicore'. In the current R session, 'multiprocess' equals 'multisession'.
## Warning: Detected creation of a 'multiprocess' future. Strategy 'multiprocess'
## is deprecated in future (>= 1.20.0) [2020-10-30]. Instead, explicitly specify
## either 'multisession' (recommended) or 'multicore'. In the current R session,
## 'multiprocess' equals 'multisession'.
## Warning: Detected creation of a 'multiprocess' future. Strategy 'multiprocess'
## is deprecated in future (>= 1.20.0) [2020-10-30]. Instead, explicitly specify
## either 'multisession' (recommended) or 'multicore'. In the current R session,
## 'multiprocess' equals 'multisession'.
## Warning: Detected creation of a 'multiprocess' future. Strategy 'multiprocess'
## is deprecated in future (>= 1.20.0) [2020-10-30]. Instead, explicitly specify
## either 'multisession' (recommended) or 'multicore'. In the current R session,
## 'multiprocess' equals 'multisession'.
## Warning: Detected creation of a 'multiprocess' future. Strategy 'multiprocess'
## is deprecated in future (>= 1.20.0) [2020-10-30]. Instead, explicitly specify
## either 'multisession' (recommended) or 'multicore'. In the current R session,
## 'multiprocess' equals 'multisession'.
## Warning: Detected creation of a 'multiprocess' future. Strategy 'multiprocess'
## is deprecated in future (>= 1.20.0) [2020-10-30]. Instead, explicitly specify
## either 'multisession' (recommended) or 'multicore'. In the current R session,
## 'multiprocess' equals 'multisession'.
## Warning: Detected creation of a 'multiprocess' future. Strategy 'multiprocess'
## is deprecated in future (>= 1.20.0) [2020-10-30]. Instead, explicitly specify
## either 'multisession' (recommended) or 'multicore'. In the current R session,
## 'multiprocess' equals 'multisession'.
## Warning: Detected creation of a 'multiprocess' future. Strategy 'multiprocess'
## is deprecated in future (>= 1.20.0) [2020-10-30]. Instead, explicitly specify
## either 'multisession' (recommended) or 'multicore'. In the current R session,
## 'multiprocess' equals 'multisession'.
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
shallow_grid$grid_df[1:10,]
## alpha beta gamma 1 2 3 4 5 6
## 1 0.1 0.1 0.1 3.318387 3.926614 5.475698 4.845851 7.792269 9.532803
## NA NA NA NA NA NA NA NA NA NA
## NA.1 NA NA NA NA NA NA NA NA NA
## NA.2 NA NA NA NA NA NA NA NA NA
## NA.3 NA NA NA NA NA NA NA NA NA
## NA.4 NA NA NA NA NA NA NA NA NA
## NA.5 NA NA NA NA NA NA NA NA NA
## NA.6 NA NA NA NA NA NA NA NA NA
## NA.7 NA NA NA NA NA NA NA NA NA
## NA.8 NA NA NA NA NA NA NA NA NA
## mean
## 1 5.815271
## NA NA
## NA.1 NA
## NA.2 NA
## NA.3 NA
## NA.4 NA
## NA.5 NA
## NA.6 NA
## NA.7 NA
## NA.8 NA
deep_grid <- ts_grid(train,
model = "HoltWinters",
periods = 6,
window_space = 6,
window_test = 12,
hyper_params = list(alpha = seq(0.1,0.5,0.01),
beta = seq(0.0,0.1,0.01),
gamma = seq(0.2,0.4,0.01)),
parallel = TRUE,
n.cores = 8)
## Warning in ts_grid(train, model = "HoltWinters", periods = 6, window_space = 6,
## : The value of the 'beta' parameter cannot be equal to 0 replacing 0 with 1e-5
## Warning: Strategy 'multiprocess' is deprecated in future (>= 1.20.0)
## [2020-10-30]. Instead, explicitly specify either 'multisession' (recommended)
## or 'multicore'. In the current R session, 'multiprocess' equals 'multisession'.
## Warning: Detected creation of a 'multiprocess' future. Strategy 'multiprocess'
## is deprecated in future (>= 1.20.0) [2020-10-30]. Instead, explicitly specify
## either 'multisession' (recommended) or 'multicore'. In the current R session,
## 'multiprocess' equals 'multisession'.
## Warning: Detected creation of a 'multiprocess' future. Strategy 'multiprocess'
## is deprecated in future (>= 1.20.0) [2020-10-30]. Instead, explicitly specify
## either 'multisession' (recommended) or 'multicore'. In the current R session,
## 'multiprocess' equals 'multisession'.
## Warning: Detected creation of a 'multiprocess' future. Strategy 'multiprocess'
## is deprecated in future (>= 1.20.0) [2020-10-30]. Instead, explicitly specify
## either 'multisession' (recommended) or 'multicore'. In the current R session,
## 'multiprocess' equals 'multisession'.
## Warning: Detected creation of a 'multiprocess' future. Strategy 'multiprocess'
## is deprecated in future (>= 1.20.0) [2020-10-30]. Instead, explicitly specify
## either 'multisession' (recommended) or 'multicore'. In the current R session,
## 'multiprocess' equals 'multisession'.
## Warning: Detected creation of a 'multiprocess' future. Strategy 'multiprocess'
## is deprecated in future (>= 1.20.0) [2020-10-30]. Instead, explicitly specify
## either 'multisession' (recommended) or 'multicore'. In the current R session,
## 'multiprocess' equals 'multisession'.
## Warning: Detected creation of a 'multiprocess' future. Strategy 'multiprocess'
## is deprecated in future (>= 1.20.0) [2020-10-30]. Instead, explicitly specify
## either 'multisession' (recommended) or 'multicore'. In the current R session,
## 'multiprocess' equals 'multisession'.
## Warning: Detected creation of a 'multiprocess' future. Strategy 'multiprocess'
## is deprecated in future (>= 1.20.0) [2020-10-30]. Instead, explicitly specify
## either 'multisession' (recommended) or 'multicore'. In the current R session,
## 'multiprocess' equals 'multisession'.
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
## Warning in base::is.null(grid.obj$parameters$hyper_params[[i]]) ||
## grid.obj$parameters$hyper_params[[i]] == : 'length(x) = 41 > 1' in coercion to
## 'logical(1)'
## Warning in base::is.null(grid.obj$parameters$hyper_params[[i]]) ||
## grid.obj$parameters$hyper_params[[i]] == : 'length(x) = 11 > 1' in coercion to
## 'logical(1)'
## Warning in base::is.null(grid.obj$parameters$hyper_params[[i]]) ||
## grid.obj$parameters$hyper_params[[i]] == : 'length(x) = 21 > 1' in coercion to
## 'logical(1)'
plot_grid(deep_grid, type = "3D", top = 250)
## Warning in base::is.null(grid.obj$parameters$hyper_params[[i]]) ||
## grid.obj$parameters$hyper_params[[i]] == : 'length(x) = 41 > 1' in coercion to
## 'logical(1)'
## Warning in base::is.null(grid.obj$parameters$hyper_params[[i]]) ||
## grid.obj$parameters$hyper_params[[i]] == : 'length(x) = 11 > 1' in coercion to
## 'logical(1)'
## Warning in base::is.null(grid.obj$parameters$hyper_params[[i]]) ||
## grid.obj$parameters$hyper_params[[i]] == : 'length(x) = 21 > 1' in coercion to
## 'logical(1)'
md_hw_grid <- HoltWinters(train,
alpha = deep_grid$alpha,
beta = deep_grid$beta,
gamma = deep_grid$gamma)
fc_hw_grid <- forecast(md_hw_grid, h = 12)
accuracy(fc_hw_grid, test)
## ME RMSE MAE MPE MAPE MASE ACF1
## Training set 4.106435 117.0347 90.37810 0.2004600 4.387451 0.7849046 0.1526260
## Test set 3.124700 113.5063 97.20942 -0.2685092 3.899686 0.8442324 0.1506711
## Theil's U
## Training set NA
## Test set 0.3687748
test_forecast(actual = USgas,
forecast.obj = fc_hw_grid,
test = test)