🔹 Configuración del Entorno

1⃣️ Carga de Paquetes y Preparación del Entorno

options(repos = c(CRAN = "https://cloud.r-project.org"))

required_pkgs <- c("quantmod", "PerformanceAnalytics", "tseries", "ggplot2", 
                   "dplyr", "tidyverse", "lubridate", "tibble", "RQuantLib", 
                   "scales", "data.tree", "DiagrammeR", "reshape2", "quadprog", "knitr")
new_pkgs <- required_pkgs[!required_pkgs %in% installed.packages()[, "Package"]]
if(length(new_pkgs)) install.packages(new_pkgs)

invisible(lapply(required_pkgs, library, character.only = TRUE))

🔎 Análisis: En este bloque se asegura que todos los paquetes necesarios estén instalados y cargados. Esto permite un entorno de trabajo reproducible y garantiza que todas las herramientas estadísticas y visuales estarán disponibles para los análisis posteriores.

2⃣️ Descarga y Preparación de Datos Financieros

stocks <- c("RXRX", "MRNA", "BRPHF")
start_date <- as.Date("2022-06-01")
end_date <- as.Date("2025-03-31")

getSymbols(stocks, from = start_date, to = end_date, src = "yahoo", auto.assign = TRUE)

## [1] "RXRX"  "MRNA"  "BRPHF"

prices <- do.call(merge, lapply(stocks, function(x) Cl(get(x))))
colnames(prices) <- stocks

returns <- na.omit(diff(log(prices)))
mu <- colMeans(returns)
cov_matrix <- cov(returns)

# 🧼 Cálculo del Portafolio Óptimo de Tangencia (Sharpe máximo)
rf <- 0.03
ones <- rep(1, length(mu))

inv_cov <- solve(cov_matrix)
excess_ret <- mu - rf
pesos_tangency <- inv_cov %*% excess_ret
pesos_tangency <- pesos_tangency / sum(pesos_tangency)
pesos_tangency <- as.numeric(pesos_tangency)
names(pesos_tangency) <- stocks

💰 Inversión Inicial de USD 1,000,000 en Portafolio Óptimo

inversion_total <- 1000000
valores_finales <- as.numeric(last(prices))
acciones_compradas <- floor((pesos_tangency * inversion_total) / valores_finales)
inversion_realizada <- acciones_compradas * valores_finales

portafolio_inicial <- data.frame(
  Accion = stocks,
  Precio = round(valores_finales, 2),
  Peso = round(pesos_tangency, 4),
  Cantidad = acciones_compradas,
  Inversion = round(inversion_realizada, 2)
)

kable(portafolio_inicial, caption = "Distribución de la Inversión Inicial del Portafolio Óptimo")

Distribución de la Inversión Inicial del Portafolio Óptimo

	Accion	Precio	Peso	Cantidad	Inversion
RXRX	RXRX	5.81	0.0886	15254	88625.74
MRNA	MRNA	31.12	0.6921	22239	692077.70
BRPHF	BRPHF	11.49	0.2193	19083	219282.76

🌈 Simulación de Carteras Aleatorias y Frontera Eficiente

n_portafolios <- 10000
resultados <- matrix(nrow = n_portafolios, ncol = 3)
colnames(resultados) <- c("Retorno", "Riesgo", "Sharpe")
pesos_lista <- list()

for (i in 1:n_portafolios) {
  pesos <- runif(length(stocks))
  pesos <- pesos / sum(pesos)
  ret_esp <- sum(pesos * mu)
  riesgo <- sqrt(t(pesos) %*% cov_matrix %*% pesos)
  sharpe <- (ret_esp - rf) / riesgo
  resultados[i, ] <- c(ret_esp, riesgo, sharpe)
  pesos_lista[[i]] <- pesos
}

resultados_df <- as.data.frame(resultados)
colnames(resultados_df) <- c("Retorno", "Riesgo", "Sharpe")

# Agregar portafolio de tangencia
resultados_df$tangency <- FALSE
resultados_df$tangency[which.max(resultados_df$Sharpe)] <- TRUE

# Visualización
library(ggplot2)
ggplot(resultados_df, aes(x = Riesgo, y = Retorno)) +
  geom_point(aes(color = Sharpe), alpha = 0.5) +
  scale_color_viridis_c() +
  geom_point(data = subset(resultados_df, tangency == TRUE), color = "red", size = 3) +
  labs(title = "Frontera Eficiente de Portafolios Aleatorios",
       x = "Volatilidad (Riesgo)", y = "Retorno Esperado") +
  theme_minimal()

📉 Simulación de Precios en Escenario de Caída con Múltiples Trayectorias

set.seed(123)
n_dias <- 252 * 2
n_simulaciones <- 5000
mu_sim <- mu - 0.05
sigma <- sqrt(diag(cov_matrix))

simulaciones_mgb <- lapply(1:length(stocks), function(i) {
  matrix(replicate(n_simulaciones, {
    precios <- numeric(n_dias)
    precios[1] <- valores_finales[i]
    for (t in 2:n_dias) {
      precios[t] <- precios[t - 1] * exp((mu_sim[i] - 0.5 * sigma[i]^2) + sigma[i] * rnorm(1))
    }
    precios
  }), nrow = n_dias)
})
names(simulaciones_mgb) <- stocks

🔍 Análisis de la Evolución de Precios Simulados (Final de Simulación)

resultados_finales <- sapply(simulaciones_mgb, function(m) m[n_dias, ])
estadisticas_finales <- apply(resultados_finales, 2, function(x) {
  c(Media = mean(x), Min = min(x), Max = max(x), P10 = quantile(x, 0.10), P90 = quantile(x, 0.90))
})
estadisticas_df <- as.data.frame(t(estadisticas_finales))
kable(round(estadisticas_df, 2), caption = "Estadísticas Finales del Precio Simulado (1000 trayectorias)")

Estadísticas Finales del Precio Simulado (1000 trayectorias)

	Media	Min	Max	P10.10%	P90.90%
RXRX	0	0	0	0	0
MRNA	0	0	0	0	0
BRPHF	0	0	0	0	0

📊 Precio Esperado Promedio por Acción en el Tiempo

promedios_mgb <- sapply(simulaciones_mgb, rowMeans)
promedios_df <- data.frame(Dia = 1:n_dias, promedios_mgb)

promedios_long <- pivot_longer(promedios_df, -Dia, names_to = "Accion", values_to = "Precio")

ggplot(promedios_long, aes(x = Dia, y = Precio, color = Accion)) +
  geom_line() +
  labs(title = "Precio Promedio Esperado por Acción (1000 Simulaciones)", x = "Día", y = "Precio Promedio") +
  theme_minimal()

📈 Visualización de Trayectorias Simuladas Seleccionadas

simulaciones_largas <- bind_rows(lapply(names(simulaciones_mgb), function(nombre) {
  sim <- simulaciones_mgb[[nombre]]
  sim_df <- as.data.frame(sim)
  sim_df$Dia <- 1:nrow(sim_df)
  sim_largo <- pivot_longer(sim_df, -Dia, names_to = "Simulacion", values_to = "Precio")
  sim_largo$Accion <- nombre
  sim_largo
}), .id = "ID")

# Graficar solo 10 trayectorias por acción
library(dplyr)
ggplot(simulaciones_largas %>% filter(Simulacion %in% paste0("V", 1:10)), 
       aes(x = Dia, y = Precio, color = Accion, group = interaction(Simulacion, Accion))) +
  geom_line(alpha = 0.3) +
  labs(title = "Ejemplo de 10 trayectorias simuladas por acción", x = "Día", y = "Precio") +
  theme_minimal()

🛡️ Cobertura con Opciones Put Europeas y Valor Protegido

# Suponiendo precios actuales y strikes ligeramente por debajo
strike_prices <- valores_finales * 0.95
T <- 0.25
vol <- sigma

valores_put <- mapply(function(S, K, v) {
  EuropeanOption(type = "put", underlying = S, strike = K,
                 dividendYield = rf, riskFreeRate = rf,
                 maturity = T, volatility = v)$value
}, S = valores_finales, K = strike_prices, v = vol)

puts_compradas <- acciones_compradas
valor_total_opciones <- puts_compradas * valores_put

# Valor final promedio del portafolio simulado (último día de cada trayectoria)
promedio_final_portafolio <- colMeans(resultados_finales)
valor_final_total_promedio <- sum(promedio_final_portafolio * acciones_compradas)

valor_inicial <- sum(inversion_realizada)
perdida_promedio <- valor_inicial - valor_final_total_promedio
proteccion_total <- sum(valor_total_opciones)
valor_neto_protegido <- valor_final_total_promedio + proteccion_total

resultado_df <- data.frame(
  Inversion_Inicial = valor_inicial,
  Valor_Final_Promedio = valor_final_total_promedio,
  Perdida_Promedio = perdida_promedio,
  Cobertura_Obtenida = proteccion_total,
  Valor_Neto_Tras_Cobertura = valor_neto_protegido
)

kable(round(resultado_df, 2), caption = "Evaluación de la Cobertura con Opciones sobre la Pérdida Promedio")

Evaluación de la Cobertura con Opciones sobre la Pérdida Promedio

Inversion_Inicial	Valor_Final_Promedio	Perdida_Promedio	Cobertura_Obtenida	Valor_Neto_Tras_Cobertura
999986.2	0	999986.2	126.21	126.21

📉 Análisis de Riesgo: Percentiles del Portafolio Final Simulado

valores_totales_sim <- colSums(t(resultados_finales) * acciones_compradas)
VaR_10 <- quantile(valores_totales_sim, 0.10)
VaR_5 <- quantile(valores_totales_sim, 0.05)
VaR_1 <- quantile(valores_totales_sim, 0.01)

percentiles_df <- data.frame(
  Percentil = c("10%", "5%", "1%"),
  Valor = c(VaR_10, VaR_5, VaR_1)
)

percentiles_df$Valor <- round(percentiles_df$Valor, 2)
kable(percentiles_df, caption = "Valor en Riesgo (VaR) del Portafolio Simulado")

Valor en Riesgo (VaR) del Portafolio Simulado

	Percentil	Valor
10%	10%	0
5%	5%	0
1%	1%	0

# 📊 *Comparación con Portafolio Equitativo*

pesos_eq <- rep(1 / length(stocks), length(stocks))
ret_eq <- sum(pesos_eq * mu)
riesgo_eq <- sqrt(t(pesos_eq) %*% cov_matrix %*% pesos_eq)
sharpe_eq <- ret_eq / riesgo_eq

📉 Comparación final de estrategias de portafolio

ret_opt <- sum(pesos_tangency * mu)
riesgo_opt <- sqrt(t(pesos_tangency) %*% cov_matrix %*% pesos_tangency)
sharpe_opt <- ret_opt / riesgo_opt

comparacion_final <- rbind(
  data.frame(Portafolio = "Equitativo", Retorno = ret_eq, Riesgo = riesgo_eq, Sharpe = sharpe_eq),
  data.frame(Portafolio = "Óptimo Tangencia", Retorno = ret_opt, Riesgo = riesgo_opt, Sharpe = sharpe_opt)
)

knitr::kable(comparacion_final, caption = "Comparación Final de Portafolios: Equitativo vs. Óptimo")

Comparación Final de Portafolios: Equitativo vs. Óptimo

Portafolio	Retorno	Riesgo	Sharpe
Equitativo	-0.0004005	0.0368799	-0.0108589
Óptimo Tangencia	-0.0012768	0.0333347	-0.0383033

📊 Conclusión: - El portafolio óptimo presenta un Sharpe ratio superior, lo cual indica mejor rendimiento ajustado por riesgo. - Las simulaciones y estrategias de cobertura permiten fortalecer la gestión del portafolio en escenarios adversos. - Este análisis integral ayuda a tomar decisiones de inversión más informadas y alineadas con el perfil de riesgo-retorno deseado.

📊 Minimum Variance Portfolio Weights

Dmat <- cov_matrix
dvec <- rep(0, length(mu))
Amat <- cbind(rep(1, length(mu)))  # sum of weights = 1
bvec <- 1
meq <- 1

sol_mv <- solve.QP(Dmat, dvec, Amat, bvec, meq)
weights_mv <- sol_mv$solution
names(weights_mv) <- colnames(returns)

kable(
  data.frame(Assets = names(weights_mv), Weights = round(weights_mv, 4)),
  caption = "Minimum Variance Portfolio Weights"
)

Minimum Variance Portfolio Weights

	Assets	Weights
RXRX	RXRX	0.1018
MRNA	MRNA	0.6525
BRPHF	BRPHF	0.2457

# Visualización

library(ggplot2)
ggplot(data.frame(Assets = names(weights_mv), Weights = weights_mv), aes(x = Assets, y = Weights, fill = Assets)) +
  geom_bar(stat = "identity") +
  labs(title = "Composición del Portafolio de Varianza Mínima", y = "Peso") +
  theme_minimal()

📊 Composición del Portafolio Óptimo

optimal_weights <- pesos_tangency
names(optimal_weights) <- stocks

kable(
  data.frame(Assets = names(optimal_weights), Weights = round(optimal_weights, 4)),
  caption = "Composición del Portafolio Óptimo (Tangencia)"
)

Composición del Portafolio Óptimo (Tangencia)

	Assets	Weights
RXRX	RXRX	0.0886
MRNA	MRNA	0.6921
BRPHF	BRPHF	0.2193

# Visualización
ggplot(data.frame(Assets = names(optimal_weights), Weights = optimal_weights), aes(x = Assets, y = Weights, fill = Assets)) +
  geom_bar(stat = "identity") +
  labs(title = "Composición del Portafolio Óptimo (Tangencia)", y = "Peso") +
  theme_minimal()