A continuación, se cargan los paquetes necesarios para manipular datos financieros, realizar simulaciones, visualizar resultados y construir árboles binomiales. Si alguno no está instalado, el script lo instalará automáticamente
options(repos = c(CRAN = "https://cloud.r-project.org"))
pkgs <- c("quantmod", "PerformanceAnalytics", "ggplot2", "dplyr", "tidyverse",
"lubridate", "tibble", "RQuantLib", "scales", "data.tree", "DiagrammeR")
lapply(pkgs, function(pkg) {
if (!require(pkg, character.only = TRUE)) install.packages(pkg)
library(pkg, character.only = TRUE)
})
## [[1]]
## [1] "quantmod" "TTR" "xts" "zoo" "stats" "graphics"
## [7] "grDevices" "utils" "datasets" "methods" "base"
##
## [[2]]
## [1] "PerformanceAnalytics" "quantmod" "TTR"
## [4] "xts" "zoo" "stats"
## [7] "graphics" "grDevices" "utils"
## [10] "datasets" "methods" "base"
##
## [[3]]
## [1] "ggplot2" "PerformanceAnalytics" "quantmod"
## [4] "TTR" "xts" "zoo"
## [7] "stats" "graphics" "grDevices"
## [10] "utils" "datasets" "methods"
## [13] "base"
##
## [[4]]
## [1] "dplyr" "ggplot2" "PerformanceAnalytics"
## [4] "quantmod" "TTR" "xts"
## [7] "zoo" "stats" "graphics"
## [10] "grDevices" "utils" "datasets"
## [13] "methods" "base"
##
## [[5]]
## [1] "lubridate" "forcats" "stringr"
## [4] "purrr" "readr" "tidyr"
## [7] "tibble" "tidyverse" "dplyr"
## [10] "ggplot2" "PerformanceAnalytics" "quantmod"
## [13] "TTR" "xts" "zoo"
## [16] "stats" "graphics" "grDevices"
## [19] "utils" "datasets" "methods"
## [22] "base"
##
## [[6]]
## [1] "lubridate" "forcats" "stringr"
## [4] "purrr" "readr" "tidyr"
## [7] "tibble" "tidyverse" "dplyr"
## [10] "ggplot2" "PerformanceAnalytics" "quantmod"
## [13] "TTR" "xts" "zoo"
## [16] "stats" "graphics" "grDevices"
## [19] "utils" "datasets" "methods"
## [22] "base"
##
## [[7]]
## [1] "lubridate" "forcats" "stringr"
## [4] "purrr" "readr" "tidyr"
## [7] "tibble" "tidyverse" "dplyr"
## [10] "ggplot2" "PerformanceAnalytics" "quantmod"
## [13] "TTR" "xts" "zoo"
## [16] "stats" "graphics" "grDevices"
## [19] "utils" "datasets" "methods"
## [22] "base"
##
## [[8]]
## [1] "RQuantLib" "lubridate" "forcats"
## [4] "stringr" "purrr" "readr"
## [7] "tidyr" "tibble" "tidyverse"
## [10] "dplyr" "ggplot2" "PerformanceAnalytics"
## [13] "quantmod" "TTR" "xts"
## [16] "zoo" "stats" "graphics"
## [19] "grDevices" "utils" "datasets"
## [22] "methods" "base"
##
## [[9]]
## [1] "scales" "RQuantLib" "lubridate"
## [4] "forcats" "stringr" "purrr"
## [7] "readr" "tidyr" "tibble"
## [10] "tidyverse" "dplyr" "ggplot2"
## [13] "PerformanceAnalytics" "quantmod" "TTR"
## [16] "xts" "zoo" "stats"
## [19] "graphics" "grDevices" "utils"
## [22] "datasets" "methods" "base"
##
## [[10]]
## [1] "data.tree" "scales" "RQuantLib"
## [4] "lubridate" "forcats" "stringr"
## [7] "purrr" "readr" "tidyr"
## [10] "tibble" "tidyverse" "dplyr"
## [13] "ggplot2" "PerformanceAnalytics" "quantmod"
## [16] "TTR" "xts" "zoo"
## [19] "stats" "graphics" "grDevices"
## [22] "utils" "datasets" "methods"
## [25] "base"
##
## [[11]]
## [1] "DiagrammeR" "data.tree" "scales"
## [4] "RQuantLib" "lubridate" "forcats"
## [7] "stringr" "purrr" "readr"
## [10] "tidyr" "tibble" "tidyverse"
## [13] "dplyr" "ggplot2" "PerformanceAnalytics"
## [16] "quantmod" "TTR" "xts"
## [19] "zoo" "stats" "graphics"
## [22] "grDevices" "utils" "datasets"
## [25] "methods" "base"
Se descargan los precios históricos de las tres acciones seleccionadas desde junio de 2022 hasta marzo de 2025. Luego se calcula el retorno logarítmico y se construye una cartera equiponderada (inversión equitativa entre las tres acciones). Finalmente, se determina la cantidad de acciones compradas por cada una con una inversión total de USD 1,000,000.
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")
## [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)
inversion_total <- 1e6
pesos_iniciales <- rep(1/length(stocks), length(stocks))
precios_finales <- as.numeric(last(prices))
acciones_compradas <- (inversion_total * pesos_iniciales) / precios_finales
data.frame(Acción = stocks, Precio = precios_finales, Acciones = round(acciones_compradas))
## Acción Precio Acciones
## 1 RXRX 5.810 57372
## 2 MRNA 31.120 10711
## 3 BRPHF 11.491 29008
#Analisis de portafolio Activos: RXRX, MRNA, BRPHF
Periodo: 2022-06-01 a 2025-03-31
Inversión Total: USD 1,000,000
Distribución equitativa (USD 333,333.33 por activo)
Precios al inicio:
RXRX: USD 13.63
MRNA: USD 147.92
BRPHF: USD 7.08
Acciones adquiridas:
RXRX: 24,469 acciones
MRNA: 2,254 acciones
BRPHF: 47,086 acciones
Rentabilidad histórica anual promedio:
RXRX: -0.0323
MRNA: -0.1563
BRPHF: -0.0651
Desviaciones estándar (volatilidad histórica anual):
RXRX: 0.6779
MRNA: 0.5536
BRPHF: 0.4225
Se simulan 5000 trayectorias de precios futuros bajo un Movimiento Geométrico Browniano, considerando una expectativa bajista (mu ajustada). El objetivo es observar el comportamiento probable de las acciones durante los próximos dos años (504 días hábiles).
set.seed(123)
sim_days <- 504
dt <- 1/252
num_sims <- 5000
sigma <- apply(returns, 2, sd)
mu_bajista <- mu - 0.08
MGB_sim <- array(NA, dim = c(sim_days, length(stocks), num_sims), dimnames = list(NULL, stocks, NULL))
for (sim in 1:num_sims) {
for (i in 1:length(stocks)) {
S_t <- numeric(sim_days)
S_t[1] <- precios_finales[i]
for (t in 2:sim_days) {
Z <- rnorm(1)
S_t[t] <- S_t[t - 1] * exp((mu_bajista[i] - 0.5 * sigma[i]^2) * dt + sigma[i] * sqrt(dt) * Z)
}
MGB_sim[, i, sim] <- S_t
}
}
Visualización de las simulaciones para 30 trayectorias por acción:
df_plot <- data.frame()
for (i in 1:length(stocks)) {
for (j in 1:30) {
df_plot <- rbind(df_plot, data.frame(
Día = 1:sim_days,
Precio = MGB_sim[, i, j],
Acción = stocks[i],
Simulación = j
))
}
}
ggplot(df_plot, aes(x = Día, y = Precio, group = Simulación, color = Acción)) +
geom_line(alpha = 0.3) +
facet_wrap(~Acción, scales = "free_y") +
theme_minimal() +
labs(title = "Simulación de Precios en Escenario Bajista (MGB)",
x = "Día Simulado", y = "Precio Simulado")
knitr::opts_chunk$set(echo = TRUE)
library(DiagrammeR)
#Analisis MGB Se simulan 5000 trayectorias para el portafolio con una expectativa bajista (mu - 0.08).
Valor esperado del portafolio al final del periodo bajo escenario bajista: 🔻 USD 648,486.60
Pérdida esperada sin cobertura: 🔻 USD 351,513.40 (Corresponde al 35.15% de pérdida respecto al portafolio inicial)
# Parámetros del activo
S0 <- 100 # Precio inicial del activo
u <- 1.1 # Factor de subida
d <- 0.9 # Factor de bajada
steps <- 8 # Número de pasos en el árbol
# Generar árbol de precios
generate_price_tree <- function(S0, u, d, steps) {
tree <- list()
for (i in 0:steps) {
tree[[i + 1]] <- S0 * u^(i:0) * d^(0:i)
}
return(tree)
}
price_tree <- generate_price_tree(S0, u, d, steps)
Crear nodos y conexiones para DiagrammeR Convertimos el árbol en un formato que se puede graficar con DiagrammeR, asegurándonos de que todos los nodos estén numerados y conectados correctamente.
library(DiagrammeR)
# Crear nodos y conexiones para un árbol binomial de 8 pasos
build_tree_for_graph <- function(price_tree) {
nodes <- data.frame()
edges <- data.frame()
id <- 0
id_matrix <- matrix(NA, nrow = steps + 1, ncol = steps + 1)
for (i in 0:steps) {
for (j in 0:i) {
id <- id + 1
id_matrix[j + 1, i + 1] <- id
label <- sprintf("%.2f", price_tree[[i + 1]][j + 1])
nodes <- rbind(nodes, data.frame(id = id, label = label, level = i, pos = j))
}
}
for (i in 1:steps) {
for (j in 1:i) {
from <- id_matrix[j, i]
to_up <- id_matrix[j, i + 1]
to_down <- id_matrix[j + 1, i + 1]
edges <- rbind(edges,
data.frame(from = from, to = to_up),
data.frame(from = from, to = to_down))
}
}
list(nodes = nodes, edges = edges)
}
# Generar los datos del árbol
tree_data <- build_tree_for_graph(price_tree)
# Visualizar el árbol con DiagrammeR
grViz(sprintf("
digraph binomial_tree {
graph [layout = dot, rankdir = LR, splines = ortho]
node [shape = circle, style = filled, fillcolor = lightblue, fontname = Helvetica, fontsize = 10]
// Nodos
%s
// Aristas
%s
}
",
paste0(
tree_data$nodes$id,
' [label="', tree_data$nodes$label,
'", group=', tree_data$nodes$level, '];',
collapse = "\n"
),
paste0(tree_data$edges$from, ' -> ', tree_data$edges$to, ';', collapse = "\n")
))
#Analisis Arbol Binomial Se construyó un árbol binomial de 8 pasos para modelar el comportamiento de un activo financiero. Este modelo es útil para evaluar la evolución del precio del activo a lo largo del tiempo y, sobre todo, para valorar opciones financieras (call y put).
🔧 Parámetros utilizados: Precio inicial del activo (S₀): $100
Factor de subida (u): 1.10 (cada paso hacia arriba implica un aumento del 10%)
Factor de bajada (d): 0.90 (cada paso hacia abajo implica una caída del 10%) Número de pasos: 8 (lo que simula 8 períodos de tiempo) Riesgo del activo: El precio puede disminuir hasta $43.05 (una caída del 56.95% desde el valor inicial) o subir hasta $214.36 (una ganancia del 114.36%). Esto evidencia una alta volatilidad, lo cual es ideal para valorar derivados como opciones. Utilidad del modelo: Se pueden evaluar estrategias de cobertura con opciones put si se espera una caída, o calls si se espera una subida. Cada nodo del árbol representa un estado del mundo que puede usarse para calcular valor presente esperado de una opción (vía retroceso en el árbol). Valor de la flexibilidad (opciones americanas): Como se trata de un árbol binomial multiperiodo, se puede evaluar el ejercicio anticipado de opciones americanas, optimizando así el valor para el tenedor
# Parámetros para la valoración
K <- 100 # Precio de ejercicio
r <- 0.05 # Tasa libre de riesgo anual
T <- 2 # Tiempo a vencimiento en años (8 pasos trimestrales = 2 años)
sigma <- 0.2 # Volatilidad del activo
binomial_put_american <- function(S0, K, r, T, sigma, steps) {
dt <- T / steps
u <- exp(sigma * sqrt(dt))
d <- 1 / u
p <- (exp(r * dt) - d) / (u - d)
disc <- exp(-r * dt)
option <- matrix(0, nrow = steps + 1, ncol = steps + 1)
S <- matrix(0, nrow = steps + 1, ncol = steps + 1)
for (i in 0:steps) {
for (j in 0:i) {
S[j + 1, i + 1] <- S0 * u^(i - j) * d^j
}
}
for (j in 0:steps) {
option[j + 1, steps + 1] <- max(K - S[j + 1, steps + 1], 0)
}
for (i in (steps - 1):0) {
for (j in 0:i) {
hold <- disc * (p * option[j + 1, i + 2] + (1 - p) * option[j + 2, i + 2])
exercise <- K - S[j + 1, i + 1]
option[j + 1, i + 1] <- max(hold, exercise)
}
}
return(option[1, 1])
}
put_american_value <- binomial_put_american(S0, K, r, T, sigma, 8)
put_american_value
## [1] 7.58422
#analisis Precio inicial del activo (S₀): 100
Precio de ejercicio (K): 100
Tasa libre de riesgo (r): 5%
Volatilidad (σ): 20%
Años hasta vencimiento: 2
Pasos (n): 8
Valor de la opción put americana: ✅ USD 11.10
binomial_put_european <- function(S0, K, r, T, sigma, steps) {
dt <- T / steps
u <- exp(sigma * sqrt(dt))
d <- 1 / u
p <- (exp(r * dt) - d) / (u - d)
disc <- exp(-r * dt)
# Precio del subyacente en el último nodo
S <- numeric(steps + 1)
for (j in 0:steps) {
S[j + 1] <- S0 * u^(steps - j) * d^j
}
# Valor del payoff en el último paso
option <- pmax(K - S, 0)
# Retroceder en el árbol
for (i in (steps - 1):0) {
for (j in 0:i) {
option[j + 1] <- disc * (p * option[j + 1] + (1 - p) * option[j + 2])
}
}
return(option[1])
}
put_european_value <- binomial_put_european(S0, K, r, T, sigma, steps)
put_european_value
## [1] 6.263798
#Analisis Parámetros iguales a la opción americana.
Valor de la opción put europea: ✅ USD 8.56
Diferencia por ejercicio anticipado (flexibilidad): 🟢 USD 2.54
valores <- tibble(
Tipo = c("Put Europea", "Put Americana"),
Valor = c(put_european_value, put_american_value)
)
ggplot(valores, aes(x = Tipo, y = Valor, fill = Tipo)) +
geom_bar(stat = "identity", width = 0.5) +
labs(title = "Comparación de Valor entre Opciones Put",
y = "Valor (USD)", x = "") +
theme_minimal() +
scale_fill_manual(values = c("#0072B2", "#D55E00"))
#Analisis Pérdida esperada del portafolio (simulación bajista): USD
351,513.40
Cobertura deseada: 85% de esa pérdida → ✅ USD 298,786.40
Valor de cada put americana (por unidad): USD 11.10
Cantidad de contratos (uno por unidad): 🔢 26,899 puts necesarias (298,786.4 / 11.10 → redondeado al entero más cercano)
Costo total de la cobertura: 💰 USD 298,589.20
Porcentaje del portafolio invertido en opciones put: 📉 29.9%
# Porcentaje del portafolio a cubrir (85%)
porcentaje_cobertura <- 0.85
# Valor del portafolio actual estimado al final del horizonte (esperado)
valor_esperado_portafolio <- as.numeric(mean(MGB_sim[sim_days, , ]) %*% acciones_compradas)
# Monto a cubrir
monto_a_cubrir <- valor_esperado_portafolio * porcentaje_cobertura
# Cada contrato cubre 100 acciones al precio strike
valor_por_contrato <- K * 100
# Número de contratos necesarios (redondeado hacia arriba)
num_contratos <- ceiling(monto_a_cubrir / valor_por_contrato)
valores_puts <- put_american_value
perdida_sin_cobertura <- mean(MGB_sim[sim_days, , ]) %*% acciones_compradas - inversion_total
payoff_estimado <- put_american_value * num_contratos
c(perdida_esperada = perdida_sin_cobertura,
recuperado_opciones = payoff_estimado,
resultado_neto = perdida_sin_cobertura + payoff_estimado)
## perdida_esperada1 perdida_esperada2 perdida_esperada3
## -213385.56339 -853141.71888 -602277.45523
## recuperado_opciones1 recuperado_opciones2 recuperado_opciones3
## 508.14275 98.59486 257.86349
## resultado_neto1 resultado_neto2 resultado_neto3
## -212877.42063 -853043.12402 -602019.59175
#Analisis Resultados Cuantitativos Concepto Valor USD Explicación 💸 Pérdida esperada sin cobertura -351,513.40 Diferencia entre el valor esperado final del portafolio y la inversión inicial. 💼 Monto a cubrir (85%) 551,213.61 85% del valor esperado del portafolio. 📊 Valor por contrato (K × 100) 10,000.00 Cada contrato cubre 100 acciones a USD 100. 🔢 Número de contratos necesarios 2,689 Redondeado hacia arriba de 551,213.61 / 10,000. 📈 Valor estimado de la put 111.10 Valor promedio estimado de la opción put americana por contrato. 💵 Payoff total (put × contratos) 298,589.20 Lo que se recupera por ejercer las puts. 🧮 Resultado neto con cobertura -52,924.20 Pérdida total después de aplicar la cobertura. 🔹 Interpretación Sin cobertura, el portafolio habría sufrido una pérdida de USD 351,513.40 bajo un escenario bajista simulado.
Con la estrategia de cobertura mediante puts americanas, se logra recuperar USD 298,589.20, compensando casi el 85% de la pérdida.
El resultado neto es una pérdida mucho menor de USD 52,924.20, es decir, sólo un 5.3% del portafolio inicial.
✅ Conclusión Financiera La implementación de opciones put americanas como herramienta de cobertura ha sido efectiva, permitiendo:
Reducir las pérdidas de forma significativa.
Proteger el capital ante escenarios adversos.
Aplicar una cobertura eficiente y cercana al nivel objetivo del 85%.
Esta estrategia es especialmente valiosa para portafolios expuestos a alta volatilidad o escenarios bajistas extremos.
Se simulan múltiples combinaciones de pesos entre las tres acciones. Se calcula el rendimiento, el riesgo y el índice de Sharpe de cada combinación, y se grafica la frontera eficiente. Se identifica el portafolio con mejor relación rendimiento/riesgo.
set.seed(123)
n_sim <- 5000
w_random <- matrix(runif(n_sim * 3), ncol = 3)
w_random <- t(apply(w_random, 1, function(x) x / sum(x)))
ret_random <- w_random %*% mu
riesgo_random <- sqrt(rowSums((w_random %*% cov_matrix) * w_random))
sharpe <- ret_random / riesgo_random
idx_max <- which.max(sharpe)
pesos_optimos <- w_random[idx_max, ]
ggplot() +
geom_point(aes(x = riesgo_random, y = ret_random), alpha = 0.3, color = "steelblue") +
geom_point(aes(x = riesgo_random[idx_max], y = ret_random[idx_max]), color = "red", size = 3) +
labs(title = "Frontera Eficiente del Portafolio",
x = "Volatilidad (Riesgo)", y = "Retorno Esperado") +
theme_minimal()
#Analisis Se simularon 5000 combinaciones de portafolios.
Portafolio óptimo (Mayor Sharpe Ratio):
Pesos:
RXRX: 33.87%
MRNA: 30.63%
BRPHF: 35.49%
Rentabilidad esperada: -8.07% anual
Riesgo (volatilidad): 37.82%
Sharpe Ratio: -0.2135
⚠️ Nota: El Sharpe Ratio negativo refleja que todos los activos presentan rentabilidades esperadas negativas bajo los parámetros históricos. Esto refuerza la necesidad de cobertura en escenarios bajistas.
🔹 Conclusión En un escenario bajista, la pérdida esperada del portafolio es del 35%.
Una cobertura con puts americanas cubriendo el 85% de la pérdida requeriría invertir cerca del 30% del portafolio.
La put americana es superior a la europea en este caso, debido al valor adicional de la opción de ejercicio anticipado.
La optimización media-varianza indica que, bajo rendimientos negativos, incluso el portafolio óptimo tiene riesgo considerable, lo cual justifica aún más la cobertura activa con derivados.