Prophet

library(tidyverse)
library(fpp3)
library(fable.prophet)

lax_passengers <- read.csv("https://raw.githubusercontent.com/mitchelloharawild/fable.prophet/master/data-raw/lax_passengers.csv")


lax_passengers <- lax_passengers |>
  mutate(datetime = mdy_hms(ReportPeriod)) |>
  group_by(month = yearmonth(datetime), type = Domestic_International) |>
  summarise(passengers = sum(Passenger_Count), .groups = "drop") |>
  ungroup() |> 
  as_tsibble(index = month, key = type)

Prophet

lax_passengers

lax_passengers |> 
  autoplot(passengers) +
  theme(legend.position = "top")

Train/Test

lax_pass_train <- lax_passengers |> 
  filter_index(.~"2017 Mar.")

lax_pass_train

Ajuste de Modelos

tictoc::tic()
lax_pass_fit <- lax_pass_train |> 
  model(
    snaive = SNAIVE(passengers),
    snaive_drift = decomposition_model(
      STL(passengers, robust = TRUE),
      RW(season_adjust ~ drift())
    ),
    ets = ETS(passengers),
    sarima = ARIMA(passengers),
    reg_lin = TSLM(passengers ~ season() + trend()),
    reg_x_partes = TSLM(passengers~ season() + trend(knots = as.Date("2010-01-01"))),
    harmonic = ARIMA(passengers ~ fourier(K = 2) + PDQ(0,0,0)),
    prophet = prophet(passengers ~ growth("linear") + season("year", type = "multiplicative")),
    prophet_auto = prophet(passengers)
  )
tictoc::toc()

25.8 sec elapsed

lax_pass_fit

accuracy(lax_pass_fit) |> 
  arrange(type, MAPE) |> 
  select(type, .model, .type, MAPE, MASE, MAE, RMSE)

Pronóstico Test

lax_pass_fc <- lax_pass_fit |> 
  forecast(h = "2 years")

Warning: There were 2 warnings in `mutate()`.
The first warning was:
ℹ In argument: `reg_x_partes = (function (object, ...) ...`.
Caused by warning:
! prediction from a rank-deficient fit may be misleading
ℹ Run `dplyr::last_dplyr_warnings()` to see the 1 remaining warning.

lax_pass_fc |> 
  autoplot(lax_passengers |> filter_index("2014 Jan." ~ .), level = NULL)

p <- lax_pass_fc |> 
  ggplot(aes(x = month, y = .mean)) +
  geom_line(data = lax_passengers|> filter_index("2014 Jan." ~ .), aes(y = passengers)) +
  geom_line(aes(color = .model)) +
  facet_wrap(~ type, scales = "free_y", ncol = 1)

Warning: The output of `fortify(<fable>)` has changed to better suit usage with the ggdist package.
If you're using it to extract intervals, consider using `hilo()` to compute intervals, and `unpack_hilo()` to obtain values.

plotly::ggplotly(p, dynamicTicks = TRUE)

Combinamos los modelos ets, prohet_auto y sarima

lax_pass_fit <- lax_pass_fit |> 
  mutate(combinado = (ets + prophet_auto+sarima)/3)
lax_pass_fit

lax_pass_fc <- lax_pass_fit |> 
  forecast(h = "2 years")

Warning: There were 2 warnings in `mutate()`.
The first warning was:
ℹ In argument: `reg_x_partes = (function (object, ...) ...`.
Caused by warning:
! prediction from a rank-deficient fit may be misleading
ℹ Run `dplyr::last_dplyr_warnings()` to see the 1 remaining warning.

p <- lax_pass_fc |> 
  ggplot(aes(x = month, y = .mean)) +
  geom_line(data = lax_passengers|> filter_index("2014 Jan." ~ .), aes(y = passengers)) +
  geom_line(aes(color = .model)) +
  facet_wrap(~ type, scales = "free_y", ncol = 1)

Warning: The output of `fortify(<fable>)` has changed to better suit usage with the ggdist package.
If you're using it to extract intervals, consider using `hilo()` to compute intervals, and `unpack_hilo()` to obtain values.

plotly::ggplotly(p, dynamicTicks = TRUE)

lax_pass_fc |> 
  accuracy(lax_passengers) |> 
  arrange(type, MAPE) |> 
  select(type, .model, .type, MAPE, MASE, MAE, RMSE)

lax_pass_fit <- lax_pass_fit |> 
  mutate(combinado2 = (combinado + prophet)/2,
         combinado3 = (prophet + prophet_auto + ets + sarima)/4)

lax_pass_fc <- lax_pass_fit |> 
  select(combinado, combinado2, combinado3, prophet, prophet_auto, sarima, ets) |> 
  forecast(h = "2 years")

p <- lax_pass_fc |> 
  ggplot(aes(x = month, y = .mean)) +
  geom_line(data = lax_passengers|> filter_index("2014 Jan." ~ .), aes(y = passengers)) +
  geom_line(aes(color = .model)) +
  facet_wrap(~ type, scales = "free_y", ncol = 1)

Warning: The output of `fortify(<fable>)` has changed to better suit usage with the ggdist package.
If you're using it to extract intervals, consider using `hilo()` to compute intervals, and `unpack_hilo()` to obtain values.

plotly::ggplotly(p, dynamicTicks = TRUE)

lax_pass_fc |> 
  accuracy(lax_passengers) |> 
  arrange(type, MAPE) |> 
  select(type, .model, .type, MAPE, MASE, MAE, RMSE)