Primera entrega

knitr::opts_chunk$set(echo = TRUE)

Datos

# Leer el archivo Excel con los precios de los activos, ahora incluyendo nombres de columnas
activos <- read_excel("C:/Users/urisa/Downloads/APLICADAII.xlsx", col_names = TRUE)

# La primera columna contiene las fechas
fechas <- as.Date(activos[[1]])

# La última columna contiene los precios de cierre del S&P 500
precios_sp500 <- activos[[ncol(activos)]]

# Las demás columnas son los precios de los activos (excluyendo la primera y la última columna)
activos_num <- activos[, -c(1, ncol(activos))]
colnames(activos_num) <- colnames(activos)[2:(ncol(activos) - 1)]

# Convertir todas las columnas a numéricas y eliminar filas con NA
activos_num <- as.data.frame(lapply(activos_num, function(x) as.numeric(as.character(x))))
activos_num <- activos_num[complete.cases(activos_num), ]
precios_sp500 <- precios_sp500[complete.cases(activos_num)]
fechas_alineadas <- fechas[1:nrow(activos_num)]

# Crear un objeto xts con los precios de los activos y las fechas alineadas
activos_xts <- xts(activos_num, order.by = fechas_alineadas)
sp500_xts <- xts(precios_sp500, order.by = fechas_alineadas)

Cálculo de rendimientos

# Calcular los rendimientos logarítmicos de los activos y del S&P 500
rend_activos_xts <- na.omit(Return.calculate(activos_xts, method = "log"))
rend_sp500_xts <- na.omit(Return.calculate(sp500_xts, method = "log"))

# Alinear las series de los rendimientos de los activos y del S&P 500
merged_data <- merge(rend_activos_xts, rend_sp500_xts, join = "inner")
rend_activos_alineados <- merged_data[, -ncol(merged_data)]
rend_sp500_alineado <- merged_data[, ncol(merged_data)]
# Calcular los betas de los activos respecto al S&P 500 usando CAPM
betas <- apply(rend_activos_alineados, 2, function(serie) {
  cov(serie, rend_sp500_alineado) / var(rend_sp500_alineado)
})

# Tasa libre de riesgo (ejemplo: Bonos del Tesoro de EE.UU.)
tasa_libre_riesgo <- 0.02 / 252

# Calcular los retornos esperados de los activos usando CAPM
rend_promedio_sp500 <- mean(rend_sp500_alineado, na.rm = TRUE)
rend_capm <- tasa_libre_riesgo + betas * (rend_promedio_sp500 - tasa_libre_riesgo)

# Definir el portafolio y añadir restricciones
Ptf <- portfolio.spec(assets = colnames(rend_activos_alineados))
Ptf <- add.constraint(portfolio = Ptf, type = "box", min = 0.15, max = 1)
Ptf <- add.constraint(portfolio = Ptf, type = "leverage", min_sum = 1, max_sum = 1)
Ptf <- add.objective(portfolio = Ptf, type = "return", name = "mean", arguments = list(mean = rend_capm))
Ptf <- add.objective(portfolio = Ptf, type = "risk", name = "StdDev")

# Optimizar el portafolio
opt_result <- optimize.portfolio(rend_activos_alineados, portfolio = Ptf, optimize_method = "ROI", trace = TRUE)
pesos_optimos <- extractWeights(opt_result)
pesos_optimos <- pesos_optimos + runif(length(pesos_optimos), min = 0.001, max = 0.01)
pesos_optimos <- pesos_optimos / sum(pesos_optimos)

Modelo de regresión lineal simple

rend_portafolio <- rend_activos_alineados %*% pesos_optimos
rend_portafolio_xts <- xts(rend_portafolio, order.by = index(rend_activos_alineados))
plot(rend_portafolio_xts, main = "Rendimiento Diario del Portafolio", col = "blue")

rend_acumulado_portafolio <- cumprod(1 + rend_portafolio_xts) - 1
plot(rend_acumulado_portafolio, main = "Rendimiento Acumulado del Portafolio", col = "darkgreen")

rend_portafolio_df <- data.frame(Fecha = index(rend_portafolio_xts), Rendimiento = coredata(rend_portafolio_xts))
rend_sp500_df <- data.frame(Fecha = index(rend_sp500_xts), Rendimiento_SP500 = coredata(rend_sp500_xts))
rend_data <- merge(rend_portafolio_df, rend_sp500_df, by = "Fecha")

# Crear el modelo de regresión lineal
modelo <- lm(Rendimiento_SP500 ~ Rendimiento, data = rend_data)

# Resumen del modelo de regresión
summary(modelo)

## 
## Call:
## lm(formula = Rendimiento_SP500 ~ Rendimiento, data = rend_data)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -0.058498 -0.003393  0.000109  0.003545  0.044769 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -0.0001154  0.0001207  -0.956    0.339    
## Rendimiento  0.5230388  0.0076229  68.614   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.006709 on 3104 degrees of freedom
## Multiple R-squared:  0.6027, Adjusted R-squared:  0.6025 
## F-statistic:  4708 on 1 and 3104 DF,  p-value: < 2.2e-16

# Gráfico de dispersión con línea de regresión
plot(rend_data$Rendimiento_SP500, rend_data$Rendimiento,
     xlab = "Rendimiento S&P 500", ylab = "Rendimiento Portafolio",
     main = "Regresión entre Rendimientos del Portafolio y S&P 500",
     pch = 16, col = "blue")
abline(modelo, col = "red", lwd = 2)

# Banda de confianza
pred_interval <- predict(modelo, interval = "confidence")
lines(rend_data$Rendimiento_SP500, pred_interval[, "lwr"], col = "green", lty = 2)
lines(rend_data$Rendimiento_SP500, pred_interval[, "upr"], col = "green", lty = 2)

corr_matrix <- cor(rend_activos_alineados, use = "complete.obs")
corrplot(corr_matrix, method = "color", title = "Correlación entre Activos", tl.cex = 0.8)

# Exportar a Excel
write.xlsx(rend_portafolio_df, file = "Resultados_Portafolio.xlsx")
cat("El archivo 'Resultados_Portafolio.xlsx' ha sido guardado exitosamente.")

## El archivo 'Resultados_Portafolio.xlsx' ha sido guardado exitosamente.

Segunda Entrega

A continuación se presentará un modelo de regresión lineal múltiple.

Esta regresión nos ayudará a ver que tanto se puede explicar el Índice del S&P 500 a través de una acción . En este caso, vamos a ocupar los rendimientos de cada activo y descartar los pesos óptimos. Como resultado, se verá cuanta información de cada activo incorpora al modelo del S&P.Al no contar con los activos totaleso a partir de este modelo se obtendrá una aproximación para saber si los datos están correlacionados o no.

Modelo de Regresión Lineal Múltiple

# Cálculo de rendimientos
rend_activos_p2 <- na.omit(Return.calculate(activos_xts, method = "simple"))
rend_sp500_p2 <- na.omit(Return.calculate(sp500_xts, method = "simple"))

# Selección de activos
rend_apple <- rend_activos_p2$AAPL
rend_meta <- rend_activos_p2$META
rend_nvda <- rend_activos_p2$NVDA
rend_pg <- rend_activos_p2$PG
rend_walmex <- rend_activos_p2$WALMEX.MX

# Modelo de regresión
modelo_p2 <- lm(rend_sp500_p2 ~ rend_meta + rend_nvda + rend_pg + rend_walmex)
print(summary(modelo_p2))

## 
## Call:
## lm(formula = rend_sp500_p2 ~ rend_meta + rend_nvda + rend_pg + 
##     rend_walmex)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -0.056257 -0.003358  0.000148  0.003495  0.041908 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -0.0001786  0.0001163  -1.535    0.125    
## rend_meta    0.1109560  0.0050835  21.827  < 2e-16 ***
## rend_nvda    0.1609335  0.0045459  35.402  < 2e-16 ***
## rend_pg      0.3664753  0.0108049  33.918  < 2e-16 ***
## rend_walmex  0.0557633  0.0076703   7.270 4.53e-13 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.006457 on 3101 degrees of freedom
## Multiple R-squared:  0.6299, Adjusted R-squared:  0.6294 
## F-statistic:  1320 on 4 and 3101 DF,  p-value: < 2.2e-16

Explicar que es un buen modelo, porque los valores P son muy bajos

anova(modelo_p2)

## Analysis of Variance Table
## 
## Response: rend_sp500_p2
##               Df   Sum Sq  Mean Sq  F value    Pr(>F)    
## rend_meta      1 0.095355 0.095355 2286.814 < 2.2e-16 ***
## rend_nvda      1 0.070816 0.070816 1698.311 < 2.2e-16 ***
## rend_pg        1 0.051711 0.051711 1240.140 < 2.2e-16 ***
## rend_walmex    1 0.002204 0.002204   52.854 4.528e-13 ***
## Residuals   3101 0.129305 0.000042                       
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

# Tablas de métricas del modelo
coef_table <- summary(modelo_p2)$coefficients
knitr::kable(coef_table, caption = "Coeficientes del Modelo de Regresión Múltiple")

Coeficientes del Modelo de Regresión Múltiple
	Estimate	Std. Error	t value	Pr(>\|t\|)
(Intercept)	-0.0001786	0.0001163	-1.535395	0.1247889
rend_meta	0.1109560	0.0050835	21.826516	0.0000000
rend_nvda	0.1609335	0.0045459	35.402266	0.0000000
rend_pg	0.3664753	0.0108049	33.917549	0.0000000
rend_walmex	0.0557633	0.0076703	7.270052	0.0000000

El análisis de varianza indica que las variables rend_meta, rend_nvda y rend_pg explican la mayor parte de la variación en la variable dependiente rend_sp500_p2, siendo rend_meta la de mayor contribución con una suma de cuadrados de 0.095355, seguida de rend_nvda con 0.070816 y rend_pg con 0.051711. Estas tres variables tienen valores F extremadamente altos (2286.814, 1698.311 y 1240.140, respectivamente) y valores p menores a \(2.2 \times 10^{-16}\), lo que confirma su impacto altamente significativo. Por otro lado, aunque rend_walmex también es significativa con un valor F de 52.854 y \(p = 4.528 \times 10^{-13}\), su contribución (Sum Sq = 0.002204) es considerablemente menor en comparación. Los residuales suman 0.129305, reflejando la variación no explicada por las variables independientes. En general, el modelo es altamente significativo y captura una proporción sustancial de la variación total, con un \(R^2\) de 0.6299, aunque aún queda cierta variación por explicar.

Heterocedasticidad

Prueba de Breusch-Pagan

print(lmtest::bptest(modelo_p2))

## 
##  studentized Breusch-Pagan test
## 
## data:  modelo_p2
## BP = 26.251, df = 4, p-value = 2.816e-05

MULTICOLINEALIDAD

# VIF para cada variable independiente
vif(modelo_p2)

##   rend_meta   rend_nvda     rend_pg rend_walmex 
##    1.228679    1.239485    1.078280    1.026907

Todos los valores de VIF están cercanos a 1, lo que indica que no hay evidencia significativa de multicolinealidad entre las variables independientes en tu modelo.

Esto significa que las variables rend_meta, rend_nvda, rend_pg y rend_walmex están suficientemente independientes entre sí y no tienen relaciones lineales fuertes que puedan afectar la estabilidad de las estimaciones de los coeficientes.

Linealidad

# Gráficos de componentes y residuos parciales
crPlots(modelo_p2)

Análisis de Linealidad

Se evaluaron los gráficos de componentes y residuos parciales para verificar la suposición de linealidad en las variables del modelo. Los resultados son los siguientes:

rend_meta: La relación entre esta variable y la variable dependiente es aproximadamente lineal. La línea azul discontinua (suavizado no paramétrico) sigue de cerca la línea rosa ajustada por el modelo.
rend_nvda: La relación es lineal en su mayor parte, aunque se observa una ligera curvatura en los extremos. Sin embargo, esta curvatura no parece ser lo suficientemente fuerte como para invalidar la suposición de linealidad.
rend_pg: Existe una relación lineal aceptable, aunque se observa una pequeña tendencia curva en la parte central. Esta curvatura no parece ser crítica para el modelo.
rend_walmex: La relación también es lineal, aunque muestra leves curvaturas en los extremos, que no representan un problema significativo. ## Correlaciones ### Análisis de Correlación

corr_matrix <- cor(rend_activos_p2, use = "complete.obs")
corrplot(corr_matrix, method = "color", title = "Matriz de Correlación", tl.cex = 0.7)

# Extraer correlaciones relevantes
correlations <- as.data.frame(as.table(corr_matrix))
colnames(correlations) <- c("Activo_1", "Activo_2", "Correlación")
correlations <- correlations[correlations$Activo_1 != correlations$Activo_2, ]
correlations <- correlations[order(abs(correlations$Correlación), decreasing = TRUE), ]
top_correlations <- correlations[c(1:5, (nrow(correlations)-4):nrow(correlations)), ]
knitr::kable(top_correlations, caption = "Correlaciones más Relevantes")

Correlaciones más Relevantes
	Activo_1	Activo_2	Correlación
3	NVDA	AAPL	0.4982767
11	AAPL	NVDA	0.4982767
2	META	AAPL	0.4254469
6	AAPL	META	0.4254469
8	NVDA	META	0.4181094
21	AAPL	WALMEX.MX	0.1107820
15	WALMEX.MX	NVDA	0.0845039
23	NVDA	WALMEX.MX	0.0845039
10	WALMEX.MX	META	0.0656523
22	META	WALMEX.MX	0.0656523

Validación del Modelo

# Gráfico de residuos vs ajustados
plot(modelo_p2, which = 1, main = "Gráfico de Residuos vs Ajustados")

# Histograma de residuos
hist(resid(modelo_p2), main = "Histograma de Residuos", xlab = "Residuos", col = "lightblue", breaks = 20)

# QQ-Plot de residuos
qqnorm(resid(modelo_p2), main = "QQ-Plot de los Residuos")
qqline(resid(modelo_p2), col = "red", lwd = 2)

Gráficos adicionales

#Rendimientos Predichos vs Observados 
plot(rend_sp500_p2, fitted(modelo_p2),
     main = "Predicción vs Observado",
     xlab = "Observado",
     ylab = "Predicho",
     pch = 16, col = "blue")
abline(a = 0, b = 1, col = "red")

Simple Vs Múltiple

comparison_table <- data.frame(
  Métrica = c("R² Ajustado", "Error Estándar de Residuos", "Número de Variables"),
  Modelo_Simple = c(0.6033, 0.0067, 1),
  Modelo_Múltiple = c(0.6299, 0.0065, 4)
)
knitr::kable(comparison_table, caption = "Comparación de Métricas: Modelo Simple vs Múltiple")

Comparación de Métricas: Modelo Simple vs Múltiple
Métrica	Modelo_Simple	Modelo_Múltiple
R² Ajustado	0.6033	0.6299
Error Estándar de Residuos	0.0067	0.0065
Número de Variables	1.0000	4.0000

Análisis Temporal

# Residuos a lo largo del tiempo
plot(index(rend_sp500_p2), resid(modelo_p2), type = "l", col = "blue",
     main = "Residuos a lo Largo del Tiempo", xlab = "Fecha", ylab = "Residuos")

Conclusión

En general, los gráficos muestran que la relación entre las variables independientes (rend_meta, rend_nvda, rend_pg, rend_walmex) y la variable dependiente es aproximadamente lineal, cumpliendo con la suposición de linealidad requerida para el modelo. Por lo tanto, no se consideran necesarias transformaciones adicionales para las variables. Si se desea explorar ajustes más detallados, podrían evaluarse interacciones o términos no lineales en futuras iteraciones del modelo.

Análisis de Rendimientos del Portafolio

Aitana Acosta, Ana Paola Arredondo, Jesús Paz, Uriel Sagahon

2024-12-10