# “GESTIÓN DEL RIESGO DE LIQUIDEZ EN EL SISTEMA BANCARIO DE GUATEMALA EN
# CONTEXTOS DE INESTABILIDAD MACROECONÓMICA: APLICACIÓN DE MODELOS LAR Y GARCH"
# TESIS DE GRADO
# R studio
# Luis David Wug Escobar 1297721
# 1. Instalación y carga de librerías
#Cargar las librerías necesarias
library(readxl)
## Warning: package 'readxl' was built under R version 4.4.3
library(xts)
## Warning: package 'xts' was built under R version 4.4.2
## Cargando paquete requerido: zoo
##
## Adjuntando el paquete: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
library(tseries)
## Warning: package 'tseries' was built under R version 4.4.2
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
library(rugarch)
## Warning: package 'rugarch' was built under R version 4.4.3
## Cargando paquete requerido: parallel
##
## Adjuntando el paquete: 'rugarch'
## The following object is masked from 'package:stats':
##
## sigma
library(moments)
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 4.4.3
library(gridExtra)
## Warning: package 'gridExtra' was built under R version 4.4.3
library(extrafont)
## Registering fonts with R
library(scales)
## Warning: package 'scales' was built under R version 4.4.3
library(lubridate)
##
## Adjuntando el paquete: 'lubridate'
## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, union
library(dplyr)
## Warning: package 'dplyr' was built under R version 4.4.3
##
## ######################### Warning from 'xts' package ##########################
## # #
## # The dplyr lag() function breaks how base R's lag() function is supposed to #
## # work, which breaks lag(my_xts). Calls to lag(my_xts) that you type or #
## # source() into this session won't work correctly. #
## # #
## # Use stats::lag() to make sure you're not using dplyr::lag(), or you can add #
## # conflictRules('dplyr', exclude = 'lag') to your .Rprofile to stop #
## # dplyr from breaking base R's lag() function. #
## # #
## # Code in packages is not affected. It's protected by R's namespace mechanism #
## # Set `options(xts.warn_dplyr_breaks_lag = FALSE)` to suppress this warning. #
## # #
## ###############################################################################
##
## Adjuntando el paquete: 'dplyr'
## The following object is masked from 'package:gridExtra':
##
## combine
## The following objects are masked from 'package:xts':
##
## first, last
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(zoo)
library(tidyr)
library(FinTS)
## Warning: package 'FinTS' was built under R version 4.4.2
library(tibble)
library(xts)
library(readr)
##
## Adjuntando el paquete: 'readr'
## The following object is masked from 'package:scales':
##
## col_factor
#Cargar fuentes adicionales
loadfonts(device = "win")
# 2. Ruta del archivo y lectura de datos
ruta_archivo <- "C:\\\\Users\\\\ldesc\\\\Desktop\\\\Universidad\\\\Clases 2025\\\\TESIS 2\\\\BD_TDG_LDWE.xlsx"
#Leer datos desde Excel
datos <- read_excel(ruta_archivo)
# 3. Series temporales y métricas descriptivas
DM <- xts(datos$Depositos_Monetarios, order.by = datos$Fecha)
DA <- xts(datos$Depositos_Ahorro, order.by = datos$Fecha)
DP <- xts(datos$Depositos_Plazo, order.by = datos$Fecha)
# 3.1 Índice de liquidez
rtl <- read_excel(ruta_archivo, sheet = "RTL")
anio <- rtl$anio
ratio_raw <- rtl$`Ratio de liquidez`
ratio_pct <- suppressWarnings(parse_number(as.character(ratio_raw)))
ratio_pct <- ifelse(ratio_pct <= 1, ratio_pct * 100, ratio_pct)
par(family = "serif", cex.main = 1.1, cex.lab = 1.1, cex.axis = 1.1, mar = c(4, 4, 4, 2))
plot(anio, ratio_pct, type = "l", lwd = 3, col = "black",
ylim = c(17, 23),
main = "Ratio de liquidez de las instituciones bancarias de Guatemala del año 2008 al 2023",
xlab = "", ylab = "", xaxt = "n")
axis(1, at = anio, labels = anio)
text(anio, ratio_pct, labels = paste0(round(ratio_pct, 2), "%"), pos = 3, cex = 0.8)
modelo <- lm(ratio_pct ~ anio)
abline(modelo, col = "gray40", lwd = 2)
# 3.2 Volatilidad de los depósitos (12M rodante)
mensual <- datos %>%
mutate(YearMonth = zoo::as.yearmon(as.Date(Fecha))) %>%
group_by(YearMonth) %>%
summarise(DM = last(Depositos_Monetarios),
DA = last(Depositos_Ahorro),
DP = last(Depositos_Plazo), .groups = "drop") %>%
arrange(YearMonth)
vol <- mensual %>%
mutate(Vol_DM = zoo::rollapply(DM, 12, sd, align="right", fill=NA, na.rm=TRUE),
Vol_DA = zoo::rollapply(DA, 12, sd, align="right", fill=NA, na.rm=TRUE),
Vol_DP = zoo::rollapply(DP, 12, sd, align="right", fill=NA, na.rm=TRUE))
idx <- rowSums(is.finite(as.matrix(vol[,c("Vol_DM","Vol_DA","Vol_DP")]))) > 0
x <- as.Date(vol$YearMonth[idx])
Yk <- as.matrix(vol[idx, c("Vol_DM","Vol_DA","Vol_DP")]) # ya está en miles de Q
yt <- pretty(c(0, max(Yk, na.rm=TRUE)*1.1), n=6)
ticks <- seq(min(x), max(x), by="1 month")
labs <- format(ticks, "%b-%Y")
par(family="serif", cex.main=1.1, cex.lab=1.0, cex.axis=0.8, mar=c(7,4,4,2))
matplot(x, Yk, type="l", lwd=2, lty=1, pch=16, col=c("black","gray50","gray"),
main="Volatilidad mensual de los depósitos monetarios, de ahorro y a plazo del sistema bancario del año 2009 al 2023",
ylab="Volatilidad (Miles de Quetzales)",
xaxt="n", yaxt="n", ylim=range(yt))
axis(1, at=ticks, labels=labs, las=2)
axis(2, at=yt, labels=format(yt, big.mark=",", scientific=FALSE))
legend("bottom", inset=c(0,-0.30), xpd=TRUE, horiz=TRUE,
legend=c("Monetarios","Ahorro","Plazo"),
col=c("black","gray50","gray"), lty=1, pch=16, cex=0.9, bty="n")
# 4. Verificación de estacionariedad (ADF)
#Función para realizar la Prueba ADF
adf_test <- function(serie) {
resultado <- adf.test(serie, alternative = "stationary")
cat("Prueba ADF: p-valor =", resultado$p.value, "\n")
if (resultado$p.value < 0.05) {
cat("La serie es estacionaria.\n")
} else {
cat("La serie no es estacionaria.\n")
}
}
#Prueba ADF para cada serie
cat("Resultados para Depósitos Monetarios:\n")
## Resultados para Depósitos Monetarios:
adf_test(DM)
## Warning in adf.test(serie, alternative = "stationary"): p-value greater than printed p-value
## Prueba ADF: p-valor = 0.99
## La serie no es estacionaria.
cat("Resultados para Depósitos de Ahorro:\n")
## Resultados para Depósitos de Ahorro:
adf_test(DA)
## Warning in adf.test(serie, alternative = "stationary"): p-value greater than printed p-value
## Prueba ADF: p-valor = 0.99
## La serie no es estacionaria.
cat("Resultados para Depósitos a Plazo:\n")
## Resultados para Depósitos a Plazo:
adf_test(DP)
## Prueba ADF: p-valor = 0.9386744
## La serie no es estacionaria.
# 5. Transformación a series estacionarias (log-diff)
#Aplicar logaritmo y diferenciación (variaciones logarítmicas)
DM_diff <- diff(log(DM))[-1]
DA_diff <- diff(log(DA))[-1]
DP_diff <- diff(log(DP))[-1]
#Prueba ADF después de la transformación
cat("Resultados para Depósitos Monetarios (transformados):\n")
## Resultados para Depósitos Monetarios (transformados):
adf_test(DM_diff)
## Warning in adf.test(serie, alternative = "stationary"): p-value smaller than printed p-value
## Prueba ADF: p-valor = 0.01
## La serie es estacionaria.
cat("Resultados para Depósitos de Ahorro (transformados):\n")
## Resultados para Depósitos de Ahorro (transformados):
adf_test(DA_diff)
## Warning in adf.test(serie, alternative = "stationary"): p-value smaller than printed p-value
## Prueba ADF: p-valor = 0.01
## La serie es estacionaria.
cat("Resultados para Depósitos a Plazo (transformados):\n")
## Resultados para Depósitos a Plazo (transformados):
adf_test(DP_diff)
## Warning in adf.test(serie, alternative = "stationary"): p-value smaller than printed p-value
## Prueba ADF: p-valor = 0.01
## La serie es estacionaria.
#Función para aplicar prueba ARCH
arch_test <- function(serie, nombre_serie) {
cat("\nPrueba ARCH-LM para", nombre_serie, ":\n")
resultado <- ArchTest(serie, lags = 12)
print(resultado)
if (resultado$p.value < 0.05) {
cat("→ Existe heterocedasticidad condicional. Se puede aplicar GARCH.\n")
} else {
cat("→ No se detecta heterocedasticidad. GARCH no es necesario.\n")
}
}
#Aplicar prueba para cada serie transformada
arch_test(DM_diff, "Depósitos Monetarios")
##
## Prueba ARCH-LM para Depósitos Monetarios :
##
## ARCH LM-test; Null hypothesis: no ARCH effects
##
## data: serie
## Chi-squared = 40.846, df = 12, p-value = 5.199e-05
##
## → Existe heterocedasticidad condicional. Se puede aplicar GARCH.
arch_test(DA_diff, "Depósitos de Ahorro")
##
## Prueba ARCH-LM para Depósitos de Ahorro :
##
## ARCH LM-test; Null hypothesis: no ARCH effects
##
## data: serie
## Chi-squared = 21.056, df = 12, p-value = 0.04956
##
## → Existe heterocedasticidad condicional. Se puede aplicar GARCH.
arch_test(DP_diff, "Depósitos a Plazo")
##
## Prueba ARCH-LM para Depósitos a Plazo :
##
## ARCH LM-test; Null hypothesis: no ARCH effects
##
## data: serie
## Chi-squared = 57.496, df = 12, p-value = 6.432e-08
##
## → Existe heterocedasticidad condicional. Se puede aplicar GARCH.
#Graficos
par(family = "serif", cex.main = 1.1, cex.lab = 1.1, cex.axis = 1.1)
plot(DM_diff)
plot(DA_diff)
plot(DP_diff)
# 6. Supuestos del modelo GARCH
# 6.1 Nula observabilidad directa de la volatilidad
# Debido a que la volatilidad no se observa directamente, sino que se infiere
# a partir de los datos, lo cual es una premisa fundamental del modelo, este
# supuesto se cumple con el desarrollo de este.
# 6.2 Aglomeración de la volatilidad (variaciones)
# Calcular variaciones logarítmicas
DM_variaciones <- diff(log(DM))
DA_variaciones <- diff(log(DA))
DP_variaciones <- diff(log(DP))
#Eliminar NA
DM_variaciones <- na.omit(DM_variaciones)
DA_variaciones <- na.omit(DA_variaciones)
DP_variaciones <- na.omit(DP_variaciones)
#Crear data.frame completo para cada serie
df_DM <- data.frame(Fecha = index(DM_variaciones),
Variacion = as.numeric(DM_variaciones),
Serie = "Depósitos Monetarios")
df_DA <- data.frame(Fecha = index(DA_variaciones),
Variacion = as.numeric(DA_variaciones),
Serie = "Depósitos de Ahorro")
df_DP <- data.frame(Fecha = index(DP_variaciones),
Variacion = as.numeric(DP_variaciones),
Serie = "Depósitos a Plazo")
#Filtrar desde 2009 hasta 2023
df_DM <- df_DM %>% filter(year(Fecha) >= 2009 & year(Fecha) <= 2023)
df_DA <- df_DA %>% filter(year(Fecha) >= 2009 & year(Fecha) <= 2023)
df_DP <- df_DP %>% filter(year(Fecha) >= 2009 & year(Fecha) <= 2023)
#Gráfico de variaciones
ggplot(df_DM, aes(x = Fecha, y = Variacion)) +
geom_line(color = "black") +
labs(title = "Variaciones logarítmicas mensuales - Depósitos Monetarios (2009–2023)",
x = "Fecha", y = "Variaciones logarítmicas") +
theme_minimal(base_family = "serif", base_size = 11) +
theme(plot.title = element_text(face = "bold", hjust = 0.5))
ggplot(df_DA, aes(x = Fecha, y = Variacion)) +
geom_line(color = "black") +
labs(title = "Variaciones logarítmicas mensuales - Depósitos de Ahorro (2009–2023)",
x = "Fecha", y = "Variaciones logarítmicas") +
theme_minimal(base_family = "serif", base_size = 11) +
theme(plot.title = element_text(face = "bold", hjust = 0.5))
ggplot(df_DP, aes(x = Fecha, y = Variacion)) +
geom_line(color = "black") +
labs(title = "Variaciones logarítmicas mensuales - Depósitos a Plazo (2009–2023)",
x = "Fecha", y = "Variaciones logarítmicas") +
theme_minimal(base_family = "serif", base_size = 11) +
theme(plot.title = element_text(face = "bold", hjust = 0.5))
# 6.3 Reversión a la media (ACF de la varianza condicional)
# Para validar el supuesto de reversión a la media se realizan las pruebas ACF
# con el fin de determinar la autocorrelación de la varianza condicional de las
# variaciones para cada tipo de depósito.
#Verificación de estructura de las series
print(str(DM_diff))
## An xts object on 2008-02-29 / 2023-12-31 containing:
## Data: double [191, 1]
## Index: POSIXct,POSIXt [191] (TZ: "UTC")
## NULL
print(head(DM_diff))
## Warning: object timezone ('UTC') is different from system timezone ('')
## NOTE: set 'options(xts_check_TZ = FALSE)' to disable this warning
## This note is displayed once per session
## [,1]
## 2008-02-29 -0.041192914
## 2008-03-31 0.026694070
## 2008-04-30 -0.038216530
## 2008-05-31 -0.004122999
## 2008-06-30 0.019952058
## 2008-07-31 -0.004035194
#Conversión de las series a formato 'ts'
if (.Platform$OS.type == "windows") {
if ("extrafont" %in% rownames(installed.packages())) {
extrafont::loadfonts(device = "win", quiet = TRUE)
}
suppressWarnings(
windowsFonts("Times New Roman" = windowsFont("Times New Roman"))
)
}
.op <- par(
family = "Times New Roman",
cex.main = 1.1, # títulos ~11 pt
cex.lab = 1.1, # ejes ~11 pt
cex.axis = 1.1 # marcas de eje ~11 pt
)
print(str(DM_diff)); print(head(DM_diff))
## An xts object on 2008-02-29 / 2023-12-31 containing:
## Data: double [191, 1]
## Index: POSIXct,POSIXt [191] (TZ: "UTC")
## NULL
## Warning: object timezone ('UTC') is different from system timezone ('')
## [,1]
## 2008-02-29 -0.041192914
## 2008-03-31 0.026694070
## 2008-04-30 -0.038216530
## 2008-05-31 -0.004122999
## 2008-06-30 0.019952058
## 2008-07-31 -0.004035194
DM_diff_ts <- ts(as.numeric(DM_diff), start = c(2008, 2), frequency = 12)
DA_diff_ts <- ts(as.numeric(DA_diff), start = c(2008, 2), frequency = 12)
DP_diff_ts <- ts(as.numeric(DP_diff), start = c(2008, 2), frequency = 12)
#Prueba de autocorrelación con estructura correcta
par(mfrow=c(1,1))
acf(DM_diff_ts^2, main="Autocorrelación de la Varianza Condicional (Depósitos Monetarios)")
acf(DA_diff_ts^2, main="Autocorrelación de la Varianza Condicional (Depósitos de Ahorro)")
acf(DP_diff_ts^2, main="Autocorrelación de la Varianza Condicional (Depósitos a Plazo)")
# 6.4 Persistencia (Ljung–Box en residuos al cuadrado)
# El supuesto de persistencia de la volatilidad en el modelo GARCH establece que
# los choques en la volatilidad tienen efectos prolongados en el tiempo, por
# lo tanto, la volatilidad en un período determinado influye en la volatilidad
# futura. Para evaluar este supuesto, se ha realizado la Prueba de Ljung-Box
# sobre los residuos al cuadrado. La prueba cuenta las siguientes hipótesis,
# para verificar su validez.
# Prueba de Ljung-Box sobre los residuos al cuadrado
Box_test <- Box.test(DM_diff^2, lag = 10, type = "Ljung-Box")
cat("Prueba de Ljung-Box: p-valor =", Box_test$p.value, "\n")
## Prueba de Ljung-Box: p-valor = 0.09451936
Box_test <- Box.test(DA_diff^2, lag = 10, type = "Ljung-Box")
cat("Prueba de Ljung-Box: p-valor =", Box_test$p.value, "\n")
## Prueba de Ljung-Box: p-valor = 0.04883461
Box_test <- Box.test(DP_diff^2, lag = 10, type = "Ljung-Box")
cat("Prueba de Ljung-Box: p-valor =", Box_test$p.value, "\n")
## Prueba de Ljung-Box: p-valor = 6.328271e-15
# 6.5 Estructura de la varianza condicional (α y β)
# Para validar este supuesto para los 3 tipos de depósitos se analizaron las
# variables Alpha y Beta para evaluar su impacto en los choques recientes
# y la persistencia de la volatilidad.
DM_diff <- diff(log(DM))[-1]
DA_diff <- diff(log(DA))[-1]
DP_diff <- diff(log(DP))[-1]
spec <- ugarchspec(variance.model = list(model = "sGARCH", garchOrder = c(1,1)), mean.model = list(armaOrder = c(0,0)))
fit <- ugarchfit(spec, data = DM_diff)
show(fit)
##
## *---------------------------------*
## * GARCH Model Fit *
## *---------------------------------*
##
## Conditional Variance Dynamics
## -----------------------------------
## GARCH Model : sGARCH(1,1)
## Mean Model : ARFIMA(0,0,0)
## Distribution : norm
##
## Optimal Parameters
## ------------------------------------
## Estimate Std. Error t value Pr(>|t|)
## mu 0.006607 0.001637 4.0369e+00 0.000054
## omega 0.000000 0.000002 2.6021e-02 0.979241
## alpha1 0.000000 0.000053 1.9800e-04 0.999842
## beta1 0.999000 0.000067 1.4978e+04 0.000000
##
## Robust Standard Errors:
## Estimate Std. Error t value Pr(>|t|)
## mu 0.006607 0.001370 4.8216e+00 0.000001
## omega 0.000000 0.000005 8.6290e-03 0.993115
## alpha1 0.000000 0.000064 1.6600e-04 0.999868
## beta1 0.999000 0.000033 3.0542e+04 0.000000
##
## LogLikelihood : 452.2469
##
## Information Criteria
## ------------------------------------
##
## Akaike -4.6937
## Bayes -4.6256
## Shibata -4.6945
## Hannan-Quinn -4.6661
##
## Weighted Ljung-Box Test on Standardized Residuals
## ------------------------------------
## statistic p-value
## Lag[1] 3.312 0.06878
## Lag[2*(p+q)+(p+q)-1][2] 3.758 0.08762
## Lag[4*(p+q)+(p+q)-1][5] 7.661 0.03575
## d.o.f=0
## H0 : No serial correlation
##
## Weighted Ljung-Box Test on Standardized Squared Residuals
## ------------------------------------
## statistic p-value
## Lag[1] 0.5834 0.4450
## Lag[2*(p+q)+(p+q)-1][5] 3.1385 0.3823
## Lag[4*(p+q)+(p+q)-1][9] 4.9458 0.4374
## d.o.f=2
##
## Weighted ARCH LM Tests
## ------------------------------------
## Statistic Shape Scale P-Value
## ARCH Lag[3] 3.180 0.500 2.000 0.07454
## ARCH Lag[5] 4.354 1.440 1.667 0.14459
## ARCH Lag[7] 4.913 2.315 1.543 0.23348
##
## Nyblom stability test
## ------------------------------------
## Joint Statistic: 24.9244
## Individual Statistics:
## mu 0.11513
## omega 4.59218
## alpha1 0.03023
## beta1 0.03093
##
## Asymptotic Critical Values (10% 5% 1%)
## Joint Statistic: 1.07 1.24 1.6
## Individual Statistic: 0.35 0.47 0.75
##
## Sign Bias Test
## ------------------------------------
## t-value prob sig
## Sign Bias 0.7171 0.47421
## Negative Sign Bias 2.2385 0.02637 **
## Positive Sign Bias 0.5882 0.55708
## Joint Effect 7.8841 0.04847 **
##
##
## Adjusted Pearson Goodness-of-Fit Test:
## ------------------------------------
## group statistic p-value(g-1)
## 1 20 16.64 0.6140
## 2 30 17.12 0.9604
## 3 40 30.78 0.8234
## 4 50 43.29 0.7028
##
##
## Elapsed time : 0.08633709
spec <- ugarchspec(variance.model = list(model = "sGARCH", garchOrder = c(1,1)), mean.model = list(armaOrder = c(0,0)))
fit <- ugarchfit(spec, data = DA_diff)
show(fit)
##
## *---------------------------------*
## * GARCH Model Fit *
## *---------------------------------*
##
## Conditional Variance Dynamics
## -----------------------------------
## GARCH Model : sGARCH(1,1)
## Mean Model : ARFIMA(0,0,0)
## Distribution : norm
##
## Optimal Parameters
## ------------------------------------
## Estimate Std. Error t value Pr(>|t|)
## mu 0.008571 0.000442 19.393320 0.000000
## omega 0.000071 0.000063 1.135393 0.256211
## alpha1 0.348910 0.159489 2.187670 0.028694
## beta1 0.000001 0.590440 0.000001 0.999999
##
## Robust Standard Errors:
## Estimate Std. Error t value Pr(>|t|)
## mu 0.008571 0.001629 5.2625 0.00000
## omega 0.000071 0.000180 0.3943 0.69336
## alpha1 0.348910 0.221753 1.5734 0.11562
## beta1 0.000001 1.652445 0.0000 1.00000
##
## LogLikelihood : 612.4126
##
## Information Criteria
## ------------------------------------
##
## Akaike -6.3708
## Bayes -6.3027
## Shibata -6.3717
## Hannan-Quinn -6.3432
##
## Weighted Ljung-Box Test on Standardized Residuals
## ------------------------------------
## statistic p-value
## Lag[1] 0.7635 0.3822
## Lag[2*(p+q)+(p+q)-1][2] 1.0413 0.4850
## Lag[4*(p+q)+(p+q)-1][5] 5.4496 0.1209
## d.o.f=0
## H0 : No serial correlation
##
## Weighted Ljung-Box Test on Standardized Squared Residuals
## ------------------------------------
## statistic p-value
## Lag[1] 0.176 0.6748
## Lag[2*(p+q)+(p+q)-1][5] 2.259 0.5586
## Lag[4*(p+q)+(p+q)-1][9] 5.835 0.3176
## d.o.f=2
##
## Weighted ARCH LM Tests
## ------------------------------------
## Statistic Shape Scale P-Value
## ARCH Lag[3] 0.5524 0.500 2.000 0.45736
## ARCH Lag[5] 4.9538 1.440 1.667 0.10532
## ARCH Lag[7] 6.8151 2.315 1.543 0.09515
##
## Nyblom stability test
## ------------------------------------
## Joint Statistic: 2.1438
## Individual Statistics:
## mu 0.40782
## omega 0.57109
## alpha1 0.05027
## beta1 0.58634
##
## Asymptotic Critical Values (10% 5% 1%)
## Joint Statistic: 1.07 1.24 1.6
## Individual Statistic: 0.35 0.47 0.75
##
## Sign Bias Test
## ------------------------------------
## t-value prob sig
## Sign Bias 0.6656 0.5065
## Negative Sign Bias 0.5081 0.6120
## Positive Sign Bias 0.1034 0.9178
## Joint Effect 0.5242 0.9135
##
##
## Adjusted Pearson Goodness-of-Fit Test:
## ------------------------------------
## group statistic p-value(g-1)
## 1 20 26.91 0.10687
## 2 30 43.50 0.04088
## 3 40 58.84 0.02156
## 4 50 71.57 0.01940
##
##
## Elapsed time : 0.1562281
spec <- ugarchspec(variance.model = list(model = "sGARCH", garchOrder = c(1,1)), mean.model = list(armaOrder = c(0,0)))
fit <- ugarchfit(spec, data = DP_diff)
show(fit)
##
## *---------------------------------*
## * GARCH Model Fit *
## *---------------------------------*
##
## Conditional Variance Dynamics
## -----------------------------------
## GARCH Model : sGARCH(1,1)
## Mean Model : ARFIMA(0,0,0)
## Distribution : norm
##
## Optimal Parameters
## ------------------------------------
## Estimate Std. Error t value Pr(>|t|)
## mu 0.007621 0.000568 13.4207 0.000000
## omega 0.000007 0.000001 13.4014 0.000000
## alpha1 0.128700 0.036177 3.5575 0.000374
## beta1 0.740772 0.047050 15.7443 0.000000
##
## Robust Standard Errors:
## Estimate Std. Error t value Pr(>|t|)
## mu 0.007621 0.000853 8.9315 0.000000
## omega 0.000007 0.000001 12.4552 0.000000
## alpha1 0.128700 0.036243 3.5510 0.000384
## beta1 0.740772 0.059186 12.5160 0.000000
##
## LogLikelihood : 666.3505
##
## Information Criteria
## ------------------------------------
##
## Akaike -6.9356
## Bayes -6.8675
## Shibata -6.9365
## Hannan-Quinn -6.9080
##
## Weighted Ljung-Box Test on Standardized Residuals
## ------------------------------------
## statistic p-value
## Lag[1] 8.546 0.0034626
## Lag[2*(p+q)+(p+q)-1][2] 11.624 0.0007120
## Lag[4*(p+q)+(p+q)-1][5] 19.605 0.0000249
## d.o.f=0
## H0 : No serial correlation
##
## Weighted Ljung-Box Test on Standardized Squared Residuals
## ------------------------------------
## statistic p-value
## Lag[1] 0.007455 0.9312
## Lag[2*(p+q)+(p+q)-1][5] 1.187864 0.8159
## Lag[4*(p+q)+(p+q)-1][9] 2.248538 0.8733
## d.o.f=2
##
## Weighted ARCH LM Tests
## ------------------------------------
## Statistic Shape Scale P-Value
## ARCH Lag[3] 0.05126 0.500 2.000 0.8209
## ARCH Lag[5] 1.13270 1.440 1.667 0.6940
## ARCH Lag[7] 1.36991 2.315 1.543 0.8471
##
## Nyblom stability test
## ------------------------------------
## Joint Statistic: 6.9435
## Individual Statistics:
## mu 1.9838
## omega 1.1161
## alpha1 0.5105
## beta1 0.3264
##
## Asymptotic Critical Values (10% 5% 1%)
## Joint Statistic: 1.07 1.24 1.6
## Individual Statistic: 0.35 0.47 0.75
##
## Sign Bias Test
## ------------------------------------
## t-value prob sig
## Sign Bias 0.9183 0.3597
## Negative Sign Bias 0.3812 0.7035
## Positive Sign Bias 0.2336 0.8156
## Joint Effect 4.1968 0.2410
##
##
## Adjusted Pearson Goodness-of-Fit Test:
## ------------------------------------
## group statistic p-value(g-1)
## 1 20 14.34 0.7635
## 2 30 26.54 0.5965
## 3 40 39.99 0.4258
## 4 50 39.63 0.8280
##
##
## Elapsed time : 0.1756408
# 6.6 Innovaciones con media cero y varianza condicional
# Según este supuesto, los residuos deben de tener una media cercana a cero,
# para indicar que no hay sesgo en la serie de innovaciones, para validarlo,
# se realizaron los histogramas con los residuos resultantes del modelo GARCH
# (1,1) de los tres tipos de depósitos:
# Función para ajustar un modelo GARCH(1,1) y extraer los residuos
ajustar_garch <- function(data, nombre, tipo_letra = "serif", tamano_fuente = 11) {
#Ajustar el modelo GARCH(1,1)
spec <- ugarchspec(
variance.model = list(model = "sGARCH", garchOrder = c(1,1)),
mean.model = list(armaOrder = c(0,0)),
distribution.model = "norm"
)
fit <- ugarchfit(spec, data = data)
print(fit)
#Extraer residuos estandarizados como vector numérico
residuos_xts <- residuals(fit, standardize = TRUE)
residuos <- as.numeric(na.omit(residuos_xts))
#Configurar fuente y tamaño de letra para la ventana gráfica
par(family = tipo_letra, cex.main = 1.1, cex.lab = 1.1, cex.axis = 1.1, cex = tamano_fuente / 10)
#Graficar histograma
hist(residuos, breaks = 30, probability = TRUE,
main = paste("Histograma de residuos -", nombre),
col = "gray", border = "black", xlab = "Residuos estandarizados",
cex.main = 1.2, cex.lab = 1, cex.axis = 1)
lines(density(residuos), col = "red", lwd = 2)
#Pruebas estadísticas
cat("\nResultados para", nombre, "\n")
print(shapiro.test(residuos))
print(Box.test(residuos, lag = 10, type = "Ljung-Box"))
print(Box.test(residuos^2, lag = 10, type = "Ljung-Box"))
}
#Aplicar a cada tipo de depósito
ajustar_garch(DM_diff, "Depósitos Monetarios")
##
## *---------------------------------*
## * GARCH Model Fit *
## *---------------------------------*
##
## Conditional Variance Dynamics
## -----------------------------------
## GARCH Model : sGARCH(1,1)
## Mean Model : ARFIMA(0,0,0)
## Distribution : norm
##
## Optimal Parameters
## ------------------------------------
## Estimate Std. Error t value Pr(>|t|)
## mu 0.006607 0.001637 4.0369e+00 0.000054
## omega 0.000000 0.000002 2.6021e-02 0.979241
## alpha1 0.000000 0.000053 1.9800e-04 0.999842
## beta1 0.999000 0.000067 1.4978e+04 0.000000
##
## Robust Standard Errors:
## Estimate Std. Error t value Pr(>|t|)
## mu 0.006607 0.001370 4.8216e+00 0.000001
## omega 0.000000 0.000005 8.6290e-03 0.993115
## alpha1 0.000000 0.000064 1.6600e-04 0.999868
## beta1 0.999000 0.000033 3.0542e+04 0.000000
##
## LogLikelihood : 452.2469
##
## Information Criteria
## ------------------------------------
##
## Akaike -4.6937
## Bayes -4.6256
## Shibata -4.6945
## Hannan-Quinn -4.6661
##
## Weighted Ljung-Box Test on Standardized Residuals
## ------------------------------------
## statistic p-value
## Lag[1] 3.312 0.06878
## Lag[2*(p+q)+(p+q)-1][2] 3.758 0.08762
## Lag[4*(p+q)+(p+q)-1][5] 7.661 0.03575
## d.o.f=0
## H0 : No serial correlation
##
## Weighted Ljung-Box Test on Standardized Squared Residuals
## ------------------------------------
## statistic p-value
## Lag[1] 0.5834 0.4450
## Lag[2*(p+q)+(p+q)-1][5] 3.1385 0.3823
## Lag[4*(p+q)+(p+q)-1][9] 4.9458 0.4374
## d.o.f=2
##
## Weighted ARCH LM Tests
## ------------------------------------
## Statistic Shape Scale P-Value
## ARCH Lag[3] 3.180 0.500 2.000 0.07454
## ARCH Lag[5] 4.354 1.440 1.667 0.14459
## ARCH Lag[7] 4.913 2.315 1.543 0.23348
##
## Nyblom stability test
## ------------------------------------
## Joint Statistic: 24.9244
## Individual Statistics:
## mu 0.11513
## omega 4.59218
## alpha1 0.03023
## beta1 0.03093
##
## Asymptotic Critical Values (10% 5% 1%)
## Joint Statistic: 1.07 1.24 1.6
## Individual Statistic: 0.35 0.47 0.75
##
## Sign Bias Test
## ------------------------------------
## t-value prob sig
## Sign Bias 0.7171 0.47421
## Negative Sign Bias 2.2385 0.02637 **
## Positive Sign Bias 0.5882 0.55708
## Joint Effect 7.8841 0.04847 **
##
##
## Adjusted Pearson Goodness-of-Fit Test:
## ------------------------------------
## group statistic p-value(g-1)
## 1 20 16.64 0.6140
## 2 30 17.12 0.9604
## 3 40 30.78 0.8234
## 4 50 43.29 0.7028
##
##
## Elapsed time : 0.06568193
##
## Resultados para Depósitos Monetarios
##
## Shapiro-Wilk normality test
##
## data: residuos
## W = 0.99218, p-value = 0.3966
##
##
## Box-Ljung test
##
## data: residuos
## X-squared = 50.42, df = 10, p-value = 2.234e-07
##
##
## Box-Ljung test
##
## data: residuos^2
## X-squared = 8.8402, df = 10, p-value = 0.5473
ajustar_garch(DA_diff, "Depósitos de Ahorro")
##
## *---------------------------------*
## * GARCH Model Fit *
## *---------------------------------*
##
## Conditional Variance Dynamics
## -----------------------------------
## GARCH Model : sGARCH(1,1)
## Mean Model : ARFIMA(0,0,0)
## Distribution : norm
##
## Optimal Parameters
## ------------------------------------
## Estimate Std. Error t value Pr(>|t|)
## mu 0.008571 0.000442 19.393320 0.000000
## omega 0.000071 0.000063 1.135393 0.256211
## alpha1 0.348910 0.159489 2.187670 0.028694
## beta1 0.000001 0.590440 0.000001 0.999999
##
## Robust Standard Errors:
## Estimate Std. Error t value Pr(>|t|)
## mu 0.008571 0.001629 5.2625 0.00000
## omega 0.000071 0.000180 0.3943 0.69336
## alpha1 0.348910 0.221753 1.5734 0.11562
## beta1 0.000001 1.652445 0.0000 1.00000
##
## LogLikelihood : 612.4126
##
## Information Criteria
## ------------------------------------
##
## Akaike -6.3708
## Bayes -6.3027
## Shibata -6.3717
## Hannan-Quinn -6.3432
##
## Weighted Ljung-Box Test on Standardized Residuals
## ------------------------------------
## statistic p-value
## Lag[1] 0.7635 0.3822
## Lag[2*(p+q)+(p+q)-1][2] 1.0413 0.4850
## Lag[4*(p+q)+(p+q)-1][5] 5.4496 0.1209
## d.o.f=0
## H0 : No serial correlation
##
## Weighted Ljung-Box Test on Standardized Squared Residuals
## ------------------------------------
## statistic p-value
## Lag[1] 0.176 0.6748
## Lag[2*(p+q)+(p+q)-1][5] 2.259 0.5586
## Lag[4*(p+q)+(p+q)-1][9] 5.835 0.3176
## d.o.f=2
##
## Weighted ARCH LM Tests
## ------------------------------------
## Statistic Shape Scale P-Value
## ARCH Lag[3] 0.5524 0.500 2.000 0.45736
## ARCH Lag[5] 4.9538 1.440 1.667 0.10532
## ARCH Lag[7] 6.8151 2.315 1.543 0.09515
##
## Nyblom stability test
## ------------------------------------
## Joint Statistic: 2.1438
## Individual Statistics:
## mu 0.40782
## omega 0.57109
## alpha1 0.05027
## beta1 0.58634
##
## Asymptotic Critical Values (10% 5% 1%)
## Joint Statistic: 1.07 1.24 1.6
## Individual Statistic: 0.35 0.47 0.75
##
## Sign Bias Test
## ------------------------------------
## t-value prob sig
## Sign Bias 0.6656 0.5065
## Negative Sign Bias 0.5081 0.6120
## Positive Sign Bias 0.1034 0.9178
## Joint Effect 0.5242 0.9135
##
##
## Adjusted Pearson Goodness-of-Fit Test:
## ------------------------------------
## group statistic p-value(g-1)
## 1 20 26.91 0.10687
## 2 30 43.50 0.04088
## 3 40 58.84 0.02156
## 4 50 71.57 0.01940
##
##
## Elapsed time : 0.1298869
##
## Resultados para Depósitos de Ahorro
##
## Shapiro-Wilk normality test
##
## data: residuos
## W = 0.9748, p-value = 0.001601
##
##
## Box-Ljung test
##
## data: residuos
## X-squared = 21.615, df = 10, p-value = 0.01719
##
##
## Box-Ljung test
##
## data: residuos^2
## X-squared = 11.79, df = 10, p-value = 0.2994
ajustar_garch(DP_diff, "Depósitos a Plazo")
##
## *---------------------------------*
## * GARCH Model Fit *
## *---------------------------------*
##
## Conditional Variance Dynamics
## -----------------------------------
## GARCH Model : sGARCH(1,1)
## Mean Model : ARFIMA(0,0,0)
## Distribution : norm
##
## Optimal Parameters
## ------------------------------------
## Estimate Std. Error t value Pr(>|t|)
## mu 0.007621 0.000568 13.4207 0.000000
## omega 0.000007 0.000001 13.4014 0.000000
## alpha1 0.128700 0.036177 3.5575 0.000374
## beta1 0.740772 0.047050 15.7443 0.000000
##
## Robust Standard Errors:
## Estimate Std. Error t value Pr(>|t|)
## mu 0.007621 0.000853 8.9315 0.000000
## omega 0.000007 0.000001 12.4552 0.000000
## alpha1 0.128700 0.036243 3.5510 0.000384
## beta1 0.740772 0.059186 12.5160 0.000000
##
## LogLikelihood : 666.3505
##
## Information Criteria
## ------------------------------------
##
## Akaike -6.9356
## Bayes -6.8675
## Shibata -6.9365
## Hannan-Quinn -6.9080
##
## Weighted Ljung-Box Test on Standardized Residuals
## ------------------------------------
## statistic p-value
## Lag[1] 8.546 0.0034626
## Lag[2*(p+q)+(p+q)-1][2] 11.624 0.0007120
## Lag[4*(p+q)+(p+q)-1][5] 19.605 0.0000249
## d.o.f=0
## H0 : No serial correlation
##
## Weighted Ljung-Box Test on Standardized Squared Residuals
## ------------------------------------
## statistic p-value
## Lag[1] 0.007455 0.9312
## Lag[2*(p+q)+(p+q)-1][5] 1.187864 0.8159
## Lag[4*(p+q)+(p+q)-1][9] 2.248538 0.8733
## d.o.f=2
##
## Weighted ARCH LM Tests
## ------------------------------------
## Statistic Shape Scale P-Value
## ARCH Lag[3] 0.05126 0.500 2.000 0.8209
## ARCH Lag[5] 1.13270 1.440 1.667 0.6940
## ARCH Lag[7] 1.36991 2.315 1.543 0.8471
##
## Nyblom stability test
## ------------------------------------
## Joint Statistic: 6.9435
## Individual Statistics:
## mu 1.9838
## omega 1.1161
## alpha1 0.5105
## beta1 0.3264
##
## Asymptotic Critical Values (10% 5% 1%)
## Joint Statistic: 1.07 1.24 1.6
## Individual Statistic: 0.35 0.47 0.75
##
## Sign Bias Test
## ------------------------------------
## t-value prob sig
## Sign Bias 0.9183 0.3597
## Negative Sign Bias 0.3812 0.7035
## Positive Sign Bias 0.2336 0.8156
## Joint Effect 4.1968 0.2410
##
##
## Adjusted Pearson Goodness-of-Fit Test:
## ------------------------------------
## group statistic p-value(g-1)
## 1 20 14.34 0.7635
## 2 30 26.54 0.5965
## 3 40 39.99 0.4258
## 4 50 39.63 0.8280
##
##
## Elapsed time : 0.1258249
##
## Resultados para Depósitos a Plazo
##
## Shapiro-Wilk normality test
##
## data: residuos
## W = 0.9839, p-value = 0.02743
##
##
## Box-Ljung test
##
## data: residuos
## X-squared = 43.034, df = 10, p-value = 4.904e-06
##
##
## Box-Ljung test
##
## data: residuos^2
## X-squared = 4.7668, df = 10, p-value = 0.9062
# 6.7 Colas pesadas (kurtosis y Jarque–Bera)
#Curtosis y Prueba de Jarque-Bera
curtosis_val <- kurtosis(DM_diff, na.rm = TRUE)
jarque_bera_test <- jarque.bera.test(DA_diff)
cat("Curtosis de la serie: ", curtosis_val, "\n")
## Curtosis de la serie: 3.138453
cat("Prueba de Jarque-Bera: p-valor =", jarque_bera_test$p.value, "\n")
## Prueba de Jarque-Bera: p-valor = 6.532677e-07
curtosis_val <- kurtosis(DA_diff, na.rm = TRUE)
jarque_bera_test <- jarque.bera.test(DA_diff)
cat("Curtosis de la serie: ", curtosis_val, "\n")
## Curtosis de la serie: 4.429045
cat("Prueba de Jarque-Bera: p-valor =", jarque_bera_test$p.value, "\n")
## Prueba de Jarque-Bera: p-valor = 6.532677e-07
curtosis_val <- kurtosis(DP_diff, na.rm = TRUE)
jarque_bera_test <- jarque.bera.test(DA_diff)
cat("Curtosis de la serie: ", curtosis_val, "\n")
## Curtosis de la serie: 4.052304
cat("Prueba de Jarque-Bera: p-valor =", jarque_bera_test$p.value, "\n")
## Prueba de Jarque-Bera: p-valor = 6.532677e-07
# 7. Modelos GARCH
# 7.1 Ajuste GARCH(1,1) por serie
#Especificación del modelo GARCH(1,1)
especificacion_garch <- ugarchspec(
variance.model = list(model = "sGARCH", garchOrder = c(1,1)),
mean.model = list(armaOrder = c(0,0), include.mean = TRUE),
distribution.model = "norm"
)
#Función para ajustar GARCH y mostrar resumen
ajustar_garch <- function(serie, nombre_serie) {
cat("\n---------------------------------------\n")
cat("Ajuste GARCH(1,1) para", nombre_serie, "\n")
cat("---------------------------------------\n")
modelo <- ugarchfit(spec = especificacion_garch, data = serie)
show(modelo)
return(modelo)
}
#Ajustar modelos para cada serie
fit_DM <- ajustar_garch(DM_diff, "Depósitos Monetarios")
##
## ---------------------------------------
## Ajuste GARCH(1,1) para Depósitos Monetarios
## ---------------------------------------
##
## *---------------------------------*
## * GARCH Model Fit *
## *---------------------------------*
##
## Conditional Variance Dynamics
## -----------------------------------
## GARCH Model : sGARCH(1,1)
## Mean Model : ARFIMA(0,0,0)
## Distribution : norm
##
## Optimal Parameters
## ------------------------------------
## Estimate Std. Error t value Pr(>|t|)
## mu 0.006607 0.001637 4.0369e+00 0.000054
## omega 0.000000 0.000002 2.6021e-02 0.979241
## alpha1 0.000000 0.000053 1.9800e-04 0.999842
## beta1 0.999000 0.000067 1.4978e+04 0.000000
##
## Robust Standard Errors:
## Estimate Std. Error t value Pr(>|t|)
## mu 0.006607 0.001370 4.8216e+00 0.000001
## omega 0.000000 0.000005 8.6290e-03 0.993115
## alpha1 0.000000 0.000064 1.6600e-04 0.999868
## beta1 0.999000 0.000033 3.0542e+04 0.000000
##
## LogLikelihood : 452.2469
##
## Information Criteria
## ------------------------------------
##
## Akaike -4.6937
## Bayes -4.6256
## Shibata -4.6945
## Hannan-Quinn -4.6661
##
## Weighted Ljung-Box Test on Standardized Residuals
## ------------------------------------
## statistic p-value
## Lag[1] 3.312 0.06878
## Lag[2*(p+q)+(p+q)-1][2] 3.758 0.08762
## Lag[4*(p+q)+(p+q)-1][5] 7.661 0.03575
## d.o.f=0
## H0 : No serial correlation
##
## Weighted Ljung-Box Test on Standardized Squared Residuals
## ------------------------------------
## statistic p-value
## Lag[1] 0.5834 0.4450
## Lag[2*(p+q)+(p+q)-1][5] 3.1385 0.3823
## Lag[4*(p+q)+(p+q)-1][9] 4.9458 0.4374
## d.o.f=2
##
## Weighted ARCH LM Tests
## ------------------------------------
## Statistic Shape Scale P-Value
## ARCH Lag[3] 3.180 0.500 2.000 0.07454
## ARCH Lag[5] 4.354 1.440 1.667 0.14459
## ARCH Lag[7] 4.913 2.315 1.543 0.23348
##
## Nyblom stability test
## ------------------------------------
## Joint Statistic: 24.9244
## Individual Statistics:
## mu 0.11513
## omega 4.59218
## alpha1 0.03023
## beta1 0.03093
##
## Asymptotic Critical Values (10% 5% 1%)
## Joint Statistic: 1.07 1.24 1.6
## Individual Statistic: 0.35 0.47 0.75
##
## Sign Bias Test
## ------------------------------------
## t-value prob sig
## Sign Bias 0.7171 0.47421
## Negative Sign Bias 2.2385 0.02637 **
## Positive Sign Bias 0.5882 0.55708
## Joint Effect 7.8841 0.04847 **
##
##
## Adjusted Pearson Goodness-of-Fit Test:
## ------------------------------------
## group statistic p-value(g-1)
## 1 20 16.64 0.6140
## 2 30 17.12 0.9604
## 3 40 30.78 0.8234
## 4 50 43.29 0.7028
##
##
## Elapsed time : 0.0742991
fit_DA <- ajustar_garch(DA_diff, "Depósitos de Ahorro")
##
## ---------------------------------------
## Ajuste GARCH(1,1) para Depósitos de Ahorro
## ---------------------------------------
##
## *---------------------------------*
## * GARCH Model Fit *
## *---------------------------------*
##
## Conditional Variance Dynamics
## -----------------------------------
## GARCH Model : sGARCH(1,1)
## Mean Model : ARFIMA(0,0,0)
## Distribution : norm
##
## Optimal Parameters
## ------------------------------------
## Estimate Std. Error t value Pr(>|t|)
## mu 0.008571 0.000442 19.393320 0.000000
## omega 0.000071 0.000063 1.135393 0.256211
## alpha1 0.348910 0.159489 2.187670 0.028694
## beta1 0.000001 0.590440 0.000001 0.999999
##
## Robust Standard Errors:
## Estimate Std. Error t value Pr(>|t|)
## mu 0.008571 0.001629 5.2625 0.00000
## omega 0.000071 0.000180 0.3943 0.69336
## alpha1 0.348910 0.221753 1.5734 0.11562
## beta1 0.000001 1.652445 0.0000 1.00000
##
## LogLikelihood : 612.4126
##
## Information Criteria
## ------------------------------------
##
## Akaike -6.3708
## Bayes -6.3027
## Shibata -6.3717
## Hannan-Quinn -6.3432
##
## Weighted Ljung-Box Test on Standardized Residuals
## ------------------------------------
## statistic p-value
## Lag[1] 0.7635 0.3822
## Lag[2*(p+q)+(p+q)-1][2] 1.0413 0.4850
## Lag[4*(p+q)+(p+q)-1][5] 5.4496 0.1209
## d.o.f=0
## H0 : No serial correlation
##
## Weighted Ljung-Box Test on Standardized Squared Residuals
## ------------------------------------
## statistic p-value
## Lag[1] 0.176 0.6748
## Lag[2*(p+q)+(p+q)-1][5] 2.259 0.5586
## Lag[4*(p+q)+(p+q)-1][9] 5.835 0.3176
## d.o.f=2
##
## Weighted ARCH LM Tests
## ------------------------------------
## Statistic Shape Scale P-Value
## ARCH Lag[3] 0.5524 0.500 2.000 0.45736
## ARCH Lag[5] 4.9538 1.440 1.667 0.10532
## ARCH Lag[7] 6.8151 2.315 1.543 0.09515
##
## Nyblom stability test
## ------------------------------------
## Joint Statistic: 2.1438
## Individual Statistics:
## mu 0.40782
## omega 0.57109
## alpha1 0.05027
## beta1 0.58634
##
## Asymptotic Critical Values (10% 5% 1%)
## Joint Statistic: 1.07 1.24 1.6
## Individual Statistic: 0.35 0.47 0.75
##
## Sign Bias Test
## ------------------------------------
## t-value prob sig
## Sign Bias 0.6656 0.5065
## Negative Sign Bias 0.5081 0.6120
## Positive Sign Bias 0.1034 0.9178
## Joint Effect 0.5242 0.9135
##
##
## Adjusted Pearson Goodness-of-Fit Test:
## ------------------------------------
## group statistic p-value(g-1)
## 1 20 26.91 0.10687
## 2 30 43.50 0.04088
## 3 40 58.84 0.02156
## 4 50 71.57 0.01940
##
##
## Elapsed time : 0.1340339
fit_DP <- ajustar_garch(DP_diff, "Depósitos a Plazo")
##
## ---------------------------------------
## Ajuste GARCH(1,1) para Depósitos a Plazo
## ---------------------------------------
##
## *---------------------------------*
## * GARCH Model Fit *
## *---------------------------------*
##
## Conditional Variance Dynamics
## -----------------------------------
## GARCH Model : sGARCH(1,1)
## Mean Model : ARFIMA(0,0,0)
## Distribution : norm
##
## Optimal Parameters
## ------------------------------------
## Estimate Std. Error t value Pr(>|t|)
## mu 0.007621 0.000568 13.4207 0.000000
## omega 0.000007 0.000001 13.4014 0.000000
## alpha1 0.128700 0.036177 3.5575 0.000374
## beta1 0.740772 0.047050 15.7443 0.000000
##
## Robust Standard Errors:
## Estimate Std. Error t value Pr(>|t|)
## mu 0.007621 0.000853 8.9315 0.000000
## omega 0.000007 0.000001 12.4552 0.000000
## alpha1 0.128700 0.036243 3.5510 0.000384
## beta1 0.740772 0.059186 12.5160 0.000000
##
## LogLikelihood : 666.3505
##
## Information Criteria
## ------------------------------------
##
## Akaike -6.9356
## Bayes -6.8675
## Shibata -6.9365
## Hannan-Quinn -6.9080
##
## Weighted Ljung-Box Test on Standardized Residuals
## ------------------------------------
## statistic p-value
## Lag[1] 8.546 0.0034626
## Lag[2*(p+q)+(p+q)-1][2] 11.624 0.0007120
## Lag[4*(p+q)+(p+q)-1][5] 19.605 0.0000249
## d.o.f=0
## H0 : No serial correlation
##
## Weighted Ljung-Box Test on Standardized Squared Residuals
## ------------------------------------
## statistic p-value
## Lag[1] 0.007455 0.9312
## Lag[2*(p+q)+(p+q)-1][5] 1.187864 0.8159
## Lag[4*(p+q)+(p+q)-1][9] 2.248538 0.8733
## d.o.f=2
##
## Weighted ARCH LM Tests
## ------------------------------------
## Statistic Shape Scale P-Value
## ARCH Lag[3] 0.05126 0.500 2.000 0.8209
## ARCH Lag[5] 1.13270 1.440 1.667 0.6940
## ARCH Lag[7] 1.36991 2.315 1.543 0.8471
##
## Nyblom stability test
## ------------------------------------
## Joint Statistic: 6.9435
## Individual Statistics:
## mu 1.9838
## omega 1.1161
## alpha1 0.5105
## beta1 0.3264
##
## Asymptotic Critical Values (10% 5% 1%)
## Joint Statistic: 1.07 1.24 1.6
## Individual Statistic: 0.35 0.47 0.75
##
## Sign Bias Test
## ------------------------------------
## t-value prob sig
## Sign Bias 0.9183 0.3597
## Negative Sign Bias 0.3812 0.7035
## Positive Sign Bias 0.2336 0.8156
## Joint Effect 4.1968 0.2410
##
##
## Adjusted Pearson Goodness-of-Fit Test:
## ------------------------------------
## group statistic p-value(g-1)
## 1 20 14.34 0.7635
## 2 30 26.54 0.5965
## 3 40 39.99 0.4258
## 4 50 39.63 0.8280
##
##
## Elapsed time : 0.1324551
# 7.2 Gráfico de volatilidad (σ) por serie
#Configurar fuente Times New Roman y tamaño 11
par(family = "serif", cex.main = 1.1, cex.lab = 1.1, cex.axis = 1.1)
plot(sigma(fit_DM), type="l", col="black", main="Volatilidad - Depósitos Monetarios",
ylab="Volatilidad", xlab="Tiempo")
plot(sigma(fit_DA), type="l", col="black", main="Volatilidad - Depósitos de Ahorro",
ylab="Volatilidad", xlab="Tiempo")
plot(sigma(fit_DP), type="l", col="black", main="Volatilidad - Depósitos a Plazo",
ylab="Volatilidad", xlab="Tiempo")
# 8. Simulación de estrés
# 8.1 Función para simular una serie de variaciones GARCH con shock puntual
sim_garch <- function(fit, shocks) {
sim_spec <- getspec(fit)
#Extraer parámetros del modelo ajustado
params <- as.list(coef(fit))
#Asignar los parámetros al modelo de simulación
setfixed(sim_spec) <- params
#Simular variaciones (12 meses útiles + 50 burn-in)
sim_series <- ugarchpath(spec = sim_spec, n.sim = 12, n.start = 50)
sim_vars <- as.numeric(fitted(sim_series)) # variaciones simuladas (media condicional)
#Aplicar shock en el primer mes
sim_vars_stress <- sim_vars
sim_vars_stress[1] <- sim_vars[1] + shocks # shock positivo
return(sim_vars_stress)
}
# 8.2 Función para ajustar y mostrar resumen del modelo GARCH
ajustar_garch <- function(serie_xts, nombre) {
spec <- ugarchspec(
variance.model = list(model = "sGARCH", garchOrder = c(1, 1)),
mean.model = list(armaOrder = c(0, 0)),
distribution.model = "norm"
)
fit <- ugarchfit(spec, data = serie_xts, solver = "hybrid") # más robusto
cat("\n*---------------------------------*\n")
cat(paste("* GARCH Model Fit for", nombre, "*\n"))
cat("*---------------------------------*\n\n")
show(fit)
}
#Semilla para reproducibilidad
set.seed(123)
shock_recesion <- 0.05 # Shock inicial
# 8.3 Simulaciones de variaciones con shock para 1 año (12 meses)
sim_DM <- sim_garch(fit_DM, shock_recesion)
sim_DA <- sim_garch(fit_DA, shock_recesion)
sim_DP <- sim_garch(fit_DP, shock_recesion)
#Crear fechas futuras para 12 meses
fechas_futuras <- seq(from = as.Date("2024-01-01"), by = "months", length.out = 12)
#Convertir simulaciones en xts
sim_DM_xts <- xts(sim_DM, order.by = fechas_futuras)
sim_DA_xts <- xts(sim_DA, order.by = fechas_futuras)
sim_DP_xts <- xts(sim_DP, order.by = fechas_futuras)
#Ajustar modelos GARCH simulados
ajustar_garch(sim_DM_xts, "Depósitos Monetarios")
## Warning in .sgarchfit(spec = spec, data = data, out.sample = out.sample, :
## ugarchfit-->waring: using less than 100 data
## points for estimation
##
## *---------------------------------*
## * GARCH Model Fit for Depósitos Monetarios *
## *---------------------------------*
##
##
## *---------------------------------*
## * GARCH Model Fit *
## *---------------------------------*
##
## Conditional Variance Dynamics
## -----------------------------------
## GARCH Model : sGARCH(1,1)
## Mean Model : ARFIMA(0,0,0)
## Distribution : norm
##
## Optimal Parameters
## ------------------------------------
## Estimate Std. Error t value Pr(>|t|)
## mu 0.006903 0.001249 5.529043 0.000000
## omega 0.000001 0.000008 0.087147 0.930555
## alpha1 0.000000 0.112419 0.000000 1.000000
## beta1 0.698003 0.224242 3.112730 0.001854
##
## Robust Standard Errors:
## Estimate Std. Error t value Pr(>|t|)
## mu 0.006903 0.000977 7.062430 0.000000
## omega 0.000001 0.000015 0.047975 0.961736
## alpha1 0.000000 0.182143 0.000000 1.000000
## beta1 0.698003 0.369329 1.889922 0.058768
##
## LogLikelihood : 39.77281
##
## Information Criteria
## ------------------------------------
##
## Akaike -5.9621
## Bayes -5.8005
## Shibata -6.1180
## Hannan-Quinn -6.0220
##
## Weighted Ljung-Box Test on Standardized Residuals
## ------------------------------------
## statistic p-value
## Lag[1] 1.717 0.1901
## Lag[2*(p+q)+(p+q)-1][2] 1.782 0.3017
## Lag[4*(p+q)+(p+q)-1][5] 2.830 0.4390
## d.o.f=0
## H0 : No serial correlation
##
## Weighted Ljung-Box Test on Standardized Squared Residuals
## ------------------------------------
## statistic p-value
## Lag[1] 0.04217 0.8373
## Lag[2*(p+q)+(p+q)-1][5] 0.67950 0.9268
## Lag[4*(p+q)+(p+q)-1][9] 1.91102 0.9154
## d.o.f=2
##
## Weighted ARCH LM Tests
## ------------------------------------
## Statistic Shape Scale P-Value
## ARCH Lag[3] 0.06949 0.500 2.000 0.7921
## ARCH Lag[5] 0.41001 1.440 1.667 0.9098
## ARCH Lag[7] 0.85934 2.315 1.543 0.9353
##
## Nyblom stability test
## ------------------------------------
## Joint Statistic: 3.5696
## Individual Statistics:
## mu 0.07847
## omega 0.31453
## alpha1 0.16259
## beta1 0.08421
##
## Asymptotic Critical Values (10% 5% 1%)
## Joint Statistic: 1.07 1.24 1.6
## Individual Statistic: 0.35 0.47 0.75
##
## Sign Bias Test
## ------------------------------------
## t-value prob sig
## Sign Bias 0.03428 0.9736
## Negative Sign Bias 0.15303 0.8827
## Positive Sign Bias 0.45185 0.6650
## Joint Effect 0.22903 0.9728
##
##
## Adjusted Pearson Goodness-of-Fit Test:
## ------------------------------------
## group statistic p-value(g-1)
## 1 20 14.67 0.7435
## 2 30 28.00 0.5179
## 3 40 34.67 0.6678
## 4 50 46.33 0.5819
##
##
## Elapsed time : 0.07137489
ajustar_garch(sim_DA_xts, "Depósitos de Ahorro")
## Warning in .sgarchfit(spec = spec, data = data, out.sample = out.sample, :
## ugarchfit-->waring: using less than 100 data
## points for estimation
##
## *---------------------------------*
## * GARCH Model Fit for Depósitos de Ahorro *
## *---------------------------------*
##
##
## *---------------------------------*
## * GARCH Model Fit *
## *---------------------------------*
##
## Conditional Variance Dynamics
## -----------------------------------
## GARCH Model : sGARCH(1,1)
## Mean Model : ARFIMA(0,0,0)
## Distribution : norm
##
## Optimal Parameters
## ------------------------------------
## Estimate Std. Error t value Pr(>|t|)
## mu 0.00465 0.001158 4.015844 0.000059
## omega 0.00000 0.000005 0.000000 1.000000
## alpha1 0.00011 0.253818 0.000435 0.999653
## beta1 0.73151 0.495067 1.477594 0.139517
##
## Robust Standard Errors:
## Estimate Std. Error t value Pr(>|t|)
## mu 0.00465 0.000612 7.597771 0.00000
## omega 0.00000 0.000008 0.000000 1.00000
## alpha1 0.00011 0.427910 0.000258 0.99979
## beta1 0.73151 0.850257 0.860337 0.38960
##
## LogLikelihood : 42.12359
##
## Information Criteria
## ------------------------------------
##
## Akaike -6.3539
## Bayes -6.1923
## Shibata -6.5098
## Hannan-Quinn -6.4138
##
## Weighted Ljung-Box Test on Standardized Residuals
## ------------------------------------
## statistic p-value
## Lag[1] 0.001896 0.9653
## Lag[2*(p+q)+(p+q)-1][2] 0.160879 0.8788
## Lag[4*(p+q)+(p+q)-1][5] 0.638872 0.9343
## d.o.f=0
## H0 : No serial correlation
##
## Weighted Ljung-Box Test on Standardized Squared Residuals
## ------------------------------------
## statistic p-value
## Lag[1] 0.0664 0.7966
## Lag[2*(p+q)+(p+q)-1][5] 0.2556 0.9880
## Lag[4*(p+q)+(p+q)-1][9] 0.5842 0.9975
## d.o.f=2
##
## Weighted ARCH LM Tests
## ------------------------------------
## Statistic Shape Scale P-Value
## ARCH Lag[3] 0.06664 0.500 2.000 0.7963
## ARCH Lag[5] 0.20066 1.440 1.667 0.9653
## ARCH Lag[7] 0.27927 2.315 1.543 0.9938
##
## Nyblom stability test
## ------------------------------------
## Joint Statistic: 3.4542
## Individual Statistics:
## mu 0.08154
## omega 0.50985
## alpha1 0.22877
## beta1 0.11486
##
## Asymptotic Critical Values (10% 5% 1%)
## Joint Statistic: 1.07 1.24 1.6
## Individual Statistic: 0.35 0.47 0.75
##
## Sign Bias Test
## ------------------------------------
## t-value prob sig
## Sign Bias 0.8814 0.4074
## Negative Sign Bias 1.4506 0.1902
## Positive Sign Bias 0.8804 0.4079
## Joint Effect 3.6301 0.3043
##
##
## Adjusted Pearson Goodness-of-Fit Test:
## ------------------------------------
## group statistic p-value(g-1)
## 1 20 21.33 0.3187
## 2 30 38.00 0.1223
## 3 40 48.00 0.1529
## 4 50 46.33 0.5819
##
##
## Elapsed time : 0.06556106
ajustar_garch(sim_DP_xts, "Depósitos a Plazo")
## Warning in .sgarchfit(spec = spec, data = data, out.sample = out.sample, :
## ugarchfit-->waring: using less than 100 data
## points for estimation
##
## *---------------------------------*
## * GARCH Model Fit for Depósitos a Plazo *
## *---------------------------------*
##
##
## *---------------------------------*
## * GARCH Model Fit *
## *---------------------------------*
##
## Conditional Variance Dynamics
## -----------------------------------
## GARCH Model : sGARCH(1,1)
## Mean Model : ARFIMA(0,0,0)
## Distribution : norm
##
## Optimal Parameters
## ------------------------------------
## Estimate Std. Error t value Pr(>|t|)
## mu 0.006098 0.001129 5.402773 0.000000
## omega 0.000000 0.000007 0.000000 1.000000
## alpha1 0.000166 0.092376 0.001793 0.998570
## beta1 0.706952 0.151246 4.674195 0.000003
##
## Robust Standard Errors:
## Estimate Std. Error t value Pr(>|t|)
## mu 0.006098 0.000710 8.588721 0.000000
## omega 0.000000 0.000013 0.000000 1.000000
## alpha1 0.000166 0.112982 0.001466 0.998831
## beta1 0.706952 0.227281 3.110472 0.001868
##
## LogLikelihood : 41.45473
##
## Information Criteria
## ------------------------------------
##
## Akaike -6.2425
## Bayes -6.0808
## Shibata -6.3983
## Hannan-Quinn -6.3023
##
## Weighted Ljung-Box Test on Standardized Residuals
## ------------------------------------
## statistic p-value
## Lag[1] 0.7157 0.3975
## Lag[2*(p+q)+(p+q)-1][2] 1.1539 0.4509
## Lag[4*(p+q)+(p+q)-1][5] 1.8159 0.6625
## d.o.f=0
## H0 : No serial correlation
##
## Weighted Ljung-Box Test on Standardized Squared Residuals
## ------------------------------------
## statistic p-value
## Lag[1] 0.09672 0.7558
## Lag[2*(p+q)+(p+q)-1][5] 0.60493 0.9404
## Lag[4*(p+q)+(p+q)-1][9] 2.35778 0.8583
## d.o.f=2
##
## Weighted ARCH LM Tests
## ------------------------------------
## Statistic Shape Scale P-Value
## ARCH Lag[3] 0.1736 0.500 2.000 0.6769
## ARCH Lag[5] 0.4972 1.440 1.667 0.8845
## ARCH Lag[7] 1.1530 2.315 1.543 0.8875
##
## Nyblom stability test
## ------------------------------------
## Joint Statistic: 4.2372
## Individual Statistics:
## mu 0.07279
## omega 0.15174
## alpha1 0.12044
## beta1 0.08821
##
## Asymptotic Critical Values (10% 5% 1%)
## Joint Statistic: 1.07 1.24 1.6
## Individual Statistic: 0.35 0.47 0.75
##
## Sign Bias Test
## ------------------------------------
## t-value prob sig
## Sign Bias 0.49658 0.6347
## Negative Sign Bias 0.53823 0.6071
## Positive Sign Bias 0.05035 0.9612
## Joint Effect 1.60242 0.6588
##
##
## Adjusted Pearson Goodness-of-Fit Test:
## ------------------------------------
## group statistic p-value(g-1)
## 1 20 18.00 0.5224
## 2 30 28.00 0.5179
## 3 40 48.00 0.1529
## 4 50 54.67 0.2681
##
##
## Elapsed time : 0.07047105
# 8.4 Gráficos: 2023 real + 2024 simulado
#Tomar las últimas 12 variaciones reales del año 2023
real_DM_2023 <- tail(DM_diff, 12)
real_DA_2023 <- tail(DA_diff, 12)
real_DP_2023 <- tail(DP_diff, 12)
#Fechas reales del año 2023
fechas_2023 <- seq(from = as.Date("2023-01-01"), by = "months", length.out = 12)
real_DM_xts <- xts(real_DM_2023, order.by = fechas_2023)
real_DA_xts <- xts(real_DA_2023, order.by = fechas_2023)
real_DP_xts <- xts(real_DP_2023, order.by = fechas_2023)
#Crear fechas futuras simuladas para 2024
fechas_2024 <- seq(from = as.Date("2024-01-01"), by = "months", length.out = 12)
sim_DM_xts <- xts(sim_DM, order.by = fechas_2024)
sim_DA_xts <- xts(sim_DA, order.by = fechas_2024)
sim_DP_xts <- xts(sim_DP, order.by = fechas_2024)
# Combinar 2023 + 2024 para una serie continua
completo_DM_xts <- c(real_DM_xts, sim_DM_xts)
completo_DA_xts <- c(real_DA_xts, sim_DA_xts)
completo_DP_xts <- c(real_DP_xts, sim_DP_xts)
par(family = "serif", cex.main = 1.1, cex.lab = 1.1, cex.axis = 1.1)
etiquetas_completas <- format(index(completo_DM_xts), "%b-%Y")
#Gráfico Depósitos Monetarios
plot(index(completo_DM_xts), coredata(completo_DM_xts), type = "l", col = "black",
main = "Volatilidad Simulada durante 2024 - Depósitos Monetarios (Años 2023 y 2024)",
xlab = "", ylab = "Volatilidad", xaxt = "n", ylim = c(min(coredata(completo_DM_xts)), 0.06))
axis(1, at = index(completo_DM_xts), labels = etiquetas_completas, las = 2, cex.axis = 0.8)
#Gráfico Depósitos de Ahorro
plot(index(completo_DA_xts), coredata(completo_DA_xts), type = "l", col = "black",
main = "Volatilidad Simulada durante 2024 - Depósitos de Ahorro (Años 2023 y 2024)",
xlab = "", ylab = "Volatilidad", xaxt = "n", ylim = c(min(coredata(completo_DA_xts)), 0.06))
axis(1, at = index(completo_DA_xts), labels = etiquetas_completas, las = 2, cex.axis = 0.8)
#Gráfico Depósitos a Plazo
plot(index(completo_DP_xts), coredata(completo_DP_xts), type = "l", col = "black",
main = "Volatilidad Simulada durante 2024 - Depósitos a Plazo (Años 2023 y 2024)",
xlab = "", ylab = "Volatilidad", xaxt = "n", ylim = c(min(coredata(completo_DP_xts)), 0.06))
axis(1, at = index(completo_DP_xts), labels = etiquetas_completas, las = 2, cex.axis = 0.8)
# 9. LaR/VaR normal (95%)
#Función para calcular el VaR normal al 95% (con signo negativo)
calcular_VaR <- function(fit, nivel_confianza = 0.95) {
sigma <- sigma(fit)
ult_sigma <- tail(sigma, 1)
VaR <- -qnorm(nivel_confianza, mean = 0, sd = ult_sigma)
return(VaR)
}
# 9.1 Cálculo del VaR normal al 95%
VaR_DM_normal <- calcular_VaR(fit_DM)
VaR_DA_normal <- calcular_VaR(fit_DA)
VaR_DP_normal <- calcular_VaR(fit_DP)
#Mostrar resultados
cat("=== VaR Normal al 95% ===\n")
## === VaR Normal al 95% ===
cat("Depósitos Monetarios:", VaR_DM_normal, "\n")
## Depósitos Monetarios: -0.03428054
cat("Depósitos de Ahorro:", VaR_DA_normal, "\n")
## Depósitos de Ahorro: -0.01404021
cat("Depósitos a Plazo:", VaR_DP_normal, "\n")
## Depósitos a Plazo: -0.01104264
# 9.2 Backtesting del VaR al 95%
validar_var <- function(modelo_garch, serie_diff, nombre_serie) {
sigma <- sigma(modelo_garch)
mu <- fitted(modelo_garch)
VaR_95 <- mu - sigma * qnorm(0.95) # signo negativo para pérdidas
serie_var <- as.numeric(serie_diff)
excedencias <- serie_var < VaR_95
cat("\n--- Backtesting VaR al 95% -", nombre_serie, "---\n")
cat("Número de excepciones:", sum(excedencias), "\n")
cat("Porcentaje de excepciones:", mean(excedencias) * 100, "%\n")
fecha <- index(serie_diff)
df <- data.frame(Fecha = fecha, Variaciones = serie_var,
VaR_95 = VaR_95, Excedencia = excedencias)
ggplot(df, aes(x = Fecha)) +
geom_line(aes(y = Variaciones, color = "Variaciones observadas"), size = 0.7) +
geom_line(aes(y = VaR_95, color = "LaR al 95%"), size = 0.7) +
geom_point(data = df[df$Excedencia, ],
aes(y = Variaciones, color = "Excepciones (Variaciones < LaR)"),
size = 2) +
scale_color_manual(name = "Leyenda",
values = c("Variaciones observadas" = "black",
"LaR al 95%" = "red",
"Excepciones (Variaciones < LaR)" = "blue1")) +
labs(title = paste("Backtesting del LaR al 95% -", nombre_serie),
x = "Fecha", y = "Variaciones") +
theme_minimal(base_family = "serif", base_size = 11) +
theme(plot.title = element_text(face = "bold", hjust = 0.5),
legend.position = "bottom",
legend.title = element_text(face = "bold"))
}
# Llamadas
validar_var(fit_DM, DM_diff, "Depósitos Monetarios")
##
## --- Backtesting VaR al 95% - Depósitos Monetarios ---
## Número de excepciones: 11
## Porcentaje de excepciones: 5.759162 %
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was generated.
validar_var(fit_DA, DA_diff, "Depósitos de Ahorro")
##
## --- Backtesting VaR al 95% - Depósitos de Ahorro ---
## Número de excepciones: 6
## Porcentaje de excepciones: 3.141361 %
validar_var(fit_DP, DP_diff, "Depósitos a Plazo")
##
## --- Backtesting VaR al 95% - Depósitos a Plazo ---
## Número de excepciones: 8
## Porcentaje de excepciones: 4.188482 %
# 10. LaR/VaR en estrés (99% y +5% σ)
# 10.1 Función para calcular el VaR con aumento del 5% de volatilidad
calcular_VaR_crisis <- function(fit, z_alpha = 2.33, aumento_vol = 0.05) {
sigma <- sigma(fit)
sigma_ult <- tail(sigma, 1)
sigma_crisis <- sigma_ult * (1 + aumento_vol)
VaR_crisis <- -z_alpha * sigma_crisis # signo negativo para pérdida
return(VaR_crisis)
}
# 10.2 Cálculo del VaR en crisis
VaR_DM_crisis <- calcular_VaR_crisis(fit_DM)
VaR_DA_crisis <- calcular_VaR_crisis(fit_DA)
VaR_DP_crisis <- calcular_VaR_crisis(fit_DP)
cat("\n=== VaR bajo estrés (99%, +5% Volatilidad) ===\n")
##
## === VaR bajo estrés (99%, +5% Volatilidad) ===
cat("Depósitos Monetarios:", VaR_DM_crisis, "\n")
## Depósitos Monetarios: -0.05098772
cat("Depósitos de Ahorro:", VaR_DA_crisis, "\n")
## Depósitos de Ahorro: -0.02088293
cat("Depósitos a Plazo:", VaR_DP_crisis, "\n")
## Depósitos a Plazo: -0.01642445
# 10.3 Backtesting del VaR al 99% (crisis)
validar_var_crisis <- function(modelo_garch, serie_diff, nombre_serie, aumento_vol = 0.05) {
sigma <- sigma(modelo_garch)
mu <- fitted(modelo_garch)
sigma_crisis <- sigma * (1 + aumento_vol)
VaR_99_Crisis <- mu - sigma_crisis * qnorm(0.99)
serie_var <- as.numeric(serie_diff)
excedencias <- serie_var < VaR_99_Crisis
cat("\n--- Backtesting VaR al 99% (Crisis) -", nombre_serie, "---\n")
cat("Número de excepciones:", sum(excedencias), "\n")
cat("Porcentaje de excepciones:", mean(excedencias) * 100, "%\n")
fecha <- index(serie_diff)
df <- data.frame(Fecha = fecha, Variaciones = serie_var,
VaR_99_Crisis = VaR_99_Crisis, Excedencia = excedencias)
ggplot(df, aes(x = Fecha)) +
geom_line(aes(y = Variaciones, color = "Variaciones observadas"), size = 0.7) +
geom_line(aes(y = VaR_99_Crisis, color = "LaR al 99% (Crisis)"), size = 0.7) +
geom_point(data = df[df$Excedencia, ],
aes(y = Variaciones, color = "Excepciones (Variaciones < LaR)"),
size = 2) +
scale_color_manual(name = "Leyenda",
values = c("Variaciones observadas" = "black",
"LaR al 99% (Crisis)" = "red",
"Excepciones (Variaciones < LaR)" = "blue1")) +
labs(title = paste("Backtesting del LaR al 99% (Crisis Financiera) -", nombre_serie),
x = "Fecha", y = "Variaciones") +
theme_minimal(base_family = "serif", base_size = 11) +
theme(plot.title = element_text(face = "bold", hjust = 0.5),
legend.position = "bottom",
legend.title = element_text(face = "bold"))
}
validar_var_crisis(fit_DM, DM_diff, "Depósitos Monetarios")
##
## --- Backtesting VaR al 99% (Crisis) - Depósitos Monetarios ---
## Número de excepciones: 1
## Porcentaje de excepciones: 0.5235602 %
validar_var_crisis(fit_DA, DA_diff, "Depósitos de Ahorro")
##
## --- Backtesting VaR al 99% (Crisis) - Depósitos de Ahorro ---
## Número de excepciones: 1
## Porcentaje de excepciones: 0.5235602 %
validar_var_crisis(fit_DP, DP_diff, "Depósitos a Plazo")
##
## --- Backtesting VaR al 99% (Crisis) - Depósitos a Plazo ---
## Número de excepciones: 0
## Porcentaje de excepciones: 0 %
# 11. Comparación normal vs. estrés y Expected Shortfall
# Configurar la fuente Times New Roman
par(family = "serif", cex.main = 1.1, cex.lab = 1.1, cex.axis = 1.1)
# 11.1 Última volatilidad (σ) estimada
vol_DM <- tail(sigma(fit_DM), 1)
vol_DA <- tail(sigma(fit_DA), 1)
vol_DP <- tail(sigma(fit_DP), 1)
# 11.2 σ en crisis (+5%)
vol_DM_crisis <- vol_DM * 1.05
vol_DA_crisis <- vol_DA * 1.05
vol_DP_crisis <- vol_DP * 1.05
# 11.3 Expected Shortfall (95% y 99%)
ES_normal <- function(sigma, alpha = 0.95) {
-sigma * dnorm(qnorm(alpha)) / (1 - alpha)
}
ES_crisis <- function(sigma, alpha = 0.99) {
-sigma * dnorm(qnorm(alpha)) / (1 - alpha)
}
# 11.4 Tabla comparativa (σ, LaR/VaR y ES)
tabla_comparativa <- tibble::tibble(
Fecha = rep(as.Date("2023-12-31"), 6),
Serie = rep(c("Depósitos Monetarios", "Depósitos de Ahorro", "Depósitos a Plazo"), each = 2),
Escenario = rep(c("Normal (95%)", "Crisis (99%)"), times = 3),
Volatilidad = c(as.numeric(vol_DM), as.numeric(vol_DM_crisis),
as.numeric(vol_DA), as.numeric(vol_DA_crisis),
as.numeric(vol_DP), as.numeric(vol_DP_crisis)),
VaR = c(as.numeric(VaR_DM_normal), as.numeric(VaR_DM_crisis),
as.numeric(VaR_DA_normal), as.numeric(VaR_DA_crisis),
as.numeric(VaR_DP_normal), as.numeric(VaR_DP_crisis)),
ES = c(ES_normal(vol_DM), ES_crisis(vol_DM_crisis),
ES_normal(vol_DA), ES_crisis(vol_DA_crisis),
ES_normal(vol_DP), ES_crisis(vol_DP_crisis))
)
print(tabla_comparativa)
## # A tibble: 6 × 6
## Fecha Serie Escenario Volatilidad VaR ES[,1]
## <date> <chr> <chr> <dbl> <dbl> <xts[,1]>
## 1 2023-12-31 Depósitos Monetarios Normal (95%) 0.0208 -0.0343 -0.04298918
## 2 2023-12-31 Depósitos Monetarios Crisis (99%) 0.0219 -0.0510 -0.05832326
## 3 2023-12-31 Depósitos de Ahorro Normal (95%) 0.00854 -0.0140 -0.01760699
## 4 2023-12-31 Depósitos de Ahorro Crisis (99%) 0.00896 -0.0209 -0.02388734
## 5 2023-12-31 Depósitos a Plazo Normal (95%) 0.00671 -0.0110 -0.01384792
## 6 2023-12-31 Depósitos a Plazo Crisis (99%) 0.00705 -0.0164 -0.01878742
comparacion_VaR <- tabla_comparativa %>%
select(Serie, Escenario, VaR) %>%
pivot_wider(names_from = Escenario, values_from = VaR) %>%
rename(VaR_Normal_95 = `Normal (95%)`, VaR_Crisis_99 = `Crisis (99%)`)
comparacion_larga <- comparacion_VaR %>%
pivot_longer(cols = starts_with("VaR"), names_to = "Tipo_VaR", values_to = "Valor_VaR") %>%
mutate(Tipo_VaR = factor(Tipo_VaR,
levels = c("VaR_Normal_95", "VaR_Crisis_99"),
labels = c("LaR al 95% (Normal)", "LaR al 99% (Crisis)")))
# 11.5 Gráfico comparativo (LaR/Q)
#Obtener saldos al 31 de diciembre de 2023
saldo_DM <- as.numeric(DM["2023-12-31"])
saldo_DA <- as.numeric(DA["2023-12-31"])
saldo_DP <- as.numeric(DP["2023-12-31"])
# Calcular LaR monetario
VaR_abs_DM_normal <- abs(saldo_DM * VaR_DM_normal)
VaR_abs_DA_normal <- abs(saldo_DA * VaR_DA_normal)
VaR_abs_DP_normal <- abs(saldo_DP * VaR_DP_normal)
VaR_abs_DM_crisis <- abs(saldo_DM * VaR_DM_crisis)
VaR_abs_DA_crisis <- abs(saldo_DA * VaR_DA_crisis)
VaR_abs_DP_crisis <- abs(saldo_DP * VaR_DP_crisis)
# Crear tabla comparativa de VaR monetario
tabla_VaR_monetaria <- tibble(
Serie = rep(c("Depósitos Monetarios", "Depósitos de Ahorro", "Depósitos a Plazo"), each = 2),
Escenario = rep(c("Normal (95%)", "Crisis (99%)"), times = 3),
VaR_monetario = c(VaR_abs_DM_normal, VaR_abs_DM_crisis,
VaR_abs_DA_normal, VaR_abs_DA_crisis,
VaR_abs_DP_normal, VaR_abs_DP_crisis)
)
#Crear tabla comparativa de niveles de saldo
tabla_saldos <- tibble(
Serie = c("Depósitos Monetarios", "Depósitos de Ahorro", "Depósitos a Plazo"),
Saldo_Normal = c(saldo_DM - VaR_abs_DM_normal,
saldo_DA - VaR_abs_DA_normal,
saldo_DP - VaR_abs_DP_normal),
`Saldo_Estres (VaR 99%)` = c(saldo_DM - VaR_abs_DM_crisis,
saldo_DA - VaR_abs_DA_crisis,
saldo_DP - VaR_abs_DP_crisis)
)
# Mostrar tabla de saldos
print(tabla_saldos)
## # A tibble: 3 × 3
## Serie Saldo_Normal `Saldo_Estres (VaR 99%)`[,1]
## <chr> <dbl> <xts[,1]>
## 1 Depósitos Monetarios 110235377. 108328278
## 2 Depósitos de Ahorro 90104577. 89479236
## 3 Depósitos a Plazo 126638420. 125949265
# Gráfico de comparación del LaR monetario
tabla_VaR_monetaria <- tabla_VaR_monetaria %>%
mutate(Escenario = factor(Escenario, levels = c("Normal (95%)", "Crisis (99%)")))
ggplot(tabla_VaR_monetaria, aes(x = Serie, y = VaR_monetario, fill = Escenario)) +
geom_bar(stat = "identity", position = position_dodge(), color = "black") +
scale_fill_manual(values = c("gray40", "gray70")) +
scale_y_continuous(labels = comma) +
labs(title = "Comparación del LaR Monetario: Normal vs Crisis (Dic 2023)",
x = "Tipo de Depósito", y = "LaR Monetario (Q)",
fill = "Escenario") +
theme_minimal(base_family = "serif", base_size = 11) +
theme(plot.title = element_text(face = "bold", hjust = 0.5),
legend.position = "bottom",
legend.title = element_text(face = "bold"))
