Set-up

#install.packages(c("forecast", "ggplot2", "ranger"))
library("forecast")
library("ggplot2")

data("gold")
dat_gold <- gold

data("wineind")
dat_wine <- wineind

forecast::autoplot(dat_gold, xlab = "Zeit", ylab = "Goldpreis [USD]")

forecast::autoplot(dat_wine, xlab = "Zeit", ylab = "Weinverläufe [Anzahl]")

Zur Veranschaulichung der Vorhersagemethoden werden zwei Zeitreihen verwendet. Eine, welche den morgendlichen Goldpreis vom 01.01.1985 - 31.03.1989 in US-Dollar angibt (tägliche Auflösung) und eine, welche die Gesamtzahl der verkauften Weinflaschen bis max. 1 Liter von Januar 1980 - August 1994 angibt (monatliche Auflösung).

Da die Wein-Daten ein klares saisonales Muster aufweisen, werden diese auf Methoden angewandt, die Saisonalität berücksichtigen können. Die Gold-Daten werden für alle übrigen Methoden verwendet.

Preprocessing

Wie die Unstetigkeiten an manchen Stellen der Kurve zeigen, enthält die Zeitreihe der Gold-Daten fehlende Werte. Dies wird verifiziert durch

any(is.na(dat_gold))
## [1] TRUE

Da viele Methoden allerdings keine fehlenden Werte unterstützten, müssen die fehlenden Werte vorher behandelt werden. Der Einfachkeit halber wird sich hier für eine lineare Interpolation der Werte entschieden.

dat_gold_imp <- forecast::na.interp(dat_gold)

forecast::autoplot(dat_gold_imp, xlab = "Zeit", ylab = "Goldpreis [USD]")

any(is.na(dat_gold_imp))
## [1] FALSE

Ansonsten zeigt die Zeitreihe der Gold-Daten keine Auffälligkeiten, sodass diese nun zur Vorhersage verwendet werden kann.

Die Zeitreihe der Wein-Daten zeigt ebenfalls keine Auffälligkeiten.

Naive

fcast_naive <- forecast::naive(dat_gold_imp, h = 365, level = FALSE)

autoplot(fcast_naive, xlab = "Zeit", ylab = "Goldpreis [USD]", fcol = "red", main = "Vorhersage der naiven Methode")

Moving Average

mod_ma <- forecast::ma(dat_gold_imp, order = 3)
fcast_ma <- forecast::forecast(mod_ma, h = 365, level = FALSE)

autoplot(fcast_ma, xlab = "Zeit", ylab = "Goldpreis [USD]", fcol = "red", main = "Vorhersage des Moving Average Modells")

Simple Exponential Smoothing

fcast_ses <- forecast::ses(dat_gold_imp, h = 365, level = FALSE)

autoplot(fcast_ses, xlab = "Zeit", ylab = "Goldpreis [USD]", fcol = "red",
         main = "Vorhersage des Simple Exponential Smoothing Modells")

Seasonal Naive

fcast_snaive <- forecast::snaive(dat_wine, level = FALSE)

autoplot(fcast_snaive, xlab = "Zeit", ylab = "Weinverläufe [Anzahl]", fcol = "red",
         main = "Vorhersage der Seasonal Naive Methode")

Holt’s Methode

fcast_holt <- forecast::holt(dat_gold_imp, h = 365, level = FALSE)

autoplot(fcast_holt, xlab = "Zeit", ylab = "Goldpreis [USD]", fcol = "red", main = "Vorhersage von Holt's Methode")

Holt-Winters’ Methode

fcast_hw <- forecast::hw(dat_wine, level = FALSE)

autoplot(fcast_hw, xlab = "Zeit", ylab = "Weinverläufe [Anzahl]", fcol = "red",
         main = "Vorhersage von Holt-Winters' Methode")

ARIMA

mod_arima <- forecast::auto.arima(dat_gold_imp)
fcast_arima <- forecast::forecast(mod_arima, h = 365, level = FALSE)

autoplot(fcast_arima, xlab = "Zeit", ylab = "Goldpreis [USD]", fcol = "red", main = "Vorhersage des ARIMA-Modells")

SARIMA

mod_sarima <- forecast::auto.arima(dat_wine, seasonal = TRUE)
fcast_sarima <- forecast::forecast(mod_sarima, level = FALSE)

autoplot(fcast_sarima, xlab = "Zeit", ylab = "Weinverläufe [Anzahl]", fcol = "red", main = "Vorhersage des SARIMA-Modells")

Lineare Regression

mod_lm <- forecast::tslm(dat_gold_imp ~ trend)
fcast_lm <- forecast(mod_lm, h = 365, level = FALSE)

autoplot(fcast_lm, xlab = "Zeit", ylab = "Goldpreis [USD]", fcol = "red", main = "Vorhersage der linearen Regression") +
  geom_abline(intercept = mod_lm$coefficients[1], slope = mod_lm$coefficients[2], linetype = "dashed")

mod_lm <- forecast::tslm(dat_wine ~ trend + season)
fcast_lm <- forecast(mod_lm, h = 24, level = FALSE)

autoplot(fcast_lm, xlab = "Zeit", ylab = "Weinverläufe [Anzahl]", fcol = "red", main = "Vorhersage der linearen Regression")

Random Forest

library("ranger")

tab_gold_imp <- data.frame(time = seq(along = dat_gold_imp), target = dat_gold_imp)
tab_gold_imp_lag <- as.data.frame(mapply(function(i) c(rep(NA, i), dat_gold_imp[seq(1, length(dat_gold_imp) - i)]), 1:365))

tab_gold_imp <- cbind(tab_gold_imp, tab_gold_imp_lag)
tab_gold_imp <- na.omit(tab_gold_imp)

set.seed(123)
mod_rf <- ranger::ranger(target ~ ., data = tab_gold_imp)
roll_forward_one_step <- function() {
  tab_new <- data.frame(max(tab_gold_imp$time) + 1, NA, tab_gold_imp[nrow(tab_gold_imp), 2:366])
  colnames(tab_new) <- colnames(tab_gold_imp)
  
  rbind(tab_gold_imp, tab_new)
}

insert_forecast <- function(fcast) {
  tab_gold_imp[nrow(tab_gold_imp), "target"] <- fcast
  
  tab_gold_imp
}

for (i in 1:365) {
  tab_gold_imp <- roll_forward_one_step()
  fcast <- predict(mod_rf, data = tab_gold_imp[nrow(tab_gold_imp), ])$predictions
  tab_gold_imp <- insert_forecast(fcast)
}
tab_gold_imp_obs <- tab_gold_imp[seq(1, nrow(tab_gold_imp) - 365), ]
tab_gold_imp_fcast <- tab_gold_imp[seq(nrow(tab_gold_imp) - 364, nrow(tab_gold_imp)), ]

ggplot() +
  geom_line(data = tab_gold_imp_obs, aes(x = time, y = target), color = "black") +
  geom_line(data = tab_gold_imp_fcast, aes(x = time, y = target), color = "red") +
  labs(x = "Zeit", y = "Goldpreis [USD]", title = "Vorhersage des Random Forest")