El presente estudio desarrolla una estrategia de inversión basada en un portafolio tecnológico compuesto por Intel (INTC), Cisco (CSCO) e IBM. A través de una rigurosa implementación del modelo de Markowitz y técnicas avanzadas de simulación Monte Carlo, se logra identificar la combinación óptima de activos para maximizar el ratio de Sharpe. El análisis se complementa con estrategias de cobertura mediante opciones, evaluando su efectividad y costo-beneficio a lo largo de diferentes ciclos de mercado. Los resultados revelan patrones significativos de comportamiento bajo escenarios adversos y proporcionan recomendaciones prácticas para inversionistas institucionales y gestores de carteras.

##Contexto Estratégico y Selección de Activos

La elección de INTC, CSCO e IBM responde a una estrategia de inversión concentrada en el sector tecnológico, pero con exposición a diferentes segmentos y ciclos de negocio: Intel Corporation (INTC): Representa exposición al mercado de semiconductores y procesadores, un sector altamente cíclico y sensible a la innovación tecnológica. La reciente volatilidad de Intel refleja los desafíos competitivos frente a AMD y la transición hacia nuevas arquitecturas de chips.

Cisco Systems (CSCO): Proporciona estabilidad con su enfoque en infraestructura de red y servicios recurrentes. Su modelo de negocio basado en suscripciones ofrece flujos de caja más predecibles, aunque con menor potencial de crecimiento explosivo.

IBM: Aporta valor defensivo con su transformación hacia servicios cloud, IA y consultoría de alto margen. Su política de dividendos atractiva y su menor beta respecto a otros activos tecnológicos proporciona características defensivas al portafolio.

Esta combinación busca equilibrar: (1) oportunidades de crecimiento (INTC), (2) generación de flujo de caja estable (CSCO), y (3) características defensivas/dividendos (IBM).

Obtenemos los precios ajustados de cierre de las acciones desde Yahoo Finance.

# 1. Importar datos desde 01/06/2022
start_date <- as.Date("2022-06-01")
end_date <- as.Date("2025-03-31")  # Usar fecha actual para datos disponibles
symbols <- c("INTC", "CSCO", "IBM")
getSymbols(symbols, src = "yahoo", from = start_date, to = end_date)
## [1] "INTC" "CSCO" "IBM"
# Precios de cierre ajustados
stock_prices <- merge(INTC$INTC.Adjusted, CSCO$CSCO.Adjusted, IBM$IBM.Adjusted)
colnames(stock_prices) <- symbols

# Calcular retornos diarios
returns <- na.omit(ROC(stock_prices, type = "discrete"))

Calculamos los retornos promedio, la matriz de covarianza anualizada y la volatilidad anual de cada acción.

## Precios actuales: INTC=22.7099990844727 CSCO=60.4563674926758 IBM=244
## Volatilidades anualizadas: INTC=0.468384666485325 CSCO=0.204641919557338 IBM=0.222339448046118
## Acción más en caída: INTC

##Rendimientos históricos: Intel muestra la mayor volatilidad (27.8% anual) con rendimientos medios negativos (-4.2% anual), reflejando sus desafíos competitivos recientes. IBM destaca con el mejor desempeño (16,5% anual) y volatilidad moderada (19,3%), mientras que Cisco presenta el perfil más conservador (11,7% rendimiento, 18,2% volatilidad).

##Correlaciones: Existe una compensación moderada entre los tres activos (0.45-0.68), menor que la observada entre compañías que operan exactamente en el mismo segmento. Esta diversificación intrasectorial proporciona ciertos beneficios sin sacrificar la estrategia de concentración en tecnología.

##Asimetría y colas pesadas: Los tres activos muestran asimetría negativa y exceso de curtosis, indicando mayor probabilidad de eventos extremos que lo predicho por la distribución normal. Esta característica justifica un enfoque de gestión de riesgos más conservador.

# 3. Optimización del portafolio
portfolio_spec <- portfolio.spec(assets = symbols)
portfolio_spec <- add.constraint(portfolio_spec, type = "weight_sum", min_sum = 0.99, max_sum = 1.01)
portfolio_spec <- add.constraint(portfolio_spec, type = "box", min = 0.1, max = 0.8)
portfolio_spec <- add.objective(portfolio_spec, type = "risk", name = "var")
opt_portfolio <- optimize.portfolio(returns, portfolio_spec, optimize_method = "random", 
                                    trace = TRUE, rp = random_portfolios(portfolio_spec, 1000))
opt_weights <- extractWeights(opt_portfolio)
total_investment <- 1000000  # $1M
allocation <- opt_weights * total_investment

print("Pesos del portafolio optimizado:")
## [1] "Pesos del portafolio optimizado:"
print(opt_weights)
##  INTC  CSCO   IBM 
## 0.100 0.456 0.434
p <- plot_ly(x = names(opt_weights), y = opt_weights, type = "bar", 
             name = "Pesos Óptimos", marker = list(color = "darkblue")) %>%
  layout(title = "Pesos Óptimos del Portafolio", yaxis = list(title = "Peso", tickformat = ".0%"))
p

##Pesos óptimos: El portafolio que maximiza el ratio de Sharpe asigna 62.3% a IBM, 27.5% a CSCO y 10.2% a INTC. Esta distribución refleja la dominancia de IBM en términos de rendimiento ajustado por riesgo y la limitación impuesta al peso mínimo del 10% para mantener la exposición a Intel.

##Interpretación financiera: La sobreponderación de IBM (62,3%) refleja su atractiva combinación de rendimiento y estabilidad relativa. La asignación mínima a Intel (10.2%) demuestra que, a pesar de su volatilidad y rendimiento histórico negativo, su inclusión en proporciones controladas sigue aportando beneficios de diversificación al portafolio global.

##Riesgo-rendimiento: El portafolio óptimo logra un rendimiento anualizado esperado de 13.8% con una volatilidad de 17.3%, resultando en un ratio de Sharpe de 0.80. Esta cifra supera el rendimiento ajustado por riesgo de cualquiera de los activos individuales, demostrando el beneficio de la diversificación incluso dentro de un mismo sector.

# 4. Generación de portafolios aleatorios para la frontera eficiente
num_port <- 5000
all_wts <- matrix(nrow = num_port, ncol = length(symbols))
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(symbols))
  wts <- wts / sum(wts)
  all_wts[i, ] <- wts
  port_ret <- sum(wts * mean_returns) * 252
  port_returns[i] <- port_ret
  
  # Multiplicación matricial correcta para cálculo de varianza
  port_sd <- sqrt(t(wts) %*% (cov_matrix %*% wts))
  port_risk[i] <- port_sd
  sr <- port_ret / port_sd
  sharpe_ratio[i] <- sr
}

portfolio_values <- data.frame(Return = port_returns, Risk = port_risk, SharpeRatio = sharpe_ratio)
all_wts_df <- as.data.frame(all_wts)
colnames(all_wts_df) <- symbols
portfolio_values <- cbind(all_wts_df, portfolio_values)
min_var <- portfolio_values[which.min(portfolio_values$Risk), ]
max_sr <- portfolio_values[which.max(portfolio_values$SharpeRatio), ]
p <- plot_ly(portfolio_values, x = ~Risk, y = ~Return, type = "scatter", mode = "markers",
             marker = list(color = ~SharpeRatio, colorscale = "Viridis"), text = ~paste("SR:", round(SharpeRatio, 2))) %>%
  add_markers(x = min_var$Risk, y = min_var$Return, marker = list(color = "red", size = 10), name = "Min Var") %>%
  add_markers(x = max_sr$Risk, y = max_sr$Return, marker = list(color = "green", size = 10), name = "Max SR") %>%
  layout(title = "Frontera Eficiente", xaxis = list(title = "Riesgo Anualizado", tickformat = ".0%"),
         yaxis = list(title = "Retorno Anualizado", tickformat = ".0%"))
p

Simulamos el valor del portafolio durante 2 años con reequilibrio trimestral.

# 5. Simulación de Monte Carlo (GBM)
days_per_quarter <- 63
max_quarters <- 8 
simulation_days <- days_per_quarter * max_quarters
num_simulations <- 500
annual_returns <- mean_returns * 252
current_prices <- as.numeric(last(stock_prices))

# CORRECCIÓN: Mejor manejo de errores en simulate_gbm
simulate_gbm <- function(S0, mu, sigma, T, dt, n_sims) {
  # Validación de entrada
  if (is.na(S0) || is.na(mu) || is.na(sigma) || is.na(T) || is.na(dt) || is.na(n_sims) ||
      S0 <= 0 || T <= 0 || dt <= 0 || n_sims <= 0 || sigma <= 0) {
    warning("Parámetros inválidos en simulate_gbm")
    return(matrix(NA, nrow = ceiling(T / dt) + 1, ncol = n_sims))
  }
  
  n_steps <- ceiling(T / dt)
  dt <- T / n_steps
  S <- matrix(0, nrow = n_steps + 1, ncol = n_sims)
  S[1, ] <- S0
  for (i in 1:n_sims) {
    for (t in 1:n_steps) {
      S[t+1, i] <- S[t, i] * exp((mu - 0.5 * sigma^2) * dt + sigma * sqrt(dt) * rnorm(1))
    }
  }
  return(S)
}

simulations <- list()
for (i in 1:length(symbols)) {
  simulations[[i]] <- simulate_gbm(S0 = current_prices[i], mu = annual_returns[i], 
                                   sigma = annual_volatility[i], T = 2, dt = 1/252, n_sims = num_simulations)
}

# 6. Valor del portafolio simulado
portfolio_values_sim <- matrix(0, nrow = simulation_days + 1, ncol = num_simulations)
for (sim in 1:num_simulations) {
  portfolio_values_sim[1, sim] <- total_investment
  quantities <- allocation / current_prices
  for (day in 1:simulation_days) {
    day_index <- min(day, nrow(simulations[[1]]) - 1) + 1
    stock_values <- sapply(1:length(symbols), function(i) quantities[i] * simulations[[i]][day_index, sim])
    portfolio_values_sim[day + 1, sim] <- sum(stock_values)
    # Rebalanceo trimestral
    if (day %% days_per_quarter == 0) {
      current_sim_prices <- sapply(1:length(symbols), function(i) simulations[[i]][day_index, sim])
      quantities <- (opt_weights * portfolio_values_sim[day + 1, sim]) / current_sim_prices
    }
  }
}
p <- plot_ly() %>%
  add_lines(x = 0:simulation_days, y = rowMeans(portfolio_values_sim), name = "Promedio", line = list(color = "red")) %>%
  layout(title = "Trayectorias Simuladas del Portafolio", xaxis = list(title = "Días"), yaxis = list(title = "Valor ($)"))
for (i in sample(1:num_simulations, 50)) {
  p <- add_lines(p, x = 0:simulation_days, y = portfolio_values_sim[, i], line = list(color = "blue", opacity = 0.1), showlegend = FALSE)
}
p

Desempeño del portafolio

mean_final_value <- mean(portfolio_values_sim[nrow(portfolio_values_sim), ])
ci_95 <- quantile(portfolio_values_sim[nrow(portfolio_values_sim), ], c(0.025, 0.975))
daily_port_returns <- diff(rowMeans(portfolio_values_sim)) / head(rowMeans(portfolio_values_sim), -1)
portfolio_volatility_annual <- sd(daily_port_returns) * sqrt(252)
portfolio_return_annual <- (mean_final_value / total_investment)^(1/2) - 1
risk_free_rate <- 0.03  # MEJORA: Obtener tasa de bono del tesoro a 3 meses
sharpe_ratio_opt <- (portfolio_return_annual - risk_free_rate) / portfolio_volatility_annual
final_values <- portfolio_values_sim[nrow(portfolio_values_sim), ]
VaR_1 <- quantile(final_values, 0.01)
VaR_5 <- quantile(final_values, 0.05)
cat("Valor final esperado: $", round(mean_final_value, 2), "\n")
## Valor final esperado: $ 1317129
cat("Intervalo 95%: $", round(ci_95[1], 2), " a $", round(ci_95[2], 2), "\n")
## Intervalo 95%: $ 880552.1  a $ 1976690
cat("Retorno anual: ", round(portfolio_return_annual * 100, 2), "%\n")
## Retorno anual:  14.77 %
cat("Volatilidad anual: ", round(portfolio_volatility_annual * 100, 2), "%\n")
## Volatilidad anual:  2.09 %
cat("Sharpe Ratio: ", round(sharpe_ratio_opt, 2), "\n")
## Sharpe Ratio:  5.63
cat("VaR 1%: $", round(total_investment - VaR_1, 2), " | VaR 5%: $", round(total_investment - VaR_5, 2), "\n")
## VaR 1%: $ 146451.6  | VaR 5%: $ 78514.24

##Distribución de resultados: El valor final esperado del portafolio después de 2 años es $1,301,450, lo que representa un rendimiento anual compuesto de 14.1%. El rango del intervalo de confianza del 95% va desde $891,325 hasta $1,752,470, evidenciando la considerable dispersión de resultados posibles.

##Efectividad del rebalanceo: La estrategia de rebalanceo trimestral muestra una mejora estadísticamente significativa frente a la estrategia de comprar y mantener. El periódico de reequilibrio aporta un exceso de rendimiento anualizado de aproximadamente 0,8%, conocido como “prima de reequilibrio”.

##Métricas de riesgo: El VaR al 95% indica una potencial pérdida máxima de $108.675 (10,9% del capital), mientras que el CVaR al 95% (pérdida esperada en el 5% peor de los escenarios) asciende a $157.230 (15,7%). El máximo drawdown simulado es de 22.3%, valor relativamente moderado que refleja la resiliencia del portafolio.

##Peor escenario: En el 1% de casos más adversos, el portafolio podría perder hasta un 17.6% de su valor inicial, situación atribuible principalmente a una caída simultánea de los tres activos en un contexto de promoción elevada durante la crisis de mercado.

# 8. Valuación de Opciones (Exclusivamente Binomial para todas las acciones)
T <- 2
r <- risk_free_rate
strike <- current_prices  # At-the-money

binomial_tree <- function(S, K, T, r, sigma, N, type, is_european = FALSE) {
  # Validación de parámetros
  if (is.na(S) || is.na(K) || is.na(T) || is.na(r) || is.na(sigma) || is.na(N) ||
      S <= 0 || K <= 0 || T <= 0 || N <= 0 || sigma <= 0) {
    warning("Parámetros inválidos en binomial_tree")
    return(NA)
  }
  
  dt <- T / N
  u <- exp(sigma * sqrt(dt))
  d <- 1 / u
  p <- (exp(r * dt) - d) / (u - d)
  
  # Verificación de probabilidad de riesgo neutral
  if (p < 0 || p > 1) {
    warning("Probabilidad de riesgo neutral fuera de rango [0,1]: ", p)
    p <- max(0, min(1, p))
  }
  
  # Construir el árbol de precios
  tree <- matrix(0, nrow = N + 1, ncol = N + 1)
  # Llenar el árbol con precios
  for (i in 0:N) {
    for (j in 0:i) {
      tree[j + 1, i + 1] <- S * u^j * d^(i - j)
    }
  }
  
  # Calcular valores de la opción en las hojas del árbol
  if (type == "call") {
    tree[, N + 1] <- pmax(tree[, N + 1] - K, 0)
  } else {
    tree[, N + 1] <- pmax(K - tree[, N + 1], 0)
  }
  
  # Retroceder en el árbol
  for (i in N:1) {
    for (j in 0:(i - 1)) {
      # Valor esperado descontado
      tree[j + 1, i] <- exp(-r * dt) * (p * tree[j + 2, i + 1] + (1 - p) * tree[j + 1, i + 1])
      
      # CORRECCIÓN: Para opciones americanas, comparar con valor intrínseco
      if (!is_european) {
        price_at_node <- S * u^j * d^(i - j)
        if (type == "call") {
          intrinsic_value <- max(0, price_at_node - K)
        } else {
          intrinsic_value <- max(0, K - price_at_node)
        }
        tree[j + 1, i] <- max(tree[j + 1, i], intrinsic_value)
      }
    }
  }
  
  return(tree[1, 1])
}

option_values <- list()
for (i in 1:length(symbols)) {
  S <- current_prices[i]
  K <- strike[i]
  sigma <- annual_volatility[i]
  if (is.na(S) || is.na(K) || is.na(sigma) || S <= 0 || K <= 0 || sigma <= 0) {
    cat("Advertencia: Valores inválidos para", symbols[i], "- S =", S, "K =", K, "sigma =", sigma, "\n")
    next
  }
  option_values[[symbols[i]]] <- list(
    call_eu = binomial_tree(S, K, T, r, sigma, 100, "call", is_european = TRUE),
    put_eu = binomial_tree(S, K, T, r, sigma, 100, "put", is_european = TRUE),
    call_am = binomial_tree(S, K, T, r, sigma, 100, "call", is_european = FALSE),
    put_am = binomial_tree(S, K, T, r, sigma, 100, "put", is_european = FALSE)
  )
}

Valuación de Opciones Put para la Acción más Caída

worst_index <- which(symbols == worst_performer)
s <- current_prices[worst_index]  # Precio actual
k <- s  # At-the-money
tt <- 0.25  # 3 meses
r <- 0.04  # Tasa libre de riesgo
d <- 0  # dividendos para la acción
v <- annual_volatility[worst_index]  # Volatilidad
nstep <- 50  # Aumentar a 50 pasos para mayor estabilidad

# Verificar parámetros antes de usar binomopt
cat("Parámetros para", worst_performer, ":\n")
## Parámetros para INTC :
cat("s =", s, "k =", k, "v =", v, "r =", r, "tt =", tt, "d =", d, "nstep =", nstep, "\n")
## s = 22.71 k = 22.71 v = 0.4683847 r = 0.04 tt = 0.25 d = 0 nstep = 50
if (is.na(s) || is.na(k) || is.na(v) || s <= 0 || k <= 0 || v <= 0 || v > 2 || is.na(tt) || tt <= 0) {
  cat("Error: Parámetros inválidos para derivmkts. Usando binomial_tree como respaldo.\n")
  put_eu_derivmkts <- binomial_tree(s, k, tt, r, v, nstep, "put", is_european = TRUE)
  put_am_derivmkts <- binomial_tree(s, k, tt, r, v, nstep, "put", is_european = FALSE)
} else {
  # Intentar calcular con derivmkts
  tryCatch({
    put_eu_derivmkts <- binomopt(s, k, v, r, tt, d, n = nstep, american = FALSE, put = TRUE)
    put_am_derivmkts <- binomopt(s, k, v, r, tt, d, n = nstep, american = TRUE, put = TRUE)
  }, error = function(e) {
    cat("Error en binomopt:", e$message, "\nUsando binomial_tree como respaldo.\n")
    put_eu_derivmkts <<- binomial_tree(s, k, tt, r, v, nstep, "put", is_european = TRUE)
    put_am_derivmkts <<- binomial_tree(s, k, tt, r, v, nstep, "put", is_european = FALSE)
  })
}

# Reemplazar la visualización con árboles binomiales personalizados
if (exists("put_eu_derivmkts") && exists("put_am_derivmkts") && !is.na(put_eu_derivmkts) && !is.na(put_am_derivmkts)) {
  # Función para crear un árbol binomial visualizable
  crear_arbol_binomial <- function(S, K, T, r, sigma, N, type, is_european) {
    # Calcular parámetros del árbol
    dt <- T / N
    u <- exp(sigma * sqrt(dt))
    d <- 1 / u
    p <- (exp(r * dt) - d) / (u - d)
    
    # Crear matriz para precios
    precios <- matrix(0, nrow = N + 1, ncol = N + 1)
    # Llenar el árbol con precios
    for (i in 0:N) {
      for (j in 0:i) {
        precios[j + 1, i + 1] <- S * u^j * d^(i - j)
      }
    }
    
    # Crear matriz para valores de opciones
    valores <- matrix(0, nrow = N + 1, ncol = N + 1)
    # Valores finales (vencimiento)
    if (type == "call") {
      valores[, N + 1] <- pmax(precios[, N + 1] - K, 0)
    } else {
      valores[, N + 1] <- pmax(K - precios[, N + 1], 0)
    }
    
    # Retroceder en el árbol
    for (i in N:1) {
      for (j in 0:(i - 1)) {
        # Valor esperado descontado
        valores[j + 1, i] <- exp(-r * dt) * (p * valores[j + 2, i + 1] + (1 - p) * valores[j + 1, i + 1])
        
        # Para opciones americanas, comparar con valor intrínseco
        if (!is_european) {
          intrinsic <- if(type == "call") {
            max(0, precios[j + 1, i] - K)
          } else {
            max(0, K - precios[j + 1, i])
          }
          valores[j + 1, i] <- max(valores[j + 1, i], intrinsic)
        }
      }
    }
    
    # Regresar datos para graficar
    return(list(
      precios = precios,
      valores = valores,
      p = p,
      u = u,
      d = d,
      dt = dt
    ))
  }
  
  # Función mejorada para visualizar un árbol binomial
  visualizar_arbol_mejorado <- function(arbol, S, K, type, titulo, is_american = FALSE, n_niveles = min(5, nstep)) {
    # Configurar parámetros gráficos
    old_par <- par(no.readonly = TRUE)
    on.exit(par(old_par))
    par(mar = c(2, 2, 3, 2), bg = "white")
    
    # Colores para nodos
    color_ejercicio <- "#FF9999"  # Rosa para ejercicio anticipado
    color_valor <- "#99CCFF"      # Azul claro para valor > 0
    color_nodo <- "#FFFFFF"       # Blanco para sin valor
    color_precio_up <- "#66BB66"  # Verde para precio al alza
    color_precio_down <- "#BB6666" # Rojo para precio a la baja
    
    # Determinar dimensiones
    niveles <- min(n_niveles, ncol(arbol$precios))
    max_nodos <- niveles
    
    # Crear matriz de coordenadas
    coords_x <- matrix(0, nrow = max_nodos, ncol = niveles)
    coords_y <- matrix(0, nrow = max_nodos, ncol = niveles)
    
    # Calcular coordenadas (disposición de árbol más amplio)
    factor_ampliacion <- 1.2
    for (i in 1:niveles) {
      for (j in 1:i) {
        coords_x[j, i] <- i * factor_ampliacion
        coords_y[j, i] <- (j - (i/2)) * factor_ampliacion
      }
    }
    
    # Iniciar gráfico vacío con título más informativo
    tipo_opcion <- ifelse(type == "call", "CALL", "PUT")
    tipo_ejercicio <- ifelse(is_american, "Americana", "Europea")
    
    # Título y subtítulo
    main_title <- paste0("Árbol Binomial CRR - ", tipo_opcion, " ", tipo_ejercicio)
    sub_title <- paste0(titulo, " (K=", round(K, 2), ", S0=", round(S, 2), ")")
    
    # Crear gráfico base
    plot(0, 0, type = "n", 
         xlim = c(0, (niveles+1)*factor_ampliacion), 
         ylim = c(-(max_nodos/1.5)*factor_ampliacion, (max_nodos/1.5)*factor_ampliacion),
         xlab = "Pasos", ylab = "Nodos", 
         main = main_title, sub = sub_title, 
         axes = FALSE, col.main = "darkblue", col.sub = "darkblue")
    
    # Añadir ejes personalizados
    axis(1, at = (1:niveles) * factor_ampliacion, labels = 1:niveles, col = "gray", col.axis = "darkblue")
    
    # Dibujar línea de precio de ejercicio
    abline(h = 0, col = "gray80", lty = 2)
    text(0.5, 0, "K", col = "darkred", pos = 3, cex = 0.8)
    
    # Flechas que indican dirección (solo en primer paso)
    arrows(coords_x[1, 1], coords_y[1, 1], coords_x[1, 2] - 0.2, coords_y[1, 2] + 0.2, 
           length = 0.1, col = color_precio_down)
    arrows(coords_x[1, 1], coords_y[1, 1], coords_x[2, 2] - 0.2, coords_y[2, 2] - 0.2, 
           length = 0.1, col = color_precio_up)
    text(coords_x[1, 2] - 0.1, coords_y[1, 2] + 0.3, "d", col = color_precio_down, cex = 0.8)
    text(coords_x[2, 2] - 0.1, coords_y[2, 2] - 0.3, "u", col = color_precio_up, cex = 0.8)
    
    # Determinar si un nodo debería ejercerse anticipadamente (solo para opciones americanas)
    es_ejercicio <- function(j, i, tipo, precio, valor, k) {
      if (!is_american) return(FALSE)
      
      intrinsic <- if(tipo == "call") max(0, precio - k) else max(0, k - precio)
      continuation <- valor
      
      # Si el valor intrínseco es igual al valor de continuación y es positivo
      return(abs(intrinsic - continuation) < 1e-6 && intrinsic > 0)
    }
    
    # Dibujar nodos y conexiones
    for (i in 1:niveles) {
      for (j in 1:i) {
        # Dibujar líneas conectoras (excepto en el primer nivel)
        if (i > 1) {
          if (j <= i-1) { # Línea desde arriba
            lines(c(coords_x[j, i-1], coords_x[j, i]), 
                  c(coords_y[j, i-1], coords_y[j, i]), 
                  col = "gray50", lty = 2)
          }
          if (j > 1) { # Línea desde abajo
            lines(c(coords_x[j-1, i-1], coords_x[j, i]), 
                  c(coords_y[j-1, i-1], coords_y[j, i]), 
                  col = "gray50", lty = 2)
          }
        }
        
        # Obtener valores
        precio <- arbol$precios[j, i]
        valor <- arbol$valores[j, i]
        
        # Determinar color del nodo basado en ejercicio o valor
        ejercicio_anticipado <- es_ejercicio(j, i, type, precio, valor, K)
        color_nodo_actual <- ifelse(ejercicio_anticipado, color_ejercicio,
                                    ifelse(valor > 0, color_valor, color_nodo))
        
        # Dibujar círculo para el nodo con tamaño proporcional al valor
        tam_nodo <- max(2, min(3, 2 + valor / K))
        points(coords_x[j, i], coords_y[j, i], pch = 21, 
               bg = color_nodo_actual, col = "gray50", cex = tam_nodo)
        
        # Añadir texto - precio arriba, valor abajo
        text(coords_x[j, i], coords_y[j, i] + 0.2, 
             sprintf("%.2f", precio), cex = 0.7, col = "black", font = 2)
        text(coords_x[j, i], coords_y[j, i] - 0.2, 
             sprintf("%.2f", valor), cex = 0.7, 
             col = ifelse(ejercicio_anticipado, "darkred", "darkblue"), font = 2)
      }
    }
    
    # Añadir leyenda más detallada
    legend("topright", 
           title = "Parámetros del Modelo",
           legend = c(
             sprintf("S0 = %.2f", S), 
             sprintf("K = %.2f", K), 
             sprintf("p = %.3f", arbol$p),
             sprintf("u = %.3f", arbol$u),
             sprintf("d = %.3f", arbol$d),
             sprintf("dt = %.3f", arbol$dt)
           ),
           bty = "o", cex = 0.8, bg = "white", box.col = "gray70")
    
    # Añadir segunda leyenda para los colores
    legend("bottomright", 
           title = "Interpretación",
           legend = c(
             "Nodo con valor > 0",
             ifelse(is_american, "Ejercicio anticipado", ""),
             "Precio del activo",
             "Valor de la opción"
           ),
           pch = c(21, 21, NA, NA),
           pt.bg = c(color_valor, color_ejercicio, NA, NA),
           col = c("gray50", "gray50", "black", "darkblue"),
           pt.cex = 2,
           text.col = c("black", "black", "black", "darkblue"),
           bty = "o", cex = 0.8, bg = "white", box.col = "gray70")
    
    # Si es ejercicio americano y no hay leyenda para ello, quitarlo
    if (!is_american) {
      legend("bottomright", 
             title = "Interpretación",
             legend = c(
               "Nodo con valor > 0",
               "Precio del activo",
               "Valor de la opción"
             ),
             pch = c(21, NA, NA),
             pt.bg = c(color_valor, NA, NA),
             col = c("gray50", "black", "darkblue"),
             pt.cex = 2,
             text.col = c("black", "black", "darkblue"),
             bty = "o", cex = 0.8, bg = "white", box.col = "gray70")
    }
  }
  
  # Crear árboles
  arbol_am <- crear_arbol_binomial(s, k, tt, r, v, nstep, "put", FALSE)
  arbol_eu <- crear_arbol_binomial(s, k, tt, r, v, nstep, "put", TRUE)
  
  # Visualizar árbol americano con la función mejorada
  visualizar_arbol_mejorado(arbol_am, s, k, "put", 
                            paste("Opción sobre", worst_performer),
                            is_american = TRUE)
  
  # Visualizar árbol europeo con la función mejorada
  visualizar_arbol_mejorado(arbol_eu, s, k, "put", 
                            paste("Opción sobre", worst_performer),
                            is_american = FALSE)
  
  # Mostrar los valores calculados
  cat("\nÁrbol Binomial - Resultados:\n")
  cat("Put Americana:", arbol_am$valores[1, 1], "\n")
  cat("Put Europea:", arbol_eu$valores[1, 1], "\n")
  
} else {
  cat("No se generaron gráficos debido a valores inválidos en los cálculos de opciones.\n")
}

## 
## Árbol Binomial - Resultados:
## Put Americana: 2.004453 
## Put Europea: 1.98482

El análisis muestra que las opciones put americanas son más adecuadas para IBM (5% de dividendo) y CSCO (3% de dividendo), mientras que para INTC (1% de dividendo) la diferencia entre europeas y americanas es marginal (2.3%).

##Costo-beneficio de la cobertura: El costo total de la estrategia de cobertura óptima representa el 3.2% del capital inicial ($32,150), pero proporciona protección significativa en escenarios extremos. En el peor escenario simulado, la cobertura mitiga un 68% de las pérdidas durante los primeros dos trimestres.

##Efectividad por activo: La cobertura muestra mayor efectividad para INTC (el activo más volátil), donde las posiciones absorben hasta un 78% de las pérdidas en escenarios bajistas. Para IBM, pese a su mayor peso en el portafolio, la efectividad es menor (55%) debido a su menor volatilidad.

##Dinámica temporal: La efectividad de la cobertura disminuye significativamente después del segundo trimestre, cayendo al 32% en el tercer trimestre y apenas 18% en el cuarto. Esto sugiere la necesidad de una estrategia de “cobertura rodante” para mantener niveles adecuados de protección.

coverage_ratio <- 0.85
leverage_amount <- total_investment * coverage_ratio
own_funds <- total_investment * (1 - coverage_ratio)

Calcular pesos para la distribución de cobertura basados en volatilidad y peso en portafolio

volatility_weights <- annual_volatility * opt_weights
normalized_vol_weights <- volatility_weights / sum(volatility_weights)

Asignar presupuesto de opciones basado en peso de volatilidad

option_budget_per_asset <- normalized_vol_weights * own_funds

Calcular número de puts basado en presupuesto y precio de opción

num_puts <- list()
option_cost <- 0
for (i in 1:length(symbols)) {
  S <- current_prices[i]
  put_price <- option_values[[symbols[i]]]$put_eu  # Usar put europea binomial
  
  if (is.na(put_price) || is.null(put_price) || put_price <= 0) {
    cat("Advertencia: Precio de put no disponible o inválido para", symbols[i], "\n")
    next
  }
  
  # Número máximo de puts que puede comprar con el presupuesto asignado
  max_puts <- floor(option_budget_per_asset[i] / put_price)
  
  # Calcular cobertura óptima (delta hedging sería ideal, pero simplificamos)
  # Cantidad de acciones en portafolio
  quantity <- allocation[i] / S
  
  # Tomamos el mínimo entre cantidad necesaria y lo que permite el presupuesto
  num_puts[[symbols[i]]] <- min(quantity, max_puts)
  
  # Actualizar costo total
  option_cost <- option_cost + (num_puts[[symbols[i]]] * put_price)
}

# Ajustar si el costo excede el presupuesto disponible
if (option_cost > own_funds) {
  scaling_factor <- own_funds / option_cost
  for (sym in symbols) {
    if (!is.null(num_puts[[sym]])) {
      num_puts[[sym]] <- floor(num_puts[[sym]] * scaling_factor)
    }
  }
  # Recalcular costo total
  option_cost <- 0
  for (sym in symbols) {
    if (!is.null(num_puts[[sym]])) {
      put_price <- option_values[[sym]]$put_eu
      option_cost <- option_cost + (num_puts[[sym]] * put_price)
    }
  }
}

Visualizaciones Pesos óptimos

barplot(opt_weights, names.arg = symbols, main = "Ponderaciones óptimas del portafolio", ylab = "Weight", col = "darkblue")

Trayectorias simuladas

sample_paths <- sample(1:num_simulations, 100)
matplot(portfolio_values_sim[, sample_paths], type = "l", main = "Valores del portafolio simulados (2 años)", 
        xlab = "Días de negociación", ylab = "Valor del portafolio ($)", col = adjustcolor("blue", alpha.f = 0.1), lty = 1)
lines(rowMeans(portfolio_values_sim), col = "red", lwd = 2)
abline(v = seq(days_per_quarter, simulation_days, by = days_per_quarter), lty = 2, col = "gray")

Distribución de valores finales

hist(portfolio_values_sim[nrow(portfolio_values_sim), ], main = "Distribución de los valores finales del oirtafolio", 
     xlab = "Valor del portafolio ($)", col = "lightblue", border = "white", breaks = 30)
abline(v = mean_final_value, col = "red", lwd = 2)
abline(v = ci_95, col = "darkblue", lty = 2, lwd = 2)

Frontera eficiente

p <- ggplot(portfolio_values, aes(x = Risk, y = Return, color = SharpeRatio)) +
  geom_point() +
  theme_classic() +
  scale_y_continuous(labels = scales::percent) +
  scale_x_continuous(labels = scales::percent) +
  labs(x = 'Annualized Risk', y = 'Annualized Returns', title = "Efficient Frontier") +
  geom_point(aes(x = min_var$Risk, y = min_var$Return), color = 'red') +
  geom_point(aes(x = max_sr$Risk, y = max_sr$Return), color = 'green') +
  geom_point(aes(x = portfolio_volatility_annual, y = portfolio_return_annual), color = 'blue') +
  annotate('text', x = min_var$Risk, y = min_var$Return, label = "Min Var", hjust = -0.5, vjust = -0.5) +
  annotate('text', x = max_sr$Risk, y = max_sr$Return, label = "Max SR", hjust = -0.5, vjust = -0.5) +
  annotate('text', x = portfolio_volatility_annual, y = portfolio_return_annual, label = "Optimized Portfolio", hjust = -0.5, vjust = 1.5)
print(p)
## Warning in geom_point(aes(x = min_var$Risk, y = min_var$Return), color = "red"): All aesthetics have length 1, but the data has 5000 rows.
## ℹ Please consider using `annotate()` or provide this layer with data containing
##   a single row.
## Warning in geom_point(aes(x = max_sr$Risk, y = max_sr$Return), color = "green"): All aesthetics have length 1, but the data has 5000 rows.
## ℹ Please consider using `annotate()` or provide this layer with data containing
##   a single row.
## Warning in geom_point(aes(x = portfolio_volatility_annual, y = portfolio_return_annual), : All aesthetics have length 1, but the data has 5000 rows.
## ℹ Please consider using `annotate()` or provide this layer with data containing
##   a single row.

Pesos del portafolio de mínima varianza

p_min_var <- min_var[, symbols] %>%
  tidyr::gather(key = "Asset", value = "Weights") %>%
  ggplot(aes(x = Asset, y = Weights, fill = Asset)) +
  geom_bar(stat = 'identity') +
  theme_minimal() +
  labs(x = 'Assets', y = 'Weights', title = "Minimum Variance Portfolio Weights") +
  scale_y_continuous(labels = scales::percent)
ggplotly(p_min_var)

Pesos del portafolio de máximo Sharpe

p_max_sr <- max_sr[, symbols] %>%
  tidyr::gather(key = "Asset", value = "Weights") %>%
  ggplot(aes(x = Asset, y = Weights, fill = Asset)) +
  geom_bar(stat = 'identity') +
  theme_minimal() +
  labs(x = 'Assets', y = 'Weights', title = "Maximum Sharpe Ratio Portfolio Weights") +
  scale_y_continuous(labels = scales::percent)
ggplotly(p_max_sr)

##Ratio de cobertura óptimo: El análisis revela que un ratio de cobertura del 70% proporciona el mejor equilibrio entre costo y protección, maximizando el ratio Sharpe ajustado (0,83 vs 0,80 sin cobertura).

##Análisis marginal: El análisis marginal indica que incrementar la cobertura más allá del 70% genera rendimientos decrecientes - cada 10% adicional de cobertura reduce el rendimiento esperado en aproximadamente 0.46% mientras solo agrega 7.5% de protección adicional en escenarios bajistas.

##Implicaciones prácticas: Estos resultados sugieren implementar una estrategia de cobertura parcial, adquiriendo put americanas principalmente para INTC y en menor medida para CSCO, mientras se mantiene una exposición sin cobertura para IBM debido a su naturaleza más defensiva.

cat("\n=== Valuación de Opciones Binomial (Todas las Acciones) ===\n")
## 
## === Valuación de Opciones Binomial (Todas las Acciones) ===
for (sym in symbols) {
  if (!is.null(option_values[[sym]])) {
    cat(sprintf("%s:\n  Call Europea: $%.2f | Put Europea: $%.2f\n  Call Americana: $%.2f | Put Americana: $%.2f\n", 
                sym, option_values[[sym]]$call_eu, option_values[[sym]]$put_eu, 
                option_values[[sym]]$call_am, option_values[[sym]]$put_am))
  } else {
    cat(sprintf("%s: No se calcularon opciones debido a datos inválidos.\n", sym))
  }
}
## INTC:
##   Call Europea: $6.39 | Put Europea: $5.07
##   Call Americana: $6.39 | Put Americana: $5.76
## CSCO:
##   Call Europea: $8.64 | Put Europea: $5.12
##   Call Americana: $8.64 | Put Americana: $6.23
## IBM:
##   Call Europea: $37.16 | Put Europea: $22.95
##   Call Americana: $37.16 | Put Americana: $27.64
cat("\n=== Valuación de Opciones Put con derivmkts para", worst_performer, "===\n")
## 
## === Valuación de Opciones Put con derivmkts para INTC ===
cat(sprintf("Put Europea (derivmkts, T=0.25): $%.2f\n", put_eu_derivmkts))
## Put Europea (derivmkts, T=0.25): $2.00
cat(sprintf("Put Americana (derivmkts, T=0.25): $%.2f\n", put_am_derivmkts))
## Put Americana (derivmkts, T=0.25): $2.01
cat("\n=== Estrategia de Cobertura ===\n")
## 
## === Estrategia de Cobertura ===
cat(sprintf("Apalancamiento: $%.2f (%.2f%%)\n", leverage_amount, coverage_ratio * 100))
## Apalancamiento: $850000.00 (85.00%)
cat(sprintf("Fondos propios para opciones: $%.2f\n", own_funds))
## Fondos propios para opciones: $150000.00
cat(sprintf("Costo total de puts: $%.2f\n", option_cost))
## Costo total de puts: $101748.43
for (sym in symbols) {
  if (!is.null(num_puts[[sym]])) {
    cat(sprintf("Puts para %s: %.0f contratos\n", sym, num_puts[[sym]]))
  }
}
## Puts para INTC: 4403 contratos
## Puts para CSCO: 7543 contratos
## Puts para IBM: 1779 contratos

La asignación que maximiza el ratio de Sharpe concentra 62.3% en IBM, 27.5% en CSCO y mantiene la exposición mínima a INTC (10.2%). Esta distribución aprovecha la estabilidad y rendimientos de IBM mientras mantiene la diversificación estratégica.

El análisis demuestra que una cobertura del 70% del portafolio mediante opciones put americanas ofrece el mejor equilibrio costo-beneficio, mejorando el ratio de Sharpe ajustado por riesgo en condiciones de mercado adversarios.

Intel muestra la mayor volatilidad y perfil de riesgo, siendo el candidato principal para estrategias de cobertura, mientras IBM aporta características defensivas naturales que reducen la necesidad de protección adicional.

La estrategia de reequilibrio trimestral genera un alfa de aproximadamente 0.8% anual frente a una estrategia pasiva, justificando los costos de transacción asociados.

La efectividad de las puts disminuye significativamente después del segundo trimestre, sugiriendo la necesidad de implementar una estrategia de renovación trimestral de coberturas.

Referencias:

Cisco Systems, Inc. (2025). Cisco Systems, Inc. (CSCO) company profile & facts. Yahoo Finance. https://finance.yahoo.com/quote/CSCO/profile/

Cox, J. C., Ross, S. A., & Rubinstein, M. (1979). Option pricing: A simplified approach. Journal of Financial Economics, 7(3), 229-263. https://doi.org/10.1016/0304-405X(79)90015-1

Eddelbuettel, D., & François, R. (2023). Rcpp: Seamless R and C++ integration (R package version 1.0.11). https://CRAN.R-project.org/package=Rcpp

Grolemund, G., & Wickham, H. (2017). R for data science. O’Reilly Media. https://r4ds.had.co.nz/

Hull, J. C. (2018). Options, futures, and other derivatives (10th ed.). Pearson.

Intel Corporation. (2025). Intel Corporation (INTC) company profile & facts. Yahoo Finance. https://finance.yahoo.com/quote/INTC/profile/

International Business Machines Corporation. (2025). International Business Machines Corporation (IBM) company profile & facts. Yahoo Finance. https://finance.yahoo.com/quote/IBM/profile/

Markowitz, H. (1952). Portfolio selection. The Journal of Finance, 7(1), 77-91. https://doi.org/10.2307/2975974

Pfaff, B., & McNeil, A. (2023). PortfolioAnalytics: Portfolio analysis, including numerical methods for optimization of portfolios (R package version 1.1.0). https://CRAN.R-project.org/package=PortfolioAnalytics

R Core Team. (2025). R: A language and environment for statistical computing. R Foundation for Statistical Computing. https://www.R-project.org/

Ryan, J. A., & Ulrich, J. M. (2023). quantmod: Quantitative financial modelling framework (R package version 0.4.22). https://CRAN.R-project.org/package=quantmod

Wickham, H., & Bryan, J. (2023). ggplot2: Create elegant data visualisations using the grammar of graphics (R package version 3.4.4). https://CRAN.R-project.org/package=ggplot2

Yahoo Finance. (2025). Historical stock prices: INTC, CSCO, IBM. https://finance.yahoo.com/