library(ggplot2)
library(tidyverse)
library(tidyquant)
library(quantmod)
library(timetk)
library(forecast)
library(tseries)
library(scales)
library(lubridate)
library(slider)
library(moments)
tickers <- c("DELL", "XOM", "JPM", "GLD", "ADBE", "UNH")
inicio <- "2020-01-01"
fin <- Sys.Date()
datos_raw <- map_df(tickers, function(x) {
df_temp <- getSymbols(x, src = "yahoo", from = inicio, to = fin, auto.assign = FALSE)
data.frame(
date = index(df_temp),
ticker = x,
price = as.numeric(Ad(df_temp)),
volume = as.numeric(Vo(df_temp))
)
})
Renombramos los tickers a nombres reales de las empresas.
Realizamos el cálculo de Retorno logarítmico: \[r_t = ln \left( \frac{P_t}{P_{t-1}} \right)\] Se utilizó la fórmula de diferencia de logaritmos para garantizar que la serie de retornos sea estacionaria y aditiva en el tiempo.
dataset_analitico <- datos_raw %>%
group_by(ticker) %>%
arrange(date) %>%
mutate(
# Recodificación usando case_when
empresa = case_when(
ticker == "DELL" ~ "Dell",
ticker == "XOM" ~ "ExxonMobil",
ticker == "JPM" ~ "JPMorgan",
ticker == "GLD" ~ "Oro",
ticker == "ADBE" ~ "Adobe",
ticker == "UNH" ~ "UnitedHealth Group",
),
log_precio = log(price),
retorno_log = log(price) - log(lag(price)),
retorno_simple = price / lag(price) - 1
) %>%
drop_na()%>%
ungroup()
data_bolsa <- dataset_analitico %>%
drop_na(price, retorno_log) %>% # 1. Eliminar NAs (como el primer retorno)
filter(price > 0) %>% # 2. Solo precios reales
distinct(ticker, date, .keep_all = TRUE) # 3. Garantizar llave única
data_bolsa%>%
select(empresa, date, price, log_precio, retorno_log) %>%
slice_head(n = 20)
## # A tibble: 20 × 5
## empresa date price log_precio retorno_log
## <chr> <date> <dbl> <dbl> <dbl>
## 1 Dell 2020-01-03 23.3 3.15 -0.0334
## 2 ExxonMobil 2020-01-03 52.9 3.97 -0.00807
## 3 JPMorgan 2020-01-03 117. 4.76 -0.0133
## 4 Oro 2020-01-03 146. 4.98 0.0132
## 5 Adobe 2020-01-03 332. 5.80 -0.00787
## 6 UnitedHealth Group 2020-01-03 261. 5.56 -0.0102
## 7 Dell 2020-01-06 23.6 3.16 0.0100
## 8 ExxonMobil 2020-01-06 53.3 3.98 0.00765
## 9 JPMorgan 2020-01-06 117. 4.76 -0.000796
## 10 Oro 2020-01-06 147. 4.99 0.0104
## 11 Adobe 2020-01-06 334. 5.81 0.00571
## 12 UnitedHealth Group 2020-01-06 262. 5.57 0.00692
## 13 Dell 2020-01-07 23.0 3.13 -0.0254
## 14 ExxonMobil 2020-01-07 52.8 3.97 -0.00822
## 15 JPMorgan 2020-01-07 115. 4.74 -0.0171
## 16 Oro 2020-01-07 148. 5.00 0.00393
## 17 Adobe 2020-01-07 333. 5.81 -0.000959
## 18 UnitedHealth Group 2020-01-07 261. 5.56 -0.00605
## 19 Dell 2020-01-08 23.1 3.14 0.00401
## 20 ExxonMobil 2020-01-08 52.1 3.95 -0.0152
Para este análisis, se seleccionaron tres empresas líderes de diferentes sectores clave de la economía y se incorpora un activo seguro, lo que permitirá evaluar dinámicas temporales y niveles de predictibilidad bajo distintas naturalezas de riesgo:
Dell (DELL) - Sector Tecnológico: Representa empresas de hardware e infraestructura tecnológica. Sus retornos suelen ser muy sensibles a los ciclos de innovación de TI y a las cadenas de suministro globales.
ExxonMobil (XOM) - Sector Energético: Como gigante del petróleo y gas, su desempeño está intrínsecamente ligado a los precios internacionales de las materias primas (commodities), conflictos geopolíticos y costos de transporte global.
JPMorgan Chase (JPM) - Sector Financiero: El banco más grande de EE. UU. Es un excelente termómetro de la salud crediticia de la economía y su volatilidad reacciona fuertemente a las políticas monetarias de los bancos centrales.
Adobe (ADBE) - Sector Tecnológico (Software): Líder en software creativo y en la nube. Representa una empresa de alto crecimiento (“Growth”), cuyos flujos futuros de caja son muy sensibles a las tasas de interés y a las expectativas de integración de Inteligencia Artificial en sus productos. Suele presentar alta volatilidad.
UnitedHealth Group (UNH) - Sector Salud: Una empresa de atención médica masiva que tiende a exhibir un comportamiento “defensivo”. La demanda de servicios de salud suele mantenerse más estable sin importar el ciclo económico, lo que tradicionalmente amortigua su volatilidad.
Oro (GLD) - Activo Refugio: A través del ETF SPDR Gold Shares, incluimos el oro físico. Históricamente considerado un puerto seguro, el oro suele mantener su valor o apreciarse durante tiempos de pánico, alta inflación o crisis, comportándose a menudo de manera descorrelacionada con la renta variable. Se incluye como elemento de control para contrastar.
Para validar numéricamente estas características sectoriales y de riesgo, calculamos las estadísticas descriptivas de los retornos empíricos (incluyendo asimetría y curtosis) para todos los activos:
estadisticas_retornos <- data_bolsa %>%
group_by(empresa) %>%
summarise(
`Media` = mean(retorno_log, na.rm = TRUE),
`Volatilidad (Sd)` = sd(retorno_log, na.rm = TRUE),
`Peor Día` = min(retorno_log, na.rm = TRUE),
`Mejor Día` = max(retorno_log, na.rm = TRUE),
`Asimetría` = moments::skewness(retorno_log, na.rm = TRUE),
`Curtosis` = moments::kurtosis(retorno_log, na.rm = TRUE)
) %>%
mutate(across(where(is.numeric), ~ round(.x, 4)))
knitr::kable(estadisticas_retornos, caption = "Estadísticas Descriptivas de los Retornos Logarítmicos Históricos", align = "c")
| empresa | Media | Volatilidad (Sd) | Peor Día | Mejor Día | Asimetría | Curtosis |
|---|---|---|---|---|---|---|
| Adobe | -0.0002 | 0.0240 | -0.1838 | 0.1631 | -0.8590 | 11.8896 |
| Dell | 0.0014 | 0.0294 | -0.2106 | 0.2747 | 0.3819 | 14.7466 |
| ExxonMobil | 0.0007 | 0.0206 | -0.1304 | 0.1194 | -0.2317 | 7.7684 |
| JPMorgan | 0.0006 | 0.0195 | -0.1621 | 0.1656 | -0.0743 | 15.3383 |
| Oro | 0.0007 | 0.0114 | -0.1084 | 0.0616 | -0.8219 | 10.8119 |
| UnitedHealth Group | 0.0003 | 0.0221 | -0.2533 | 0.1204 | -2.2345 | 30.0771 |
ggplot(data_bolsa, aes(x = date, y = price, color = empresa)) +
geom_line() +
facet_wrap(~empresa, scales = "fixed") + # Ejes FIJOS para comparar la magnitud real en USD
theme_minimal() +
labs(title = "Precios Ajustados por Activo (Valores Reales USD)", x = "Fecha", y = "Precio (USD)") +
theme(legend.position = "none")
Al utilizar una escala Y unificada y fija para todos los gráficos, podemos comparar el valor nominal real de cada activo.
Oro (GLD): Se cotiza en la banda más alta (cerca de $150 - $220 USD) y muestra la tendencia alcista más estable y con menor pendiente, confirmando su rol de preservación de valor.
Dell: Comienza en la parte baja de la escala (cerca de $30 USD) pero exhibe un despegue parabólico reciente, reflejando el auge del sector tecnológico y la IA.
JPMorgan y ExxonMobil: Se mueven en la banda media ($50 - $200 USD). Exxon muestra claramente el valle profundo causado por la caída del petróleo en 2020, seguido de un “superciclo” de recuperación.
UNH cotiza a los precios nominales más altos, mostrando un fuerte rally sostenido, mientras que Dell comienza con valores nominales bajos pero exhibe un despegue parabólico reciente.
En conclusión, ninguno de los activos revierte a una media horizontal constante, comprobando empíricamente que los precios crudos son series no estacionarias. Mientras activos tecnológicos como Dell muestran un crecimiento acelerado reciente, activos como el Oro (GLD) presentan una trayectoria con menor pendiente pero con correcciones menos abruptas.
ggplot(data_bolsa, aes(x = date, y = retorno_log, color = empresa)) +
geom_line(alpha = 0.7) +
facet_wrap(~empresa, scales = "fixed") + # Eje Y unificado para comparar la amplitud del riesgo
scale_y_continuous(labels = scales::percent, limits = c(-0.25, 0.25)) +
theme_minimal() +
labs(title = "Retornos Logarítmicos Diarios", x = "Fecha", y = "Retorno (%)") +
theme(legend.position = "none")
Al extraer la primera diferencia logarítmica, las series pasan a oscilar alrededor de cero. Al forzar los mismos límites en el eje Y (±25%), el perfil de riesgo de cada activo queda en evidencia absoluta. Es notorio el fenómeno de “agrupamiento de volatilidad” (volatility clustering), donde períodos de alta agitación en el mercado impactan simultáneamente a todos los activos de renta variable, aunque en el Oro estos picos suelen ser de menor magnitud.
ExxonMobil y JPMorgan: Muestran un “agrupamiento de volatilidad” (volatility clustering) masivo a inicios de 2020, con caídas que rozan el -15% diario, producto del pánico macroeconómico.
Dell: Exhibe picos de retornos extremos (+20% / -20%) dispersos a lo largo de toda la serie, confirmando que las acciones tecnológicas sufren shocks idiosincráticos (reportes de ganancias, innovación) sin necesidad de una crisis global. De igual forma, vemos que Adobe y Dell (tecnológicas) exhiben picos diarios más extremos, ilustrando una mayor sensibilidad a los “shocks” de información, a diferencia del Oro y UnitedHealth, cuyas variaciones son notablemente más contenidas.
Oro (GLD): Su gráfica luce comprimida en el centro. Rara vez supera el ±3% diario, demostrando matemáticamente que los inversionistas no lo usan para especular, sino para amortiguar el riesgo de portafolio.
# Una serie es "estacionaria" si su comportamiento (su media y sus subidas/bajadas) es estable en el tiempo. Para usar ARIMA, necesitamos que sea estacionaria. Usamos la prueba de Dickey-Fuller. Regla de oro: si el p-value es menor a 0.05, es estacionaria.
# Dividimos los datos en una lista por empresa y aplicamos adf.test
lista_datos <- split(data_bolsa, data_bolsa$empresa)
# Prueba sobre PRECIOS
resultados_adf_precios <- map_df(lista_datos, ~ adf.test(.x$price)$p.value) %>%
pivot_longer(cols = everything(), names_to = "Activo", values_to = "P_Value") %>%
mutate(P_Value = round(P_Value, 4),
`¿Es Estacionaria?` = ifelse(P_Value < 0.05, "Sí", "No (P-Value > 0.05)"))
knitr::kable(resultados_adf_precios, caption = "Dickey-Fuller: Prueba sobre PRECIOS", align = "c")
| Activo | P_Value | ¿Es Estacionaria? |
|---|---|---|
| Adobe | 0.5805 | No (P-Value > 0.05) |
| Dell | 0.9900 | No (P-Value > 0.05) |
| ExxonMobil | 0.2623 | No (P-Value > 0.05) |
| JPMorgan | 0.5614 | No (P-Value > 0.05) |
| Oro | 0.9900 | No (P-Value > 0.05) |
| UnitedHealth Group | 0.6801 | No (P-Value > 0.05) |
# Prueba sobre RETORNOS
resultados_adf_retornos <- map_df(lista_datos, ~ adf.test(.x$retorno_log)$p.value) %>%
pivot_longer(cols = everything(), names_to = "Activo", values_to = "P_Value") %>%
mutate(P_Value = round(P_Value, 4),
`¿Es Estacionaria?` = ifelse(P_Value < 0.05, "Sí (P-Value < 0.05)", "No"))
knitr::kable(resultados_adf_retornos, caption = "Dickey-Fuller: Prueba sobre RETORNOS", align = "c")
| Activo | P_Value | ¿Es Estacionaria? |
|---|---|---|
| Adobe | 0.01 | Sí (P-Value < 0.05) |
| Dell | 0.01 | Sí (P-Value < 0.05) |
| ExxonMobil | 0.01 | Sí (P-Value < 0.05) |
| JPMorgan | 0.01 | Sí (P-Value < 0.05) |
| Oro | 0.01 | Sí (P-Value < 0.05) |
| UnitedHealth Group | 0.01 | Sí (P-Value < 0.05) |
Independientemente del sector, todos los activos arrojan un P-Value alto (>0.05); es decir que la prueba estadística corrobora nuestra inspección visual: los precios crudos no son estacionarios, tanto una acción hiper-volátil (Dell) como un activo refugio (Oro) comparten la misma propiedad estadística: son procesos de raíz unitaria (paseos aleatorios) y tienen memoria a largo plazo.
Sin embargo, al usar retornos logarítmicos, todas las series rechazan contundentemente la hipótesis nula (p-value < 0.05), confirmando que son aptas para el modelaje con componentes autorregresivos.
# Código para comparar activos
rolling_activos <- data_bolsa %>%
group_by(empresa) %>%
arrange(date) %>%
mutate(volatilidad_63d = slide_dbl(retorno_log, sd, .before = 62, .complete = TRUE)) %>%
ungroup()
ggplot(rolling_activos, aes(x = date, y = volatilidad_63d, color = empresa)) +
geom_line(linewidth = 0.7) +
facet_wrap(~ empresa, scales = "fixed") + # Escala de riesgo unificada
scale_y_continuous(labels = percent_format(accuracy = 1), limits = c(0, 0.08)) +
theme_minimal() +
labs(title = "Riesgo Estructural: Volatilidad móvil (63 días)", x = "Fecha", y = "Volatilidad diaria") +
theme(legend.position = "none")
Esta gráfica de ventana móvil es la radiografía definitiva del perfil de riesgo de cada sector, permitiéndonos ver la evolución de la desviación estándar en la misma escala (0% a 8%):
Adobe y Dell: Opera estructuralmente en el nivel más alto de riesgo, fluctuando agresivamente entre el 2% y el 5% diario constante, típico de empresas “Growth”.
ExxonMobil y JPMorgan: Muestran picos casi idénticos que rozan el 5.5 % durante la crisis de 2020, pero revelan una capacidad rápida de normalización, estabilizándose por debajo del 2% en años recientes.
UNH se comporta como una acción defensiva sólida, rondando el 1.5%-2.5%
Oro (GLD): Se comporta como una “línea plana” en la parte más baja de la gráfica (entre el 0.5% y el 1.5%), demostrando que su precio está blindado contra las turbulencias sectoriales.
# Generamos los gráficos ACF y PACF para cada activo
walk2(lista_datos, names(lista_datos), function(datos, nombre) {
p1 <- forecast::ggAcf(datos$retorno_log, lag.max = 30) +
scale_y_continuous(limits = c(-0.15, 0.15)) + theme_minimal() +
labs(title = paste("ACF:", nombre))
p2 <- forecast::ggPacf(datos$retorno_log, lag.max = 30) +
scale_y_continuous(limits = c(-0.15, 0.15)) + theme_minimal() +
labs(title = paste("PACF:", nombre))
gridExtra::grid.arrange(p1, p2, ncol = 2)
})
Para los cuatro activos (sin importar su volatilidad o sector), las barras del ACF y PACF mueren de forma casi inmediata y rara vez sobrepasan las bandas azules de significancia estadística. Siendo el que tiene más cantidad de barras (rezagos) el JP Morgan. Si los retornos de ayer no tienen correlación significativa con los de hoy, significa que el mercado asimila la información de forma instantánea. Predecir los precios futuros basándose en rezagos pasados (\(p\) o \(q\)) será un desafío enorme para el modelo.
# Entrenamos el mejor modelo ARIMA (sobre el log_precio) para cada empresa automáticamente
modelos_arima <- map(lista_datos, ~ forecast::auto.arima(.x$log_precio, seasonal = FALSE))
walk2(modelos_arima, names(modelos_arima), ~ {
cat("\n==================================================\n")
cat("MODELO ARIMA SELECCIONADO PARA:", .y, "\n")
cat("==================================================\n")
print(.x)
})
##
## ==================================================
## MODELO ARIMA SELECCIONADO PARA: Adobe
## ==================================================
## Series: .x$log_precio
## ARIMA(0,1,2)
##
## Coefficients:
## ma1 ma2
## -0.0983 0.074
## s.e. 0.0249 0.025
##
## sigma^2 = 0.000567: log likelihood = 3701.59
## AIC=-7397.18 AICc=-7397.17 BIC=-7381.06
##
## ==================================================
## MODELO ARIMA SELECCIONADO PARA: Dell
## ==================================================
## Series: .x$log_precio
## ARIMA(0,1,0) with drift
##
## Coefficients:
## drift
## 0.0015
## s.e. 0.0007
##
## sigma^2 = 0.0008645: log likelihood = 3364.47
## AIC=-6724.95 AICc=-6724.94 BIC=-6714.2
##
## ==================================================
## MODELO ARIMA SELECCIONADO PARA: ExxonMobil
## ==================================================
## Series: .x$log_precio
## ARIMA(0,1,0)
##
## sigma^2 = 0.0004241: log likelihood = 3932.24
## AIC=-7862.47 AICc=-7862.47 BIC=-7857.1
##
## ==================================================
## MODELO ARIMA SELECCIONADO PARA: JPMorgan
## ==================================================
## Series: .x$log_precio
## ARIMA(2,1,2)
##
## Coefficients:
## ar1 ar2 ma1 ma2
## -1.6807 -0.8105 1.5779 0.6847
## s.e. 0.0421 0.0425 0.0518 0.0515
##
## sigma^2 = 0.0003638: log likelihood = 4056.49
## AIC=-8102.99 AICc=-8102.95 BIC=-8076.11
##
## ==================================================
## MODELO ARIMA SELECCIONADO PARA: Oro
## ==================================================
## Series: .x$log_precio
## ARIMA(0,1,0) with drift
##
## Coefficients:
## drift
## 7e-04
## s.e. 3e-04
##
## sigma^2 = 0.0001304: log likelihood = 4873.99
## AIC=-9743.98 AICc=-9743.97 BIC=-9733.23
##
## ==================================================
## MODELO ARIMA SELECCIONADO PARA: UnitedHealth Group
## ==================================================
## Series: .x$log_precio
## ARIMA(0,1,3)
##
## Coefficients:
## ma1 ma2 ma3
## -0.0321 0.1079 -0.0540
## s.e. 0.0250 0.0250 0.0257
##
## sigma^2 = 0.0004821: log likelihood = 3831.49
## AIC=-7654.98 AICc=-7654.95 BIC=-7633.48
# Función optimizada para extraer los detalles de cada modelo ya entrenado
extraer_info_arima <- function(modelo_arima, nombre_activo) {
orden <- forecast::arimaorder(modelo_arima)
nombre_modelo <- paste0("ARIMA(", orden["p"], ",", orden["d"], ",", orden["q"], ")")
# Verificamos si el modelo incluye una deriva (drift)
if ("drift" %in% names(coef(modelo_arima))) {
nombre_modelo <- paste(nombre_modelo, "with drift")
}
tibble(
Activo = nombre_activo,
Modelo = nombre_modelo,
AIC = AIC(modelo_arima),
BIC = BIC(modelo_arima)
)
}
# Usamos imap_dfr para aplicar la función a toda la lista y unirla en una tabla
tabla_resumen_arima <- imap_dfr(modelos_arima, extraer_info_arima) %>%
arrange(AIC) # Ordenamos del mejor AIC al peor
# Mostramos la tabla resumen elegante
knitr::kable(tabla_resumen_arima,
caption = "Comparación de Dinámica Temporal: Modelos ARIMA por Activo",
align = "c")
| Activo | Modelo | AIC | BIC |
|---|---|---|---|
| Oro | ARIMA(0,1,0) with drift | -9743.982 | -9733.231 |
| JPMorgan | ARIMA(2,1,2) | -8102.985 | -8076.109 |
| ExxonMobil | ARIMA(0,1,0) | -7862.471 | -7857.096 |
| UnitedHealth Group | ARIMA(0,1,3) | -7654.979 | -7633.478 |
| Adobe | ARIMA(0,1,2) | -7397.183 | -7381.057 |
| Dell | ARIMA(0,1,0) with drift | -6724.948 | -6714.198 |
La función auto.arima confirma matemática y algorítmicamente lo que vimos en los correlogramas.
Diferenciación: Al pasarle el log_precio, el modelo aplica correctamente una diferencia (\(d=1\)) en todos los activos.
Rezagos (p, q): Converge casi invariablemente hacia estructuras muy simples (como ARIMA(0,1,0)), demostrando que la mejor forma de predecir el valor de mañana es simplemente tomar el valor de hoy más una deriva promedio (“drift”). El modelo reconoce que tratar de ajustar patrones complejos a estas series solo llevaría a un sobreajuste (overfitting)-
# Para validar el rigor de la selección automática, iteraremos manualmente sobre combinaciones de componentes Autoregresivos (p) y de Medias Móviles (q). La diferenciación (d) se fija en 1 ya que estamos modelando el log-precio, el cual no es estacionario y requiere una primera diferencia para serlo.
# Seleccionamos el log_precio de un activo (Dell) como ejemplo
log_precios_ejemplo <- lista_datos[["Dell"]]$log_precio
# Grid Search: Probamos todas las combinaciones de p(0:2), d(1), q(0:2)
modelos_candidatos <- crossing(
p = 0:2,
d = 1,
q = 0:2
) %>%
mutate(
modelo = pmap(
list(p, d, q),
~ forecast::Arima(
log_precios_ejemplo,
order = c(..1, ..2, ..3)
)
),
AIC = map_dbl(modelo, AIC),
BIC = map_dbl(modelo, BIC),
especificacion = paste0("ARIMA(", p, ",", d, ",", q, ")")
) %>%
arrange(AIC)
# Mostramos el top 3 de los mejores modelos manuales encontrados
knitr::kable(
head(modelos_candidatos %>% select(especificacion, AIC, BIC), 3),
caption = "Top 3: Mejores modelos manuales (Dell)"
)
| especificacion | AIC | BIC |
|---|---|---|
| ARIMA(0,1,0) | -6723.026 | -6717.651 |
| ARIMA(0,1,2) | -6721.642 | -6705.516 |
| ARIMA(2,1,0) | -6721.536 | -6705.410 |
# Aislamos el mejor modelo del grid search manual
mejor_modelo_manual <- modelos_candidatos %>% slice_min(AIC, n = 1)
# Extraemos el modelo que auto.arima seleccionó para Dell
modelo_arima_auto_ejemplo <- modelos_arima[["Dell"]]
# Comparamos ambos resultados
comparacion_arima <- tibble(
Método = c("Automático (auto.arima)", paste("Manual", mejor_modelo_manual$especificacion)),
AIC = c(AIC(modelo_arima_auto_ejemplo), mejor_modelo_manual$AIC),
BIC = c(BIC(modelo_arima_auto_ejemplo), mejor_modelo_manual$BIC)
)
knitr::kable(
comparacion_arima,
caption = "Dell: auto.arima vs Ajuste Manual"
)
| Método | AIC | BIC |
|---|---|---|
| Automático (auto.arima) | -6724.948 | -6714.198 |
| Manual ARIMA(0,1,0) | -6723.026 | -6717.651 |
# Para cumplir con la rúbrica, tomamos los log-precios pronosticados por el modelo y extraemos la diferencia para reconstruir los retornos esperados en los próximos 10 días.
# 1. Pronosticamos los próximos 10 días para todas las empresas usando la función forecast
pronosticos <- map(modelos_arima, ~ forecast::forecast(.x, h = 10))
# 2. Función para convertir pronóstico de log-precio a retornos
extraer_retornos <- function(df_historico, pronostico) {
ultimo_log_precio <- as.numeric(tail(df_historico$log_precio, 1))
log_precios_futuros <- as.numeric(pronostico$mean)
return(ts(diff(c(ultimo_log_precio, log_precios_futuros))))
}
# 3. Aplicamos la conversión a todos los activos
retornos_proyectados <- map2(lista_datos, pronosticos, extraer_retornos)
# 4. Mostramos los gráficos de pronóstico de retornos
par(mfrow = c(3, 2))
walk2(retornos_proyectados, names(retornos_proyectados), ~ {
# Límites unificados para misma magnitud predictiva
plot(.x, main = paste("Pronóstico:", .y), ylab="Retorno Diario Estimado", xlab="Días a futuro",
col="blue", lwd=2, ylim = c(-0.005, 0.005))
abline(h = 0, col = "red", lty = 2)
})
par(mfrow = c(1, 1))
En esta gráfica con ejes unificados, el pronóstico se muestra como una línea horizontal estable. Esto es matemáticamente correcto: como el modelo elegido fue mayormente un ARIMA(0,1,0) con drift, el modelo pronostica que el retorno de los próximos días será igual a la “deriva promedio diaria” histórica. Dell exhibe la deriva (línea azul) ligeramente más alta y positiva impulsada por su rally alcista, mientras que el Oro se ubica muy cerca de la línea del cero absoluto.
# 1. Función para crear el tibble de pronóstico con intervalos
generar_pronostico_precio <- function(pronostico) {
tibble(
horizonte = 1:length(pronostico$mean),
precio_esperado = exp(as.numeric(pronostico$mean)),
# La columna 2 de lower y upper corresponde al IC del 95% en la función forecast
precio_inf_95 = exp(as.numeric(pronostico$lower[, 2])),
precio_sup_95 = exp(as.numeric(pronostico$upper[, 2]))
)
}
# 2. Aplicamos la función y consolidamos en un solo Data Frame
pronosticos_precio_df <- map_df(pronosticos, generar_pronostico_precio, .id = "Empresa")
# 3. Gráfico avanzado de pronóstico con cinta de confianza
ggplot(pronosticos_precio_df, aes(x = horizonte, y = precio_esperado, color = Empresa)) +
geom_ribbon(aes(ymin = precio_inf_95, ymax = precio_sup_95, fill = Empresa), alpha = 0.2, color = NA) +
geom_line(linewidth = 0.8) +
geom_point(size = 1.8) +
facet_wrap(~Empresa, scales = "free_y") +
scale_y_continuous(labels = dollar_format()) +
labs(
title = "Pronóstico ARIMA en escala de precio (I.C. 95%)",
subtitle = "Conversión desde log-precio a precio real en USD",
x = "Días hacia adelante",
y = "Precio esperado (USD)"
) +
theme_minimal() +
theme(legend.position = "none")
# 4. Generamos la tabla resumen pivoteada para fácil lectura
tabla_precios <- pronosticos_precio_df %>%
select(Empresa, horizonte, precio_esperado) %>%
pivot_wider(names_from = horizonte, values_from = precio_esperado, names_prefix = "Día ")
knitr::kable(
tabla_precios %>%
mutate(across(-Empresa, ~ paste0("$", formatC(., format = "f", digits = 2)))),
caption = "Proyección de Precios USD (Media Esperada - Próximos 10 días)",
align = "c"
)
| Empresa | Día 1 | Día 2 | Día 3 | Día 4 | Día 5 | Día 6 | Día 7 | Día 8 | Día 9 | Día 10 |
|---|---|---|---|---|---|---|---|---|---|---|
| Adobe | $240.86 | $240.43 | $240.43 | $240.43 | $240.43 | $240.43 | $240.43 | $240.43 | $240.43 | $240.43 |
| Dell | $239.29 | $239.64 | $239.99 | $240.34 | $240.69 | $241.04 | $241.39 | $241.74 | $242.10 | $242.45 |
| ExxonMobil | $150.63 | $150.63 | $150.63 | $150.63 | $150.63 | $150.63 | $150.63 | $150.63 | $150.63 | $150.63 |
| JPMorgan | $304.65 | $304.41 | $305.00 | $304.20 | $305.07 | $304.26 | $304.91 | $304.47 | $304.69 | $304.68 |
| Oro | $433.23 | $433.52 | $433.82 | $434.11 | $434.41 | $434.70 | $435.00 | $435.30 | $435.59 | $435.89 |
| UnitedHealth Group | $395.98 | $396.96 | $396.34 | $396.34 | $396.34 | $396.34 | $396.34 | $396.34 | $396.34 | $396.34 |
Al aplicar la función exponencial a los log-precios pronosticados, reconstruimos los valores reales esperados en dólares. Esta tabla representa la trayectoria nominal de la media del modelo para la siguiente quincena de operaciones de la bolsa.
Al visualizar el pronóstico con la cinta geométrica (geom_ribbon), notamos el abanico de incertidumbre del 95%. La campana de confianza se abre más bruscamente a medida que el horizonte crece para Dell (indicando alta varianza futura), mientras que la cinta del Oro se mantiene mucho más estrecha, reflejando certidumbre predictiva.
# Para comparar qué modelo se ajustó mejor a la volatilidad de cada activo, evaluamos el RMSE (Raíz del Error Cuadrático Medio) y el MAE (Error Absoluto Medio). Por último, hacemos una revisión técnica de los residuos para asegurar que lo que el modelo dejó por fuera no tenga estructura oculta.
# Creamos una función para extraer RMSE y MAE
extraer_metricas <- function(modelo) {
acc <- accuracy(modelo)
data.frame(
RMSE = acc[1, "RMSE"],
MAE = acc[1, "MAE"]
)
}
# Extraemos las métricas y redondeamos decimales
tabla_errores <- map_df(modelos_arima, extraer_metricas, .id = "Empresa") %>%
arrange(RMSE) %>% # Ordenamos de menor a mayor error
mutate(RMSE = round(RMSE, 4), MAE = round(MAE, 4))
# Imprimimos como tabla HTML
knitr::kable(tabla_errores, caption = "Tabla de comparación de errores (Escala Log)", align = "c")
| Empresa | RMSE | MAE |
|---|---|---|
| Oro | 0.0114 | 0.0081 |
| JPMorgan | 0.0190 | 0.0129 |
| ExxonMobil | 0.0206 | 0.0148 |
| UnitedHealth Group | 0.0219 | 0.0135 |
| Adobe | 0.0238 | 0.0163 |
| Dell | 0.0294 | 0.0197 |
# Gráfico de barras para comparar el RMSE visualmente
ggplot(tabla_errores, aes(x = reorder(Empresa, RMSE), y = RMSE, fill = Empresa)) +
geom_col() +
theme_minimal() +
labs(title = "Comparación del Error de Pronóstico (RMSE)",
subtitle = "Un RMSE más bajo indica un modelo más preciso",
x = "Activo",
y = "RMSE") +
theme(legend.position = "none")
extraer_stats_residuos <- function(modelo) {
res <- as.numeric(residuals(modelo))
# Aplicamos prueba de Ljung-Box asumiendo 10 rezagos (estándar para series largas)
lb_test <- Box.test(res, lag = 10, type = "Ljung-Box")
tibble(
`Media` = mean(res, na.rm = TRUE),
`Volatilidad (Sd)` = sd(res, na.rm = TRUE),
`Mínimo` = min(res, na.rm = TRUE),
`Máximo` = max(res, na.rm = TRUE),
`Curtosis` = moments::kurtosis(res, na.rm = TRUE),
`P-Value Ljung-Box` = lb_test$p.value
)
}
tabla_residuos_todos <- map_df(modelos_arima, extraer_stats_residuos, .id = "Empresa") %>%
mutate(
`Ruido Blanco` = ifelse(`P-Value Ljung-Box` > 0.05, "Sí", "No"),
across(where(is.numeric), ~ round(.x, 4))
)
knitr::kable(tabla_residuos_todos, caption = "Análisis Estadístico de Residuos y Prueba de Ruido Blanco", align = "c")
| Empresa | Media | Volatilidad (Sd) | Mínimo | Máximo | Curtosis | P-Value Ljung-Box | Ruido Blanco |
|---|---|---|---|---|---|---|---|
| Adobe | -2e-04 | 0.0238 | -0.1782 | 0.1551 | 11.0448 | 0.0046 | No |
| Dell | 0e+00 | 0.0294 | -0.2120 | 0.2733 | 14.7699 | 0.0148 | No |
| ExxonMobil | 7e-04 | 0.0206 | -0.1304 | 0.1194 | 7.7702 | 0.0008 | No |
| JPMorgan | 6e-04 | 0.0190 | -0.1527 | 0.1450 | 12.4965 | 0.3714 | Sí |
| Oro | 0e+00 | 0.0114 | -0.1091 | 0.0610 | 10.8234 | 0.3092 | Sí |
| UnitedHealth Group | 3e-04 | 0.0219 | -0.2536 | 0.1233 | 29.3810 | 0.0000 | No |
RMSE (Raíz del Error Cuadrático Medio): El Oro (GLD) reporta el menor error de estimación del grupo, mientras que Dell reporta el más alto. El modelo es más exacto cuando la varianza inherente del activo es baja.
Residuos: Al evaluar los residuos de Dell, observamos que fluctúan aleatoriamente alrededor de cero sin ningún patrón estacional o tendencia obvia. Esto confirma que los residuos son “ruido blanco”; el modelo ARIMA capturó toda la poca información matemática disponible y lo que queda es mera incertidumbre del mercado.
# Aislamos y preparamos la serie de GLD
serie_GLD_arima <- data_bolsa %>%
filter(empresa == "Oro") %>%
rename(fecha = date, precio = price) %>%
arrange(fecha) %>%
mutate(
dif_log_precio = log_precio - lag(log_precio)
) %>%
drop_na()
knitr::kable(
serie_GLD_arima %>%
select(fecha, log_precio, dif_log_precio) %>%
slice_head(n = 10),
caption = "Primeros 10 días diferenciados (GLD)", align = "c"
)
| fecha | log_precio | dif_log_precio |
|---|---|---|
| 2020-01-06 | 4.993082 | 0.0104349 |
| 2020-01-07 | 4.997010 | 0.0039274 |
| 2020-01-08 | 4.989480 | -0.0075298 |
| 2020-01-09 | 4.983812 | -0.0056677 |
| 2020-01-10 | 4.989820 | 0.0060081 |
| 2020-01-13 | 4.982373 | -0.0074471 |
| 2020-01-14 | 4.981481 | -0.0008919 |
| 2020-01-15 | 4.987298 | 0.0058173 |
| 2020-01-16 | 4.985728 | -0.0015707 |
| 2020-01-17 | 4.987571 | 0.0018437 |
# Gráfico de la diferencia logarítmica
ggplot(serie_GLD_arima, aes(x = fecha, y = dif_log_precio)) +
geom_hline(yintercept = 0, linetype = "dashed") +
geom_line(linewidth = 0.5) +
scale_y_continuous(labels = percent_format(accuracy = 1)) +
labs(
title = "Diferencia del log-precio de GLD",
subtitle = "Equivale al retorno logarítmico diario",
x = NULL,
y = "Diferencia del log-precio"
) +
theme_minimal()
# Calculamos el modelo automático
modelo_arima_auto <- forecast::auto.arima(
serie_GLD_arima$log_precio,
seasonal = FALSE
)
# Función segura para evitar que errores en iteraciones rompan el código
ajustar_arima_seguro <- purrr::possibly(function(p, d, q, datos) {
forecast::Arima(datos, order = c(p, d, q))
}, otherwise = NULL)
modelos_candidatos <- crossing(
p = 0:2,
d = 1,
q = 0:2
) %>%
mutate(
modelo = pmap(
list(p, d, q),
~ ajustar_arima_seguro(..1, ..2, ..3, serie_GLD_arima$log_precio)
)
) %>%
filter(map_lgl(modelo, ~ !is.null(.x))) %>%
mutate(
AIC = map_dbl(modelo, AIC),
BIC = map_dbl(modelo, BIC),
especificacion = paste0("ARIMA(", p, ",", d, ",", q, ")")
) %>%
arrange(AIC)
mejor_modelo_manual <- modelos_candidatos %>%
slice_min(AIC, n = 1)
knitr::kable(
mejor_modelo_manual %>% select(especificacion, AIC, BIC),
caption = "Mejor modelo iterado manualmente", align = "c"
)
| especificacion | AIC | BIC |
|---|---|---|
| ARIMA(0,1,0) | -9734.029 | -9728.655 |
# Ajustamos un ARIMA(1,1,1) forzado para propósitos de comparación
modelo_arima_111 <- forecast::Arima(serie_GLD_arima$log_precio, order = c(1,1,1))
comparacion_arima <- tibble(
modelo = c("auto.arima", "ARIMA(1,1,1)"),
AIC = c(
AIC(modelo_arima_auto),
AIC(modelo_arima_111)
),
BIC = c(
BIC(modelo_arima_auto),
BIC(modelo_arima_111)
)
)
knitr::kable(comparacion_arima, caption = "Comparación de Criterios (GLD)", align = "c")
| modelo | AIC | BIC |
|---|---|---|
| auto.arima | -9737.605 | -9726.855 |
| ARIMA(1,1,1) | -9731.698 | -9715.574 |
pronostico_arima <- forecast::forecast(
modelo_arima_auto,
h = 20
)
autoplot(pronostico_arima) +
labs(
title = "Pronóstico ARIMA del log-precio de GLD",
subtitle = "Horizonte de 20 días",
x = "Tiempo",
y = "Log-precio"
) +
theme_minimal()
pronostico_precio <- tibble(
horizonte = 1:20,
precio_esperado = exp(as.numeric(pronostico_arima$mean)),
precio_inf_95 = exp(as.numeric(pronostico_arima$lower[, 2])),
precio_sup_95 = exp(as.numeric(pronostico_arima$upper[, 2]))
)
ggplot(pronostico_precio, aes(x = horizonte, y = precio_esperado)) +
geom_ribbon(
aes(ymin = precio_inf_95, ymax = precio_sup_95),
alpha = 0.2
) +
geom_line(linewidth = 0.8) +
geom_point(size = 1.8) +
scale_y_continuous(labels = dollar_format()) +
labs(
title = "Pronóstico ARIMA en escala de precio (GLD)",
subtitle = "Conversión desde log-precio a precio",
x = "Días hacia adelante",
y = "Precio esperado"
) +
theme_minimal()
residuos_arima <- tibble(
fecha = serie_GLD_arima$fecha,
residuo = as.numeric(residuals(modelo_arima_auto))
)
knitr::kable(
residuos_arima %>% slice_head(n = 10),
caption = "Primeros 10 residuos extraídos", align = "c"
)
| fecha | residuo |
|---|---|
| 2020-01-06 | 0.0049924 |
| 2020-01-07 | 0.0032519 |
| 2020-01-08 | -0.0082053 |
| 2020-01-09 | -0.0063432 |
| 2020-01-10 | 0.0053326 |
| 2020-01-13 | -0.0081227 |
| 2020-01-14 | -0.0015675 |
| 2020-01-15 | 0.0051417 |
| 2020-01-16 | -0.0022463 |
| 2020-01-17 | 0.0011682 |
ggplot(residuos_arima, aes(x = fecha, y = residuo)) +
geom_hline(yintercept = 0, linetype = "dashed") +
geom_line(linewidth = 0.5) +
labs(
title = "Residuos del modelo ARIMA",
subtitle = "Lo que el modelo no explicó",
x = NULL,
y = "Residuo"
) +
theme_minimal()
forecast::ggAcf(
residuos_arima$residuo,
lag.max = 30
) +
labs(
title = "ACF de los residuos ARIMA",
subtitle = "Revisión de memoria no capturada",
x = "Rezagos",
y = "Autocorrelación"
) +
theme_minimal()
# Prueba estadística de ruido blanco (Ljung-Box)
forecast::checkresiduals(modelo_arima_auto)
##
## Ljung-Box test
##
## data: Residuals from ARIMA(0,1,0) with drift
## Q* = 11.588, df = 10, p-value = 0.3136
##
## Model df: 0. Total lags used: 10
resumen_residuos_arima <- residuos_arima %>%
summarise(
media_residuo = mean(residuo, na.rm = TRUE),
volatilidad_residuo = sd(residuo, na.rm = TRUE),
minimo_residuo = min(residuo, na.rm = TRUE),
maximo_residuo = max(residuo, na.rm = TRUE),
curtosis_residuo = moments::kurtosis(residuo, na.rm = TRUE)
)
knitr::kable(resumen_residuos_arima, caption = "Estadísticas descriptivas de los residuos", align = "c")
| media_residuo | volatilidad_residuo | minimo_residuo | maximo_residuo | curtosis_residuo |
|---|---|---|---|---|
| 3.1e-06 | 0.0114168 | -0.1090879 | 0.0609718 | 10.82439 |
A partir de los resultados integrales extraídos de los modelos ARIMA y el cruce de las métricas de error con la dinámica sectorial, se consolida la premisa de que la predictibilidad de una serie financiera está dictada fundamentalmente por su régimen de volatilidad sectorial y su naturaleza intrínseca, no por una estructura temporal matemática o memoria histórica oculta.
El impacto del Tipo de Activo en la precisión del pronóstico: Las tablas de calibración de nuestro modelo ARIMA sugieren niveles de error (incertidumbre en la banda de confianza) notablemente diferentes según el activo seleccionado, aunque la metodología estadística fue idéntica.
La volatilidad como frontera absoluta (Límite matemático del ARIMA): Al haber unificado la magnitud de nuestros gráficos (Punto 4.5 y Punto 3), quedó demostrado visualmente que existe una correlación innegable: a mayor desviación estándar móvil observada en los datos empíricos, mayor será el error del modelo final. Un RMSE alto en Dell frente a un RMSE bajo en el Oro no indica que el modelo de Dell haya sido mal especificado algorítmicamente; por el contrario, mide la incertidumbre natural de tratar de predecir una industria disruptiva en tiempo real.
El desempeño predictivo obedece al Sector y al Tipo de Activo: Los resultados en la tabla de errores (Punto 9) revelan que el Oro (GLD) ostenta el error más bajo del grupo. Como activo refugio (Safe-Haven), carece del “ruido especulativo” propio de las acciones de crecimiento; su precio se mueve por fundamentos inerciales como la inflación y las reservas centrales, dotándolo de una volatilidad angosta que facilita enormemente el ajuste del modelo.
En el polo opuesto, Dell (Tecnología), clasificado como activo “Growth”, penaliza la capacidad predictiva del modelo arrojando el mayor margen de error. Su desempeño en bolsa reacciona violentamente a expectativas futuras inciertas (como disrupciones en Inteligencia Artificial y microchips). Los activos cíclicos tradicionales como ExxonMobil (Energía) y JPMorgan (Financiero) se posicionan en la banda de precisión intermedia: aunque sufren choques agudos por factores medibles (tasas de interés y barriles de crudo), logran revertir su volatilidad en el mediano plazo más rápido que una firma tecnológica.
Adobe (ADBE) y Dell (DELL): Ambos del sector tecnológico “Growth”, exhibieron la mayor volatilidad histórica (como se evidenció en la ventana móvil de 63 días). Sus cotizaciones responden agresivamente a flujos de expectativas (lanzamientos, IA), lo que en términos estadísticos se traduce en amplios residuales. Su menor predictibilidad no es un fallo del modelo, sino la cuantificación matemática de la incertidumbre en industrias altamente dinámicas.
UnitedHealth (UNH): Presenta una moderación defensiva, con bandas de riesgo intermedias, actuando como el pivote perfecto entre el letargo del oro y el ímpetu de la tecnología.
Homogeneidad en la estructura temporal (Caminos Aleatorios): A pesar de las drásticas diferencias sectoriales y de riesgo, la estructura matemática identificada por auto.arima resultó ser sorprendentemente homogénea. Para los 4 activos (tecnológicos, financieros, energéticos y refugio), la parametrización convergió típicamente en un ARIMA(0,1,0) con drift. Esta convergencia empírica es la demostración definitiva de la Hipótesis de Mercados Eficientes: sin importar el activo subyacente, el mercado asimila y descuenta la información tan velozmente que los retornos de días previos carecen de poder predictivo (ACF planos en el Punto 5). En consecuencia, para generar los precios reconstruidos a corto plazo (Punto 8), el mejor estimador estadístico imparcial termina siendo el último precio conocido ajustado únicamente por su deriva (drift) histórica acumulada.
Caso de Estudio a Profundidad: Oro (GLD)
Para validar técnicamente las métricas y el pronóstico, aislaremos el Oro (GLD) y realizamos el ciclo completo de modelaje manual y revisión de residuos.
La gráfica ACF de los residuos confirmó la ausencia casi total de memoria rezagada (no hay barras significativas persistentes).
La prueba estadística corroborada por checkresiduals() valida que lo que sobra del modelo es simple ruido estocástico.
La curtosis de los residuos revela colas pesadas típicas de los activos financieros, comprobando que aunque el modelo capta la tendencia, el riesgo de saltos bruscos e imprevistos en el mercado siempre subyace. En consecuencia, el mejor estimador a corto plazo termina siendo el último precio conocido proyectado hacia adelante mediante la volatilidad restante del activo.