Análisis del portafolio

Portafolio Óptimo con Media-Varianza y Análisis de Riesgo.

El presente análisis desarrolla un portafolio óptimo basado en el modelo de media-varianza de Markowitz, utilizando datos históricos de las acciones de Intel (INTC), Cisco (CSCO) e IBM, con el objetivo de maximizar el retorno ajustado al riesgo mediante el ratio de Sharpe. A través de herramientas cuantitativas como el Movimiento Browniano Geométrico para proyecciones de precios, simulaciones Monte Carlo para escenarios futuros y árboles binomiales para valoración de opciones, se evalúan el desempeño del portafolio y estrategias de cobertura ante riesgos de mercado. Este estudio integra análisis de volatilidad, correlaciones y métricas clave como el VaR, ofreciendo una perspectiva integral sobre la gestión de inversiones en un contexto financiero dinámico.

Para el desarollo contemplamos las siguientes compañias:

Intel Corporation (INTC): Intel es una multinacional estadounidense líder en la fabricación de semiconductores, reconocida por desarrollar la serie de microprocesadores x86, ampliamente utilizados en computadoras personales. Con sede en Santa Clara, California, la empresa diseña y produce componentes como CPUs y chipsets, siendo uno de los mayores proveedores mundiales de tecnología para sistemas informáticos (Intel Corporation, 2025).

Cisco Systems, Inc. (CSCO): Cisco es una corporación multinacional con sede en San José, California, especializada en tecnología de comunicaciones digitales. Se dedica al diseño, fabricación y venta de equipos de red, software y servicios, destacando en mercados como el Internet de las Cosas, seguridad de dominio y videoconferencia, con productos como Webex y Silicon One (Cisco Systems, Inc., 2025).

International Business Machines Corporation (IBM): IBM, fundada en 1911 y con sede en Armonk, Nueva York, es una de las empresas pioneras en tecnología informática. Ofrece servicios de TI, software, sistemas y soluciones de inteligencia artificial y nube, habiendo evolucionado desde la producción de hardware hacia un enfoque en innovación tecnológica y consultoría (International Business Machines Corporation, 2025).

A continuación damos desarrollo al taller planteado:

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.468384650298428 CSCO=0.204642052165547 IBM=0.222339410267505

## Acción más en caída: INTC

Optimizamos el portafolio con un capital inicial de $1,000,000, restringiendo los pesos entre 10% y 80%.

# 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
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

Generamos 5.000 portafolios aleatorios para trazar la frontera eficientemente.

# 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.26

Valoración de Opciones con Árboles Binomiales

Acá es donde entran los derivados. Para cubrir el activo con menor peso en el portafolio el cual resultó ser INTC, construmos árboles binomiales para valorar opciones.

Modelo CRR (Cox-Ross-Rubinstein) para armar el árbol.

Compararamos opciones europeas vs americanas

Calculamos las griegas: Delta, Gamma, Theta, Vega, Rho

# 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

Estrategias de Cobertura con Opciones

El último componente fue analizar cómo cubrir el portafolio sin gastar de más, usando diferentes estrategias con puts, incluyendo un rolling trimestral

Analizamos distintos niveles de cobertura y cómo cambian los resultados.

Probamos con puts ATM, OTM, collars, put spreads, etc.

Simulamos escenarios de mercado: bajista, neutral y alcista.

Evaluamos cómo la volatilidad impacta el costo/beneficio de cubrirse.

El rolling trimestral nos permitió mantener cobertura activa y ajustada.

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)

Resultados

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.45

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

Resultados y Conclusiones sobre el portafolio:

Según el análisis realizado, el modelo de Markowitz permitió construir un portafolio óptimo que maximiza el ratio de Sharpe, priorizando activos menos volátiles como IBM y CSCO, mientras que INTC se identificó como el de peor rendimiento histórico. La frontera eficiente delineó combinaciones óptimas de riesgo y rendimiento, evidenciando una volatilidad anual moderada y un retorno positivo, resultados validados mediante simulaciones Monte Carlo. En la valoración de opciones, los árboles binomiales CRR mostraron que las opciones americanas, particularmente puts sobre INTC, presentan mayor valor debido a la flexibilidad de ejercicio anticipado en escenarios bajistas. La estrategia de cobertura, con un 85% de protección mediante puts europeos ajustados por volatilidad y peso, demostró efectividad para mitigar caídas, apoyada en un reequilibrio trimestral que aportó adaptabilidad al mercado. Finalmente, métricas como el VaR al 1% y 5% cuantificaron riesgos extremos, y las trayectorias simuladas confirmaron la estabilidad del portafolio a dos años con reequilibrio periódico.

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/