SERIES_TIEMPO_TALLER
Mayller_Perez
2026-07-20
Importar data
library(readxl)
library(dplyr)
library(tseries)
library(forecast)
ING <- read_excel("ING.xlsx", sheet = "Mensuales")Serie de tiempo
library(tseries)
INGTS <- ts(ING$ING, start = c(2016,06), frequency = 12)Ingresos corrientes del gobierno central (millones S/) - Ingresos Tributarios (BCRP) SERIE MENSUAL 121 OBSERVACIONES
Se selecciona esta variable por su importancia en la toma de decisiones gubernamentales. Dado que los ingresos tributarios constituyen la base del financiamiento del gasto público, analizar su dinámica permitirá anticipar y comprender posibles escenarios futuros.
Análisis gráfico
Gráfico de la serie en niveles
plot(INGTS, ylab= "Ingresos Tributarios (millones S/)")
Gráfico de la serie en logaritmos
Debido a la clara variabilidad de la serie se aplica el LOG
plot(log(INGTS), ylab= "LOG Ingresos Tributarios (millones S/)")
SE USA LA SERIE LOG A PARTIR DE ESTE PUNTO
INGTS <- log(INGTS)Gráfico de la primera diferencia
plot(diff(INGTS), ylab= "DIF Ingresos Tributarios (millones S/)")
Gráfico de la tasa de crecimiento
ING <- ING %>% mutate(TCING = (ING-lag(ING))/lag(ING))
TSCING <- ts(ING$TCING, start = c(2016,06), frequency= 12)
plot(TSCING, ylab= "Tasa de Crecimiento Ingresos Tributarios (millones S/)")
DESCOMPOSICIÓN DE LA SERIE
D1 <- decompose(INGTS)Tendencia
plot(D1$trend)
Estacionalidad
plot(D1$seasonal)
volatilidad
plot(D1$random)
valores atípicos
OUT <- boxplot(ING$ING, labels= TRUE)
VALORES ATÍPICOS
OUT$out## [1] 20907.79 21066.62 24954.27SE CORRIGE LOS VALORES ATIPICOS A TRAVES DE LA INTERPOLACIÓN LINEAL DE LOS RESIDUOS
INGTS <- tsclean(INGTS)boxplot(INGTS)
SE ELIMINAN LOS OUTLIER
Estacionariedad
ADF test
adf.test(INGTS)##
## Augmented Dickey-Fuller Test
##
## data: INGTS
## Dickey-Fuller = -3.3559, Lag order = 4, p-value = 0.06523
## alternative hypothesis: stationarylibrary(fUnitRoots)
adfTable(trend = "ct")## $x
## [1] 25 50 100 250 500 Inf
##
## $y
## [1] 0.010 0.025 0.050 0.100 0.900 0.950 0.975 0.990
##
## $z
## 0.010 0.025 0.050 0.100 0.900 0.950 0.975 0.990
## 25 -4.38 -3.95 -3.60 -3.24 -1.14 -0.80 -0.50 -0.15
## 50 -4.15 -3.80 -3.50 -3.18 -1.19 -0.87 -0.58 -0.24
## 100 -4.04 -3.73 -3.45 -3.15 -1.22 -0.90 -0.62 -0.28
## 250 -3.99 -3.69 -3.43 -3.13 -1.23 -0.92 -0.64 -0.31
## 500 -3.98 -3.68 -3.42 -3.13 -1.24 -0.93 -0.65 -0.32
## Inf -3.96 -3.66 -3.41 -3.12 -1.25 -0.94 -0.66 -0.33
##
## attr(,"class")
## [1] "gridData"
## attr(,"control")
## table trend statistic
## "adf" "ct" "t"La serie presenta un dickey-Fuller = -3.3559, para la cantidad de datos de la serie y con un 1% de significancia el punto critico DF es -4.04 por lo que no se rechaza la hipotesis nula y se reconoce que la serie tiene raíz unitaria.
Prueba PP
PP.test(INGTS)##
## Phillips-Perron Unit Root Test
##
## data: INGTS
## Dickey-Fuller = -7.5627, Truncation lag parameter = 4, p-value = 0.01Prueba KPSS
kpss.test(INGTS, null = "Level") ## Warning in kpss.test(INGTS, null = "Level"): p-value smaller than printed
## p-value##
## KPSS Test for Level Stationarity
##
## data: INGTS
## KPSS Level = 2.1577, Truncation lag parameter = 4, p-value = 0.01Tanto el ADF y el KPSS demuestran que la serie presenta raíz unitaria por lo que se debe aplicar una diferencia para eliminar dicho estatus.
SERIE ESTACIONARIA
DINGTS <- diff(INGTS)library(tseries)
adf.test(DINGTS)## Warning in adf.test(DINGTS): p-value smaller than printed p-value##
## Augmented Dickey-Fuller Test
##
## data: DINGTS
## Dickey-Fuller = -5.8503, Lag order = 4, p-value = 0.01
## alternative hypothesis: stationaryLa serie presenta un dickey-Fuller = -5.8503, para la cantidad de datos de la serie y con un 1% de significancia el punto critico DF es -4.04 por lo que se rechaza la hipotesis nula y se reconoce que la serie no tiene raíz unitaria.
Análisis de estacionalidad
library(forecast)
seasonplot(DINGTS)
Se observa estacionalidad entre los meses de febrero a mayo en todos los años de estudio. Para el mes de abril la serie presenta un pico fuerte y para el mes de mayo una caida profunda.
Eliminación de la estacionalidad
DSINGTS <- stl(DINGTS, s.window = "periodic")
DSINGTS_adj <- seasadj(DSINGTS)
seasonplot(DSINGTS_adj)
Eliminación de estacionalidad con diff
DDSINGTS <- diff(DINGTS, lag = 12)seasonplot(DDSINGTS)
Se observa claramente que la serie ha perdido completamente su componente estacional
Identificación del modelo
Primera parte del modelo SARIMA
acf(ts(DINGTS, frequency = 1))
Caracteristico de un modelo MA (0-1)
Pacf(ts(DINGTS, frequency = 1))
Caracteristico de un modelo AR (0-1)
Se debe tener en cuenta que se aplico una primera diferencia para lograr la estacionaridad
Parte estacional del modelo SARIMA
acf(ts(DDSINGTS, frequency =1))
SMA (1), debido a que presenta significancia en el rezado 12
Pacf(ts(DDSINGTS, frequency =1))
No presenta significancia en el rezago 12
Se aplico una diferencia para eliminar el componente estacional
En base al análisis del correlalograma se consideran los siguientes modelos iniciales a estudiar:
SARIMA(1,1,1)(0,1,1)
SARIMA(1,1,1)(1,1,0)
SARIMA(1,1,0)(1,1,0)
SARIMA(0,1,1)(0,1,1)
Estimación y selección
Estimación
library(lmtest)
m1<- Arima(INGTS ,order = c(1,1,1), seasonal = c(0,1,1))
m2<- Arima(INGTS, order = c(1,1,1), seasonal = c(1,1,0))
m3<- Arima(INGTS, order = c(1,1,0), seasonal = c(1,1,0))
m4<- Arima(INGTS, order = c(0,1,1), seasonal = c(0,1,1))
m5 <- Arima(INGTS, order = c(2,1,2), seasonal = c(1,1,0))Selecición
library(texreg)## Warning: package 'texreg' was built under R version 4.4.3## Version: 1.39.4
## Date: 2024-07-23
## Author: Philip Leifeld (University of Manchester)
##
## Consider submitting praise using the praise or praise_interactive functions.
## Please cite the JSS article in your publications -- see citation("texreg").screenreg(list(m1, m2,m3,m4,m5))##
## ===============================================================================
## Model 1 Model 2 Model 3 Model 4 Model 5
## -------------------------------------------------------------------------------
## ar1 0.10 0.16 -0.23 * 0.63 ***
## (0.19) (0.21) (0.10) (0.15)
## ma1 -0.48 ** -0.46 * -0.40 *** -0.92 ***
## (0.16) (0.18) (0.09) (0.12)
## sma1 -0.87 *** -0.87 ***
## (0.17) (0.17)
## sar1 -0.41 *** -0.40 *** -0.40 ***
## (0.09) (0.09) (0.09)
## ar2 -0.69 ***
## (0.20)
## ma2 0.75 ***
## (0.19)
## -------------------------------------------------------------------------------
## AIC -227.76 -206.07 -204.22 -229.48 -208.81
## AICc -227.37 -205.68 -203.98 -229.25 -207.98
## BIC -217.03 -195.34 -196.17 -221.44 -192.72
## Log Likelihood 117.88 107.03 105.11 117.74 110.41
## Num. obs. 108 108 108 108 108
## ===============================================================================
## *** p < 0.001; ** p < 0.01; * p < 0.05El Modelo 4 fue seleccionado porque ofrece el mejor balance entre ajuste estadístico y parsimonia. En primer lugar, sus coeficientes principales (ma1 y sma1) resultan altamente significativos (p < 0.001), lo que indica que capturan de manera robusta la dinámica de la serie. A diferencia de otros modelos, donde algunos parámetros no alcanzan significancia, en el Modelo 4 los términos incluidos aportan evidencia sólida de su relevancia.
En segundo lugar, los criterios de información refuerzan esta elección: el AIC (-229.25 ) y el BIC (-221.44 ) son los más bajos entre los modelos comparados, lo que significa que logra un mejor ajuste penalizado por complejidad. Además, el log‑likelihood (117.74) es prácticamente igual al del Modelo 1, pero con un conjunto de parámetros más parsimonioso y estadísticamente significativo.
Diagnóstico de los residuos
Correlograma de residuos
acf(ts(residuals(m4), frequency= 1), lag.max = 48)
pacf(ts(residuals(m4), frequency= 1), lag.max = 48)
No presentan signifificancia en los rezagos
Media cercana a 0
mean(residuals(m4))## [1] 0.004945606Media de los errores igual a 0
plot(residuals(m4))
Estadístico de Ljung–Box
Box.test(residuals(m4), type = "Ljung-Box")##
## Box-Ljung test
##
## data: residuals(m4)
## X-squared = 0.036241, df = 1, p-value = 0.849Los residuos del modelo se comportan como ruido blanco
Prueba de Jarque–Bera
Histograma
hist(residuals(m4), breaks = 48)
curve(dnorm(x, mean = mean(residuals(m4)), sd= sd(residuals(m4))), add = TRUE, col= "red")
jarque.bera.test(residuals(m4))##
## Jarque Bera Test
##
## data: residuals(m4)
## X-squared = 4.1158, df = 2, p-value = 0.1277No existe presencia estadistica pra determinar normalidad en los residuos
Valores atípicos
boxplot(residuals(m4))
Exsisten valores atipicos
El análisis de los residuos del modelo evidencia un comportamiento compatible con un proceso de ruido blanco, debido a que presentan una media aproximadamente igual a cero, lo cual indica que los errores no presentan un sesgo sistemático de sobreestimación o subestimación. Asimismo, el test de Ljung-Box no permite rechazar la hipótesis nula de independencia de los residuos, evidenciando la ausencia de autocorrelación significativa en los diferentes rezagos evaluados. Por tanto, los errores no contienen información temporal adicional que pueda ser aprovechada por el modelo, lo que indica que la estructura dinámica de la serie fue adecuadamente capturada por el modelo SARIMA. Si bien en los residuos se identifican algunos valores atípicos, estas característica no invalidan el modelo, debido a que los valores extremos pueden estar asociados a eventos particulares de los ingresos tributarios (pandemia) sin embargo, al no generar patrones persistentes de autocorrelación, no afectan la capacidad predictiva del modelo.
Pronostico
Pronostico junio 2026
train <- window(INGTS, end=c(2025,06))
test <- window(INGTS, start=c(2025,06))
modelo <- forecast::Arima(train, order = c(0,1,1), seasonal = c(0,1,1))
pron <- forecast(modelo, h=12)
accuracy(pron, test)## ME RMSE MAE MPE MAPE MASE
## Training set 0.002843516 0.07210176 0.05085269 0.02662332 0.5475816 0.3547691
## Test set 0.056270575 0.09246584 0.06651920 0.57584326 0.6831439 0.4640651
## ACF1 Theil's U
## Training set 0.02708784 NA
## Test set 0.39327314 0.4666635El modelo demuestra un ajuste sólido en entrenamiento con errores bajos y residuos bien comportados. En el set de entrenamiento, aunque los errores aumentan ligeramente y aparece algo de autocorrelación, las métricas clave como MASE = 0.449 y Theil’s U = 0.458 confirman que el modelo sigue siendo mejor que un pronóstico ingenuo y mantiene una capacidad predictiva valiosa.
plot(forecast::forecast(modelo, h=12))
lines(INGTS, col= "red",lty= , lwd=2)
legend("topleft", legend = c("Estimación", "Serie real"), lty = 1, col= c("lightblue", "red"))
Se observa que las estimaciones presentan amplia similitud
pron## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jul 2025 9.429877 9.329203 9.530550 9.275910 9.583843
## Aug 2025 9.505804 9.388921 9.622687 9.327047 9.684561
## Sep 2025 9.523653 9.392549 9.654757 9.323147 9.724159
## Oct 2025 9.548185 9.404258 9.692111 9.328068 9.768301
## Nov 2025 9.602075 9.446378 9.757771 9.363958 9.840192
## Dec 2025 9.650455 9.483818 9.817092 9.395606 9.905305
## Jan 2026 9.728796 9.551893 9.905698 9.458247 9.999345
## Feb 2026 9.512560 9.325957 9.699164 9.227174 9.797947
## Mar 2026 9.667535 9.471709 9.863360 9.368046 9.967024
## Apr 2026 9.970085 9.765453 10.174717 9.657128 10.283042
## May 2026 9.561098 9.348024 9.774173 9.235229 9.886968
## Jun 2026 9.492162 9.270885 9.713438 9.153748 9.830575as.data.frame(tail(INGTS,n=12))## x
## 1 9.464777
## 2 9.604803
## 3 9.481326
## 4 9.574340
## 5 9.606372
## 6 9.658187
## 7 9.709631
## 8 9.529662
## 9 9.722807
## 10 10.124800
## 11 9.682980
## 12 9.707846