OPCIONES Y ARBOLES BINOMIALES
ISABEL GOEZ - VERONICA ARANGO - TATIANA VALENCIA
2025-04-06
1. Carga de Paquetes
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"2. Portafolio con inversión de USD 1,000,000
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 290083. Simulación de precios con MGB (tendencia bajista)
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)árbol de precios del activo Este árbol muestra cómo se mueve el precio del activo (por ejemplo, una acción) en cada paso, considerando una subida o bajada en cada periodo.
# 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")
))4. Valoración de la Opción Put Americana
# 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.584225. Valoración de la Opción Put Europea
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.2637986. Comparación y Visualización de Resultados
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"))
7. Análisis del Payoff con cobertura
Este bloque calcula la pérdida esperada del portafolio en un escenario bajista sin cobertura, y cuánto se recupera con la opción put. El resultado neto permite observar si la cobertura es efectiva y adecuada.
# 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.591758. Frontera eficiente y portafolio óptimo
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()
Conclusión general:
Se logró simular el comportamiento futuro del portafolio y se demostró cómo una estrategia de cobertura con opciones put puede limitar las pérdidas en escenarios adversos. El uso de árboles binomiales permitió representar visualmente la evolución de precios y decisiones óptimas. Finalmente, el análisis de frontera eficiente permitió identificar una asignación de activos con mayor rendimiento ajustado por riesgo.
El valor de la opción put americana siempre será mayor o igual al valor de la opción put europea, por la posibilidad de ejercicio anticipado.
El modelo binomial permite representar múltiples escenarios y valorar opciones de forma precisa incluso cuando se usa un horizonte de 8 pasos con rolling trimestral.
Este tipo de coberturas permite a los inversionistas proteger sus activos ante eventos adversos del mercado.