# Definir la ruta del archivo
file_path <- "C:/Users/william/Desktop/Econometria II/tasa de interes efectiva de la politica monetaria efectiva.xlsx"
# Leer el archivo Excel
data <- read_excel(file_path)
# Verificar los nombres de las columnas en el archivo
colnames(data)
## [1] "Fecha" "Valor"
# Seleccionar la columna de tasa de interés efectiva
tasa_interes <- data$Valor
# Convertir las fechas a un objeto Date
fechas <- as.Date(data$Fecha, format="%Y-%m-%d")
# Ajustar los parámetros de inicio y frecuencia según los datos
start_year <- as.numeric(format(min(fechas), "%Y"))
start_month <- as.numeric(format(min(fechas), "%m"))
# Asegurarse de que la serie tenga un formato de serie de tiempo
ts_interes <- ts(tasa_interes, start=c(start_year, start_month), frequency=12)
# Verificar la serie de tiempo
print(ts_interes)
## Jan Feb Mar Apr May Jun Jul Aug Sep Oct
## 2015
## 2016 30.75 31.15 38.00 38.00 35.25 30.75 30.25 28.25 26.75 26.75
## 2017 24.75 24.75 24.75 26.25 26.25 26.25 26.25 26.25 26.25 27.75
## 2018 27.25 27.25 27.25 30.25 40.00 40.00 40.00 60.00 65.00 68.05
## 2019 53.69 50.13 68.16 73.93 70.73 62.69 60.40 83.26 78.37 68.00
## 2020 50.00 40.00 38.00 38.00 38.00 38.00 38.00 38.00 38.00 36.00
## 2021 38.00 38.00 38.00 38.00 38.00 38.00 38.00 38.00 38.00 38.00
## 2022 44.50 47.00 49.00 52.00 60.00 69.50 75.00 75.00 75.00 75.00
## 2023 78.00 91.00 97.00 97.00 97.00 118.00 118.00 133.00 133.00 100.00
## 2024 80.00 60.00 40.00 40.00 40.00
## Nov Dec
## 2015 33.00
## 2016 24.75 24.75
## 2017 28.75 28.75
## 2018 60.75 59.25
## 2019 63.00 55.00
## 2020 38.00 38.00
## 2021 40.00 42.50
## 2022 75.00 75.00
## 2023 100.00 100.00
## 2024
plot(ts_interes, main="Serie de Tasa de Interés Efectiva", ylab="Tasa de Interés", xlab="Tiempo")
# Descomposición de la serie de tiempo
interes.fit <- decompose(ts_interes, type="multiplicative")
plot(interes.fit)
# Componentes de la descomposición
Estac.interes <- interes.fit$seasonal
Trend.interes <- interes.fit$trend
Res.interes <- interes.fit$random
par(mfrow=c(2,2))
plot(ts_interes, main='Tasa de Interés')
plot(Estac.interes, main='Componente Estacional')
plot(Trend.interes, main='Tendencia')
plot(Res.interes, main='Componente Aleatorio')
# Descomposición aditiva
interes.fit1 <- decompose(ts_interes, type="additive")
plot(interes.fit1)
# Componentes de la descomposición aditiva
Estac.interes1 <- interes.fit1$seasonal
Trend.interes1 <- interes.fit1$trend
Res.interes1 <- interes.fit1$random
par(mfrow=c(2,2))
plot(ts_interes, main='Tasa de Interés')
plot(Estac.interes1, main='Componente Estacional')
plot(Trend.interes1, main='Tendencia')
plot(Res.interes1, main='Componente Aleatorio')
# Descomposición STL
stl.fit <- stl(ts_interes, s.window="periodic")
plot(stl.fit)
# Medias estacionales y regresión dicotómica
interes.1 <- season(ts_interes)
interes.lm <- lm(ts_interes ~ interes.1 - 1)
# Quitar el intercepto
summary(interes.lm)
##
## Call:
## lm(formula = ts_interes ~ interes.1 - 1)
##
## Residuals:
## Min 1Q Median 3Q Max
## -33.970 -18.764 -8.684 14.170 72.954
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## interes.1January 47.438 8.947 5.302 8.11e-07 ***
## interes.1February 45.476 8.947 5.083 2.01e-06 ***
## interes.1March 46.684 8.947 5.218 1.15e-06 ***
## interes.1April 48.159 8.947 5.383 5.79e-07 ***
## interes.1May 49.470 8.947 5.529 3.12e-07 ***
## interes.1June 52.899 9.490 5.574 2.57e-07 ***
## interes.1July 53.237 9.490 5.610 2.21e-07 ***
## interes.1August 60.220 9.490 6.346 8.75e-09 ***
## interes.1September 60.046 9.490 6.327 9.49e-09 ***
## interes.1October 54.944 9.490 5.790 1.02e-07 ***
## interes.1November 53.781 9.490 5.667 1.73e-07 ***
## interes.1December 50.694 8.947 5.666 1.74e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 26.84 on 90 degrees of freedom
## Multiple R-squared: 0.809, Adjusted R-squared: 0.7836
## F-statistic: 31.78 on 12 and 90 DF, p-value: < 2.2e-16
interes.lm1 <- fitted(interes.lm)
interes.lm1.ts <- ts(interes.lm1, start=c(start_year, start_month), freq=12)
ts.plot(ts_interes, interes.lm1.ts, main="Regresión dicotómica")
# Criterios de información
AIC(interes.lm)
## [1] 973.8458
BIC(interes.lm)
## [1] 1007.97
# Regresión trigonométrica
interes2 <- harmonic(ts_interes)
interes.lm3 <- lm(ts_interes ~ interes2)
summary(interes.lm3)
##
## Call:
## lm(formula = ts_interes ~ interes2)
##
## Residuals:
## Min 1Q Median 3Q Max
## -31.835 -18.694 -8.067 13.381 75.111
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 51.927 2.541 20.434 <2e-16 ***
## interes2cos(2*pi*t) -4.168 3.591 -1.161 0.249
## interes2sin(2*pi*t) -4.704 3.591 -1.310 0.193
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 25.63 on 99 degrees of freedom
## Multiple R-squared: 0.02997, Adjusted R-squared: 0.01037
## F-statistic: 1.529 on 2 and 99 DF, p-value: 0.2218
interes.lm3.ts <- ts(fitted(interes.lm3), start=c(start_year, start_month), freq=12)
ts.plot(ts_interes, interes.lm3.ts, main="Regresión trigonométrica")
# Modelo sinusoidal
interes.vec <- as.vector(ts_interes)
t <- seq(1, length(interes.vec))
cos1 <- cos(2 * pi * t / 12)
sin1 <- sin(2 * pi * t / 12)
cos2 <- cos(4 * pi * t / 12)
sin2 <- sin(4 * pi * t / 12)
interes.lm4 <- lm(interes.vec ~ t + cos1 + sin1 + cos2 + sin2)
summary(interes.lm4)
##
## Call:
## lm(formula = interes.vec ~ t + cos1 + sin1 + cos2 + sin2)
##
## Residuals:
## Min 1Q Median 3Q Max
## -37.548 -13.765 -2.106 12.146 50.549
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 22.69863 3.89821 5.823 7.66e-08 ***
## t 0.56755 0.06571 8.638 1.25e-13 ***
## cos1 2.03939 2.73659 0.745 0.4580
## sin1 -5.96782 2.73751 -2.180 0.0317 *
## cos2 -1.00182 2.73515 -0.366 0.7150
## sin2 0.18830 2.73816 0.069 0.9453
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 19.52 on 96 degrees of freedom
## Multiple R-squared: 0.4545, Adjusted R-squared: 0.4261
## F-statistic: 16 on 5 and 96 DF, p-value: 1.917e-11
interes.lm4.ts <- ts(fitted(interes.lm4), start=c(start_year, start_month), freq=12)
ts.plot(ts_interes, interes.lm4.ts, main="Regresión Trigonométrica")
# valores estimados histograma
hist(interes.lm4.ts, main = "Histograma de valores estimado por el modelo", col = "blue")
plot(ts_interes, type = "l", xlab = "Tiempo", ylab = "Tasa de Interés Efectiva")
lines(interes.lm4.ts, col = "red")
# Criterios de información
AIC(interes.lm4)
## [1] 903.4167
BIC(interes.lm4)
## [1] 921.7915
# Medidas de error para la descomposición multiplicativa
mse_multiplicativa <- mean((ts_interes - interes.fit$trend - interes.fit$seasonal - interes.fit$random)^2, na.rm = TRUE)
mae_multiplicativa <- mean(abs(ts_interes - interes.fit$trend - interes.fit$seasonal - interes.fit$random), na.rm = TRUE)
# Medidas de error para la descomposición aditiva
mse_aditiva <- mean((ts_interes - interes.fit1$trend - interes.fit1$seasonal - interes.fit1$random)^2, na.rm = TRUE)
mae_aditiva <- mean(abs(ts_interes - interes.fit1$trend - interes.fit1$seasonal - interes.fit1$random), na.rm = TRUE)
cat("MSE multiplicativa: ", mse_multiplicativa, "\nMAE multiplicativa: ", mae_multiplicativa, "\n")
## MSE multiplicativa: 54.82642
## MAE multiplicativa: 5.52105
cat("MSE aditiva: ", mse_aditiva, "\nMAE aditiva: ", mae_aditiva, "\n")
## MSE aditiva: 7.356128e-30
## MAE aditiva: 1.958927e-15
# Medidas de error para la regresión dicotómica
mse_dicotomica <- mean((ts_interes - interes.lm1.ts)^2, na.rm = TRUE)
mae_dicotomica <- mean(abs(ts_interes - interes.lm1.ts), na.rm = TRUE)
cat("MSE dicotómica: ", mse_dicotomica, "\nMAE dicotómica: ", mae_dicotomica, "\n")
## MSE dicotómica: 635.7012
## MAE dicotómica: 20.36049
# Medidas de error para la regresión trigonométrica
mse_trigonometrica <- mean((ts_interes - interes.lm3.ts)^2, na.rm = TRUE)
mae_trigonometrica <- mean(abs(ts_interes - interes.lm3.ts), na.rm = TRUE)
cat("MSE trigonométrica: ", mse_trigonometrica, "\nMAE trigonométrica: ", mae_trigonometrica, "\n")
## MSE trigonométrica: 637.5016
## MAE trigonométrica: 20.38477
# Medidas de error para el modelo sinusoidal
mse_sinusoidal <- mean((ts_interes - interes.lm4.ts)^2, na.rm = TRUE)
mae_sinusoidal <- mean(abs(ts_interes - interes.lm4.ts), na.rm = TRUE)
cat("MSE sinusoidal: ", mse_sinusoidal, "\nMAE sinusoidal: ", mae_sinusoidal, "\n")
## MSE sinusoidal: 358.4879
## MAE sinusoidal: 15.25976
# Error de pronóstico
# Función para calcular medidas de error de pronósticos
calculate_forecast_errors <- function(forecast_obj) {
error_measures <- accuracy(forecast_obj)
return(error_measures)
}
# Suavizamiento
# Ajustar un modelo de suavización exponencial
fit_additive <- HoltWinters(ts_interes, seasonal="additive")
# Ajustar un modelo de suavización exponencial a los residuos de STL
fit_multiplicative <- ets(ts_interes)
# Pronóstico
# Realizar pronósticos
forecast_additive <- forecast(fit_additive, h=12)
forecast_multiplicative <- forecast(fit_multiplicative, h=12)
# Medidas del error
# Calcular medidas de error
error_additive <- calculate_forecast_errors(forecast_additive)
error_multiplicative <- calculate_forecast_errors(forecast_multiplicative)
# Mostrar medidas de error
print("Errores de pronóstico para la descomposición aditiva:")
## [1] "Errores de pronóstico para la descomposición aditiva:"
print(error_additive)
## ME RMSE MAE MPE MAPE MASE
## Training set -0.4127219 7.975996 4.808281 -0.2521646 8.219631 0.2278842
## ACF1
## Training set 0.1527616
print("Errores de pronóstico para la descomposición multiplicativa:")
## [1] "Errores de pronóstico para la descomposición multiplicativa:"
print(error_multiplicative)
## ME RMSE MAE MPE MAPE MASE
## Training set 0.07925799 7.304771 3.77974 -0.3893468 6.316119 0.1791374
## ACF1
## Training set 0.2620382
# Comparar las medidas de error
best_method <- ifelse(error_additive[2] < error_multiplicative[2], "Aditiva", "Multiplicativa")
print(paste("La mejor técnica de descomposición es:", best_method))
## [1] "La mejor técnica de descomposición es: Multiplicativa"
# VARIABLES DICOTÓMICAS
meses <- season(ts_interes)
t <- 1:length(ts_interes)
# Ver algunos datos de la serie de tiempo
head(ts_interes)
## Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
## 2015 33.00
## 2016 30.75 31.15 38.00 38.00 35.25
summary(ts_interes)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 24.75 33.56 40.00 51.69 68.04 133.00
plot(ts_interes, main="Tasa de Interés Efectiva", ylab="Tasa de Interés", xlab="Tiempo")
# Ajuste del modelo
fit.data <- lm(ts_interes ~ t + meses)
summary(fit.data)
##
## Call:
## lm(formula = ts_interes ~ t + meses)
##
## Residuals:
## Min 1Q Median 3Q Max
## -36.75 -12.60 -2.47 13.04 49.08
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 19.0187 7.5498 2.519 0.0136 *
## t 0.5684 0.0681 8.347 8.41e-13 ***
## mesesFebruary -2.5306 9.5299 -0.266 0.7912
## mesesMarch -1.8901 9.5306 -0.198 0.8432
## mesesApril -0.9840 9.5318 -0.103 0.9180
## mesesMay -0.2413 9.5335 -0.025 0.9799
## mesesJune 6.0293 9.8232 0.614 0.5409
## mesesJuly 5.7997 9.8229 0.590 0.5564
## mesesAugust 12.2138 9.8232 1.243 0.2170
## mesesSeptember 11.4717 9.8239 1.168 0.2460
## mesesOctober 5.8008 9.8250 0.590 0.5564
## mesesNovember 4.0699 9.8267 0.414 0.6797
## mesesDecember 3.8251 9.5299 0.401 0.6891
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 20.22 on 89 degrees of freedom
## Multiple R-squared: 0.4574, Adjusted R-squared: 0.3843
## F-statistic: 6.253 on 12 and 89 DF, p-value: 7.032e-08
# Valores estimados
ml.fitted <- fitted(fit.data)
hist(ml.fitted, main = "Histograma de valores estimado por el modelo", col = "blue")
datosfit.ts <- ts(ml.fitted, start = c(start_year, start_month), frequency = 12)
plot(datosfit.ts, type = "l", xlab = "Tiempo", ylab = "Valores ajustados")
plot(ts_interes, type = "l", xlab = "Tiempo", ylab = "Tasa de Interés Efectiva")
lines(datosfit.ts, col = "red")
# Calcular los residuos y las métricas de error
resi <- residuals(fit.data)
Errorpromedio <- mean(resi)
print(Errorpromedio)
## [1] 2.201398e-16
Promedioabsolutos <- mean(abs(resi))
sce <- sum(resi^2)
n_k <- length(ts_interes) - length(fit.data$coefficients)
ECM <- sce / n_k
Desv.Errores <- sqrt(ECM)
tabla_comparativa <- round(cbind(Errorpromedio, Promedioabsolutos, sce, ECM), 20)
print(tabla_comparativa)
## Errorpromedio Promedioabsolutos sce ECM
## [1,] 2.2014e-16 15.26242 36371.02 408.6632
# Valores estimados
ml.fitted <- fitted(fit.data)
hist(ml.fitted, main = "Histograma de valores estimado por el modelo", col = "blue")
datosfit.ts <- ts(ml.fitted, start = c(start_year, start_month), frequency = 12)
plot(datosfit.ts, type = "l", xlab = "Tiempo", ylab = "Valores ajustados")
plot(ts_interes, type = "l", xlab = "Tiempo", ylab = "Tasa de Interés Efectiva")
lines(datosfit.ts, col = "red")
resi <- residuals(fit.data)
Errorpromedio = mean(resi)
print(Errorpromedio)
## [1] 2.201398e-16
Promedioabsolutos = mean(abs(resi))
sce = sum(resi)
n_k <- c(length(ts_interes) - length(fit.data$coefficients))
ECM <- sce / n_k
Desv.Errores <- sqrt(ECM)
tabla_comparativa <- round(cbind(Errorpromedio, Promedioabsolutos, sce, ECM), 20)
tabla_comparativa
## Errorpromedio Promedioabsolutos sce ECM
## [1,] 2.2014e-16 15.26242 2.253753e-14 2.5323e-16
# VARIABLES TRIGONOMÉTRICAS
t = 1:length(ts_interes)
L = frequency(ts_interes)
seno2p = sin((2*pi*t)/L)
cos2p = cos((2*pi*t)/L)
seno4p = sin((4*pi*t)/L)
cos4p = cos((4*pi*t)/L)
# Modelo uno
mltrigo = lm(ts_interes ~ t + seno2p + cos2p)
# Modelo cuatro
mltrigo2 = lm(ts_interes ~ t + seno2p + seno2p * t + cos2p + t * cos2p + seno4p + seno4p * t + cos4p + cos4p * t)
summary(mltrigo)
##
## Call:
## lm(formula = ts_interes ~ t + seno2p + cos2p)
##
## Residuals:
## Min 1Q Median 3Q Max
## -38.482 -13.184 -1.649 12.644 51.610
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 22.73723 3.85767 5.894 5.34e-08 ***
## t 0.56679 0.06501 8.719 7.24e-14 ***
## seno2p -5.94096 2.71041 -2.192 0.0308 *
## cos2p 2.06765 2.70706 0.764 0.4468
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 19.33 on 98 degrees of freedom
## Multiple R-squared: 0.4537, Adjusted R-squared: 0.437
## F-statistic: 27.13 on 3 and 98 DF, p-value: 7.367e-13
summary(mltrigo2)
##
## Call:
## lm(formula = ts_interes ~ t + seno2p + seno2p * t + cos2p + t *
## cos2p + seno4p + seno4p * t + cos4p + cos4p * t)
##
## Residuals:
## Min 1Q Median 3Q Max
## -36.80 -10.64 -2.50 11.79 40.30
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 21.39718 3.84660 5.563 2.59e-07 ***
## t 0.59501 0.06503 9.150 1.40e-14 ***
## seno2p 5.61073 5.41033 1.037 0.3024
## cos2p -2.93113 5.46991 -0.536 0.5933
## seno4p -3.93101 5.38697 -0.730 0.4674
## cos4p 3.29202 5.43997 0.605 0.5466
## t:seno2p -0.22547 0.09221 -2.445 0.0164 *
## t:cos2p 0.09183 0.09176 1.001 0.3196
## t:seno4p 0.08122 0.09165 0.886 0.3779
## t:cos4p -0.08257 0.09115 -0.906 0.3674
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 19.06 on 92 degrees of freedom
## Multiple R-squared: 0.5013, Adjusted R-squared: 0.4525
## F-statistic: 10.28 on 9 and 92 DF, p-value: 8.124e-11
mlt.fitted <- fitted(mltrigo)
hist(mlt.fitted, main = "Histograma de valores estimado por el modelo", col = "blue")
datos.ts <- ts(mlt.fitted, start = c(start_year, start_month), frequency = 12)
plot(datos.ts, type = "l", xlab = "Tiempo", ylab = "Valores ajustados")
plot(ts_interes, type = "l", xlab = "Tiempo", ylab = "Tasa de Interés Efectiva")
lines(datos.ts, col = "red")
resi <- residuals(mltrigo)
Errorpromedio = mean(resi)
print(Errorpromedio)
## [1] 2.544805e-15
Promedioabsolutos = mean(abs(resi))
sce = sum(resi)
n_k <- c(length(ts_interes) - length(mltrigo$coefficients))
ECM <- sce / n_k
Desv.Errores <- sqrt(ECM)
tabla_comparativa <- round(cbind(Errorpromedio, Promedioabsolutos, sce, ECM), 20)
tabla_comparativa
## Errorpromedio Promedioabsolutos sce ECM
## [1,] 2.54481e-15 15.22206 2.596812e-13 2.64981e-15
