## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ----setup--------------------------------------------------------------------
library(utsf)

## -----------------------------------------------------------------------------
m <- create_model(AirPassengers, lags = 1:12, method = "rt")
f <- forecast(m, h = 12)

## -----------------------------------------------------------------------------
f$pred
library(ggplot2)
autoplot(f)

## -----------------------------------------------------------------------------
head(m$targets)  # first targets
head(m$features) # and its associated features

## -----------------------------------------------------------------------------
t <- ts(c(1, 3, 6, 7, 9, 11, 16))
out <- create_model(t, lags = c(1, 2, 4), trend = "none")
cbind(out$features, Target = out$targets)

## -----------------------------------------------------------------------------
m <- create_model(USAccDeaths, method = "mt")
f <- forecast(m, h = 12, PI = TRUE, level = 90)
f
library(ggplot2)
autoplot(f)

## -----------------------------------------------------------------------------
m <- create_model(fdeaths, lags = 1:12, method = "rt")
m$model

## -----------------------------------------------------------------------------
# Modeling function: in this case (k-NN) just stores the training set
my_knn_model <- function(X, y, ...) { structure(list(X = X, y = y), class = "my_knn") }

# Regression function
predict.my_knn <- function(object, new_value) {
  FNN::knn.reg(train = object$X, test = new_value, y = object$y)$pred
}

m <- create_model(AirPassengers, lags = 1:12, method = my_knn_model)
f <- forecast(m, h = 12)
f$pred
autoplot(f)

## -----------------------------------------------------------------------------
# Modeling function
my_knn_model2 <- function(X, y, ...) {
  structure(list(X = X, y = y), class = "my_knn2")
}

# Regression function
predict.my_knn2 <- function(object, new_value) {
  k <- 3 # number of nearest neighbors
  distances <- sapply(1:nrow(object$X), function(i) sum((object$X[i, ] - new_value)^2))
  k_nearest <- order(distances)[1:k]
  mean(object$y[k_nearest])
}

m2 <- create_model(AirPassengers, lags = 1:12, method = my_knn_model2)
forecast(m2, h = 12)$pred

## -----------------------------------------------------------------------------
library(randomForest)
my_model <- function(X, y, ...) { randomForest(x = X, y = y) }
m <- create_model(USAccDeaths, lags = 1:12, method = my_model)
f <- forecast(m, h = 12)
library(ggplot2)
autoplot(f)
print(m$model)

## -----------------------------------------------------------------------------
library(nnet)
my_model <- function(X, y, ...) {
  nnet(x = X, y = y, size = 5, linout = TRUE, trace = FALSE)
}
m <- create_model(USAccDeaths, lags = 1:12, method = my_model)
f <- forecast(m, h = 12)
library(ggplot2)
autoplot(f)

## -----------------------------------------------------------------------------
# A bagging model set with default parameters
m <- create_model(USAccDeaths, lags = 1:12, method = "bagging")
length(m$model$mtrees) # number of regression trees (25 by default)
# A bagging model set with 3 regression trees
m2 <- create_model(USAccDeaths,
                   lags = 1:12,
                   method = "bagging",
                   nbagg = 3
)
length(m2$model$mtrees) # number of regression trees

## -----------------------------------------------------------------------------
# Function to train the model
my_knn_model <- function(X, y, ...) {
  param <- list(...)
  k <- if ("k" %in% names(param)) param$k else 3
  structure(list(X = X, y = y, k = k), class = "my_knn")
}

# Regression function for object of class my_knn
predict.my_knn <- function(object, new_value) {
  FNN::knn.reg(train = object$X, test = new_value,
               y = object$y, k = object$k)$pred
}

# The model is trained with default parameters (k = 3)
m <- create_model(AirPassengers, lags = 1:12,  method = my_knn_model)
print(m$model$k)
# The model is trained with k = 5
m2 <- create_model(AirPassengers, method = my_knn_model, k = 5)
print(m2$model$k)

## -----------------------------------------------------------------------------
library(randomForest)
my_model <- function(X, y, ...) {
    param <- list(...)
    args <- list(x = X, y = y, ntree = 200) # default parameters
    args <- args[!(names(args) %in% names(param))]
    args <- c(args, param)
    do.call(randomForest::randomForest, args = args)
}
# The random forest is built with our default parameters
m <- create_model(USAccDeaths, method = my_model)
print(m$model$ntree)
print(m$model$mtry)
# The random forest is built with ntree = 400 and mtry = 6
m <- create_model(USAccDeaths, method = my_model, ntree = 400, mtry = 6)
print(m$model$ntree)
print(m$model$mtry)

## -----------------------------------------------------------------------------
m <- create_model(UKgas, lags = 1:4, method = "knn")
r <- efa(m, h = 4, type = "normal", size = 8)
r$per_horizon
r$global

## ----out.width = '85%', echo = FALSE------------------------------------------
knitr::include_graphics("ro_normal.png")

## ----eval = FALSE-------------------------------------------------------------
# m <- create_model(UKgas, lags = 1:4, method = "knn")
# # Use the last 9 observations of the series to build test sets
# r1 <- efa(m, h = 4, type = "normal", size = 9)
# # Use the last 20% observations of the series to build test sets
# r2 <- efa(m, h = 4, type = "normal", prop = 0.2)

## -----------------------------------------------------------------------------
m <- create_model(UKgas, lags = 1:4, method = "knn")
r <- efa(m, h = 4, type = "minimum")
r$per_horizon
r$global

## ----out.width = '85%', echo = FALSE------------------------------------------
knitr::include_graphics("ro_minimum.png")

## -----------------------------------------------------------------------------
timeS <- ts(1:25)
m <- create_model(timeS, lags = 1:3, method = "mt")
r <- efa(m, h = 5, size = 7)
r$test_sets
r$predictions

## -----------------------------------------------------------------------------
timeS <- ts(1:25)
m <- create_model(timeS, lags = 1:3, method = "mt")
r <- efa(m, h = 3, type = "minimum")
r$test_sets
r$predictions

## -----------------------------------------------------------------------------
m <- create_model(UKgas, lags = 1:4, method = "knn")
r <- tune_grid(m, h = 4, tuneGrid = expand.grid(k = 1:7), type = "normal", size = 8)
# To see the estimated forecast accuracy with the different configurations
r$tuneGrid

## -----------------------------------------------------------------------------
r$best
r$forecast

## -----------------------------------------------------------------------------
plot(r$tuneGrid$k, r$tuneGrid$RMSE, type = "o", pch = 19, xlab = "k (number of nearest neighbors)", ylab = "RMSE", main = "Estimated accuracy")

## -----------------------------------------------------------------------------
m <- create_model(UKDriverDeaths, lags = 1:12, method = "rf")
r <- tune_grid(m, 
               h = 12, 
               tuneGrid = expand.grid(num.trees = c(200, 500), replace = c(TRUE, FALSE), mtry = c(4, 8)),
               type = "normal", 
               size = 12
)
r$tuneGrid

## -----------------------------------------------------------------------------
m <- create_model(airmiles, lags = 1:4, method = "rf", trend = "none")
f <- forecast(m, h = 4)
autoplot(f)

## -----------------------------------------------------------------------------
m <- create_model(airmiles, lags = 1:4, method = "rf", trend = "differences", nfd = 1)
f <- forecast(m, h = 4)
autoplot(f)

## -----------------------------------------------------------------------------
# The order of first differences is estimated using the ndiffs function
m <- create_model(airmiles, lags = 1:4, method = "rf", trend = "differences", nfd = -1)
m$differences

## -----------------------------------------------------------------------------
timeS <- ts(c(1, 3, 7, 9, 10, 12))
m <- create_model(timeS, lags = 1:2, trend = "none")
cbind(m$features, Targets = m$targets)

## -----------------------------------------------------------------------------
timeS <- ts(c(1, 3, 7, 9, 10, 12))
m <- create_model(timeS, lags = 1:2, trend = "additive", transform_features = FALSE)
cbind(m$features, Targets = m$targets)

## -----------------------------------------------------------------------------
timeS <- ts(c(1, 3, 7, 9, 10, 12))
m <- create_model(timeS, lags = 1:2, trend = "additive", transform_features = TRUE)
cbind(m$features, Targets = m$targets)

## -----------------------------------------------------------------------------
m <- create_model(airmiles, lags = 1:4, method = "rf")
f <- forecast(m, h = 4)
autoplot(f)

## -----------------------------------------------------------------------------
t <- ts(10 * 1.05^(1:20))
m_m <- create_model(t, lags = 1:3, method = "rf", trend = "multiplicative")
f_m <- forecast(m_m, h = 4)
m_a <- create_model(t, lags = 1:3, method = "rf", trend = "additive")
f_a <- forecast(m_a, h = 4)
library(vctsfr)
plot_predictions(t, predictions = list(Multiplicative = f_m$pred, Additive = f_a$pred))

## ----fig.width= 6-------------------------------------------------------------
m_m <- create_model(AirPassengers, lags = 1:12, method = "knn", trend = "multiplicative")
f_m <- forecast(m_m, h = 36)
m_a <- create_model(AirPassengers, lags = 1:12, method = "knn", trend = "additive")
f_a <- forecast(m_a, h = 36)
library(vctsfr)
plot_predictions(AirPassengers, predictions = list(Multiplicative = f_m$pred, Additive = f_a$pred))