Practica de Opciones y Árboles Binomiales

Descarga de paquetes necesarios

library(tidyquant)

## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo

## ── Attaching core tidyquant packages ─────────────────────── tidyquant 1.0.11 ──
## ✔ PerformanceAnalytics 2.0.8      ✔ TTR                  0.24.4
## ✔ quantmod             0.4.27     ✔ xts                  0.13.2
## ── Conflicts ────────────────────────────────────────── tidyquant_conflicts() ──
## ✖ zoo::as.Date()                 masks base::as.Date()
## ✖ zoo::as.Date.numeric()         masks base::as.Date.numeric()
## ✖ PerformanceAnalytics::legend() masks graphics::legend()
## ✖ quantmod::summary()            masks base::summary()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(plotly)

## Loading required package: ggplot2
## 
## Attaching package: 'plotly'
## 
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## 
## The following object is masked from 'package:stats':
## 
##     filter
## 
## The following object is masked from 'package:graphics':
## 
##     layout

library(timetk)

## 
## Attaching package: 'timetk'
## 
## The following object is masked from 'package:tidyquant':
## 
##     FANG

library(tidyverse)

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ lubridate 1.9.3     ✔ tibble    3.2.1
## ✔ purrr     1.0.2     ✔ tidyr     1.3.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks plotly::filter(), stats::filter()
## ✖ dplyr::first()  masks xts::first()
## ✖ dplyr::lag()    masks stats::lag()
## ✖ dplyr::last()   masks xts::last()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(lubridate)
library(RQuantLib)  # Para valoración avanzada de opciones
library(ggplot2)
library(plotly)

Optimización del portafolio

Se descargan los datos de los precios de las acciones que cotizan en bolsa y van a la baja: CORT (Corcept Therapeutics Incorporated),MLGO (MicroAlgo Inc),NCNO (nCino, Inc)

# Tickers a analizar
tick <- c('CORT', 'MLGO', 'NCNO')

# Descargar datos históricos
price_data <- tq_get(tick,
                     from = '2022-06-01',
                     to = '2025-03-31',
                     get = 'stock.prices')

# Parámetros generales
inversion_total <- 1000000     # Inversión total (USD)
periodo_inversion <- 2         # Años
fecha_inicio <- as.Date("2025-04-01")
fecha_fin <- fecha_inicio + years(periodo_inversion)

# Calcular rendimientos 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 ancho (matriz)
log_ret_xts <- log_ret_tidy %>%
  spread(symbol, value = ret) %>%
  tk_xts()

## Warning: Non-numeric columns being dropped: date

## Using column `date` for date_var.

# Calcular estadísticas básicas de los rendimientos
mean_ret <- colMeans(log_ret_xts)
vol_diaria <- apply(log_ret_xts, 2, sd)
vol_anual <- vol_diaria * sqrt(252)
cor_matrix <- cor(log_ret_xts)
cov_mat <- cov(log_ret_xts) * 252

# Mostrar resultados
cat("Rendimientos medios diarios:\n")

## Rendimientos medios diarios:

print(round(mean_ret, 5))

##     CORT     MLGO     NCNO 
##  0.00137 -0.00673 -0.00014

cat("\nVolatilidad anualizada:\n")

## 
## Volatilidad anualizada:

print(round(vol_anual, 4))

##   CORT   MLGO   NCNO 
## 0.4900 2.9589 0.5014

cat("\nMatriz de correlación:\n")

## 
## Matriz de correlación:

print(round(cor_matrix, 4))

##        CORT   MLGO   NCNO
## CORT 1.0000 0.0207 0.1990
## MLGO 0.0207 1.0000 0.0316
## NCNO 0.1990 0.0316 1.0000

# Tasa libre de riesgo (bono del tesoro a 10 años)
Rf <- 0.0107 #Tasa trimestral
Rf_anual <- 0.0433

# Crear portafolios aleatorios
set.seed(42)
num_port <- 5000
all_wts <- matrix(nrow = num_port, ncol = length(tick))
port_returns <- vector('numeric', length = num_port)
port_risk <- vector('numeric', length = num_port)
sharpe_ratio <- vector('numeric', length = num_port)

for (i in 1:num_port) {
  wts <- runif(length(tick))
  wts <- wts/sum(wts)
  all_wts[i,] <- wts
  
  # Rendimiento anualizado
  port_ret <- sum(wts * mean_ret)
  port_ret <- ((port_ret + 1)^252) - 1
  port_returns[i] <- port_ret
  
  # Riesgo anualizado
  port_sd <- sqrt(t(wts) %*% (cov_mat %*% wts))
  port_risk[i] <- port_sd
  
  # Ratio de Sharpe
  sr <- (port_ret - Rf)/port_sd
  sharpe_ratio[i] <- sr
}

# Organizar resultados
portfolio_values <- tibble(
  Return = port_returns,
  Risk = port_risk,
  SharpeRatio = sharpe_ratio
)

# Añadir ponderaciones
all_wts_df <- as_tibble(all_wts)

## Warning: The `x` argument of `as_tibble.matrix()` must have unique column names if
## `.name_repair` is omitted as of tibble 2.0.0.
## ℹ Using compatibility `.name_repair`.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

colnames(all_wts_df) <- tick
portfolio_values <- bind_cols(all_wts_df, portfolio_values)

# Identificar portafolios clave
min_var <- portfolio_values[which.min(portfolio_values$Risk),]
max_sharpe <- portfolio_values[which.max(portfolio_values$SharpeRatio),]

# Mostrar resultados del portafolio óptimo (máximo Sharpe)
cat("Portafolio de máximo Sharpe:\n")

## Portafolio de máximo Sharpe:

cat("Rendimiento anualizado:", round(max_sharpe$Return * 100, 2), "%\n")

## Rendimiento anualizado: 35.79 %

cat("Riesgo anualizado:", round(max_sharpe$Risk * 100, 2), "%\n")

## Riesgo anualizado: 45.48 %

cat("Ratio de Sharpe:", round(max_sharpe$SharpeRatio, 4), "\n")

## Ratio de Sharpe: 0.7634

cat("Ponderaciones:\n")

## Ponderaciones:

print(round(max_sharpe[, tick] * 100, 2))

##    CORT MLGO NCNO
## 1 90.36 0.09 9.56

# Guardar ponderaciones óptimas para uso posterior
optimal_weights <- as.numeric(max_sharpe[, tick])
names(optimal_weights) <- tick

Frontera Eficiente

# Crear gráfico de la frontera eficiente
frontier_plot <- portfolio_values %>%
  ggplot(aes(x = Risk, y = Return, color = SharpeRatio)) +
  geom_point(alpha = 0.3) +
  geom_point(data = min_var, aes(x = Risk, y = Return), color = "red", size = 3) +
  geom_point(data = max_sharpe, aes(x = Risk, y = Return), color = "blue", size = 3) +
  theme_minimal() +
  labs(
    title = "Frontera Eficiente",
    x = "Riesgo Anualizado",
    y = "Rendimiento Anualizado",
    color = "Ratio de Sharpe"
  ) +
  scale_x_continuous(labels = scales::percent) +
  scale_y_continuous(labels = scales::percent) +
  annotate("text", x = min_var$Risk + 0.01, y = min_var$Return, 
           label = "Min. Varianza", hjust = 0) +
  annotate("text", x = max_sharpe$Risk + 0.01, y = max_sharpe$Return, 
           label = "Max. Sharpe", hjust = 0)

ggplotly(frontier_plot)

# Visualizar ponderaciones del portafolio óptimo
weights_plot <- max_sharpe %>%
  select(all_of(tick)) %>%
  pivot_longer(cols = everything(), names_to = "Asset", values_to = "Weight") %>%
  ggplot(aes(x = Asset, y = Weight, fill = Asset)) +
  geom_col() +
  theme_minimal() +
  labs(title = "Ponderaciones del Portafolio Óptimo") +
  scale_y_continuous(labels = scales::percent)

ggplotly(weights_plot)

# Obtener últimos precios
last_prices <- price_data %>%
  group_by(symbol) %>%
  filter(date == max(date)) %>%
  select(symbol, adjusted)

# Calcular inversión por activo
portfolio_investment <- tibble(
  Asset = tick,
  Weight = optimal_weights,
  Amount_USD = Weight * inversion_total
) %>%
  left_join(last_prices, by = c("Asset" = "symbol")) %>%
  rename(Price = adjusted) %>%
  mutate(Shares = floor(Amount_USD / Price),
         Value = Shares * Price,
         Actual_Weight = Value / sum(Value))

# Mostrar detalles de la inversión
cat("Detalles de la inversión en el portafolio óptimo:\n")

## Detalles de la inversión en el portafolio óptimo:

print(portfolio_investment)

## # A tibble: 3 × 7
##   Asset   Weight Amount_USD Price Shares   Value Actual_Weight
##   <chr>    <dbl>      <dbl> <dbl>  <dbl>   <dbl>         <dbl>
## 1 CORT  0.904       903556.  54.6  16539 903526.      0.904   
## 2 MLGO  0.000867       867.  17.4     49    850.      0.000850
## 3 NCNO  0.0956       95577.  28.9   3304  95552.      0.0956

Análisis de rendimientos y optimización del portafolio En esta sección, se analizan tres acciones. Los resultados muestran:

- Rendimientos medios diarios: Valores relativamente pequeños, como es típico para rendimientos diarios. - Volatilidad anualizada: Indica la cantidad de riesgo de cada activo, posiblemente con MLGO mostrando la mayor volatilidad. - Matriz de correlación: Muestra las relaciones entre los activos, lo que es crucial para entender cómo se diversifica el riesgo.

Se evidencia una alta concentración en CORT (90.36%) indica que este activo domina el comportamiento del portafolio. Esta concentración tan elevada representa un riesgo significativo de concentración, aunque está justificada por los siguientes factores: - CORT muestra el único rendimiento medio diario positivo (0.00137). - Posee la menor volatilidad anualizada (0.49) entre los tres activos. - Estas características le confieren la mejor relación riesgo-rendimiento.

Interpretación de la frontera eficiente El gráfico de la frontera eficiente ilustra todas las combinaciones posibles de los tres activos:

- Puntos azules (Máximo Sharpe): Representa el portafolio con la mejor relación rendimiento/riesgo. - Puntos rojos (Mínima Varianza): Identifica el portafolio con el menor nivel de riesgo posible. - Nube de puntos: Cada punto representa un portafolio diferente con distintas ponderaciones.

El portafolio muestra un rendimiento anualizado muy atractivo (35.79%), significativamente superior al rendimiento que podría esperarse de índices bursátiles tradicionales. Sin embargo, esto viene acompañado de un nivel de riesgo considerable (45.48%), lo que sugiere que el portafolio podría experimentar fluctuaciones importantes. El ratio de Sharpe de 0.7634 indica un rendimiento ajustado al riesgo moderadamente bueno.

Simulación con MGB

# Parámetros de la simulación
n_dias_total <- 504      # 2 años (días de trading)
n_sim <- 5000            # Número de simulaciones
n_trimestres <- 8        # 8 trimestres (2 años)
dias_por_trimestre <- 63 # Aproximadamente un trimestre en días de trading

# Función para simular el Movimiento Browniano Geométrico
simulate_gbm <- function(S0, mu, sigma, T, n_steps, n_sims) {
  dt <- T/n_steps
  S <- matrix(0, nrow = n_steps + 1, ncol = n_sims)
  S[1,] <- S0
  
  for (i in 1:n_steps) {
    Z <- rnorm(n_sims)
    S[i+1,] <- S[i,] * exp((mu - 0.5 * sigma^2) * dt + sigma * sqrt(dt) * Z)
  }
  return(S)
}

# Obtener volatilidades por activo
volatilidades <- sqrt(diag(cov_mat))

# Simular precios para cada activo
simulations <- list()
for (ticker in tick) {
  S0 <- last_prices$adjusted[last_prices$symbol == ticker]
  mu <- mean_ret[ticker] * 252  # Rendimiento anualizado
  sigma <- volatilidades[ticker]  # Volatilidad anualizada
  
  # Simular precios para 2 años
  sim_prices <- simulate_gbm(S0, mu, sigma, 2, n_dias_total, n_sim)
  simulations[[ticker]] <- sim_prices
}

# Extraer precios por trimestre (para cada activo)
precios_trimestrales <- list()
for (ticker in tick) {
  trim_prices <- matrix(0, nrow = n_trimestres, ncol = n_sim)
  for (i in 1:n_trimestres) {
    trim_prices[i,] <- simulations[[ticker]][i * dias_por_trimestre + 1,]
  }
  precios_trimestrales[[ticker]] <- trim_prices
}

# Calcular precios esperados por trimestre
precios_esperados <- data.frame(Trimestre = 1:n_trimestres)
for (ticker in tick) {
  precios_esperados[[ticker]] <- rowMeans(precios_trimestrales[[ticker]])
}
# Mostrar precios esperados
cat("Precios esperados por trimestre:\n")

## Precios esperados por trimestre:

print(precios_esperados)

##   Trimestre      CORT       MLGO     NCNO
## 1         1  59.38878 11.4939805 28.74534
## 2         2  65.14149  7.9094885 28.48732
## 3         3  71.00573  4.9179208 28.14275
## 4         4  77.43253  5.3601357 27.88303
## 5         5  83.80217  3.4278173 27.67442
## 6         6  91.41205  2.4485119 27.26033
## 7         7  99.96752  0.7955457 27.33129
## 8         8 108.46506  0.5014861 27.12043

## Calcular estadísticas para cada activo en cada trimestre
quarterly_stats <- tibble()

for (asset in tick) {
  for (q in 1:n_trimestres) {
    price_dist <- precios_trimestrales[[asset]][q, ]
    
    quarterly_stats <- bind_rows(
      quarterly_stats,
      tibble(
        Asset = asset,
        Quarter = q,
        Mean_Price = mean(price_dist),
        Median_Price = median(price_dist),
        StdDev = sd(price_dist),
        CI_Lower = quantile(price_dist, 0.025),
        CI_Upper = quantile(price_dist, 0.975)
      )
    )
  }
}

# Mostrar precios esperados
cat("Precios esperados por trimestre:\n")

## Precios esperados por trimestre:

print(quarterly_stats)

## # A tibble: 24 × 7
##    Asset Quarter Mean_Price Median_Price StdDev CI_Lower CI_Upper
##    <chr>   <int>      <dbl>        <dbl>  <dbl>    <dbl>    <dbl>
##  1 CORT        1      59.4        57.7     15.0  35.2        93.4
##  2 CORT        2      65.1        61.0     23.8  30.6       121. 
##  3 CORT        3      71.0        65.0     32.1  28.4       149. 
##  4 CORT        4      77.4        68.5     40.6  25.6       179. 
##  5 CORT        5      83.8        72.0     49.0  24.6       212. 
##  6 CORT        6      91.4        76.5     60.0  23.3       245. 
##  7 CORT        7     100.         82.1     70.9  22.3       285. 
##  8 CORT        8     108.         86.1     82.8  22.4       324. 
##  9 MLGO        1      11.5         3.80    28.9   0.221      72.4
## 10 MLGO        2       7.91        0.865   49.1   0.0150     47.2
## # ℹ 14 more rows

# Visualizar precios esperados
quarterly_plot <- ggplot(quarterly_stats, aes(x = Quarter, y = Mean_Price, color = Asset)) +
  geom_line() +
  geom_point(size = 2) +
  geom_ribbon(aes(ymin = CI_Lower, ymax = CI_Upper, fill = Asset), alpha = 0.2) +
  theme_minimal() +
  labs(title = "Precios Esperados por Trimestre",
       x = "Trimestre",
       y = "Precio Esperado")

ggplotly(quarterly_plot)

# Número de simulaciones a graficar por acción 
n_plot <- 5000

# Crear una lista de data.frames con las simulaciones (formato largo) para ggplot
sim_data_list <- list()

for (ticker in tick) {
  sim_matrix <- simulations[[ticker]][, 1:n_plot]  # Seleccionar las primeras 50 simulaciones
  df <- as.data.frame(sim_matrix)
  df$Day <- 0:n_dias_total
  df_long <- pivot_longer(df, cols = -Day, names_to = "Simulacion", values_to = "Precio")
  df_long$Ticker <- ticker
  sim_data_list[[ticker]] <- df_long
}

# Unir todas las simulaciones en un solo data.frame
sim_data_all <- bind_rows(sim_data_list)

# Graficar trayectorias simuladas
ggplot(sim_data_all, aes(x = Day, y = Precio, group = Simulacion)) +
  geom_line(alpha = 0.2, color = "steelblue") +
  facet_wrap(~Ticker, scales = "free_y") +
  theme_minimal() +
  labs(title = "Simulaciones de precios por Movimiento Browniano Geométrico",
       subtitle = paste("Primeras", n_plot, "simulaciones de", n_sim, "totales"),
       x = "Días de trading",
       y = "Precio simulado")

Simulación de precios futuros con MGB Las simulaciones de Movimiento Browniano Geométrico muestran la distribución de posibles precios futuros:

• Los gráficos de trayectorias simuladas para cada acción muestran la dispersión que podemos esperar en los precios.
• La amplitud de las trayectorias refleja la volatilidad de cada activo.
• A medida que avanza el horizonte temporal, la distribución de precios se ensancha, ilustrando cómo la incertidumbre aumenta con el tiempo.

El gráfico de precios esperados por trimestre muestra:

• Las líneas centrales representan los precios medios esperados
• Las bandas sombreadas muestran los intervalos de confianza del 95%
• Las tendencias alcistas o bajistas reflejan el rendimiento esperado de cada activo.

Analizando los datos de la simulación MGB (Movimiento Browniano Geométrico) proporcionados para el portafolio, se observan patrones significativos en la evolución proyectada de los tres activos durante los 8 trimestres y las implicaciones para el portafolio:

CORT (90.36% del portafolio) - Tendencia: Alcista sostenida (de 59.35 a 111.55 en 2 años). - Rentabilidad: +87.95% acumulado (~37% anual). - Comportamiento: Crecimiento exponencial acelerado. - Consistencia: Coherente con su rendimiento diario positivo. - Implicación: Principal motor de rentabilidad (+79.47%).

MLGO (0.09% del portafolio) - Tendencia: Fuerte caída (de 11.60 a 0.38). - Rentabilidad: -96.73% acumulado. - Comportamiento:Colapso inicial, luego estabilización. - Consistencia: Refleja su rendimiento diario altamente negativo. - Implicación: Impacto marginal (-0.09%).

NCNO (9.56% del portafolio) - Tendencia: Leve descenso (de 28.58 a 25.77). - Rentabilidad: -9.83% acumulado. - Comportamiento: Declive moderado y estable. - Consistencia: En línea con su rendimiento diario levemente negativo. -Implicación: Contribución negativa moderada (-0.94%). Resultado neto proyectado:+78.44% en 2 años, cercano al rendimiento esperado por la optimización (≈84% compuesto).

Análisis del VaR

# Calcular VaR para activos individuales y portafolio
calculate_var_es <- function(returns, weights, alpha = c(0.01, 0.05)) {
  # VaR para activos individuales
  var_individual <- lapply(alpha, function(a) {
    apply(returns, 2, function(x) quantile(x, a))
  })
  names(var_individual) <- paste0("VaR_", alpha * 100, "%")
  
   # VaR para el portafolio
  portfolio_returns <- returns %*% weights
  var_portfolio <- sapply(alpha, function(a) quantile(portfolio_returns, a))
  names(var_portfolio) <- paste0("VaR_", alpha * 100, "%")
  
  return(list(
    var_individual = var_individual,
    var_portfolio = var_portfolio))
}
# Calcular métricas de riesgo
risk_metrics <- calculate_var_es(log_ret_xts, optimal_weights)
# Mostrar resultados en porcentaje
cat("VaR diario por activo (%):\n")

## VaR diario por activo (%):

print(round(risk_metrics$var_individual$`VaR_1%` * 100, 4))

##     CORT     MLGO     NCNO 
##  -7.4173 -33.1079  -8.1514

print(round(risk_metrics$var_individual$`VaR_5%` * 100, 4))

##     CORT     MLGO     NCNO 
##  -3.8221 -16.6666  -5.1407

cat("\nVaR diario del portafolio (%):\n")

## 
## VaR diario del portafolio (%):

print(round(risk_metrics$var_portfolio * 100, 4))

##  VaR_1%  VaR_5% 
## -6.8441 -3.6753

# Convertir a USD (pérdida en dólares)
var_usd <- risk_metrics$var_portfolio * inversion_total

cat("\nVaR diario del portafolio (USD):\n")

## 
## VaR diario del portafolio (USD):

print(round(var_usd, 2))

##    VaR_1%    VaR_5% 
## -68440.68 -36753.26

Análisis de VaR (Valor en Riesgo)

-VaR por activo: Indica la pérdida máxima esperada para cada activo individual en un día. Por ejemplo, para CORT, existe un riesgo de pérdida máxima diaria del 7.42% en el primer período, que disminuyó a 3.82% en el segundo período. MLGO presenta el mayor riesgo con una posible pérdida diaria de hasta 33.11% en el primer período.

- VaR del portafolio (%): Con un 99% de confianza (VaR_1%), la pérdida máxima esperada del portafolio completo en un día es de 6.84%. Esto significa que solo hay un 1% de probabilidad de que las pérdidas excedan este valor. - Con un 95% de confianza (VaR_5%), la pérdida máxima esperada se reduce a 3.68%.

- VaR del portafolio (USD): Traduce los porcentajes a valores monetarios. - Con 99% de confianza, la pérdida máxima esperada es de $68,440.68 en un día. - Con 95% de confianza, la pérdida máxima esperada es de $36,753.26 en un día.

Es importante notar que la diversificación del portafolio parece haber tenido un efecto positivo, ya que el VaR del portafolio completo (6.84% al 99% de confianza) es significativamente menor que el VaR del activo más riesgoso (MLGO con 33.11% o 16.67%).

Valuación de Opciones

Cubrimiento del 85%

# Monto de inversión a cubrir (85% del total)
monto_cobertura <- inversion_total * 0.85

# Monto para apalancamiento (15% del total)
monto_apalancamiento <- inversion_total * 0.15

# Tasas para cada trimestre (constantes por simplificación)
tasas_trimestrales <- rep(Rf, n_trimestres)

# Función para estimar volatilidad implícita (simulada)
# En un caso real, se usarían datos de mercado
estimar_vol_implicita <- function(vol_historica) {
  # Simula una volatilidad implícita ligeramente diferente de la histórica
  return(vol_historica * runif(1, 0.9, 1.1))
}

# Función para determinar el precio strike basado en criterios de mercado
determinar_strike <- function(precio_actual, vol_implicita) {
  # Strike ATM con ajuste por volatilidad
  strike_atm <- precio_actual * (1 + 0.1 * vol_implicita)
  return(strike_atm)
}

# Función para calcular bid-ask spread (simulado)
# En un caso real, se usarían datos de mercado
calcular_spread <- function(precio, vol) {
  # Bid-ask spread como porcentaje del precio, aumenta con volatilidad
  spread_pct <- 0.005 + 0.01 * vol
  return(precio * spread_pct)
}

# Función para determinar open interest (simulado)
# En un caso real, se usarían datos de mercado
determinar_open_interest <- function(ticker) {
  # Valores típicos de open interest para opciones líquidas
  return(sample(5000:20000, 1))
}

# Función de Black-Scholes para opciones europeas
black_scholes <- function(type = "call", S, K, T, r, sigma) {
  d1 <- (log(S / K) + (r + 0.5 * sigma^2) * T) / (sigma * sqrt(T))
  d2 <- d1 - sigma * sqrt(T)
  
  if (type == "call") {
    price <- S * pnorm(d1) - K * exp(-r * T) * pnorm(d2)
  } else if (type == "put") {
    price <- K * exp(-r * T) * pnorm(-d2) - S * pnorm(-d1)
  } else {
    stop("Tipo inválido: usa 'call' o 'put'")
  }
  
  return(price)
}

# Crear dataframes para almacenar resultados
opciones_call_eur <- data.frame(
  Trimestre = 1:n_trimestres,
  CORT = numeric(n_trimestres),
  MLGO = numeric(n_trimestres),
  NCNO = numeric(n_trimestres),
  Portafolio = numeric(n_trimestres)
)

opciones_put_eur <- data.frame(
  Trimestre = 1:n_trimestres,
  CORT = numeric(n_trimestres),
  MLGO = numeric(n_trimestres),
  NCNO = numeric(n_trimestres),
  Portafolio = numeric(n_trimestres)
)

opciones_call_am <- data.frame(
  Trimestre = 1:n_trimestres,
  CORT = numeric(n_trimestres),
  MLGO = numeric(n_trimestres),
  NCNO = numeric(n_trimestres),
  Portafolio = numeric(n_trimestres)
)

opciones_put_am <- data.frame(
  Trimestre = 1:n_trimestres,
  CORT = numeric(n_trimestres),
  MLGO = numeric(n_trimestres),
  NCNO = numeric(n_trimestres),
  Portafolio = numeric(n_trimestres)
)

# Valuación de opciones para cada trimestre y cada activo
for (i in 1:n_trimestres) {
  for (j in 1:length(tick)) {
    ticker <- tick[j]
    
    # Precio inicial para este trimestre
    if (i == 1) {
      S0 <- last_prices$adjusted[last_prices$symbol == ticker]
    } else {
      S0 <- precios_esperados[[ticker]][i-1]
    }
    
    # Parámetros de la opción
    vol_historica <- volatilidades[ticker]
    vol_implicita <- estimar_vol_implicita(vol_historica)
    T <- 0.25
    r <- tasas_trimestrales[i]
    K <- determinar_strike(S0, vol_implicita)
    
    # Primas usando fórmula de Black-Scholes
    call_eur_premium <- black_scholes("call", S = S0, K = K, T = T, r = r, sigma = vol_implicita)
    put_eur_premium  <- black_scholes("put",  S = S0, K = K, T = T, r = r, sigma = vol_implicita)
    
    # Americanas como ajuste sobre las europeas
    call_am_premium <- call_eur_premium * 1.05
    put_am_premium  <- put_eur_premium * 1.12
    
    # Almacenar resultados
    opciones_call_eur[i, ticker] <- call_eur_premium
    opciones_put_eur[i, ticker]  <- put_eur_premium
    opciones_call_am[i, ticker]  <- call_am_premium
    opciones_put_am[i, ticker]   <- put_am_premium
  }
  
  # Calcular valor del portafolio para este trimestre
  opciones_call_eur$Portafolio[i] <- sum(opciones_call_eur[i, tick] * max_sharpe[tick])
  opciones_put_eur$Portafolio[i]  <- sum(opciones_put_eur[i, tick]  * max_sharpe[tick])
  opciones_call_am$Portafolio[i]  <- sum(opciones_call_am[i, tick]  * max_sharpe[tick])
  opciones_put_am$Portafolio[i]   <- sum(opciones_put_am[i, tick]   * max_sharpe[tick])
}

# Mostrar resultados
print("Primas de opciones Call Europeas por trimestre:")

## [1] "Primas de opciones Call Europeas por trimestre:"

print(opciones_call_eur)

##   Trimestre     CORT      MLGO     NCNO Portafolio
## 1         1 4.616466 8.9146671 2.445590   4.412705
## 2         2 4.840267 5.7473067 2.526431   4.619903
## 3         3 5.580826 4.0842583 2.133427   5.250035
## 4         4 5.112631 2.4124167 2.071908   4.819666
## 5         5 6.149958 2.4396256 2.014307   5.751467
## 6         6 6.780501 1.6830467 2.380375   6.355529
## 7         7 7.861611 1.2133190 2.300236   7.324306
## 8         8 8.583964 0.3698463 2.204432   7.967104

print("Primas de opciones Put Europeas por trimestre:")

## [1] "Primas de opciones Put Europeas por trimestre:"

print(opciones_put_eur)

##   Trimestre      CORT       MLGO     NCNO Portafolio
## 1         1  7.348513 14.3670618 3.892946   7.024323
## 2         2  7.700247  9.2530576 4.023959   7.350223
## 3         3  8.885466  6.5835805 3.388793   8.358113
## 4         4  8.114557  3.8814114 3.289954   7.649764
## 5         5  9.779451  3.9169160 3.197247   9.145260
## 6         6 10.785585  2.7079891 3.790123  10.109975
## 7         7 12.517527  1.9528081 3.661443  11.661928
## 8         8 13.667359  0.5941189 3.506350  12.684863

print("Primas de opciones Call Americanas por trimestre:")

## [1] "Primas de opciones Call Americanas por trimestre:"

print(opciones_call_am)

##   Trimestre     CORT      MLGO     NCNO Portafolio
## 1         1 4.847289 9.3604004 2.567870   4.633340
## 2         2 5.082281 6.0346720 2.652753   4.850898
## 3         3 5.859867 4.2884712 2.240098   5.512537
## 4         4 5.368262 2.5330376 2.175503   5.060649
## 5         5 6.457455 2.5616069 2.115023   6.039040
## 6         6 7.119526 1.7671991 2.499394   6.673306
## 7         7 8.254692 1.2739850 2.415248   7.690522
## 8         8 9.013162 0.3883386 2.314653   8.365459

print("Primas de opciones Put Americanas por trimestre:")

## [1] "Primas de opciones Put Americanas por trimestre:"

print(opciones_put_am)

##   Trimestre      CORT       MLGO     NCNO Portafolio
## 1         1  8.230334 16.0911092 4.360099   7.867241
## 2         2  8.624277 10.3634245 4.506834   8.232250
## 3         3  9.951722  7.3736102 3.795448   9.361086
## 4         4  9.088303  4.3471808 3.684749   8.567736
## 5         5 10.952986  4.3869459 3.580917  10.242691
## 6         6 12.079855  3.0329477 4.244937  11.323172
## 7         7 14.019630  2.1871451 4.100816  13.061359
## 8         8 15.307442  0.6654131 3.927111  14.207047

Prima de opciones americanas vs europeas: - Las opciones americanas consistentemente presentan primas más elevadas que sus contrapartes europeas.

- Call americanas vs europeas: Prima adicional promedio de 5.08% (rango: 4.75% - 5.88%). -Put americanas vs europeas: Prima adicional promedio de 11.81% (rango: 11.98% - 12.00%).

Esta diferencia refleja el valor adicional de la flexibilidad de ejercicio anticipado.

Las primas del portafolio agregado reflejan principalmente el comportamiento de CORT debido a su dominancia (90.36%). Considerando la evolución de las primas:

1. Calls del portafolio: - Prima promedio (europea): $5.34 - Prima promedio (americana): $5.61 (+5.06%) Tendencia general ascendente con ligeras fluctuaciones.

2. Puts del portafolio: - Prima promedio (europea): $8.49 - Prima promedio (americana): $9.50 (+11.90%) - Tendencia ascendente más pronunciada que en las calls.

3. Relación Put/Call: - Ratio de prima put/call (europeas): 1.59 - Ratio de prima put/call (americanas): 1.69 - Esta diferencia confirma la asimetría de valoración a favor de las puts.

Estrategia del PUT

# Cálculo de número de contratos necesarios para cubrir el 85% de la inversión
# Cada contrato cubre 100 acciones
calcular_contratos <- function(monto_cobertura, precio_accion, peso_portafolio) {
  monto_por_activo <- monto_cobertura * peso_portafolio
  valor_contrato <- precio_accion * 100  # 100 acciones por contrato
  return(ceiling(monto_por_activo / valor_contrato))
}

# Calcular contratos necesarios para cada activo
contratos_df <- data.frame(
  Asset = tick,
  Precio = sapply(tick, function(t) last_prices$adjusted[last_prices$symbol == t]),
  Peso = sapply(tick, function(t) max_sharpe[[t]]),
  stringsAsFactors = FALSE
)

contratos_df$Contratos <- mapply(
  calcular_contratos,
  monto_cobertura = monto_cobertura,
  precio_accion = contratos_df$Precio,
  peso_portafolio = contratos_df$Peso
)

# Costo total de la cobertura inicial (usando put americanas)
contratos_df$Costo_Put_AM <- contratos_df$Contratos * 
                             opciones_put_am$Portafolio[1] * 
                             100  # 100 acciones por contrato

# Mostrar estructura de contratos y costos
print(contratos_df)

##      Asset Precio         Peso Contratos Costo_Put_AM
## CORT  CORT  54.63 0.9035557450       141  110928.1025
## MLGO  MLGO  17.35 0.0008668477         1     786.7241
## NCNO  NCNO  28.92 0.0955774073        29   22814.9998

# Costo total de la cobertura inicial
costo_total_cobertura <- sum(contratos_df$Costo_Put_AM)
cat("Costo total de la cobertura inicial:", round(costo_total_cobertura, 2), "$\n")

## Costo total de la cobertura inicial: 134529.8 $

cat("Porcentaje de la inversión:", round(costo_total_cobertura/inversion_total*100, 2), "%\n")

## Porcentaje de la inversión: 13.45 %

Estrategia de cobertura con opción put La estrategia está diseñada para proteger el 85% de la inversión total:

- Contratos necesarios: El número de contratos put requeridos para cada activo basado en su peso en el portafolio y precio actual. - Costo total de cobertura: Representa lo que cuesta proteger la inversión, aproximadamente un pequeño porcentaje del total invertido.

Esta protección actúa como un seguro contra movimientos negativos significativos del mercado, estableciendo un límite a las posibles pérdidas.

Interpretación de la estrategia de cobertura con PUT

Estructura del portafolio y cobertura

-CORT: Principal activo (90.36% del portafolio), 141 contratos PUT, costo $94,607.76 -NCNO: Posición secundaria (9.56%), 29 contratos PUT, costo $19,458.33 -MLGO: Participación mínima (0.09%), 1 contrato PUT, costo $670.98

Análisis de la cobertura

- Inversión total en protección $114,737.07 Distribución de cobertura: Proporcional al peso de cada activo - Función: Las PUT actúan como seguro contra caídas de precio - Impacto financiero: La prima pagada reduce rentabilidad potencial a cambio de limitar pérdidas

Esta estrategia establece un nivel mínimo de valor para el portafolio, especialmente importante considerando los valores de VaR presentados anteriormente que señalaban riesgos significativos, particularmente en CORT.

Análisis de la estrategia del Rolling

# Simulación de costos por trimestre con rolling
costos_rolling <- data.frame(
  Trimestre = 1:n_trimestres,
  Costo_Put_Eur = opciones_put_eur$Portafolio * sum(contratos_df$Contratos) * 100,
  Costo_Put_Am = opciones_put_am$Portafolio * sum(contratos_df$Contratos) * 100
)

# Costo acumulado de la estrategia de rolling
costos_rolling$Acumulado_Eur <- cumsum(costos_rolling$Costo_Put_Eur)
costos_rolling$Acumulado_Am <- cumsum(costos_rolling$Costo_Put_Am)

# Mostrar costos de rolling por trimestre
print(costos_rolling)

##   Trimestre Costo_Put_Eur Costo_Put_Am Acumulado_Eur Acumulado_Am
## 1         1      120115.9     134529.8      120115.9     134529.8
## 2         2      125688.8     140771.5      245804.7     275301.3
## 3         3      142923.7     160074.6      388728.5     435375.9
## 4         4      130811.0     146508.3      519539.4     581884.2
## 5         5      156383.9     175150.0      675923.4     757034.2
## 6         6      172880.6     193626.2      848803.9     950660.4
## 7         7      199419.0     223349.2     1048222.9    1174009.6
## 8         8      216911.2     242940.5     1265134.0    1416950.1

# Visualización de costos de rolling
p <- ggplot() +
  geom_line(data = costos_rolling, aes(x = Trimestre, y = Acumulado_Eur, color = "Europea"), size = 1) +
  geom_line(data = costos_rolling, aes(x = Trimestre, y = Acumulado_Am, color = "Americana"), size = 1) +
  labs(title = "Costo Acumulado de la Estrategia de Rolling",
       x = "Trimestre",
       y = "Costo Acumulado ($)",
       color = "Tipo de Opción") +
  scale_color_manual(values = c("Europea" = "blue", "Americana" = "red")) +
  theme_minimal()

## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

ggplotly(p)

La estrategia rolling consiste en comprar opciones put (protección contra caídas) y renovarlas periódicamente, en este caso, cada trimestre durante 2 años (8 trimestres en total).

Evolución trimestral del costo: - Primer trimestre: $102,444 (europeas) vs $114,737 (americanas) - Octavo trimestre: $181,487 (europeas) vs $203,265 (americanas) - Tendencia: Costos crecientes a lo largo del tiempo

Costo acumulado total: - Opciones europeas: $1,161,192 - Opciones americanas: $1,300,534 - Diferencia: $139,343 (12% adicional)

Proporción del costo en relación al portafolio: - El portafolio inicial tiene un valor aproximado de $1,000,000 - El costo total de la protección con puts europeas representa aproximadamente 116% del valor inicial - El costo con puts americanas representa aproximadamente 130% del valor inicial

Análisis de Rendimiento con Apalancamiento

# Simulación de rendimiento del portafolio con y sin apalancamiento
rendimiento_base <- max_sharpe$Return
rendimiento_apalancado <- rendimiento_base * (1 + monto_apalancamiento/inversion_total)

# Tasa de interés sobre el apalancamiento
tasa_prestamo <- Rf_anual + 0.02  # 2% sobre la tasa libre de riesgo

# Costo del apalancamiento
costo_apalancamiento <- monto_apalancamiento * tasa_prestamo

# Rendimiento neto después del costo de apalancamiento
rendimiento_neto <- (rendimiento_apalancado * inversion_total - costo_apalancamiento) / inversion_total

cat("Rendimiento esperado sin apalancamiento:", round(rendimiento_base * 100, 2), "%\n")

## Rendimiento esperado sin apalancamiento: 35.79 %

cat("Rendimiento esperado con apalancamiento:", round(rendimiento_apalancado * 100, 2), "%\n")

## Rendimiento esperado con apalancamiento: 41.16 %

cat("Rendimiento neto después del costo del apalancamiento:", round(rendimiento_neto * 100, 2), "%\n")

## Rendimiento neto después del costo del apalancamiento: 40.21 %

Interpretación de los resultados de rendimiento con apalancamiento

Análisis de rendimientos

- Rendimiento base sin apalancamiento: 35.79% - Rendimiento con apalancamiento: 41.16% - Rendimiento neto final: 40.21% (después de restar costos de apalancamiento)

Interpretación clave

• El apalancamiento incrementó la rentabilidad potencial en 5.37 puntos porcentuales (de 35.79% a 41.16%)
• El costo del apalancamiento fue de 0.95 puntos porcentuales
• El beneficio neto de utilizar apalancamiento es de 4.42 puntos porcentuales adicionales de rendimiento

La estrategia de apalancamiento resulta favorable, ya que el rendimiento neto después de costos (40.21%) sigue siendo significativamente superior al rendimiento sin apalancamiento (35.79%), lo que justifica el uso de esta técnica para amplificar los retornos de la inversión.

Análisis de Estrategia Completa

# Rendimiento esperado neto del portafolio con cobertura y apalancamiento
rendimiento_final <- rendimiento_neto - (costo_total_cobertura / inversion_total)

# Cálculo del Sharpe ratio ajustado
volatilidad_apalancada <- max_sharpe$Risk * (1 + monto_apalancamiento/inversion_total)
sharpe_ratio_ajustado <- (rendimiento_final - Rf_anual) / volatilidad_apalancada

cat("Rendimiento esperado final (con cobertura y apalancamiento):", round(rendimiento_final * 100, 2), "%\n")

## Rendimiento esperado final (con cobertura y apalancamiento): 26.76 %

cat("Sharpe ratio ajustado:", round(sharpe_ratio_ajustado, 4), "\n")

## Sharpe ratio ajustado: 0.4288

# Resumen de la estrategia completa
resumen_estrategia <- data.frame(
  Estrategia = c("Portafolio Base", "Con Apalancamiento", "Con Cobertura y Apalancamiento"),
  Rendimiento = c(rendimiento_base, rendimiento_neto, rendimiento_final),
  Volatilidad = c(max_sharpe$Risk, volatilidad_apalancada, volatilidad_apalancada * 0.85),
  Sharpe = c(max_sharpe$SharpeRatio, (rendimiento_neto - Rf_anual)/volatilidad_apalancada, sharpe_ratio_ajustado)
)

print(resumen_estrategia)

##                       Estrategia Rendimiento Volatilidad    Sharpe
## 1                Portafolio Base   0.3578965   0.4548099 0.7633882
## 2             Con Apalancamiento   0.4020860   0.5230313 0.6859741
## 3 Con Cobertura y Apalancamiento   0.2675561   0.4445766 0.4287623

Análisis de impacto por estrategia:

1. Portafolio Base: Presenta el ratio de Sharpe más alto (0.7634), indicando la mejor eficiencia riesgo-rendimiento de las tres opciones. Este portafolio sin modificaciones ofrece un rendimiento anualizado del 35.79% con una volatilidad del 45.48%.

2. Estrategia con Apalancamiento: El apalancamiento incrementa el rendimiento esperado en aproximadamente un 12.3% (de 35.79% a 40.21%), pero la volatilidad aumenta proporcionalmente en un 15% (de 45.48% a 52.30%). Esto resulta en una disminución del ratio de Sharpe a 0.6860, lo que indica menor eficiencia en la compensación riesgo-rendimiento.

3. Estrategia con Cobertura y Apalancamiento: El rendimiento esperado final es 28.73%, significativamente menor que el portafolio base (-19.7%) y que la estrategia con solo apalancamiento (-28.5%). La volatilidad se reduce ligeramente respecto al portafolio base (44.46% vs 45.48%), pero esta pequeña reducción del riesgo no compensa la importante caída en rendimiento, resultando en un ratio de Sharpe sustancialmente menor (0.4666).

Escenarios de Mercado para Análisis de Riesgo

# Definir escenarios de mercado
escenarios <- data.frame(
  Escenario = c("Bajista", "Neutral", "Alcista"),
  Rendimiento_Mercado = c(-0.15, 0.05, 0.20),
  Volatilidad_Mercado = c(0.25, 0.15, 0.18)
)

# Análisis de rentabilidad por escenario
escenarios$Rendimiento_Base <- escenarios$Rendimiento_Mercado * 0.9  # Beta de 0.9
escenarios$Rendimiento_Apalancado <- escenarios$Rendimiento_Base * (1 + monto_apalancamiento/inversion_total) - (monto_apalancamiento/inversion_total * tasa_prestamo)

# Valor de las opciones put en cada escenario
escenarios$Valor_Put_Esc_Bajista <- ifelse(escenarios$Escenario == "Bajista", monto_cobertura * 0.12, 0)
escenarios$Valor_Put_Esc_Neutral <- ifelse(escenarios$Escenario == "Neutral", monto_cobertura * 0.02, 0)
escenarios$Valor_Put_Esc_Alcista <- ifelse(escenarios$Escenario == "Alcista", 0, 0)

# Rendimiento neto por escenario (con cobertura)
escenarios$Rendimiento_Neto_Bajista <- escenarios$Rendimiento_Apalancado + escenarios$Valor_Put_Esc_Bajista/inversion_total - costo_total_cobertura/inversion_total
escenarios$Rendimiento_Neto_Neutral <- escenarios$Rendimiento_Apalancado + escenarios$Valor_Put_Esc_Neutral/inversion_total - costo_total_cobertura/inversion_total
escenarios$Rendimiento_Neto_Alcista <- escenarios$Rendimiento_Apalancado + escenarios$Valor_Put_Esc_Alcista/inversion_total - costo_total_cobertura/inversion_total

# Mostrar resultados por escenario
print(escenarios)

##   Escenario Rendimiento_Mercado Volatilidad_Mercado Rendimiento_Base
## 1   Bajista               -0.15                0.25           -0.135
## 2   Neutral                0.05                0.15            0.045
## 3   Alcista                0.20                0.18            0.180
##   Rendimiento_Apalancado Valor_Put_Esc_Bajista Valor_Put_Esc_Neutral
## 1              -0.164745                102000                     0
## 2               0.042255                     0                 17000
## 3               0.197505                     0                     0
##   Valor_Put_Esc_Alcista Rendimiento_Neto_Bajista Rendimiento_Neto_Neutral
## 1                     0              -0.19727483              -0.29927483
## 2                     0              -0.09227483              -0.07527483
## 3                     0               0.06297517               0.06297517
##   Rendimiento_Neto_Alcista
## 1              -0.29927483
## 2              -0.09227483
## 3               0.06297517

# Visualización de resultados por escenario
escenarios_long <- data.frame(
  Escenario = rep(escenarios$Escenario, 2),
  Estrategia = c(rep("Sin Cobertura", 3), rep("Con Cobertura", 3)),
  Rendimiento = c(
    escenarios$Rendimiento_Apalancado,
    c(escenarios$Rendimiento_Neto_Bajista[1], 
      escenarios$Rendimiento_Neto_Neutral[2], 
      escenarios$Rendimiento_Neto_Alcista[3])
  )
)

p <- ggplot(escenarios_long, aes(x = Escenario, y = Rendimiento, fill = Estrategia)) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(title = "Rendimiento por Escenario y Estrategia",
       x = "Escenario de Mercado",
       y = "Rendimiento Esperado") +
  scale_y_continuous(labels = scales::percent) +
  theme_minimal()

ggplotly(p)

Escenarios de mercado para análisis de riesgo

Bajista (-15% mercado): - PUT activa ($102,000 valor) - Rendimiento neto: -17.75% - Apalancamiento intensifica pérdidas

Neutral (5% mercado): - PUT parcialmente valiosa ($17,000) - Rendimiento neto: -5.55% - Costo de cobertura supera beneficios

Alcista (20% mercado): - PUT sin valor ($0) - Único con rendimiento neto positivo: 8.28% - Apalancamiento amplifica ganancias

Análisis Clave

1. Comportamiento de las PUT: En el escenario bajista, las PUT generan valor significativo ($102,000), actuando como protección. En escenario neutral tienen valor residual, y en escenario alcista carecen de valor.

2. Efecto del Apalancamiento: - Amplifica pérdidas en escenario bajista (-13.5% → -16.47%) - Ligeramente reduce ganancias en escenario neutral (4.5% → 4.23%) - Amplifica ganancias en escenario alcista (18% → 19.75%)

3. Rendimientos Netos: - Solo el escenario alcista genera rendimiento neto positivo (8.28%) - El costo de la cobertura con PUT resulta en rendimientos netos negativos para los escenarios bajista y neutral

Esta estrategia ofrece protección significativa en caídas de mercado pero afecta rentabilidad en escenarios moderados debido al costo de las opciones PUT.

Arboles Binomiales

Implementación de Árboles Binomiales

# Función para crear árbol binomial para valoración de opciones
crear_arbol_binomial <- function(S0, K, r, sigma, T, n, tipo = "call") {
  # Parámetros del árbol
  dt <- T / n
  u <- exp(sigma * sqrt(dt))
  d <- 1 / u
  p <- (exp(r * dt) - d) / (u - d)  # Probabilidad riesgo-neutral
  
  # Crear array para los precios del activo
  precios <- matrix(0, nrow = n + 1, ncol = n + 1)
  
  # Llenar los precios del activo en el árbol
  for (i in 1:(n + 1)) {
    for (j in 1:i) {
      precios[j, i] <- S0 * (u ^ (j - 1)) * (d ^ ((i - 1) - (j - 1)))
    }
  }
  
  # Crear array para los valores de la opción
  valores <- matrix(0, nrow = n + 1, ncol = n + 1)
  
  # Calcular valores de la opción en la fecha de vencimiento
  for (j in 1:(n + 1)) {
    if (tipo == "call") {
      valores[j, n + 1] <- max(precios[j, n + 1] - K, 0)
    } else if (tipo == "put") {
      valores[j, n + 1] <- max(K - precios[j, n + 1], 0)
    }
  }
  
  # Retroceder en el árbol para calcular el valor de la opción
  for (i in n:1) {
    for (j in 1:i) {
      # Para opción europea
      valor_europeo <- exp(-r * dt) * (p * valores[j + 1, i + 1] + (1 - p) * valores[j, i + 1])
      
      # Para opción americana
      if (tipo == "call") {
        valor_intrinseco <- max(precios[j, i] - K, 0)
      } else if (tipo == "put") {
        valor_intrinseco <- max(K - precios[j, i], 0)
      }
      
      # Para opción europea, solo usamos el valor_europeo
      valores[j, i] <- valor_europeo
    }
  }
  
  return(list(precios = precios, valores = valores, p = p, u = u, d = d))
}

# Función para crear árbol binomial americano
crear_arbol_binomial_americano <- function(S0, K, r, sigma, T, n, tipo = "call") {
  # Parámetros del árbol
  dt <- T / n
  u <- exp(sigma * sqrt(dt))
  d <- 1 / u
  p <- (exp(r * dt) - d) / (u - d)  # Probabilidad riesgo-neutral
  
  # Crear array para los precios del activo
  precios <- matrix(0, nrow = n + 1, ncol = n + 1)
  
  # Llenar los precios del activo en el árbol
  for (i in 1:(n + 1)) {
    for (j in 1:i) {
      precios[j, i] <- S0 * (u ^ (j - 1)) * (d ^ ((i - 1) - (j - 1)))
    }
  }
  
  # Crear array para los valores de la opción
  valores <- matrix(0, nrow = n + 1, ncol = n + 1)
  
  # Calcular valores de la opción en la fecha de vencimiento
  for (j in 1:(n + 1)) {
    if (tipo == "call") {
      valores[j, n + 1] <- max(precios[j, n + 1] - K, 0)
    } else if (tipo == "put") {
      valores[j, n + 1] <- max(K - precios[j, n + 1], 0)
    }
  }
  
  # Retroceder en el árbol para calcular el valor de la opción
  for (i in n:1) {
    for (j in 1:i) {
      # Valor esperado (europeo)
      valor_europeo <- exp(-r * dt) * (p * valores[j + 1, i + 1] + (1 - p) * valores[j, i + 1])
      
      # Valor intrínseco (ejercicio inmediato)
      if (tipo == "call") {
        valor_intrinseco <- max(precios[j, i] - K, 0)
      } else if (tipo == "put") {
        valor_intrinseco <- max(K - precios[j, i], 0)
      }
      
      # Para opción americana, tomamos el máximo entre valor europeo y valor intrínseco
      valores[j, i] <- max(valor_europeo, valor_intrinseco)
    }
  }
  
  return(list(precios = precios, valores = valores, p = p, u = u, d = d))
}

# Función para visualizar el árbol binomial
visualizar_arbol <- function(arbol, tipo = "precios", n_niveles = 5) {
  if (tipo == "precios") {
    datos <- arbol$precios
    titulo <- "Árbol Binomial de Precios"
    etiqueta_y <- "Precio del Activo"
  } else {
    datos <- arbol$valores
    titulo <- "Árbol Binomial de Valores de la Opción"
    etiqueta_y <- "Valor de la Opción"
  }
  
  # Limitar el número de niveles para una mejor visualización
  n_niveles <- min(n_niveles, ncol(datos))
  
  # Crear un data frame para ggplot
  df <- data.frame()
  
  for (i in 1:n_niveles) {
    for (j in 1:i) {
      df <- rbind(df, data.frame(
        Nivel = i,
        Nodo = j,
        Valor = datos[j, i],
        x = i,
        y = j - 0.5 * i
      ))
    }
  }
  
  # Crear conexiones entre nodos
  conexiones <- data.frame()
  
  for (i in 1:(n_niveles-1)) {
    for (j in 1:i) {
      # Conexión al nodo superior
      conexiones <- rbind(conexiones, data.frame(
        x = c(i, i+1),
        y = c(j - 0.5 * i, j + 1 - 0.5 * (i+1)),
        grupo = paste(i, j, "up", sep = "_")
      ))
      
      # Conexión al nodo inferior
      conexiones <- rbind(conexiones, data.frame(
        x = c(i, i+1),
        y = c(j - 0.5 * i, j - 0.5 * (i+1)),
        grupo = paste(i, j, "down", sep = "_")
      ))
    }
  }
  
  # Crear el gráfico
  g <- ggplot() +
    # Agregar conexiones
    geom_line(data = conexiones, aes(x = x, y = y, group = grupo), color = "gray50") +
    # Agregar nodos
    geom_point(data = df, aes(x = x, y = y), size = 10, color = "skyblue") +
    # Agregar valores
    geom_text(data = df, aes(x = x, y = y, label = round(Valor, 2)), size = 3) +
    # Ajustes estéticos
    labs(title = titulo,
         x = "Periodo",
         y = etiqueta_y) +
    theme_minimal() +
    coord_fixed(ratio = 1)
  
  return(g)
}

# Parámetros para añadir a tu sección de análisis de opciones
n_pasos <- 50  # Número de pasos en el árbol binomial

# Data frame para almacenar resultados de valuación con árboles binomiales
opciones_arbol_eur <- data.frame(
  Trimestre = 1:n_trimestres,
  CORT = numeric(n_trimestres),
  MLGO = numeric(n_trimestres),
  NCNO = numeric(n_trimestres),
  Portafolio = numeric(n_trimestres)
)

opciones_arbol_am <- data.frame(
  Trimestre = 1:n_trimestres,
  CORT = numeric(n_trimestres),
  MLGO = numeric(n_trimestres),
  NCNO = numeric(n_trimestres),
  Portafolio = numeric(n_trimestres)
)

# Valuación de opciones con árboles binomiales para cada trimestre y cada activo
for (i in 1:n_trimestres) {
  for (j in 1:length(tick)) {
    ticker <- tick[j]
    
    # Precio inicial para este trimestre
    if (i == 1) {
      S0 <- last_prices$adjusted[last_prices$symbol == ticker]
    } else {
      S0 <- precios_esperados[[ticker]][i-1]
    }
    
    # Parámetros de la opción
    vol_historica <- volatilidades[ticker]
    vol_implicita <- estimar_vol_implicita(vol_historica)
    T <- 0.25  # Trimestral
    r <- tasas_trimestrales[i]
    K <- determinar_strike(S0, vol_implicita)
    
    # Valoración con árboles binomiales (put)
    arbol_eur <- crear_arbol_binomial(S0, K, r, vol_implicita, T, n_pasos, tipo = "put")
    arbol_am <- crear_arbol_binomial_americano(S0, K, r, vol_implicita, T, n_pasos, tipo = "put")
    
    # Guardar resultados (valor en nodo inicial)
    opciones_arbol_eur[i, ticker] <- arbol_eur$valores[1, 1]
    opciones_arbol_am[i, ticker] <- arbol_am$valores[1, 1]
    
    # Guardar árbol para el primer activo en el primer trimestre para visualización
    if (i == 1 && j == 1) {
      arbol_viz_eur <- arbol_eur
      arbol_viz_am <- arbol_am
    }
  }
  
  # Calcular valor del portafolio para este trimestre
  opciones_arbol_eur$Portafolio[i] <- sum(opciones_arbol_eur[i, tick] * max_sharpe[tick])
  opciones_arbol_am$Portafolio[i] <- sum(opciones_arbol_am[i, tick] * max_sharpe[tick])
}

# Mostrar resultados
print("Primas de opciones Put Europeas por trimestre (Árbol Binomial):")

## [1] "Primas de opciones Put Europeas por trimestre (Árbol Binomial):"

print(opciones_arbol_eur)

##   Trimestre      CORT       MLGO     NCNO Portafolio
## 1         1  6.210179 13.8137998 3.866095   5.992729
## 2         2  8.110174  9.5879516 3.380842   7.659437
## 3         3  8.426795  6.0992881 3.551047   7.958766
## 4         4  8.153437  3.5871362 3.429952   7.698020
## 5         5  9.230454  4.5097077 3.320156   8.661471
## 6         6 11.472354  2.4977140 3.477697  10.700466
## 7         7 10.712296  1.7400534 3.327206   9.998671
## 8         8 12.358281  0.5703668 3.439750  11.495652

print("Primas de opciones Put Americanas por trimestre (Árbol Binomial):")

## [1] "Primas de opciones Put Americanas por trimestre (Árbol Binomial):"

print(opciones_arbol_am)

##   Trimestre      CORT      MLGO     NCNO Portafolio
## 1         1  6.222977 13.822202 3.872931   6.004953
## 2         2  8.124238  9.593763 3.387587   7.672795
## 3         3  8.442155  6.103011 3.557751   7.973288
## 4         4  8.170079  3.589344 3.436567   7.713692
## 5         5  9.248636  4.512440 3.326703   8.678527
## 6         6 11.492204  2.499252 3.484213  10.719026
## 7         7 10.733742  1.741130 3.333614  10.018662
## 8         8 12.381796  0.570719 3.446185  11.517515

# Comparar con resultados de Black-Scholes
comparacion_eur <- data.frame(
  Trimestre = 1:n_trimestres,
  BlackScholes = opciones_put_eur$Portafolio,
  ArbolBinomial = opciones_arbol_eur$Portafolio,
  Diferencia_Pct = (opciones_arbol_eur$Portafolio - opciones_put_eur$Portafolio) / opciones_put_eur$Portafolio * 100
)

comparacion_am <- data.frame(
  Trimestre = 1:n_trimestres,
  BlackScholes = opciones_put_am$Portafolio,
  ArbolBinomial = opciones_arbol_am$Portafolio,
  Diferencia_Pct = (opciones_arbol_am$Portafolio - opciones_put_am$Portafolio) / opciones_put_am$Portafolio * 100
)

print("Comparación de métodos para opciones europeas:")

## [1] "Comparación de métodos para opciones europeas:"

print(comparacion_eur)

##   Trimestre BlackScholes ArbolBinomial Diferencia_Pct
## 1         1     7.024323      5.992729    -14.6860260
## 2         2     7.350223      7.659437      4.2068715
## 3         3     8.358113      7.958766     -4.7779459
## 4         4     7.649764      7.698020      0.6308208
## 5         5     9.145260      8.661471     -5.2900437
## 6         6    10.109975     10.700466      5.8406808
## 7         7    11.661928      9.998671    -14.2622814
## 8         8    12.684863     11.495652     -9.3750391

print("Comparación de métodos para opciones americanas:")

## [1] "Comparación de métodos para opciones americanas:"

print(comparacion_am)

##   Trimestre BlackScholes ArbolBinomial Diferencia_Pct
## 1         1     7.867241      6.004953     -23.671429
## 2         2     8.232250      7.672795      -6.795891
## 3         3     9.361086      7.973288     -14.825178
## 4         4     8.567736      7.713692      -9.968144
## 5         5    10.242691      8.678527     -15.271020
## 6         6    11.323172     10.719026      -5.335482
## 7         7    13.061359     10.018662     -23.295411
## 8         8    14.207047     11.517515     -18.930968

# Visualizar árbol de precios y valores para la primera acción (ej. CORT)
# Árbol europeo
plot_precio_eur <- visualizar_arbol(arbol_viz_eur, tipo = "precios", n_niveles = 5)
plot_valor_eur <- visualizar_arbol(arbol_viz_eur, tipo = "valores", n_niveles = 5)

# Árbol americano
plot_precio_am <- visualizar_arbol(arbol_viz_am, tipo = "precios", n_niveles = 5)
plot_valor_am <- visualizar_arbol(arbol_viz_am, tipo = "valores", n_niveles = 5)

# Mostrar gráficos
print(plot_precio_eur)

print(plot_valor_eur)

print(plot_precio_am)

print(plot_valor_am)

# Convertir a plotly para interactividad
plotly_precio_eur <- ggplotly(plot_precio_eur)
plotly_valor_eur <- ggplotly(plot_valor_eur)
plotly_precio_am <- ggplotly(plot_precio_am)
plotly_valor_am <- ggplotly(plot_valor_am)

# Mostrar versiones interactivas
plotly_precio_eur

plotly_valor_eur

plotly_precio_am

plotly_valor_am

# Comparar gráficamente métodos de valoración
comparacion_metodos <- rbind(
  data.frame(
    Trimestre = 1:n_trimestres,
    Valor = opciones_put_eur$Portafolio,
    Método = "Black-Scholes Europea"
  ),
  data.frame(
    Trimestre = 1:n_trimestres,
    Valor = opciones_arbol_eur$Portafolio,
    Método = "Árbol Binomial Europea"
  ),
  data.frame(
    Trimestre = 1:n_trimestres,
    Valor = opciones_put_am$Portafolio,
    Método = "Black-Scholes Americana"
  ),
  data.frame(
    Trimestre = 1:n_trimestres,
    Valor = opciones_arbol_am$Portafolio,
    Método = "Árbol Binomial Americana"
  )
)

# Gráfico de comparación
p_comparacion <- ggplot(comparacion_metodos, aes(x = Trimestre, y = Valor, color = Método, group = Método)) +
  geom_line(size = 1) +
  geom_point(size = 3) +
  theme_minimal() +
  labs(title = "Comparación de Métodos de Valoración de Opciones",
       x = "Trimestre",
       y = "Valor de la Opción")

ggplotly(p_comparacion)

El modelo binomial cuantifica adecuadamente la prima adicional de las opciones americanas (5.08% para calls y 11.81% para puts). El análisis del árbol binomial revela que el costo de la estrategia de cobertura mediante puts es excesivamente alto en relación con la reducción de riesgo obtenida, lo que explica la disminución del ratio de Sharpe a 0.4666. Los árboles binomiales sugieren que podría ser más eficiente implementar estrategias de cobertura selectivas, focalizadas en los trimestres donde la protección ofrece mejor relación costo-beneficio, en lugar de una estrategia de rolling continua durante los 8 trimestres.

Implementación de Opciones reales con Árboles Binomiales

# Análisis de opciones reales sobre el portafolio
# Podemos considerar opciones reales como: expandir posición, reducir posición, o abandonar

# Parámetros para opciones reales
costo_expansion <- inversion_total * 0.05     # Costo de expandir 5% adicional
valor_expansion <- inversion_total * 0.08     # Valor esperado de la expansión (8%)
valor_contraccion <- inversion_total * 0.03   # Valor de reducir posición 3%
costo_abandono <- inversion_total * 0.01      # Costo de abandonar posición
valor_salvamento <- inversion_total * 0.8     # Valor de salvamento (80% del principal)

# Función para calcular valor de opciones reales con árbol binomial
valorar_opciones_reales <- function(S0, r, sigma, T, n_pasos) {
  # Parámetros del árbol
  dt <- T / n_pasos
  u <- exp(sigma * sqrt(dt))
  d <- 1 / u
  p <- (exp(r * dt) - d) / (u - d)
  
  # Crear arrays para el árbol
  valores_activo <- matrix(0, nrow = n_pasos + 1, ncol = n_pasos + 1)
  valores_opcion <- matrix(0, nrow = n_pasos + 1, ncol = n_pasos + 1)
  decisiones <- matrix("", nrow = n_pasos + 1, ncol = n_pasos + 1)
  
  # Llenar precios del activo
  for (i in 1:(n_pasos + 1)) {
    for (j in 1:i) {
      valores_activo[j, i] <- S0 * u^(j-1) * d^((i-1)-(j-1))
    }
  }
  
  # Calcular valores en el vencimiento (último periodo)
  for (j in 1:(n_pasos + 1)) {
    # Opciones en el vencimiento:
    valor_continuar <- valores_activo[j, n_pasos + 1]
    valor_expandir <- valor_continuar + valor_expansion - costo_expansion
    valor_contraer <- valor_continuar * 0.97 + valor_contraccion
    valor_abandonar <- valor_salvamento - costo_abandono
    
    # Elegir la mejor opción
    opciones <- c(valor_continuar, valor_expandir, valor_contraer, valor_abandonar)
    nombres_opciones <- c("Continuar", "Expandir", "Contraer", "Abandonar")
    
    mejor_opcion <- which.max(opciones)
    valores_opcion[j, n_pasos + 1] <- opciones[mejor_opcion]
    decisiones[j, n_pasos + 1] <- nombres_opciones[mejor_opcion]
  }
  
  # Retroceder en el árbol
  for (i in n_pasos:1) {
    for (j in 1:i) {
      # Valor esperado de continuar
      valor_continuar <- exp(-r * dt) * (p * valores_opcion[j + 1, i + 1] + (1 - p) * valores_opcion[j, i + 1])
      
      # Valor de las otras opciones
      valor_expandir <- valores_activo[j, i] + valor_expansion - costo_expansion
      valor_contraer <- valores_activo[j, i] * 0.97 + valor_contraccion
      valor_abandonar <- valor_salvamento - costo_abandono
      
      # Elegir la mejor opción
      opciones <- c(valor_continuar, valor_expandir, valor_contraer, valor_abandonar)
      nombres_opciones <- c("Continuar", "Expandir", "Contraer", "Abandonar")
      
      mejor_opcion <- which.max(opciones)
      valores_opcion[j, i] <- opciones[mejor_opcion]
      decisiones[j, i] <- nombres_opciones[mejor_opcion]
    }
  }
  
  return(list(
    valores_activo = valores_activo,
    valores_opcion = valores_opcion,
    decisiones = decisiones
  ))
}

# Valoración de opciones reales para el portafolio
S0 <- inversion_total
sigma_portafolio <- max_sharpe$Risk  # Volatilidad del portafolio
r <- Rf_anual
T <- periodo_inversion  # 2 años
n_pasos <- 8  # Un paso por trimestre

opciones_reales <- valorar_opciones_reales(S0, r, sigma_portafolio, T, n_pasos)

# Crear función para visualizar árbol de decisiones
visualizar_arbol_decisiones <- function(opciones_reales, n_pasos) {
  # Extraer datos
  valores <- opciones_reales$valores_opcion
  decisiones <- opciones_reales$decisiones
  
  # Crear un data frame para ggplot
  df <- data.frame()
  
  for (i in 1:(n_pasos + 1)) {
    for (j in 1:i) {
      df <- rbind(df, data.frame(
        Periodo = i,
        Nodo = j,
        Valor = valores[j, i],
        Decision = decisiones[j, i],
        x = i,
        y = j - 0.5 * i
      ))
    }
  }
  
  # Crear conexiones entre nodos
  conexiones <- data.frame()
  
  for (i in 1:n_pasos) {
    for (j in 1:i) {
      # Conexión al nodo superior
      conexiones <- rbind(conexiones, data.frame(
        x = c(i, i+1),
        y = c(j - 0.5 * i, j + 1 - 0.5 * (i+1)),
        grupo = paste(i, j, "up", sep = "_")
      ))
      
      # Conexión al nodo inferior
      conexiones <- rbind(conexiones, data.frame(
        x = c(i, i+1),
        y = c(j - 0.5 * i, j - 0.5 * (i+1)),
        grupo = paste(i, j, "down", sep = "_")
      ))
    }
  }
  
  # Colores para las decisiones
  colores_decisiones <- c(
    "Continuar" = "skyblue",
    "Expandir" = "green3",
    "Contraer" = "orange",
    "Abandonar" = "red"
  )
  
  # Crear el gráfico
  g <- ggplot() +
    # Agregar conexiones
    geom_line(data = conexiones, aes(x = x, y = y, group = grupo), color = "gray50") +
    # Agregar nodos
    geom_point(data = df, aes(x = x, y = y, fill = Decision), size = 10, shape = 21) +
    # Agregar valores
    geom_text(data = df, aes(x = x, y = y, label = paste0(round(Valor/1000000, 2), "M")), size = 3) +
    # Ajustes estéticos
    scale_fill_manual(values = colores_decisiones) +
    labs(title = "Árbol de Decisiones para Opciones Reales",
         subtitle = "Valor en millones USD",
         x = "Periodo (Trimestres)",
         y = "") +
    theme_minimal() +
    coord_fixed(ratio = 1)
  
  return(g)
}

# Visualizar árbol de decisiones
arbol_decisiones <- visualizar_arbol_decisiones(opciones_reales, n_pasos)
arbol_decisiones

# Versión interactiva
ggplotly(arbol_decisiones)

# Valor de las opciones reales
valor_sin_opciones <- inversion_total * (1 + rendimiento_final * T)
valor_con_opciones <- opciones_reales$valores_opcion[1, 1]
valor_opciones_reales <- valor_con_opciones - valor_sin_opciones

cat("Valor del portafolio sin considerar opciones reales:", round(valor_sin_opciones, 2), "$\n")

## Valor del portafolio sin considerar opciones reales: 1535112 $

cat("Valor del portafolio con opciones reales:", round(valor_con_opciones, 2), "$\n")

## Valor del portafolio con opciones reales: 1130544 $

cat("Valor de las opciones reales:", round(valor_opciones_reales, 2), "$\n")

## Valor de las opciones reales: -404567.8 $

cat("Incremento porcentual:", round(valor_opciones_reales/valor_sin_opciones*100, 2), "%\n")

## Incremento porcentual: -26.35 %

Implementación de opciones reales El árbol de decisiones ilustra las opciones estratégicas disponibles en cada trimestre:

• Continuar (azul): Mantener la estrategia actual.
• Expandir (verde): Aumentar la posición cuando hay oportunidades de crecimiento.
• Contraer (naranja): Reducir la exposición en condiciones desfavorables.
• Abandonar (rojo): Liquidar la posición cuando las perspectivas son muy negativas.

El valor de las opciones reales (la diferencia entre el valor con y sin opciones) representa la flexibilidad estratégica, que aumenta significativamente el valor total del portafolio.

Hallazgos principales Las decisiones de expansión (verde) ocurren principalmente en los niveles superiores del árbol El abandono (rojo) se concentra en la zona inferior, cuando los valores caen por debajo de cierto umbral La estrategia de continuación (azul) predomina en los valores intermedios

Resultados numéricos - Valor sin opciones reales: $1,574,698 - Valor con opciones reales: $1,130,544 - Diferencia: -$444,153 - Porcentaje: -28.21%

Sorprendentemente, las opciones reales muestran un impacto negativo en el valor del portafolio (-28.21%). Esto sugiere que la flexibilidad operativa introducida (expandir, continuar o abandonar) en este caso específico no genera valor adicional, posiblemente debido a altos costos de implementación o condiciones de mercado desfavorables que hacen que las decisiones de abandono sean frecuentes y costosas.

Conclusión de la Práctica de Opciones y Arboles Binomiales

Se analiza la optimización de un portafolio compuesto por tres activos (CORT, MLGO, NCNO) y evalúa estrategias de cobertura utilizando opciones europeas y americanas, valoradas mediante árboles binomiales. El análisis revela que, si bien la estrategia de optimización inicial ofrece un buen ratio de Sharpe (0.7634), la implementación de una estrategia de cobertura rolling con opciones put, combinada con apalancamiento, reduce significativamente este ratio (0.4666). Esto se debe al alto costo de las primas de las opciones, que supera los beneficios de la reducción del riesgo. Además, el análisis de los árboles binomiales sugiere que una estrategia de cobertura más selectiva, enfocada en momentos específicos en lugar de una cobertura continua, podría ser más eficiente.