Pronóstico del indicador trimestral de actividad económica estatal de Baja California (ITAEE)

Author

Dirección de estadística

# Importar librerías
library("tidyverse")

-- Attaching core tidyverse packages ------------------------ tidyverse 2.0.0 --
v dplyr     1.1.0     v readr     2.1.4
v forcats   1.0.0     v stringr   1.5.0
v ggplot2   3.4.1     v tibble    3.2.1
v lubridate 1.9.2     v tidyr     1.3.0
v purrr     1.0.1     
-- Conflicts ------------------------------------------ tidyverse_conflicts() --
x dplyr::filter() masks stats::filter()
x dplyr::lag()    masks stats::lag()
i Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library("fpp")

Loading required package: forecast
Registered S3 method overwritten by 'quantmod':
  method            from
  as.zoo.data.frame zoo 
Loading required package: fma
Loading required package: expsmooth
Loading required package: lmtest
Loading required package: zoo

Attaching package: 'zoo'

The following objects are masked from 'package:base':

    as.Date, as.Date.numeric

Loading required package: tseries

library("openxlsx")
library("tsibble")


Attaching package: 'tsibble'

The following object is masked from 'package:zoo':

    index

The following object is masked from 'package:lubridate':

    interval

The following objects are masked from 'package:base':

    intersect, setdiff, union

library("fable")

Loading required package: fabletools

Attaching package: 'fabletools'

The following object is masked from 'package:forecast':

    accuracy

library("fpp3")

-- Attaching packages ---------------------------------------------- fpp3 0.5 --
v tsibbledata 0.4.1     v feasts      0.3.1
-- Conflicts ------------------------------------------------- fpp3_conflicts --
x lubridate::date()    masks base::date()
x dplyr::filter()      masks stats::filter()
x tsibble::index()     masks zoo::index()
x tsibble::intersect() masks base::intersect()
x tsibble::interval()  masks lubridate::interval()
x dplyr::lag()         masks stats::lag()
x tsibble::setdiff()   masks base::setdiff()
x tsibble::union()     masks base::union()

Attaching package: 'fpp3'

The following object is masked from 'package:fpp':

    insurance

# Leer archivo

ITAEE <- read.xlsx("D:/Bases de datos/DM/ITAEE/ITAEE_Tidy.xlsx")

# Convertir valores numéricos de Excel a fechas en R
ITAEE$Fecha <- as.Date("1899-12-30") + ITAEE$Fecha

# Formatear las fechas al formato deseado
ITAEE$Fecha <- format(ITAEE$Fecha, "%d/%m/%Y")

# Filtrar el dataframe para seleccionar solo las filas con "Baja California" en la columna "Entidad"
ITAEE_Baja_California <- ITAEE[ITAEE$Entidad == "Baja California", ]

# Convertir a tibble
ITAEE_Baja_California_tibble <- as_tibble(ITAEE_Baja_California)
# Cambiar a formato de fecha la columna "Fecha"
ITAEE_Baja_California_tibble <- ITAEE_Baja_California_tibble %>%
  mutate(Fecha = as.Date(Fecha, format = "%d/%m/%Y"))

# Extraer el año y el trimestre de la columna Fecha
ITAEE_Baja_California_tibble <- ITAEE_Baja_California_tibble %>%
  mutate(AñoTrimestre = yearquarter(Fecha))

ITAEE_Baja_California_tibble

# A tibble: 173 x 4
   Fecha      Entidad         ITAEE AñoTrimestre
   <date>     <chr>           <dbl>        <qtr>
 1 1980-03-01 Baja California  48.1      1980 Q1
 2 1980-06-01 Baja California  48.2      1980 Q2
 3 1980-09-01 Baja California  49.5      1980 Q3
 4 1980-12-01 Baja California  51.7      1980 Q4
 5 1981-03-01 Baja California  53.7      1981 Q1
 6 1981-06-01 Baja California  55.8      1981 Q2
 7 1981-09-01 Baja California  56.1      1981 Q3
 8 1981-12-01 Baja California  56.7      1981 Q4
 9 1982-03-01 Baja California  56.0      1982 Q1
10 1982-06-01 Baja California  56.0      1982 Q2
# i 163 more rows

# Convertir el tibble en un tsibble
ITAEE_Baja_California_tsibble <- ITAEE_Baja_California_tibble %>%
  as_tsibble(index = AñoTrimestre)

ITAEE_Baja_California_tsibble

# A tsibble: 173 x 4 [1Q]
   Fecha      Entidad         ITAEE AñoTrimestre
   <date>     <chr>           <dbl>        <qtr>
 1 1980-03-01 Baja California  48.1      1980 Q1
 2 1980-06-01 Baja California  48.2      1980 Q2
 3 1980-09-01 Baja California  49.5      1980 Q3
 4 1980-12-01 Baja California  51.7      1980 Q4
 5 1981-03-01 Baja California  53.7      1981 Q1
 6 1981-06-01 Baja California  55.8      1981 Q2
 7 1981-09-01 Baja California  56.1      1981 Q3
 8 1981-12-01 Baja California  56.7      1981 Q4
 9 1982-03-01 Baja California  56.0      1982 Q1
10 1982-06-01 Baja California  56.0      1982 Q2
# i 163 more rows

autoplot(ITAEE_Baja_California_tsibble, ITAEE) +
  labs(y = "ITAEE",
       title = "Actividad económica en Baja California (ITAEE)")

ITAEE_Baja_California_tsibble |>
  gg_season(ITAEE, labels = "both") +
  labs(y = "ITAEE",
       title = "Gráfica estacional: actividad económica en Baja California (ITAEE)")

ITAEE_Baja_California_tsibble |>
  gg_subseries(ITAEE) +
  labs(
    y = "ITAEE",
    title = "Actividad económica en Baja California (ITAEE)"
  )

recent_ITAEE <- ITAEE_Baja_California_tsibble |>
  filter(year(Fecha) >= 2015)
recent_ITAEE |>
  gg_lag(ITAEE, geom = "point") +
  labs(x = "ITAEE")

recent_ITAEE |> ACF(ITAEE, lag_max = 9)

# A tsibble: 9 x 2 [1Q]
       lag     acf
  <cf_lag>   <dbl>
1       1Q 0.666  
2       2Q 0.549  
3       3Q 0.459  
4       4Q 0.365  
5       5Q 0.258  
6       6Q 0.189  
7       7Q 0.131  
8       8Q 0.0491 
9       9Q 0.00975

recent_ITAEE |>
  ACF(ITAEE) |>
  autoplot() + labs(title="Actividad económica en Baja California")

fit <- recent_ITAEE |>
  model(trend_model = TSLM(ITAEE ~ trend()))

fit |> forecast(h = "3 years")

# A fable: 12 x 4 [1Q]
# Key:     .model [1]
   .model      AñoTrimestre      ITAEE .mean
   <chr>              <qtr>     <dist> <dbl>
 1 trend_model      2023 Q2 N(133, 23)  133.
 2 trend_model      2023 Q3 N(134, 24)  134.
 3 trend_model      2023 Q4 N(135, 24)  135.
 4 trend_model      2024 Q1 N(136, 24)  136.
 5 trend_model      2024 Q2 N(136, 25)  136.
 6 trend_model      2024 Q3 N(137, 25)  137.
 7 trend_model      2024 Q4 N(138, 25)  138.
 8 trend_model      2025 Q1 N(138, 25)  138.
 9 trend_model      2025 Q2 N(139, 26)  139.
10 trend_model      2025 Q3 N(140, 26)  140.
11 trend_model      2025 Q4 N(140, 27)  140.
12 trend_model      2026 Q1 N(141, 27)  141.

fit |>
  forecast(h = "1 years") |>
  autoplot(recent_ITAEE) +
  labs(y = "ITAEE", title = "Actividad económica de Baja California")

recent_ITAEE_fit <- recent_ITAEE |> 
  model(
    Mean = MEAN(ITAEE),
    Seasonal_naive = SNAIVE(ITAEE ~ lag("year")),
    Naive = NAIVE(ITAEE),
    Drift = RW (ITAEE ~ drift()))

recent_ITAEE_fc <- recent_ITAEE_fit |> 
  forecast(h = "2 years")
recent_ITAEE_fc

# A fable: 32 x 4 [1Q]
# Key:     .model [4]
   .model         AñoTrimestre      ITAEE .mean
   <chr>                 <qtr>     <dist> <dbl>
 1 Mean                2023 Q2 N(122, 68)  122.
 2 Mean                2023 Q3 N(122, 68)  122.
 3 Mean                2023 Q4 N(122, 68)  122.
 4 Mean                2024 Q1 N(122, 68)  122.
 5 Mean                2024 Q2 N(122, 68)  122.
 6 Mean                2024 Q3 N(122, 68)  122.
 7 Mean                2024 Q4 N(122, 68)  122.
 8 Mean                2025 Q1 N(122, 68)  122.
 9 Seasonal_naive      2023 Q2 N(132, 55)  132.
10 Seasonal_naive      2023 Q3 N(133, 55)  133.
# i 22 more rows

recent_ITAEE_fc |>
  autoplot(recent_ITAEE, level = NULL) +
  labs(title = "Pronóstico ITAEE de Baja California") +
  guides(Color = guide_legend (title = "Forecast"))

# Set training data from 1992 to 2006
train <- recent_ITAEE |>
  filter_index("2015 Q1" ~ "2019 Q4")
# Fit the models
recent_ITAEE_fit <- train |>
  model(
    Mean = MEAN(ITAEE),
    `Naïve` = NAIVE(ITAEE),
    `Seasonal naïve` = SNAIVE(ITAEE),
    Drift = RW (ITAEE ~ drift())
  )

# Generate forecasts for 9 quarters
recent_ITAEE_fc <- recent_ITAEE_fit |> forecast(h = 13)

# Plot forecasts against actual values
recent_ITAEE_fc |>
  autoplot(train, level = NULL) +
  autolayer(
    filter_index(recent_ITAEE, "2020 Q3" ~ .),
    colour = "black"
  ) +
  labs(
    y = "ITAEE",
    title = "Test del pronóstico del ITAEE de Baja California"
  ) +
  guides(colour = guide_legend(title = "Forecast"))

Plot variable not specified, automatically selected `.vars = ITAEE`