Proyecto final

pkgs

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

Datos

Importación de datos

train <- read_csv("train.csv", show_col_types = FALSE)
train_tsbl <- train |> 
  as_tsibble(index = date, key = c(store_nbr, family)) 

train_tsbl

Limpieza de datos

cerrado <- train_tsbl |> 
  count_gaps(.full = TRUE) |> 
  distinct(.from)

Warning: Returning more (or less) than 1 row per `summarise()` group was deprecated in
dplyr 1.1.0.
ℹ Please use `reframe()` instead.
ℹ When switching from `summarise()` to `reframe()`, remember that `reframe()`
  always returns an ungrouped data frame and adjust accordingly.
ℹ The deprecated feature was likely used in the tsibble package.
  Please report the issue at <https://github.com/tidyverts/tsibble/issues>.

cerrado

train_tsbl <- train_tsbl |> 
  fill_gaps(.full = TRUE, 
            sales = 0L, 
            onpromotion = 0L)

train_tsbl

Gráfica

train_tsbl |> 
  autoplot(sales, alpha = 0.3) + 
  theme(legend.position = "none")

Train/Test

data_train <- train_tsbl |>  
  filter_index(. ~ "2016-08-15")

data_train |> 
  features(sales, unitroot_nsdiffs)

data_train |> 
  features(sales, unitroot_ndiffs)

Ajuste de modelos

tictoc::tic()
data_fit <- data_train |> 
  model(
    combinado = (ETS(sales ~ error("A") + trend("N") + season("A")) + 
                   ARIMA(sales ~ pdq(0,0,0) + PDQ(0,1,1) + 1))/2,
    #combi_2 = (ETS(sales ~ error("A") + trend("N") + season("A")) + 
                   #ARIMA(sales ~ pdq(1,1,1) + PDQ(0,1,1) + 1))/2,
    #combi_3 = (ETS(sales ~ error("A") + trend("N") + season("A")) + 
                   #ARIMA(sales ~ pdq(1,0,1) + PDQ(1,1,1) + 1))/2,
    #ets_ANA = ETS(sales ~ error("A") + trend("N") + season("A")),
    #arima_111_011 = ARIMA(sales ~ pdq(1,1,1) + PDQ(0,1,1) + 1),
    #reg_x_partes = TSLM(passengers~ season() + 
                          #trend(knots = as.Date("2015-05-01")))
  )

Warning in sqrt(diag(best$var.coef)): Se han producido NaNs

Warning: 120 errors (1 unique) encountered for combinado
[120] non-finite value supplied by optim

tictoc::toc()

1088.55 sec elapsed

data_fit

data_fit |> 
  accuracy()

Forecast del test

tictoc::tic()
data_fc <- data_fit |> 
  forecast(h = "1 year")
tictoc::toc()

729.5 sec elapsed

data_fc |> 
  accuracy(train_tsbl)

Forecast

tictoc::tic()
train_fut <- train_tsbl |> 
  model(
    combinado = (ETS(sales ~ error("A") + trend("N") + season("A")) +  ARIMA(sales ~ pdq(0,0,0) + PDQ(0,1,1) + 1))/2
  ) |> 
  forecast(h = 16)

Warning in sqrt(diag(best$var.coef)): Se han producido NaNs

Warning in sqrt(diag(best$var.coef)): Se han producido NaNs

Warning: 53 errors (1 unique) encountered for combinado
[53] non-finite value supplied by optim

tictoc::toc()

1573.81 sec elapsed

train_fut

Kaggle

test <- read_csv("test.csv", show_col_types = FALSE)
test

submission <- train_fut |> 
  left_join(test, by = c("date", "store_nbr", "family")) |> 
  as_tibble() |> 
  select(id, .mean) |>   
  rename(sales = .mean)
submission

submission$sales <- replace(submission$sales, is.na(submission$sales), 0)
submission

submission |> 
  write_csv("submission.csv")