Pronósticos
Registered S3 method overwritten by 'quantmod':
method from
as.zoo.data.frame zoo
── Attaching packages ────────────────────────────────────────────── fpp2 2.4 ──
✔ ggplot2 3.4.0 ✔ fma 2.4
✔ forecast 8.20 ✔ expsmooth 2.3
── Attaching packages ──────────────────────────────────────────── fpp3 0.4.0 ──
✔ tibble 3.1.8 ✔ tsibble 1.1.3
✔ dplyr 1.0.10 ✔ tsibbledata 0.4.1
✔ tidyr 1.2.1 ✔ feasts 0.3.0
✔ lubridate 1.9.0 ✔ fable 0.3.2
── Conflicts ───────────────────────────────────────────────── fpp3_conflicts ──
✖ lubridate::date() masks base::date()
✖ dplyr::filter() masks stats::filter()
✖ tsibble::intersect() masks base::intersect()
✖ tsibble::interval() masks lubridate::interval()
✖ dplyr::lag() masks stats::lag()
✖ tsibble::setdiff() masks base::setdiff()
✖ tsibble::union() masks base::union()
Attaching package: 'fpp3'
The following object is masked from 'package:fpp2':
insurance
── Attaching packages
───────────────────────────────────────
tidyverse 1.3.2 ──
✔ readr 2.1.3 ✔ stringr 1.5.0
✔ purrr 1.0.1 ✔ forcats 0.5.2
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ lubridate::as.difftime() masks base::as.difftime()
✖ lubridate::date() masks base::date()
✖ dplyr::filter() masks stats::filter()
✖ tsibble::intersect() masks lubridate::intersect(), base::intersect()
✖ tsibble::interval() masks lubridate::interval()
✖ dplyr::lag() masks stats::lag()
✖ tsibble::setdiff() masks lubridate::setdiff(), base::setdiff()
✖ tsibble::union() masks lubridate::union(), base::union()
library (ggplot2)library (tsibbledata)library (tsibble)library (forecast)library (fma)library (expsmooth)library (feasts)
1. Conseguir datos históricos sobre dos series de tiempo.
<- global_economy %>% filter (Country == "Mexico" ) %>% ggplot (aes (x = Year, y = GDP/ Population)) + geom_line (color = "pink" ) + ggtitle ("GDP of Mexico" )
2. Seguir los pasos del flujo de trabajo de pronóstico.
<- global_economy %>% filter (Country == "Mexico" ) %>% mutate (GDPpC = GDP/ Population) %>% select (Country, Year, GDP, GDPpC)
# A tsibble: 58 x 4 [1Y]
# Key: Country [1]
Country Year GDP GDPpC
<fct> <dbl> <dbl> <dbl>
1 Mexico 1960 13040000000 342.
2 Mexico 1961 14160000000 359.
3 Mexico 1962 15200000000 374.
4 Mexico 1963 16960000000 404.
5 Mexico 1964 20080000000 464.
6 Mexico 1965 21840000000 489.
7 Mexico 1966 24320000000 529.
8 Mexico 1967 26560000000 560.
9 Mexico 1968 29360000000 600.
10 Mexico 1969 32480000000 644.
# … with 48 more rows
3. Estimar los modelos de referencia (benchmark ) que consideren adecuados para su serie.
<- PIBperC_Mexico %>% filter_index (. ~ "2005" )<- Mexico_train %>% model (Media = MEAN (GDPpC),Ingenuo = NAIVE (GDPpC),` Estacional ` = SNAIVE (GDPpC),Deriva = RW ((GDPpC) ~ drift ())
Warning: 1 error encountered for Estacional
[1] Non-seasonal model specification provided, use RW() or provide a different lag specification.
<- augment (Mexico_fit)
# A tsibble: 184 x 7 [1Y]
# Key: Country, .model [4]
Country .model Year GDPpC .fitted .resid .innov
<fct> <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
1 Mexico Media 1960 342. 2872. -2530. -2530.
2 Mexico Media 1961 359. 2872. -2512. -2512.
3 Mexico Media 1962 374. 2872. -2498. -2498.
4 Mexico Media 1963 404. 2872. -2467. -2467.
5 Mexico Media 1964 464. 2872. -2408. -2408.
6 Mexico Media 1965 489. 2872. -2382. -2382.
7 Mexico Media 1966 529. 2872. -2343. -2343.
8 Mexico Media 1967 560. 2872. -2312. -2312.
9 Mexico Media 1968 600. 2872. -2271. -2271.
10 Mexico Media 1969 644. 2872. -2228. -2228.
# … with 174 more rows
4. Realicen el diagnóstico de residuales e interpreten los resultados.
<- function (modelo = "Media" ){%>% select (modelo) %>% gg_tsresiduals () + ggtitle (paste ("Diagnóstico de residuales para el modelo" , modelo))residuo ("Media" )
Warning: Using an external vector in selections was deprecated in tidyselect 1.1.0.
ℹ Please use `all_of()` or `any_of()` instead.
# Was:
data %>% select(modelo)
# Now:
data %>% select(all_of(modelo))
See <https://tidyselect.r-lib.org/reference/faq-external-vector.html>.
Warning: Removed 1 row containing missing values (`geom_line()`).
Warning: Removed 1 rows containing missing values (`geom_point()`).
Warning: Removed 1 rows containing non-finite values (`stat_bin()`).
Warning: Removed 1 row containing missing values (`geom_line()`).
Warning: Removed 1 rows containing missing values (`geom_point()`).
Warning: Removed 1 rows containing non-finite values (`stat_bin()`).
5. Ejecuten un pronóstico (ustedes deciden el horizonte de pronóstico) y definan si utilizar el método bootstrap o no y justifiquen su decisión.
<- Mexico_fit %>% forecast (h = "12 years" )
# A fable: 48 x 5 [1Y]
# Key: Country, .model [4]
Country .model Year GDPpC .mean
<fct> <chr> <dbl> <dist> <dbl>
1 Mexico Media 2006 N(2872, 5737828) 2872.
2 Mexico Media 2007 N(2872, 5737828) 2872.
3 Mexico Media 2008 N(2872, 5737828) 2872.
4 Mexico Media 2009 N(2872, 5737828) 2872.
5 Mexico Media 2010 N(2872, 5737828) 2872.
6 Mexico Media 2011 N(2872, 5737828) 2872.
7 Mexico Media 2012 N(2872, 5737828) 2872.
8 Mexico Media 2013 N(2872, 5737828) 2872.
9 Mexico Media 2014 N(2872, 5737828) 2872.
10 Mexico Media 2015 N(2872, 5737828) 2872.
# … with 38 more rows
%>% autoplot (Mexico_train %>% drop_na (), level = NULL )
Warning: Removed 12 rows containing missing values (`()`).
%>% autoplot (PIBperC_Mexico %>% drop_na (), level = NULL )
Warning: Removed 12 rows containing missing values (`()`).
# A tibble: 4 × 11
Country .model .type ME RMSE MAE MPE MAPE MASE RMSSE
<fct> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 Mexico Media Train… -2.33e-13 2344. 1981. -140. 173. 5.03 4.12
2 Mexico Ingenuo Train… 1.72e+ 2 569. 394. 5.51 13.7 1 1
3 Mexico Estacional Train… NaN NaN NaN NaN NaN NaN NaN
4 Mexico Deriva Train… -6.82e-14 542. 358. -8.10 17.1 0.908 0.953
# … with 1 more variable: ACF1 <dbl>
%>% accuracy (PIBperC_Mexico)
# A tibble: 4 × 11
.model Country .type ME RMSE MAE MPE MAPE MASE RMSSE ACF1
<chr> <fct> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 Deriva Mexico Test 153. 940. 866. 0.987 9.37 2.20 1.65 0.423
2 Estacional Mexico Test NaN NaN NaN NaN NaN NaN NaN NA
3 Ingenuo Mexico Test 1272. 1491. 1322. 13.0 13.6 3.36 2.62 0.316
4 Media Mexico Test 6490. 6536. 6490. 69.1 69.1 16.5 11.5 0.316
Sí se utiliza DERIVA
%>% filter (.model == "Deriva" ) %>% autoplot (Mexico_train %>% drop_na ()) + ggtitle ("Pronóstico Deriva" )
%>% filter (.model == "Deriva" ) %>% autoplot (PIBperC_Mexico %>% drop_na ()) + ggtitle ("Pronóstico Deriva" )
Aplicando Bootstraping
<- Mexico_train %>% model (RW ((GDPpC) ~ drift ()))<- fit %>% forecast (h = "12 years" , bootstrap = TRUE )
# A fable: 12 x 5 [1Y]
# Key: Country, .model [1]
Country .model Year GDPpC .mean
<fct> <chr> <dbl> <dist> <dbl>
1 Mexico RW((GDPpC) ~ drift()) 2006 t(sample[5000]) 8327.
2 Mexico RW((GDPpC) ~ drift()) 2007 t(sample[5000]) 8564.
3 Mexico RW((GDPpC) ~ drift()) 2008 t(sample[5000]) 8792.
4 Mexico RW((GDPpC) ~ drift()) 2009 t(sample[5000]) 9008.
5 Mexico RW((GDPpC) ~ drift()) 2010 t(sample[5000]) 9219.
6 Mexico RW((GDPpC) ~ drift()) 2011 t(sample[5000]) 9440.
7 Mexico RW((GDPpC) ~ drift()) 2012 t(sample[5000]) 9648.
8 Mexico RW((GDPpC) ~ drift()) 2013 t(sample[5000]) 9861.
9 Mexico RW((GDPpC) ~ drift()) 2014 t(sample[5000]) 10094.
10 Mexico RW((GDPpC) ~ drift()) 2015 t(sample[5000]) 10313.
11 Mexico RW((GDPpC) ~ drift()) 2016 t(sample[5000]) 10523.
12 Mexico RW((GDPpC) ~ drift()) 2017 t(sample[5000]) 10746.
%>% autoplot (Mexico_train)
%>% autoplot (PIBperC_Mexico)
El pronóstico con el método deriva sí se asemejó a la realidad. Utilizamos el método deriva con bootstrap para trazar el pronóstico a 2030.
<- PIBperC_Mexico %>% model (RW ((GDPpC) ~ drift ()))<- fit %>% forecast (h = "10 years" , bootstrap = TRUE )
# A fable: 10 x 5 [1Y]
# Key: Country, .model [1]
Country .model Year GDPpC .mean
<fct> <chr> <dbl> <dist> <dbl>
1 Mexico RW((GDPpC) ~ drift()) 2018 t(sample[5000]) 9314.
2 Mexico RW((GDPpC) ~ drift()) 2019 t(sample[5000]) 9703.
3 Mexico RW((GDPpC) ~ drift()) 2020 t(sample[5000]) 10083.
4 Mexico RW((GDPpC) ~ drift()) 2021 t(sample[5000]) 10485.
5 Mexico RW((GDPpC) ~ drift()) 2022 t(sample[5000]) 10884.
6 Mexico RW((GDPpC) ~ drift()) 2023 t(sample[5000]) 11257.
7 Mexico RW((GDPpC) ~ drift()) 2024 t(sample[5000]) 11660.
8 Mexico RW((GDPpC) ~ drift()) 2025 t(sample[5000]) 12058.
9 Mexico RW((GDPpC) ~ drift()) 2026 t(sample[5000]) 12447.
10 Mexico RW((GDPpC) ~ drift()) 2027 t(sample[5000]) 12847.
%>% autoplot (PIBperC_Mexico)
Comparación de resultados de 2030
