Gastos

library(tidyverse)
library(fpp3)
library(plotly)
library(readxl)
library(tsibble)
library(tibble)
library(zoo)
library(lubridate)

datos <- read_excel("Gasto.xlsx", sheet = 1)

datos$Date <- as.Date(datos$Date)

Gastos diarios

datos <- as_tsibble(datos, index = Date)
datos

d <- datos |> 
  autoplot(Expense)
ggplotly(d, dynamicTicks = TRUE)

Modelos de referencia

datos_train <- datos |> filter_index(. ~ "2024-02-23")

datos_fit <- datos_train |> 
  model(
    mean = MEAN(Expense),
    snaive = SNAIVE(Expense),
    naive = NAIVE(Expense),
    drift = RW(Expense ~ drift())
  )

datos_fc <- datos_fit |> 
  forecast(h = 12)

datos_fc |> 
  autoplot(datos, level = NULL)

accuracy(datos_fit) |> 
  arrange(MAE)

datos_fc |> 
  accuracy(datos) |> 
  arrange(MAE)

Transformación y descomposición de los datos

lambda <- datos_train |> 
  features(Expense, features = guerrero) |> 
  pull(lambda_guerrero)

dcmp <- datos_train |> 
  model(
    STL(box_cox(Expense, lambda), robust = TRUE)
  ) 

dcmp |> 
  components() |> 
  autoplot()

dcmp |> 
  components() |> 
  ggplot(aes(x = Date, y = season_adjust)) +
  geom_line()

datos_train |> 
  model(
    STL(Expense, robust = TRUE)
  ) |> 
  components() |> 
  autoplot()

Ajuste de los modelos

datos_fit <- datos_train |> 
  model(
    mean = MEAN(Expense),
    ets_AAA = ETS(Expense ~ error("A") + trend("A") + season("A")),
    ets_MAM = ETS(Expense ~ error("M") + trend("A") + season("M")),
    ets_AAdA = ETS(Expense ~ error("A") + trend("Ad") + season("A")),
    ets_MAdM = ETS(Expense ~ error("M") + trend("Ad") + season("M")),
    
    stl_ets_A = decomposition_model(
      STL(Expense, robust = TRUE),
      ETS(season_week ~ error('A') + trend('N')+ season('A')),
      ETS(season_adjust~ error('A') + trend('Ad')+ season('N'))
    )
  )
datos_fit

accuracy(datos_fit) |> 
  arrange(MAE)

Análisis de residuos

datos_fit |> 
  augment() |> 
  features(.innov, ljung_box, lag = 8) |> 
  arrange(lb_pvalue)

Pronóstico para test

datos_fc <- datos_fit |> 
  forecast(h = 12)

datos_fc

datos_fc |> 
  autoplot(datos, level = NULL)

datos_fc |> 
  autoplot(datos |> filter_index("2024-02-15" ~ .), level = NULL)

datos_fc |> 
  autoplot(datos |> filter_index("2024-02-15" ~ .)) + 
  facet_wrap(~ .model, ncol = 3) + theme(legend.position = "bottom")

datos_fc |> 
  accuracy(datos) |> 
  arrange(MAE)

Pronóstico

datos_fut <- datos |> 
  model(
    ets_AAdA = ETS(Expense ~ error("A") + trend("Ad") + season("A"))
  ) |> 
  forecast(h = "14 days")

datos_fut2 <- datos |> 
  model(
    mean = MEAN(Expense)
  ) |> 
  forecast(h = "14 days")

datos_fut2

datos_fut2 |> 
  autoplot(datos |>filter_index("2024-02-15" ~ .)) + ggtitle("Mean")

datos_fut

datos_fut |> 
  autoplot(datos |>filter_index("2024-02-15" ~ .)) + ggtitle("ETS")

m2 <- datos_fut2 |> 
  filter(.model == 'mean')
m2 <- as_tibble(m2)
m2 <- as_tsibble(m2, index = Date)
km2 <- m2 |> 
  select(c(Date, .mean)) |> 
  autoplot(.mean) + ggtitle("Mean") + ylab("Gasto $") + xlab("Fecha")
ggplotly(km2, dynamicTicks = TRUE)

m <- datos_fut |> 
  filter(.model == 'ets_AAdA')
m <- as_tibble(m)
m <- as_tsibble(m, index = Date)
km <- m |> 
  select(c(Date, .mean)) |> 
  autoplot(.mean) + ggtitle("Pronóstico ETS") + ylab("Gasto $") + xlab("Fecha")
ggplotly(km, dynamicTicks = TRUE)

Modelo ARIMA

Prueba de diferenciación

datos_train |> 
  features(Expense, unitroot_ndiffs)

Análisis de grados

datos_train |> 
  gg_tsdisplay(Expense, plot_type = "partial")

Ajuste de los modelos

datos_fit2 <- datos_train |> 
  model(
    arima_000 = ARIMA(Expense ~ pdq(0,0,0) + PDQ(0,0,0)),
    arima_100 = ARIMA(Expense ~ pdq(1,0,0) + PDQ(0,0,0)),
    arima_001 = ARIMA(Expense ~ pdq(0,0,1) + PDQ(0,0,0)),
  )

datos_fit2

datos_fit2 |> 
  glance() |> 
  arrange(AICc)

accuracy(datos_fit2) |> 
  arrange(MAE)

Análisis de residuos

datos_fit2 |> 
  select(arima_000) |> 
  gg_tsresiduals()

datos_fit2 |> 
  select(arima_001) |> 
  gg_tsresiduals()

datos_fit2 |> 
  augment() |> 
  features(.innov, ljung_box, lag = 10) |> 
  mutate(residuos_autocorrelacionados = if_else(lb_pvalue >=0.05, "No autocorrelación", "Autocorrelacionados"))

Pronóstico para test

datos_fc2 <- datos_fit2 |> 
  forecast(h = 12)

datos_fc2

datos_fc2 |> 
  autoplot(datos, level = NULL)

datos_fc2 |> 
  autoplot(datos |> filter_index("2024-02-15" ~ .), level = NULL)

datos_fc2 |> 
  autoplot(datos |> filter_index("2024-02-15" ~ .)) + 
  facet_wrap(~ .model, ncol = 3) + theme(legend.position = "bottom")

datos_fc2 |> 
  accuracy(datos) |> 
  arrange(MAE)

Pronóstico

datos_fut3 <- datos |> 
  model(
    arima_001 = ARIMA(Expense ~ pdq(0,0,1) + PDQ(0,0,0))
  ) |> 
  forecast(h = "14 days")


datos_fut3

datos_fut3 |> 
  autoplot(datos |>filter_index("2024-02-15" ~ .)) + ggtitle("Arima 001")