Taller: Creación de Árboles Binomiales para cobertura de inversión
Natalia O y Maritza A
2025-04-06
## 1. Carga de paquetes
# Instalar y cargar paquetes necesarios
required_packages <- c("quantmod", "tidyquant", "PortfolioAnalytics",
"PerformanceAnalytics", "xts", "ggplot2",
"plotly", "reshape2", "scales", "zoo",
"timetk", "tidyverse", "fGarch")
# Instalar y cargar paquetes faltantes
for (pkg in required_packages) {
if (!require(pkg, character.only = TRUE)) {
install.packages(pkg, repos = "https://cran.rstudio.com/")
library(pkg, character.only = TRUE)
}
}## 2. Configuración inicial y obtención de datos
# Definir las fechas y acciones
inicio <- as.Date("2022-06-22")
fin <- as.Date("2025-03-31")
hoy <- Sys.Date()
tickers <- c('APH', 'MU', 'NVDA')
# Inversión inicial
investment <- 1000000 # $1 millón
# Tasa libre de riesgo (Tbond a 3 meses)
rf_rate <- 0.05 # Aproximadamente 5% anual# Obtener datos históricos de precios
price_data <- tq_get(tickers,
from = inicio,
to = hoy,
get = 'stock.prices')
# Calcular los retornos logarítmicos diarios
log_ret_tidy <- price_data %>%
group_by(symbol) %>%
tq_transmute(select = adjusted,
mutate_fun = periodReturn,
period = 'daily',
col_rename = 'ret',
type = 'log')
# Convertir a formato amplio y a xts
log_ret_xts <- log_ret_tidy %>%
spread(symbol, value = ret) %>%
tk_xts()
# Calcular retornos medios diarios
mean_ret <- colMeans(log_ret_xts, na.rm = TRUE)
print("Retornos medios diarios:")## [1] "Retornos medios diarios:"print(round(mean_ret, 5))## APH MU NVDA
## 0.00093 0.00022 0.00250# Calcular matriz de covarianza (anualizada)
cov_mat <- cov(log_ret_xts, use = "complete.obs") * 252
print("Matriz de covarianza anualizada:")## [1] "Matriz de covarianza anualizada:"print(round(cov_mat, 4))## APH MU NVDA
## APH 0.0749 0.0748 0.0897
## MU 0.0748 0.2291 0.1508
## NVDA 0.0897 0.1508 0.2869## 3. Construcción del portafolio de media-varianza
# Generar 5000 portafolios aleatorios
set.seed(123)
num_port <- 5000
all_wts <- matrix(nrow = num_port, ncol = length(tickers))
port_returns <- vector('numeric', length = num_port)
port_risk <- vector('numeric', length = num_port)
sharpe_ratio <- vector('numeric', length = num_port)
# Crear portafolios aleatorios
for (i in seq_along(port_returns)) {
wts <- runif(length(tickers))
wts <- wts/sum(wts)
# Almacenar pesos
all_wts[i,] <- wts
# Retornos del portafolio
port_ret <- sum(wts * mean_ret)
port_ret <- ((port_ret + 1)^252) - 1
port_returns[i] <- port_ret
# Riesgo del portafolio
port_sd <- sqrt(t(wts) %*% (cov_mat %*% wts))
port_risk[i] <- port_sd
# Sharpe ratio
sr <- (port_ret - rf_rate) / port_sd
sharpe_ratio[i] <- sr
}
# Crear tabla con los valores del portafolio
portfolio_values <- tibble(Return = port_returns,
Risk = port_risk,
SharpeRatio = sharpe_ratio)
# Convertir matriz a tibble y cambiar nombres de columnas
all_wts <- as_tibble(all_wts)
colnames(all_wts) <- colnames(log_ret_xts)
# Combinar todos los valores
portfolio_values <- bind_cols(all_wts, portfolio_values)
# Encontrar el portafolio con mínima varianza y máximo Sharpe ratio
min_var <- portfolio_values[which.min(portfolio_values$Risk),]
max_sr <- portfolio_values[which.max(portfolio_values$SharpeRatio),]
# Usar los pesos del portafolio óptimo (máximo Sharpe ratio)
optimal_weights <- as.numeric(max_sr[1:length(tickers)])
names(optimal_weights) <- tickers
print("Pesos óptimos del portafolio (Máximo Sharpe Ratio):")## [1] "Pesos óptimos del portafolio (Máximo Sharpe Ratio):"print(round(optimal_weights, 4))## APH MU NVDA
## 0.0605 0.0058 0.9336# Inversión por activo
investment_per_asset <- optimal_weights * investment
print("Inversión por activo:")## [1] "Inversión por activo:"print(round(investment_per_asset, 2))## APH MU NVDA
## 60536.15 5828.19 933635.66# Determinar la acción con menor peso
min_weight_ticker <- names(which.min(optimal_weights))
print(paste("La acción con menor peso en el portafolio es:", min_weight_ticker))## [1] "La acción con menor peso en el portafolio es: MU"### 3.1 Frontera eficiente
# Crear un dataframe con los portafolios generados
frontier_data <- data.frame(
Return = port_returns,
Risk = port_risk
)
# Añadir puntos especiales
frontier_data$Type <- "Regular"
frontier_data$Type[which.min(port_risk)] <- "Mínima Varianza"
frontier_data$Type[which.max(sharpe_ratio)] <- "Máximo Sharpe"
# Crear gráfico de frontera eficiente
frontier_plot <- ggplot(frontier_data, aes(x = Risk, y = Return, color = Type)) +
geom_point(size = 1, alpha = 0.5) +
geom_point(data = subset(frontier_data, Type != "Regular"),
aes(x = Risk, y = Return),
size = 4) +
scale_color_manual(values = c("Mínima Varianza" = "red",
"Máximo Sharpe" = "green",
"Regular" = "blue")) +
labs(title = "Frontera Eficiente",
x = "Riesgo (Volatilidad)",
y = "Rendimiento Esperado",
color = "Tipo de Portafolio") +
theme_minimal() +
scale_y_continuous(labels = scales::percent) +
scale_x_continuous(labels = scales::percent)
print(frontier_plot)
### 3.2 Ponderaciones óptimas
# Gráfico de pesos óptimos
weights_df <- data.frame(
Ticker = names(optimal_weights),
Weight = optimal_weights
)
weights_plot <- ggplot(weights_df, aes(x = Ticker, y = Weight, fill = Ticker)) +
geom_bar(stat = "identity") +
geom_text(aes(label = scales::percent(Weight, accuracy = 0.1)),
vjust = -0.5) +
labs(title = "Ponderaciones Óptimas del Portafolio",
x = "Acción",
y = "Peso") +
theme_minimal() +
scale_y_continuous(labels = scales::percent)
print(weights_plot)
## 4. Simulación de precios y análisis de rendimiento
# Obtener precios actuales
last_prices <- price_data %>%
group_by(symbol) %>%
slice_tail(n = 1) %>%
select(symbol, adjusted)
# Convertir a vector
current_prices <- last_prices$adjusted
names(current_prices) <- last_prices$symbol
# Calcular volatilidades históricas (anualizadas)
volatility <- apply(log_ret_xts, 2, sd, na.rm = TRUE) * sqrt(252)
print("Volatilidades anualizadas:")## [1] "Volatilidades anualizadas:"print(round(volatility, 4))## APH MU NVDA
## 0.2737 0.4787 0.5356# Función para simular precios con Movimiento Browniano Geométrico
simulate_prices <- function(S0, mu, sigma, T, dt, n_sim) {
# Asegurar que T sea positivo
if (T <= 0) T <- 1
# Calcular número de pasos y asegurar que sea al menos 1
n_steps <- max(1, ceiling(T/dt))
# Crear matriz para almacenar resultados
S <- matrix(0, nrow = n_steps + 1, ncol = n_sim)
S[1, ] <- S0
# Simular precios
for (i in 2:(n_steps + 1)) {
Z <- rnorm(n_sim)
S[i, ] <- S[i-1, ] * exp((mu - 0.5 * sigma^2) * dt + sigma * sqrt(dt) * Z)
}
return(S)
}
# Periodo de simulación en años
T <- as.numeric(difftime(fin, hoy, units = "days")) / 365
# Asegurar que T sea positivo (importante para la simulación)
if (T <= 0) {
cat("Advertencia: La fecha final es anterior o igual a la fecha actual. Usando 1 año como horizonte de simulación.\n")
T <- 1
}## Advertencia: La fecha final es anterior o igual a la fecha actual. Usando 1 año como horizonte de simulación.# Parámetros de simulación
n_simulations <- 1000
dt <- 1/252 # Paso diario (252 días de trading por año)# Simular precios para cada activo
simulated_prices <- list()
for (i in 1:length(tickers)) {
ticker <- tickers[i]
S0 <- current_prices[ticker]
mu <- mean_ret[ticker] * 252 # Retorno anualizado
sig <- volatility[ticker]
simulated_prices[[ticker]] <- simulate_prices(
S0 = S0,
mu = mu,
sigma = sig,
T = T,
dt = dt,
n_sim = n_simulations
)
}
# Calcular valor del portafolio simulado
n_steps <- nrow(simulated_prices[[1]])
portfolio_values_sim <- matrix(0, nrow = n_steps, ncol = n_simulations)
for (j in 1:n_simulations) {
for (i in 1:n_steps) {
portfolio_value <- 0
for (k in 1:length(tickers)) {
ticker <- tickers[k]
portfolio_value <- portfolio_value +
investment_per_asset[k] * simulated_prices[[ticker]][i, j] / current_prices[ticker]
}
portfolio_values_sim[i, j] <- portfolio_value
}
}
# Calcular estadísticas del portafolio
# Retornos esperados
expected_return <- mean(portfolio_values_sim[n_steps, ]) / investment - 1
print(paste("Rendimiento esperado del portafolio:", round(expected_return * 100, 2), "%"))## [1] "Rendimiento esperado del portafolio: 84.15 %"# Volatilidad del portafolio
portfolio_volatility <- sd(portfolio_values_sim[n_steps, ]) / investment
print(paste("Volatilidad del portafolio:", round(portfolio_volatility * 100, 2), "%"))## [1] "Volatilidad del portafolio: 104.14 %"# VaR al 1% y 5%
VaR_1pct <- quantile(portfolio_values_sim[n_steps, ] - investment, 0.01)
VaR_5pct <- quantile(portfolio_values_sim[n_steps, ] - investment, 0.05)
print(paste("VaR al 1%:", round(VaR_1pct, 2)))## [1] "VaR al 1%: -464822.35"print(paste("VaR al 5%:", round(VaR_5pct, 2)))## [1] "VaR al 5%: -321940.66"# Índice de Sharpe
sharpe <- (expected_return - rf_rate) / portfolio_volatility
print(paste("Índice de Sharpe del portafolio:", round(sharpe, 4)))## [1] "Índice de Sharpe del portafolio: 0.76"### 4.1 Trayectorias de simulación
# Extraemos solo algunas simulaciones para claridad
sample_indices <- sample(1:n_simulations, 50)
portfolio_data <- data.frame()
for (i in sample_indices) {
temp_df <- data.frame(
Tiempo = 1:nrow(portfolio_values_sim),
Valor = portfolio_values_sim[, i],
Simulacion = as.factor(i)
)
portfolio_data <- rbind(portfolio_data, temp_df)
}
# Añadir el valor promedio
avg_values <- rowMeans(portfolio_values_sim)
avg_df <- data.frame(
Tiempo = 1:length(avg_values),
Valor = avg_values,
Simulacion = "Promedio"
)
portfolio_data <- rbind(portfolio_data, avg_df)
# Gráfico de simulación
portfolio_plot <- ggplot(portfolio_data, aes(x = Tiempo, y = Valor, group = Simulacion)) +
geom_line(alpha = 0.2) +
geom_line(data = subset(portfolio_data, Simulacion == "Promedio"),
aes(x = Tiempo, y = Valor),
color = "red", size = 1) +
geom_hline(yintercept = investment, linetype = "dashed", color = "green") +
labs(
title = "Simulación del Valor del Portafolio",
x = "Tiempo (días)",
y = "Valor del Portafolio ($)"
) +
theme_minimal() +
scale_y_continuous(labels = scales::dollar)
print(portfolio_plot)
### 4.2 Distribución de valores finales
# Distribución de valores finales
final_values <- portfolio_values_sim[nrow(portfolio_values_sim), ]
values_df <- data.frame(Valor = final_values)
dist_plot <- ggplot(values_df, aes(x = Valor)) +
geom_histogram(bins = 30, fill = "skyblue", color = "white") +
geom_vline(xintercept = investment, color = "green", linetype = "dashed") +
geom_vline(xintercept = investment + VaR_1pct, color = "red", linetype = "dashed") +
geom_vline(xintercept = investment + VaR_5pct, color = "orange", linetype = "dashed") +
annotate("text", x = investment, y = max(hist(final_values, plot = FALSE)$counts) * 0.9,
label = "Inversión Inicial", color = "green", hjust = -0.1) +
annotate("text", x = investment + VaR_1pct, y = max(hist(final_values, plot = FALSE)$counts) * 0.8,
label = "VaR 1%", color = "red", hjust = -0.1) +
annotate("text", x = investment + VaR_5pct, y = max(hist(final_values, plot = FALSE)$counts) * 0.7,
label = "VaR 5%", color = "orange", hjust = -0.1) +
labs(
title = "Distribución de Valores Finales del Portafolio",
x = "Valor Final ($)",
y = "Frecuencia"
) +
scale_x_continuous(labels = scales::dollar) +
theme_minimal()
print(dist_plot)
## 5. Análisis de tendencia para identificar acciones en caída
# Analizar tendencia de las acciones para identificar las que están en caída
analizar_tendencia <- function(price_data, tickers, periodo=30) {
tendencias <- numeric(length(tickers))
names(tendencias) <- tickers
for (i in 1:length(tickers)) {
ticker <- tickers[i]
# Filtrar datos del ticker específico
ticker_data <- price_data[price_data$symbol == ticker, ]
# Asegurarse de que hay suficientes datos
if (nrow(ticker_data) >= periodo) {
# Obtener los últimos precios disponibles
ultimos_precios <- tail(ticker_data$adjusted, periodo)
# Calcular el retorno en el periodo
retorno_periodo <- (ultimos_precios[length(ultimos_precios)] / ultimos_precios[1]) - 1
tendencias[i] <- retorno_periodo
} else {
# Si no hay suficientes datos, asignar un valor neutral
tendencias[i] <- 0
warning(paste("No hay suficientes datos para calcular la tendencia de", ticker))
}
}
return(tendencias)
}
# Calcular tendencias
tendencias <- tryCatch({
analizar_tendencia(price_data, tickers)
}, error = function(e) {
# Si hay error, usamos la acción con menor peso como alternativa
cat("Error al calcular tendencias:", e$message, "\n")
cat("Usando la acción con menor peso como alternativa.\n")
temp <- numeric(length(tickers))
names(temp) <- tickers
temp[min_weight_ticker] <- -0.1 # Simulamos una caída
return(temp)
})
print("Tendencias recientes de las acciones:")## [1] "Tendencias recientes de las acciones:"print(round(tendencias * 100, 2))## APH MU NVDA
## -11.75 -32.08 -27.60# Identificar la acción con mayor caída
accion_caida <- names(which.min(tendencias))
print(paste("La acción con mayor caída es:", accion_caida))## [1] "La acción con mayor caída es: MU"## 6. Modelo binomial para valoración de opciones
# Implementación del modelo binomial
binomial_tree <- function(S, K, r, q, sigma, T, n, type, american = TRUE) {
dt <- T/n
u <- exp(sigma * sqrt(dt))
d <- 1/u
p <- (exp((r - q) * dt) - d) / (u - d) # Probabilidad neutral al riesgo
# Crear matriz de precios
prices <- matrix(0, n + 1, n + 1)
for (i in 0:n) {
for (j in 0:i) {
prices[j + 1, i + 1] <- S * u^(i - j) * d^j
}
}
# Crear matriz para valores de la opción
option_values <- matrix(0, n + 1, n + 1)
# Calcular payoff al vencimiento
if (type == "call") {
option_values[, n + 1] <- pmax(prices[, n + 1] - K, 0)
} else { # put
option_values[, n + 1] <- pmax(K - prices[, n + 1], 0)
}
# Retroceder en el árbol
for (j in seq(n, 1, -1)) {
for (i in 1:j) {
# Valor si mantenemos la opción
hold_value <- exp(-r * dt) * (p * option_values[i, j + 1] + (1 - p) * option_values[i + 1, j + 1])
# Valor si ejercemos la opción (solo para americana)
if (american) {
if (type == "call") {
exercise_value <- pmax(prices[i, j] - K, 0)
} else { # put
exercise_value <- pmax(K - prices[i, j], 0)
}
# Elegimos el mayor valor
option_values[i, j] <- max(hold_value, exercise_value)
} else {
option_values[i, j] <- hold_value
}
}
}
# Creamos un dataframe para visualización
tree_data <- data.frame()
for (i in 1:(n+1)) {
for (j in 1:i) {
if (!is.na(prices[j, i]) && !is.na(option_values[j, i])) {
tree_data <- rbind(tree_data, data.frame(
step = i - 1,
node = j - 1,
price = prices[j, i],
option_value = option_values[j, i]
))
}
}
}
return(list(
option_price = option_values[1, 1],
tree = tree_data,
prices = prices,
values = option_values
))
}# Parámetros para valoración de opciones
# Usamos la acción con mayor caída
S0 <- current_prices[accion_caida] # Precio spot actual
K <- S0 # Strike price (ATM)
r <- rf_rate # Tasa libre de riesgo
q <- 0.01 # Tasa de dividendos (ajustar según la acción)
vol <- volatility[accion_caida] # Volatilidad anualizada
# Crear árboles binomiales con menos pasos para visualización
vis_steps <- 8 # Usar 8 pasos para representar los trimestres en 2 años
# Tiempo hasta vencimiento (2 años)
T_expiry <- 2
# Crear árboles binomiales solo para opción put (ya que estamos en un mercado bajista)
euro_put <- binomial_tree(S0, K, r, q, vol, T_expiry, vis_steps, "put", american = FALSE)
amer_put <- binomial_tree(S0, K, r, q, vol, T_expiry, vis_steps, "put", american = TRUE)
# Precios de las opciones put
option_prices <- data.frame(
Tipo = c("Put Europea", "Put Americana"),
Precio = c(euro_put$option_price, amer_put$option_price)
)
print("Precios de opciones put para la acción en caída:")## [1] "Precios de opciones put para la acción en caída:"print(option_prices)## Tipo Precio
## 1 Put Europea 13.33513
## 2 Put Americana 14.29094### 6.1 Visualización de árboles binomiales
# Función para visualizar el árbol binomial
visualize_binomial_tree <- function(tree_result, title) {
# Extraer los datos del árbol
prices <- tree_result$prices
values <- tree_result$values
n <- nrow(prices) - 1 # Número de pasos
# Crear dataframe para graficar
nodes <- data.frame()
for (i in 0:n) {
for (j in 0:i) {
if (i <= n && j <= i) {
nodes <- rbind(nodes, data.frame(
step = i,
node = j,
price = prices[j+1, i+1],
option_value = values[j+1, i+1]
))
}
}
}
# Crear gráfico básico
p <- ggplot(nodes, aes(x = step, y = node)) +
geom_point(aes(size = option_value, color = price), alpha = 0.8) +
scale_color_gradient(low = "blue", high = "red") +
ggtitle(title) +
xlab("Paso (Trimestre)") +
ylab("Nodo") +
theme_minimal()
# Añadir etiquetas de precios
for (i in 1:nrow(nodes)) {
p <- p + annotate(
"text",
x = nodes$step[i],
y = nodes$node[i] + 0.2,
label = sprintf("%.1f", nodes$price[i]),
size = 3
)
}
# Añadir etiquetas de valores de opción
for (i in 1:nrow(nodes)) {
p <- p + annotate(
"text",
x = nodes$step[i],
y = nodes$node[i] - 0.2,
label = sprintf("(%.1f)", nodes$option_value[i]),
size = 3,
color = "darkred"
)
}
return(p)
}print_binomial_tree <- function(tree_result, title) {
# Extraer precios y valores
prices <- tree_result$prices
values <- tree_result$values
cat("\n", title, "\n\n")
cat("Árbol de precios:\n")
print(round(prices, 2))
cat("\nÁrbol de valores de opción:\n")
print(round(values, 2))
cat("\nPrecio de la opción:", round(tree_result$option_price, 4), "\n\n")
}
# Usar así:
print_binomial_tree(euro_put, paste("Opción Put Europea para", accion_caida))##
## Opción Put Europea para MU
##
## Árbol de precios:
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
## [1,] 64.72 82.22 104.45 132.69 168.57 214.15 272.06 345.62 439.08
## [2,] 0.00 50.94 64.72 82.22 104.45 132.69 168.57 214.15 272.06
## [3,] 0.00 0.00 40.10 50.94 64.72 82.22 104.45 132.69 168.57
## [4,] 0.00 0.00 0.00 31.57 40.10 50.94 64.72 82.22 104.45
## [5,] 0.00 0.00 0.00 0.00 24.85 31.57 40.10 50.94 64.72
## [6,] 0.00 0.00 0.00 0.00 0.00 19.56 24.85 31.57 40.10
## [7,] 0.00 0.00 0.00 0.00 0.00 0.00 15.40 19.56 24.85
## [8,] 0.00 0.00 0.00 0.00 0.00 0.00 0.00 12.12 15.40
## [9,] 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 9.54
##
## Árbol de valores de opción:
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
## [1,] 13.34 8.05 3.77 1.05 0.00 0.00 0.00 0.00 0.00
## [2,] 0.00 18.17 11.91 6.19 1.97 0.00 0.00 0.00 0.00
## [3,] 0.00 0.00 23.95 17.07 9.95 3.71 0.00 0.00 0.00
## [4,] 0.00 0.00 0.00 30.40 23.57 15.53 6.97 0.00 0.00
## [5,] 0.00 0.00 0.00 0.00 36.96 31.01 23.22 13.10 0.00
## [6,] 0.00 0.00 0.00 0.00 0.00 42.92 38.40 32.43 24.62
## [7,] 0.00 0.00 0.00 0.00 0.00 0.00 47.80 44.41 39.87
## [8,] 0.00 0.00 0.00 0.00 0.00 0.00 0.00 51.83 49.32
## [9,] 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 55.18
##
## Precio de la opción: 13.3351print_binomial_tree(amer_put, paste("Opción Put Americana para", accion_caida))##
## Opción Put Americana para MU
##
## Árbol de precios:
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
## [1,] 64.72 82.22 104.45 132.69 168.57 214.15 272.06 345.62 439.08
## [2,] 0.00 50.94 64.72 82.22 104.45 132.69 168.57 214.15 272.06
## [3,] 0.00 0.00 40.10 50.94 64.72 82.22 104.45 132.69 168.57
## [4,] 0.00 0.00 0.00 31.57 40.10 50.94 64.72 82.22 104.45
## [5,] 0.00 0.00 0.00 0.00 24.85 31.57 40.10 50.94 64.72
## [6,] 0.00 0.00 0.00 0.00 0.00 19.56 24.85 31.57 40.10
## [7,] 0.00 0.00 0.00 0.00 0.00 0.00 15.40 19.56 24.85
## [8,] 0.00 0.00 0.00 0.00 0.00 0.00 0.00 12.12 15.40
## [9,] 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 9.54
##
## Árbol de valores de opción:
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
## [1,] 14.29 8.54 3.98 1.10 0.00 0.00 0.00 0.00 0.00
## [2,] 0.00 19.55 12.64 6.54 2.07 0.00 0.00 0.00 0.00
## [3,] 0.00 0.00 25.91 18.16 10.52 3.90 0.00 0.00 0.00
## [4,] 0.00 0.00 0.00 33.15 25.13 16.44 7.33 0.00 0.00
## [5,] 0.00 0.00 0.00 0.00 39.87 33.15 24.62 13.78 0.00
## [6,] 0.00 0.00 0.00 0.00 0.00 45.16 39.87 33.15 24.62
## [7,] 0.00 0.00 0.00 0.00 0.00 0.00 49.32 45.16 39.87
## [8,] 0.00 0.00 0.00 0.00 0.00 0.00 0.00 52.60 49.32
## [9,] 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 55.18
##
## Precio de la opción: 14.2909# Datos para la opción put Europea de MU
precio_euro_put_MU <- matrix(
c(64.72, 82.22, 104.45, 132.69, 168.57, 214.15, 272.06, 345.62, 439.08,
0.00, 50.94, 64.72, 82.22, 104.45, 132.69, 168.57, 214.15, 272.06,
0.00, 0.00, 40.10, 50.94, 64.72, 82.22, 104.45, 132.69, 168.57,
0.00, 0.00, 0.00, 31.57, 40.10, 50.94, 64.72, 82.22, 104.45,
0.00, 0.00, 0.00, 0.00, 24.85, 31.57, 40.10, 50.94, 64.72,
0.00, 0.00, 0.00, 0.00, 0.00, 19.56, 24.85, 31.57, 40.10,
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 15.40, 19.56, 24.85,
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 12.12, 15.40,
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 9.54),
nrow = 9, byrow = TRUE
)
valor_euro_put_MU <- matrix(
c(13.34, 8.05, 3.77, 1.05, 0.00, 0.00, 0.00, 0.00, 0.00,
0.00, 18.17, 11.91, 6.19, 1.97, 0.00, 0.00, 0.00, 0.00,
0.00, 0.00, 23.95, 17.07, 9.95, 3.71, 0.00, 0.00, 0.00,
0.00, 0.00, 0.00, 30.40, 23.57, 15.53, 6.97, 0.00, 0.00,
0.00, 0.00, 0.00, 0.00, 36.96, 31.01, 23.22, 13.10, 0.00,
0.00, 0.00, 0.00, 0.00, 0.00, 42.92, 38.40, 32.43, 24.62,
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 47.80, 44.41, 39.87,
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 51.83, 49.32,
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 55.18),
nrow = 9, byrow = TRUE
)
# Datos para la opción put Americana de MU
precio_amer_put_MU <- matrix(
c(64.72, 82.22, 104.45, 132.69, 168.57, 214.15, 272.06, 345.62, 439.08,
0.00, 50.94, 64.72, 82.22, 104.45, 132.69, 168.57, 214.15, 272.06,
0.00, 0.00, 40.10, 50.94, 64.72, 82.22, 104.45, 132.69, 168.57,
0.00, 0.00, 0.00, 31.57, 40.10, 50.94, 64.72, 82.22, 104.45,
0.00, 0.00, 0.00, 0.00, 24.85, 31.57, 40.10, 50.94, 64.72,
0.00, 0.00, 0.00, 0.00, 0.00, 19.56, 24.85, 31.57, 40.10,
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 15.40, 19.56, 24.85,
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 12.12, 15.40,
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 9.54),
nrow = 9, byrow = TRUE
)
valor_amer_put_MU <- matrix(
c(14.29, 8.54, 3.98, 1.10, 0.00, 0.00, 0.00, 0.00, 0.00,
0.00, 19.55, 12.64, 6.54, 2.07, 0.00, 0.00, 0.00, 0.00,
0.00, 0.00, 25.91, 18.16, 10.52, 3.90, 0.00, 0.00, 0.00,
0.00, 0.00, 0.00, 33.15, 25.13, 16.44, 7.33, 0.00, 0.00,
0.00, 0.00, 0.00, 0.00, 39.87, 33.15, 24.62, 13.78, 0.00,
0.00, 0.00, 0.00, 0.00, 0.00, 45.16, 39.87, 33.15, 24.62,
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 49.32, 45.16, 39.87,
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 52.60, 49.32,
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 55.18),
nrow = 9, byrow = TRUE
)
# Función simplificada para visualizar árbol binomial
plot_simple_tree <- function(prices, values, title) {
# Dimensiones
n_rows <- nrow(prices)
n_cols <- ncol(prices)
# Crear un gráfico vacío
plot(0, 0, type = "n",
xlim = c(0, n_cols-1), ylim = c(-(n_rows-1), 0),
xlab = "Trimestre", ylab = "Nivel",
main = title)
# Dibujar cada nodo
for(i in 1:n_rows) {
for(j in 1:n_cols) {
if(prices[i, j] > 0) {
# Coordenadas
x <- j-1
y <- -(i-1)
# Cambio porcentual desde el precio inicial
change_pct <- (prices[i, j] / prices[1, 1] - 1) * 100
# Determinar color basado en el cambio porcentual
if(change_pct > 0) {
node_color <- rgb(0, 0.8, 0, alpha = 0.7) # Verde para subidas
} else if(change_pct < 0) {
node_color <- rgb(0.8, 0, 0, alpha = 0.7) # Rojo para bajadas
} else {
node_color <- rgb(0.8, 0.8, 0, alpha = 0.7) # Amarillo para sin cambio
}
# Tamaño basado en el valor de la opción (si existe)
point_size <- 1
if(!is.na(values[i, j]) && values[i, j] > 0) {
# Escalar tamaño entre 1 y 3 según el valor
max_val <- max(values[values > 0], na.rm = TRUE)
point_size <- 1 + 2 * (values[i, j] / max_val)
}
# Dibujar el nodo
points(x, y, pch = 16, col = node_color, cex = point_size)
# Añadir texto con precio y valor de la opción
if(!is.na(values[i, j])) {
text(x, y + 0.2, sprintf("%.0f", prices[i, j]), cex = 0.8)
text(x, y - 0.2, sprintf("(%.1f)", values[i, j]), cex = 0.8, col = "blue")
} else {
text(x, y, sprintf("%.0f", prices[i, j]), cex = 0.8)
}
# Conectar con líneas a los nodos hijos (si existen)
if(j < n_cols) {
if(i < n_rows && prices[i+1, j+1] > 0) {
lines(c(x, x+1), c(y, y-1), col = "gray")
}
if(prices[i, j+1] > 0) {
lines(c(x, x+1), c(y, y), col = "gray")
}
}
}
}
}
# Añadir información
legend_x <- n_cols * 0.05
legend_y <- -n_rows * 0.9
legend_text <- sprintf(
"Precio Inicial: $%.2f\nValor de la Opción: $%.2f",
prices[1, 1], values[1, 1]
)
text(legend_x, legend_y, legend_text, adj = c(0, 0), cex = 0.8)
# Leyenda de colores
legend(n_cols * 0.6, legend_y,
legend = c("Subida", "Sin cambio", "Bajada"),
col = c(rgb(0, 0.8, 0, alpha = 0.7),
rgb(0.8, 0.8, 0, alpha = 0.7),
rgb(0.8, 0, 0, alpha = 0.7)),
pch = 16, pt.cex = 1.5, cex = 0.8, horiz = TRUE)
}
# Usar la función con los datos de la opción put Europea
plot_simple_tree(
precio_euro_put_MU,
valor_euro_put_MU,
"Árbol Binomial: Opción Put Europea para MU"
)
# Usar la función con los datos de la opción put Americana
plot_simple_tree(
precio_amer_put_MU,
valor_amer_put_MU,
"Árbol Binomial: Opción Put Americana para MU"
)
El portafolio está concentrado en NVIDIA (93.36%), con pequeñas
participaciones en APH (6.05%) y MU (0.58%), lo que representa un alto
riesgo de concentración. El rendimiento esperado es del 84.15%, pero con
una volatilidad de 104.14%, lo que indica un riesgo extremo. Las caídas
recientes de las acciones justifican la estrategia de cobertura. Se
implementó una cobertura con opciones put para MU, aunque MU representa
solo el 0.58% del portafolio. Las opciones put europeas y americanas
tienen una pequeña diferencia de precio, lo que sugiere la posibilidad
de usar una estrategia mixta. Recomendaciones Estratégicas: diversificar
el portafolio para reducir el riesgo de concentración, ampliar la
cobertura a NVIDIA, que también ha tenido una caída significativa,
implementar un programa de rolling de opciones trimestral y monitorear
las correlaciones entre activos. El portafolio está optimizado para el
rendimiento, pero su alta concentración aumenta el riesgo. La estrategia
de cobertura es adecuada, pero debe extenderse a NVIDIA y mejorar con
opciones mixtas. Las visualizaciones adicionales ayudarían a evaluar
mejor el impacto de la cobertura.