Instalación de las librerias

install.packages(c("forecast", "ggplot2"), repos = "https://cran.us.r-project.org")
## Installing packages into 'C:/Users/apamo/AppData/Local/R/win-library/4.5'
## (as 'lib' is unspecified)
## Warning: unable to access index for repository https://cran.us.r-project.org/src/contrib:
##   no fue posible abrir la URL 'https://cran.us.r-project.org/src/contrib/PACKAGES'
## Warning: packages 'forecast', 'ggplot2' are not available for this version of R
## 
## Versions of these packages for your version of R might be available elsewhere,
## see the ideas at
## https://cran.r-project.org/doc/manuals/r-patched/R-admin.html#Installing-packages
## Warning: unable to access index for repository https://cran.us.r-project.org/bin/windows/contrib/4.5:
##   no fue posible abrir la URL 'https://cran.us.r-project.org/bin/windows/contrib/4.5/PACKAGES'
library(forecast)  # Para ma, ses y autoplot (de series temporales)
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo
library(ggplot2)   # Para autoplot (de gráficos)

DataFrame

library(readxl)
df <- read_excel("C:/Users/apamo/Downloads/File.xlsx", 
    sheet = "Series de datos (2)")
head(df)

#Renombrar la variable la “tasa de interés de créditos de consumo”

names(df)[2] <- "Consumo"
ts_consumo <- ts(df$Consumo, start=c(1998,3), frequency=12)

Modelos Suavisados

# La fecha sea tipo Date
df$Fecha <- as.Date(df$Fecha, format="%Y-%m-%d") 

# Serie temporal mensual
ts_consumo <- ts(df$Consumo, start=c(1998,3), frequency=12)

# Promedios móviles (ventana de 12 meses)
ma_12 <- ma(ts_consumo, order=12)

# Suavización exponencial simple
ses_model <- ses(ts_consumo, h=12) # h=12 pronósticos a 12 meses

# Graficar resultados
autoplot(ts_consumo, series="Original") +
  autolayer(ma_12, series="Promedio móvil 12") +
  autolayer(ses_model$mean, series="Suavización exponencial") +
  ggtitle("Modelos de Suavizamiento") +
  xlab("Año") + ylab("Tasa de interés (%)")
## Warning: Removed 12 rows containing missing values or values outside the scale range
## (`geom_line()`).

Modelo de regresiones polinómicas

# Crear variable de tiempo
df$tiempo <- 1:nrow(df)

# Ajustar un polinomio de grado 2 (puedes cambiar el grado si lo deseas)
modelo_poly <- lm(Consumo ~ poly(tiempo, 2), data=df)

# Pronóstico para los próximos 12 meses
n_futuro <- 12
tiempo_futuro <- data.frame(tiempo = (max(df$tiempo)+1):(max(df$tiempo)+n_futuro))
pred_poly <- predict(modelo_poly, newdata=tiempo_futuro)

# Fechas futuras para graficar los pronósticos
fechas_futuras <- seq(max(df$Fecha) + 30, by=30, length.out=n_futuro)

# Graficar
plot(df$Fecha, df$Consumo, type="l", main="Regresión Polinómica", xlab="Fecha", ylab="Tasa (%)")
lines(df$Fecha, fitted(modelo_poly), col="blue")
points(fechas_futuras, pred_poly, col="red", type="b")
legend("topright", legend=c("Datos", "Ajuste polinómico", "Pronóstico"), col=c("black", "blue", "red"), lty=1)

Modelo estocástico (Arima)

# Crear la serie temporal
ts_consumo <- ts(df$Consumo, start=c(1998,3), frequency=12)

# Ajustar el modelo ARIMA automáticamente
arima_model <- auto.arima(ts_consumo)

# Mostrar resumen del modelo
summary(arima_model)
## Series: ts_consumo 
## ARIMA(3,1,0)(2,0,0)[12] 
## 
## Coefficients:
##          ar1     ar2     ar3    sar1    sar2
##       0.3837  0.1371  0.1524  0.0035  0.2434
## s.e.  0.0566  0.0585  0.0562  0.0591  0.0744
## 
## sigma^2 = 0.4726:  log likelihood = -337.8
## AIC=687.59   AICc=687.86   BIC=710.3
## 
## Training set error measures:
##                       ME      RMSE      MAE        MPE     MAPE      MASE
## Training set -0.02252006 0.6810838 0.435269 -0.0522599 1.835139 0.1270782
##                    ACF1
## Training set 0.01065201
# Pronóstico a 12 meses
forecast_arima <- forecast(arima_model, h=12)

# Graficar el pronóstico
autoplot(forecast_arima) +
  ggtitle("Pronóstico ARIMA para Créditos de Consumo") +
  xlab("Año") + ylab("Tasa de interés (%)")

Desripción de la serie

# Gráfico de la serie
plot(df$Fecha, df$Consumo, type="l", main="Serie histórica: Créditos de Consumo", xlab="Fecha", ylab="Tasa (%)")

# Descomposición de la serie (aditiva)
ts_consumo <- ts(df$Consumo, start=c(1998,3), frequency=12)
decomp <- decompose(ts_consumo)
plot(decomp)

Descripción de la serie

La gráfica muestra la descomposición aditiva de la serie histórica de la tasa de interés de créditos de consumo desde 1998 hasta 2025. Se observan los siguientes componentes:

  • Tendencia (trend): La serie presenta una tendencia descendente desde finales de los años 90 hasta aproximadamente 2010, seguida de una estabilización y un leve repunte en los últimos años.

  • Estacionalidad (seasonal): Se observa un patrón estacional claro, con fluctuaciones que se repiten cada año, lo que indica la presencia de efectos estacionales en la tasa de interés.

  • Componente aleatorio (random): El componente aleatorio muestra variaciones no explicadas por la tendencia ni la estacionalidad, aunque en general se mantiene dentro de un rango moderado, salvo algunos picos aislados.

  • Ciclico: La serie muestra estacionalidad clara (patrones que se repiten cada año), pero también se observan movimientos de mediano y largo plazo que pueden considerarse cíclicos.

Aunque el ultimo componete no sea tan claro, se puede considerar que es una serie de tiempo

Para la tabla, métricas

Modelos suavizados

ses_model <- ses(ts_consumo, h=12)
# Métricas
fitted_ses <- fitted(ses_model)
resid_ses <- ts_consumo - fitted_ses
R2_ses <- 1 - sum(resid_ses^2) / sum((ts_consumo - mean(ts_consumo))^2)
RMSE_ses <- sqrt(mean(resid_ses^2, na.rm=TRUE))
MAE_ses <- mean(abs(resid_ses), na.rm=TRUE)
MAPE_ses <- mean(abs(resid_ses/ts_consumo), na.rm=TRUE) * 100

Modelo polinomico

modelo_poly <- lm(Consumo ~ poly(tiempo, 2), data=df)
summary(modelo_poly) # Para ver los betas y R²
## 
## Call:
## lm(formula = Consumo ~ poly(tiempo, 2), data = df)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -11.5907  -2.0986  -0.0513   1.6436  12.4473 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)       23.1727     0.2042  113.46   <2e-16 ***
## poly(tiempo, 2)1 -91.9788     3.6876  -24.94   <2e-16 ***
## poly(tiempo, 2)2  79.3189     3.6876   21.51   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.688 on 323 degrees of freedom
## Multiple R-squared:  0.7706, Adjusted R-squared:  0.7691 
## F-statistic: 542.4 on 2 and 323 DF,  p-value: < 2.2e-16
fitted_poly <- fitted(modelo_poly)
resid_poly <- df$Consumo - fitted_poly
R2_poly <- summary(modelo_poly)$r.squared
RMSE_poly <- sqrt(mean(resid_poly^2))
MAE_poly <- mean(abs(resid_poly))
MAPE_poly <- mean(abs(resid_poly/df$Consumo)) * 100
betas_poly <- coef(modelo_poly)

Modelo estocastico

arima_model <- auto.arima(ts_consumo)
summary(arima_model) # Para ver los coeficientes
## Series: ts_consumo 
## ARIMA(3,1,0)(2,0,0)[12] 
## 
## Coefficients:
##          ar1     ar2     ar3    sar1    sar2
##       0.3837  0.1371  0.1524  0.0035  0.2434
## s.e.  0.0566  0.0585  0.0562  0.0591  0.0744
## 
## sigma^2 = 0.4726:  log likelihood = -337.8
## AIC=687.59   AICc=687.86   BIC=710.3
## 
## Training set error measures:
##                       ME      RMSE      MAE        MPE     MAPE      MASE
## Training set -0.02252006 0.6810838 0.435269 -0.0522599 1.835139 0.1270782
##                    ACF1
## Training set 0.01065201
fitted_arima <- fitted(arima_model)
resid_arima <- ts_consumo - fitted_arima
R2_arima <- 1 - sum(resid_arima^2) / sum((ts_consumo - mean(ts_consumo))^2)
RMSE_arima <- sqrt(mean(resid_arima^2, na.rm=TRUE))
MAE_arima <- mean(abs(resid_arima), na.rm=TRUE)
MAPE_arima <- mean(abs(resid_arima/ts_consumo), na.rm=TRUE) * 100
betas_arima <- arima_model$coef

Tabla

# tabla de métricas
tabla_metricas <- data.frame(
  Modelo = c("Suavizado", "Regresión Polinómica", "Estocástico"),
  R2 = c(R2_ses, R2_poly, R2_arima),
  RMSE = c(RMSE_ses, RMSE_poly, RMSE_arima),
  MAE = c(MAE_ses, MAE_poly, MAE_arima),
  MAPE = c(MAPE_ses, MAPE_poly, MAPE_arima)
)

print(tabla_metricas)
##                 Modelo        R2      RMSE       MAE      MAPE
## 1            Suavizado 0.9885788 0.8189565 0.5106304  2.096323
## 2 Regresión Polinómica 0.7705686 3.6705507 2.6568104 11.464330
## 3          Estocástico 0.9921006 0.6810838 0.4352690  1.835139

Elección del mejor modelo

# Mejor modelo por cada métrica
mejor_R2 <- tabla_metricas$Modelo[which.max(tabla_metricas$R2)]
mejor_RMSE <- tabla_metricas$Modelo[which.min(tabla_metricas$RMSE)]
mejor_MAE <- tabla_metricas$Modelo[which.min(tabla_metricas$MAE)]
mejor_MAPE <- tabla_metricas$Modelo[which.min(tabla_metricas$MAPE)]

cat("Mejor modelo según R²:", mejor_R2, "\n")
## Mejor modelo según R²: Estocástico
cat("Mejor modelo según RMSE:", mejor_RMSE, "\n")
## Mejor modelo según RMSE: Estocástico
cat("Mejor modelo según MAE:", mejor_MAE, "\n")
## Mejor modelo según MAE: Estocástico
cat("Mejor modelo según MAPE:", mejor_MAPE, "\n")
## Mejor modelo según MAPE: Estocástico

El pronóstico para la tasa de créditos de consumo para los periodos de mayo y junio de 2025.

Modelo SES

# Pronóstico para los próximos 2 meses (mayo y junio 2025)
forecast_ses_2 <- forecast(ses_model, h=2)

cat("Pronóstico SES (mayo y junio 2025):\n")
## Pronóstico SES (mayo y junio 2025):
print(forecast_ses_2$mean)
##           May      Jun
## 2025 19.50865 19.50865

Modelo polinomico

# Pronóstico para los próximos 2 períodos (mayo y junio 2025)
tiempo_futuro_2 <- data.frame(tiempo = (max(df$tiempo)+1):(max(df$tiempo)+2))
pred_poly_2 <- predict(modelo_poly, newdata=tiempo_futuro_2)

cat("Pronóstico Regresión Polinómica (mayo y junio 2025):\n")
## Pronóstico Regresión Polinómica (mayo y junio 2025):
print(pred_poly_2)
##        1        2 
## 24.23609 24.36387

Modelo estocastico

# Pronóstico para los próximos 2 meses (mayo y junio 2025)
forecast_arima_2 <- forecast(arima_model, h=2)

cat("Pronóstico ARIMA (mayo y junio 2025):\n")
## Pronóstico ARIMA (mayo y junio 2025):
print(forecast_arima_2$mean)
##           May      Jun
## 2025 19.37891 19.33996