Carga de paquetes

options(scipen=999)
library(quantmod)
library(ggplot2)
library(plotly)
library(papaja)
library(dplyr)
library(lubridate)
library(xts)
library(forecast)
library(knitr)
library(scales)
library(tidyr)
library(tidyquant)
library(plotly) 
library(timetk)
library(scales)
library(gridExtra)
library(forcats)
library(kableExtra)
library(e1071)

Introducción

El presente informe tiene como propósito diseñar y evaluar una estrategia de inversión a 10 años basada en un portafolio diversificado de tres acciones, con una inversión inicial de 10 millones de dólares. A partir del análisis de datos históricos desde el 1 de octubre de 2023, se construye un portafolio óptimo bajo el enfoque de media-varianza, complementado con una simulación de precios mediante un modelo de Movimiento Geométrico Browniano (MGB) que permite proyectar el comportamiento esperado de los activos en el tiempo. El estudio incluye la medición del desempeño a través de indicadores clave como el índice de Sharpe, la volatilidad, los precios esperados trimestrales y el Valor en Riesgo (VaR) al 1% y 5%. Finalmente, se plantea una estrategia de cobertura integral mediante opciones europeas y americanas —calls y puts— con pagos trimestrales y apalancamiento basado en la tasa de los bonos del tesoro, orientada a cubrir el 85% del portafolio. Con ello, se busca garantizar una gestión eficiente del riesgo, mantener la exposición controlada ante la volatilidad del mercado y maximizar el rendimiento ajustado al riesgo de la inversión.

Parte 1. Cree un portafolio de media varianza de las tres acciones en las cuales invertirá 10 millones de dólares, usando la misma base de datos y simule por medio de MGB los precios hasta la fecha máxima de inversión, este portafolio será su subyacente.

1.1 Descargar los datos

# --- Parámetros base ---
tickers <- c("INTC", "KO", "BAC")
start_date <- "2023-10-01"
end_date <- "2025-10-31"
investment <- 10000000   # 10 millones de dólares
risk_free <- 0.040930       # Tasa bono del Tesoro a 10 años

# --- Descarga de precios históricos ---
price_data <- tq_get(tickers, from = start_date, to = end_date, get = "stock.prices")

#Mostrar el head
head(price_data,5)
## # A tibble: 5 × 8
##   symbol date        open  high   low close   volume adjusted
##   <chr>  <date>     <dbl> <dbl> <dbl> <dbl>    <dbl>    <dbl>
## 1 INTC   2023-10-02  35.6  36.0  35.0  35.5 26086200     34.9
## 2 INTC   2023-10-03  35.3  36.5  35.3  35.7 45292600     35.1
## 3 INTC   2023-10-04  36.5  36.5  35.3  35.9 39842200     35.3
## 4 INTC   2023-10-05  36.0  36.1  35.6  35.9 25771200     35.3
## 5 INTC   2023-10-06  35.9  36.5  35.2  36.2 33262200     35.6
# --- Gráfico interactivo con Plotly ---
plot_hist <- price_data %>%
  ggplot(aes(x = date, y = close, color = symbol)) +
  geom_line(size = 0.9, alpha = 0.9) +
  theme_minimal() +
  labs(
    title = "Evolución histórica del precio de cierre (INTC, KO, BAC)",
    subtitle = "Desde 1 de octubre de 2023 hasta la fecha actual",
    x = "Fecha",
    y = "Precio de cierre (USD)",
    color = "Acción"
  ) +
  theme(
    plot.title = element_text(size = 14, face = "bold"),
    plot.subtitle = element_text(size = 11),
    legend.position = "bottom"
  )

ggplotly(plot_hist)

El gráfico muestra la evolución histórica del precio de cierre de tres acciones: Bank of America (BAC), Intel (INTC) y Coca-Cola (KO), desde Octubre de 2023 hasta Octubre de 2025. Se observa que:

KO (Coca-Cola) presenta un comportamiento más estable, con precios relativamente altos (entre 55 y 70 USD) y menor volatilidad. Esto sugiere que puede actuar como un activo defensivo dentro del portafolio.

BAC (Bank of America) mantiene un rango medio (alrededor de 30–40 USD) y muestra fluctuaciones moderadas, reflejando cierta sensibilidad a las condiciones del mercado financiero.

INTC (Intel) exhibe el comportamiento más volátil, con caídas marcadas y recuperaciones pronunciadas, oscilando entre 20 y 45 USD. Esta volatilidad puede aumentar el riesgo, pero también ofrecer oportunidades de rendimiento.

En conjunto, las tres acciones representan sectores distintos (financiero, tecnológico y de consumo básico), lo que favorece la diversificación. Por tanto, al combinarlas, es posible reducir el riesgo total del portafolio mediante la compensación de sus variaciones individuales.

# --- Cálculo de retornos logarítmicos diarios ---
log_ret_tidy <- price_data %>%
  group_by(symbol) %>%
  tq_transmute(select = close,
               mutate_fun = periodReturn,
               period = "daily",
               col_rename = "ret",
               type = "log")

# Convertir a formato xts
log_ret_xts <- log_ret_tidy %>%
  spread(symbol, value = ret) %>%
  tk_xts()

# --- Media y matriz de covarianzas anualizadas ---
mean_ret <- colMeans(log_ret_xts, na.rm = TRUE)
sd_ret <- apply(log_ret_xts, 2, sd, na.rm = TRUE)  
cov_mat <- cov(log_ret_xts, use = "complete.obs") * 252  # anualizado

# --- Tablas ---
tabla_estad <- data.frame(
  Activo = names(mean_ret),
  Media_Diaria = round(mean_ret, 6),
  Desv_Diaria = round(sd_ret, 6)
)

knitr::kable(
  tabla_estad,
  caption = "Media y desviación estándar diaria de los retornos logarítmicos",
  align = "c"
)
Media y desviación estándar diaria de los retornos logarítmicos
Activo Media_Diaria Desv_Diaria
BAC BAC 0.001312 0.016324
INTC INTC 0.000238 0.035669
KO KO 0.000416 0.009845 
kable(as.data.frame(cov_mat), 
      caption = "Matriz de covarianzas anualizada de los retornos logarítmicos")
Matriz de covarianzas anualizada de los retornos logarítmicos
BAC INTC KO
BAC 0.0671478 0.0432754 0.0025627
INTC 0.0432754 0.3206164 0.0024494
KO 0.0025627 0.0024494 0.0244255

La tabla evidencia diferencias importantes en el comportamiento de los activos analizados. Bank of America (BAC) presenta la mayor rentabilidad promedio diaria (0.0013), lo que sugiere un activo con mejor desempeño esperado, mientras que Intel (INTC) muestra la mayor volatilidad (0.0357), reflejando un riesgo más elevado frente a variaciones en el mercado. Por su parte, Coca-Cola (KO) exhibe tanto la menor volatilidad (0.0098) como un retorno moderado, lo que la convierte en un activo defensivo dentro del portafolio. En conjunto, estas diferencias anticipan que la combinación óptima podría asignar un mayor peso a BAC por su rendimiento y riesgo intermedio y a INTC en caso de buscar un perfil de riesgo mayor.

# --- Simulación de 5000 combinaciones de pesos ---
num_port <- 5000
all_wts <- matrix(nrow = num_port, ncol = length(tickers))
port_returns <- port_risk <- sharpe_ratio <- numeric(num_port)

set.seed(123)
for (i in seq_len(num_port)) {
  wts <- runif(length(tickers))
  wts <- wts / sum(wts)
  
  all_wts[i, ] <- wts
  port_ret <- sum(wts * mean_ret)
  port_ret <- ((1 + port_ret)^252) - 1
  port_sd <- sqrt(t(wts) %*% (cov_mat %*% wts))
  
  port_returns[i] <- port_ret
  port_risk[i] <- port_sd
  sharpe_ratio[i] <- (port_ret - risk_free) / port_sd
}

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

all_wts <- tk_tbl(all_wts)
colnames(all_wts) <- tickers
portfolio_values <- tk_tbl(cbind(all_wts, portfolio_values))

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

all_wts <- tk_tbl(all_wts)
colnames(all_wts) <- tickers
portfolio_values <- tk_tbl(cbind(all_wts, portfolio_values))

# --- Portafolios clave ---
min_var <- portfolio_values[which.min(portfolio_values$Risk), ]
max_sr <- portfolio_values[which.max(portfolio_values$SharpeRatio), ]

# Crear tablas limpias con los pesos
tabla_min_var <- min_var %>%
  select(INTC, KO, BAC) %>%
  round(3) %>%
  kable(col.names = c("INTC", "KO", "BAC"),
        caption = "Pesos del Portafolio de Varianza Mínima") %>%
  kable_styling(full_width = FALSE, position = "center")

tabla_max_sr <- max_sr %>%
  select(INTC, KO, BAC) %>%
  round(3) %>%
  kable(col.names = c("INTC", "KO", "BAC"),
        caption = "Pesos del Portafolio Tangencial (Máxima Razón de Sharpe)") %>%
  kable_styling(full_width = FALSE, position = "center")

# Mostrar tablas
tabla_min_var
Pesos del Portafolio de Varianza Mínima
INTC KO BAC
0.241 0.018 0.741 
tabla_max_sr
Pesos del Portafolio Tangencial (Máxima Razón de Sharpe)
INTC KO BAC
0.726 0 0.274 
# --- Gráfico portafolio de mínima varianza ---
p <- min_var %>%
  gather(INTC:BAC, key = Asset,
         value = Weights) %>%
  mutate(Asset = as.factor(Asset)) %>%
  ggplot(aes(x = fct_reorder(Asset,Weights), y = Weights, fill = Asset)) +
  geom_bar(stat = 'identity') +
  theme_minimal() +
  labs(x = 'Assets', y = 'Weights', title = "Pesos del portafolio de mínima varianza") +
  scale_y_continuous(labels = scales::percent) 

ggplotly(p)
# --- Gráfico portafolio tangencial ---
p <- max_sr %>%
  gather(INTC:BAC, key = Asset,
         value = Weights) %>%
  mutate(Asset = as.factor(Asset)) %>%
  ggplot(aes(x = fct_reorder(Asset,Weights), y = Weights, fill = Asset)) +
  geom_bar(stat = 'identity') +
  theme_minimal() +
  labs(x = 'Assets', y = 'Weights', title = "Pesos del portafolio de tangencial") +
  scale_y_continuous(labels = scales::percent) 

ggplotly(p)
# --- Gráfico frontera eficiente ---
p <- portfolio_values %>%
  ggplot(aes(x = Risk, y = Return, color = SharpeRatio)) +
  geom_point(alpha = 0.6) +
  theme_minimal() +
  scale_y_continuous(labels = scales::percent_format(accuracy = 0.1)) +
  scale_x_continuous(labels = scales::percent_format(accuracy = 0.1)) +
  labs(x = "Riesgo Anualizado",
       y = "Retorno Anualizado",
       title = "Frontera Eficiente - Portafolio INTC, KO, BAC",
       color = "Ratio de Sharpe") +
  
  # Puntos especiales (color fijo, sin aes)
  geom_point(data = min_var, aes(x = Risk, y = Return),
             color = "red", size = 3) +
  geom_point(data = max_sr, aes(x = Risk, y = Return),
             color = "blue", size = 3) +
  
  # Añadimos leyenda manual aparte
  annotate("text", x = 0.40, y = max(portfolio_values$Return)*0.95,
           label = "⬤ Portafolio de Varianza Mínima", color = "red", hjust = 1, size = 3.5) +
  annotate("text", x = 0.40, y = max(portfolio_values$Return)*0.90,
           label = "⬤ Portafolio Tangencial (Máx. Sharpe)", color = "blue", hjust = 1, size = 3.5) +
  
  theme(
    legend.position = "bottomright",
    legend.title = element_text(size = 10, face = "bold"),
    legend.text = element_text(size = 9)
  )

ggplotly(p)

La frontera eficiente muestra las combinaciones óptimas de INTC, KO y BAC, generadas a partir de 5.000 simulaciones. El portafolio de varianza mínima se ubica en la zona de menor riesgo, compuesto principalmente por BAC, que aporta estabilidad debido a su relación riesgo_rentabilidad. En contraste, el portafolio tangencial o de máxima razón de Sharpe (azul) prioriza el portafolio que ofrece el sharpe máximo y se concentra en INTC (72.6%) y BAC (27.4%), excluyendo a KO por su bajo rendimiento. Los resultados evidencian que la diversificación entre sectores permite reducir el riesgo total, mientras que la combinación INTC–BAC maximiza el rendimiento ajustado por riesgo (Sharpe).

# --- Simulación de precios con MGB ---
price_last <- price_data %>% group_by(symbol) %>% summarize(last_price = last(close))

# Parámetros base
n_years <- 10
n_days <- 252 * n_years
n_sims <- 1000

simulate_MGB <- function(S0, mu, sigma, T = n_days, N = n_sims) {
  dt <- 1/252
  W <- matrix(rnorm(T * N, mean = 0, sd = sqrt(dt)), nrow = T)
  drift <- (mu - 0.5 * sigma^2) * dt
  diffusion <- sigma * W
  log_paths <- apply(diffusion, 2, cumsum) + drift * (1:T)
  S <- S0 * exp(log_paths)
  return(S)
}

# --- Simulación por activo ---
set.seed(123)
sim_INTC <- simulate_MGB(price_last$last_price[price_last$symbol == "INTC"],
                         mean_ret["INTC"], sd(log_ret_xts[, "INTC"]))
sim_KO <- simulate_MGB(price_last$last_price[price_last$symbol == "KO"],
                       mean_ret["KO"], sd(log_ret_xts[, "KO"]))
sim_BAC <- simulate_MGB(price_last$last_price[price_last$symbol == "BAC"],
                        mean_ret["BAC"], sd(log_ret_xts[, "BAC"]))

# --- Gráfico 1: INTC ---
matplot(sim_INTC, type = "l", lty = 1, col = rgb(0.2, 0.4, 0.8, 0.1),
        main = "INTC - Simulación MGB (1000 caminos a 10 años)",
        xlab = "Días", ylab = "Precio (USD)")
lines(rowMeans(sim_INTC), col = "red", lwd = 2)
legend("topleft", legend = c("Caminos simulados", "Promedio"),
       col = c(rgb(0.2, 0.4, 0.8, 0.4), "red"), lwd = c(1, 2), bty = "n")

# --- Gráfico 2: KO ---
matplot(sim_KO, type = "l", lty = 1, col = rgb(0.2, 0.6, 0.2, 0.1),
        main = "KO - Simulación MGB (1000 caminos a 10 años)",
        xlab = "Días", ylab = "Precio (USD)")
lines(rowMeans(sim_KO), col = "red", lwd = 2)
legend("topleft", legend = c("Caminos simulados", "Promedio"),
       col = c(rgb(0.2, 0.6, 0.2, 0.4), "red"), lwd = c(1, 2), bty = "n")

# --- Gráfico 3: BAC ---
matplot(sim_BAC, type = "l", lty = 1, col = rgb(0.8, 0.4, 0.2, 0.1),
        main = "BAC - Simulación MGB (1000 caminos a 10 años)",
        xlab = "Días", ylab = "Precio (USD)")
lines(rowMeans(sim_BAC), col = "red", lwd = 2)
legend("topleft", legend = c("Caminos simulados", "Promedio"),
       col = c(rgb(0.8, 0.4, 0.2, 0.4), "red"), lwd = c(1, 2), bty = "n")

Las simulaciones por Movimiento Geométrico Browniano (MGB) proyectan 1.000 trayectorias de precios para 10 años. En INTC, se evidencia una mayor dispersión de los caminos, reflejando alta volatilidad y, por tanto, un riesgo elevado en el largo plazo. En KO, los precios simulados se mantienen más concentrados alrededor del promedio, confirmando su carácter defensivo y baja volatilidad. En BAC, la dispersión es moderada, situándose entre ambos extremos. En conjunto, los resultados son coherentes con las desviaciones históricas estimadas y permiten inferir que INTC aporta mayor potencial de retorno pero con más riesgo, mientras que KO y BAC actuan como activos un poco más defensivos

Parte 2. Analice criterios de índice Sharpe, Volatilidad, precios esperados cada trimestre de cierre, el comportamiento de mercado y la estructura de ganancias esperadas y perdidas VaR al 1% y 5%.

# ----- Parámetros -----
risk_free <- 0.040930 
n_years <- 10
trading_days_per_year <- 252
n_days <- n_years * trading_days_per_year
n_sims <- 1000
days_per_quarter <- round(trading_days_per_year/4)

# ----- Pesos del portafolio -----
w_min <- as.numeric(min_var %>% select(INTC, KO, BAC))
w_tang <- as.numeric(max_sr %>% select(INTC, KO, BAC))
names(w_min) <- names(w_tang) <- c("INTC","KO","BAC")

# ----- Estadísticos básicos (en forma anual) -----
mean_ret_annual <- mean_ret * 252       # vector por activo
sd_ret_annual   <- apply(log_ret_xts, 2, sd, na.rm=TRUE) * sqrt(252)

stats_tbl <- data.frame(
  Activo = names(mean_ret_annual),
  Mean_Annual = round(mean_ret_annual, 6),
  SD_Annual = round(sd_ret_annual, 6)
)
kable(stats_tbl, caption = "Media y desviación anual de retornos (por activo)")
Media y desviación anual de retornos (por activo)
Activo Mean_Annual SD_Annual
BAC BAC 0.330633 0.259129
INTC INTC 0.059972 0.566230
KO KO 0.104941 0.156287 
# ----- Portafolio: retorno, riesgo y Sharpe para ambos conjuntos de pesos -----
port_metrics <- function(w) {
  cov_annual <- cov(log_ret_xts, use = "complete.obs") * 252
  mu_p <- sum(w * mean_ret_annual)
  sd_p <- sqrt(t(w) %*% cov_annual %*% w)
  tibble(Return = mu_p, Vol = sd_p, Sharpe = (mu_p - risk_free) / sd_p)
}

metrics_minvar <- port_metrics(w_min) %>% mutate(Portafolio = "MinVar")
metrics_tang  <- port_metrics(w_tang) %>% mutate(Portafolio = "Tangency")

bind_rows(metrics_minvar, metrics_tang) %>%
  select(Portafolio, everything()) %>%
  kable(caption = "Métricas de portafolio (anuales)")
Métricas de portafolio (anuales)
Portafolio Return Vol Sharpe
MinVar 0.1585475 0.1370079 0.8584725
Tangency 0.2686743 0.1954849 1.1650226

Métricas anuales de los activos

BAC (Bank of America): Tiene la mayor rentabilidad esperada anual (33.06%), pero con una volatilidad moderada (25.9%), lo que la hace el activo con mejor relación retorno-riesgo individual.

INTC (Intel): Presenta una rentabilidad esperada muy baja (5.99%) y una volatilidad muy alta (56.6%), por lo tanto, es el activo más riesgoso.

KO (Coca-Cola): Ofrece una rentabilidad intermedia (10.49%) con baja volatilidad (15.6%), siendo el activo más estable del conjunto.

Análisis portafolios

-Portafolio de mínima varianza (MinVar):

Rentabilidad esperada: 15.85% anual Volatilidad: 13.70% anual Sharpe: 0.86

Este portafolio prioriza la reducción del riesgo total, logrando una buena eficiencia: obtiene un rendimiento razonable con baja volatilidad.

-Portafolio de tangencia (máximo Sharpe):

Rentabilidad esperada: 26.87% anual Volatilidad: 19.55% anual Sharpe: 1.17

Este es el portafolio óptimo, ya que maximiza el retorno por unidad de riesgo. Ofrece un rendimiento superior al de mínima varianza, con algo más de riesgo, pero una mejor compensación riesgo-beneficio.

# Tomo últimos precios observados
S0 <- price_last$last_price
names(S0) <- price_last$symbol
# Cantidad de acciones por activo si se invierte según pesos tangenciales o minvar:
shares_from_weights <- function(w, S0, invest = investment){
  alloc <- invest * w         # dólares por activo
  shares <- alloc / S0[names(w)]
  return(shares)
}
shares_minvar <- shares_from_weights(w_min, S0)
shares_tang    <- shares_from_weights(w_tang, S0)

# ----- Precios esperados cada trimestre basados en las simulaciones MGB -----

# Función para obtener medias en los finales de trimestre
get_quarter_means <- function(sim_mat){
  q_indices <- seq(days_per_quarter, n_days, by = days_per_quarter)
  q_means <- sapply(q_indices, function(i) mean(sim_mat[i, ], na.rm = TRUE))
  return(q_means)
}

q_means_INTC <- get_quarter_means(sim_INTC)
q_means_KO   <- get_quarter_means(sim_KO)
q_means_BAC  <- get_quarter_means(sim_BAC)

quarters <- seq(1, length(q_means_INTC))

# Tabla resumen de precios esperados por trimestre (primeras filas)
table_quarter_prices <- tibble(
  Quarter = quarters,
  INTC = round(q_means_INTC, 2),
  KO   = round(q_means_KO, 2),
  BAC  = round(q_means_BAC, 2)
)

kable(head(table_quarter_prices, 40), caption = "Precios esperados por trimestre")
Precios esperados por trimestre
Quarter INTC KO BAC
1 40.17 68.99 53.05
2 40.18 68.99 53.07
3 40.20 68.97 53.07
4 40.26 68.97 53.12
5 40.25 68.98 53.17
6 40.24 68.98 53.18
7 40.29 68.99 53.20
8 40.26 69.01 53.22
9 40.25 69.01 53.24
10 40.24 69.03 53.23
11 40.21 69.05 53.26
12 40.21 69.06 53.28
13 40.20 69.06 53.31
14 40.19 69.07 53.34
15 40.22 69.07 53.37
16 40.24 69.07 53.36
17 40.25 69.08 53.37
18 40.24 69.07 53.36
19 40.20 69.09 53.35
20 40.16 69.10 53.36
21 40.16 69.11 53.38
22 40.14 69.10 53.41
23 40.18 69.09 53.42
24 40.19 69.11 53.45
25 40.16 69.11 53.46
26 40.14 69.10 53.49
27 40.14 69.10 53.52
28 40.12 69.12 53.54
29 40.14 69.12 53.55
30 40.15 69.13 53.55
31 40.17 69.14 53.56
32 40.17 69.16 53.60
33 40.19 69.14 53.60
34 40.16 69.14 53.61
35 40.13 69.14 53.63
36 40.08 69.14 53.67
37 40.07 69.15 53.68
38 40.08 69.18 53.69
39 40.11 69.18 53.70
40 40.15 69.20 53.71 
# ----- Valor del portafolio esperado por trimestre (promedio de simulaciones) -----
calc_portfolio_values_by_quarter <- function(sim_list, shares){
  q_indices <- seq(days_per_quarter, n_days, by = days_per_quarter)
  n_q <- length(q_indices)
  portfolio_vals <- matrix(0, nrow = n_q, ncol = n_sims)
  for (j in seq_along(q_indices)){
    i <- q_indices[j]
    portfolio_vals[j, ] <- shares["INTC"] * sim_list$INTC[i, ] +
                           shares["KO"]   * sim_list$KO[i, ] +
                           shares["BAC"]  * sim_list$BAC[i, ]
  }
  return(portfolio_vals)
}

sim_list <- list(INTC=sim_INTC, KO=sim_KO, BAC=sim_BAC)
port_vals_minvar <- calc_portfolio_values_by_quarter(sim_list, shares_minvar)
port_vals_tang    <- calc_portfolio_values_by_quarter(sim_list, shares_tang)

# medias por trimestre
port_mean_minvar <- rowMeans(port_vals_minvar)
port_mean_tang    <- rowMeans(port_vals_tang)

kable( tibble(
  Quarter = quarters,
  PortVal_MinVar = round(port_mean_minvar,2),
  PortVal_Tang = round(port_mean_tang,2)
), caption = "Valor de portafolio esperado por trimestre (promedio de simulaciones)")
Valor de portafolio esperado por trimestre (promedio de simulaciones)
Quarter PortVal_MinVar PortVal_Tang
1 10003150 10002780
2 10007170 10006566
3 10008318 10010086
4 10018578 10022771
5 10024780 10023545
6 10026706 10023324
7 10031536 10032376
8 10032258 10028018
9 10034109 10026831
10 10033248 10025213
11 10035362 10020268
12 10038638 10022097
13 10042048 10021097
14 10046191 10022374
15 10051822 10028854
16 10051550 10031906
17 10052660 10034075
18 10051272 10032033
19 10047168 10024429
20 10046999 10017603
21 10049072 10017441
22 10051851 10016244
23 10056609 10024074
24 10060821 10027199
25 10060566 10021901
26 10064094 10020662
27 10067633 10020997
28 10069644 10019089
29 10072164 10024214
30 10072696 10025870
31 10075393 10029255
32 10080695 10030686
33 10081427 10035260
34 10081328 10029989
35 10082873 10025604
36 10084664 10019185
37 10085781 10017849
38 10087108 10018780
39 10090588 10025545
40 10094721 10033118 
# ----- VaR al 1% y 5% por trimestre (desde simulaciones) -----
compute_var_sim <- function(port_vals_matrix, invest = investment){

  n_q <- nrow(port_vals_matrix)
  VaR_1 <- VaR_5 <- numeric(n_q)
  for (j in 1:n_q){
    rets <- (port_vals_matrix[j, ] - invest) / invest 
    VaR_1[j] <- -quantile(rets, probs = 0.01, na.rm = TRUE)  
    VaR_5[j] <- -quantile(rets, probs = 0.05, na.rm = TRUE)
  }
  tibble(Quarter = 1:n_q, VaR_1 = VaR_1, VaR_5 = VaR_5)
}

VaR_minvar_tbl <- compute_var_sim(port_vals_minvar)
VaR_tang_tbl    <- compute_var_sim(port_vals_tang)

kable(head(VaR_tang_tbl, 8), caption = "VaR (simulado) por trimestre - Portafolio Tangencial (primeras 8 trimestres)")
VaR (simulado) por trimestre - Portafolio Tangencial (primeras 8 trimestres)
Quarter VaR_1 VaR_5
1 0.0288562 0.0209200
2 0.0402512 0.0296594
3 0.0506927 0.0350649
4 0.0554126 0.0394509
5 0.0602289 0.0427518
6 0.0639534 0.0456727
7 0.0691429 0.0508992
8 0.0719342 0.0551467 
# ----- VaR paramétrico (normal) por horizonte trimestral -----
mu_p_min <- as.numeric(metrics_minvar$Return)
sd_p_min <- as.numeric(metrics_minvar$Vol)

mu_p_tan <- as.numeric(metrics_tang$Return)
sd_p_tan <- as.numeric(metrics_tang$Vol)

# VaR paramétrico para horizonte h años (trimestre = 0.25)
z_1pct <- qnorm(0.01)
z_5pct <- qnorm(0.05)
h <- 1/4

param_var <- function(mu_p, sd_p, h){
  mu_h <- mu_p * h
  sd_h <- sd_p * sqrt(h)
  VaR1 <- -(mu_h + z_1pct * sd_h)
  VaR5 <- -(mu_h + z_5pct * sd_h)
  return(c(VaR1 = VaR1, VaR5 = VaR5))
}

param_var_min <- param_var(mu_p_min, sd_p_min, h)
param_var_tan <- param_var(mu_p_tan, sd_p_tan, h)

tibble(
  Portafolio = c("MinVar", "Tangency"),
  ParamVaR_1 = c(param_var_min["VaR1"], param_var_tan["VaR1"]),
  ParamVaR_5 = c(param_var_min["VaR5"], param_var_tan["VaR5"])
) %>% kable(caption = "VaR paramétrico por trimestre (retornos)")
VaR paramétrico por trimestre (retornos)
Portafolio ParamVaR_1 ParamVaR_5
MinVar 0.1197272 0.0730421
Tangency 0.1602144 0.0936034 
# --- Preparar datos para graficar ---
VaR_minvar_tbl <- VaR_minvar_tbl %>%
  mutate(Portafolio = "MinVar")

VaR_tang_tbl <- VaR_tang_tbl %>%
  mutate(Portafolio = "Tangency")

VaR_combined <- bind_rows(VaR_minvar_tbl, VaR_tang_tbl) %>%
  pivot_longer(cols = c(VaR_1, VaR_5),
               names_to = "Nivel",
               values_to = "VaR")

# --- Gráfico de evolución del VaR ---
ggplot(VaR_combined, aes(x = Quarter, y = VaR, color = Portafolio, linetype = Nivel)) +
  geom_line(size = 1) +
  theme_minimal() +
  labs(
    title = "Evolución del VaR simulado por trimestre",
    subtitle = "Comparación entre portafolios MinVar y Tangency",
    x = "Trimestre",
    y = "VaR (pérdida porcentual esperada)",
    color = "Portafolio",
    linetype = "Nivel de confianza"
  ) +
  scale_color_manual(values = c("MinVar" = "steelblue", "Tangency" = "darkorange")) +
  theme(
    legend.position = "top",
    plot.title = element_text(face = "bold")
  )

La tabla del VaR paramétrico por trimestre muestra las pérdidas porcentuales esperadas bajo una distribución normal de los rendimientos. Para el portafolio de mínima varianza (MinVar), el VaR al 1% es de 11.97% y al 5% de 7.30%, mientras que para el portafolio tangencial los valores ascienden a 16.02% y 9.36% respectivamente. Esto muestra que que, aunque el portafolio tangencial ofrece una mayor rentabilidad esperada, también asume un riesgo más alto: ante escenarios adversos, sus pérdidas potenciales son más altas a las del portafolio más conservador.

El gráfico complementa este análisis al mostrar la evolución del VaR simulado a lo largo de los 40 trimestres (10 años). Ambas curvas tienen un comportamiento ascendente, lo que indica que el riesgo crece con el tiempo, dada una mayor incertidumbre asociada a horizontes más largos. El portafolio tangencial (líneas naranjas) mantiene un VaR superior al del MinVar (líneas azules), tanto al 1% como al 5%, evidenciando su perfil más agresivo.

En resumen, el portafolio tangencial podría generar mayores beneficios esperados, pero también caídas más severas en escenarios extremos. Por su parte, el MinVar, aunque menos rentable, preserva mejor el capital ante cambios fuertes en el mercado.

# ----- Comportamiento de mercado (resumen estadístico de los retornos simulados trimestrales) -----
# Retornos de portafolio por trimestre (distribución simulada)
port_rets_tang_q <- (port_vals_tang - investment) / investment
summary_stats_rets <- function(mat){
  q <- nrow(mat)
  out <- tibble(
    Quarter = 1:q,
    Mean = apply(mat, 1, mean),
    Median = apply(mat, 1, median),
    SD = apply(mat, 1, sd),
    Skew = apply(mat, 1, function(x) {e1071::skewness(x)}),
    Kurt = apply(mat, 1, function(x) {e1071::kurtosis(x)})
  )
  return(out)
}

summary_tang <- summary_stats_rets(port_rets_tang_q)
kable(head(summary_tang, 8), caption = "Resumen estadístico de retornos trimestrales - Portafolio Tangencial (primeros 8 trimestres)")
Resumen estadístico de retornos trimestrales - Portafolio Tangencial (primeros 8 trimestres)
Quarter Mean Median SD Skew Kurt
1 0.0002780 -0.0002047 0.0136623 0.1914770 0.1636497
2 0.0006566 0.0006258 0.0192980 0.1787218 0.0032808
3 0.0010086 0.0015597 0.0229473 0.1187467 -0.0570175
4 0.0022771 0.0025378 0.0261014 0.1407354 0.0474545
5 0.0023545 0.0012872 0.0291333 0.1742574 0.1555587
6 0.0023324 0.0013244 0.0311044 0.2446382 0.1470842
7 0.0032376 0.0011383 0.0337711 0.2597384 0.3744239
8 0.0028018 0.0016346 0.0360335 0.2145378 0.1476764 
# ----- Gráficos: precios esperados por trimestre (línea) -----
df_q <- tibble(
  Quarter = quarters,
  INTC = q_means_INTC,
  KO = q_means_KO,
  BAC = q_means_BAC,
  Port_MinVar = port_mean_minvar,
  Port_Tang = port_mean_tang
)

df_q_long <- df_q %>% pivot_longer(-Quarter, names_to = "Series", values_to = "Value")

gg_q <- ggplot(df_q_long %>% filter(Series %in% c("Port_MinVar","Port_Tang")), 
               aes(x = Quarter, y = Value, color = Series)) +
  geom_line(size = 1) +
  theme_minimal() +
  labs(title = "Valor esperado del portafolio por trimestre (promedio simulaciones)",
       x = "Trimestre", y = "Valor (USD)")

ggplotly(gg_q)

La gráfica muestra la evolución del valor esperado de los portafolios MinVar y Tangencial a lo largo de 40 trimestres (10 años), calculada como el promedio de las simulaciones. En ella se observa que el portafolio de mínima varianza crece de forma más sostenida y estable, mientras que el tangencial presenta oscilaciones y una tendencia más volátil, evidenciando su mayor exposición al riesgo. Aunque el Tangencial fue diseñado para maximizar el ratio de Sharpe, en el horizonte simulado no logra superar al MinVar, lo que indica que en escenarios con alta volatilidad su desempeño puede verse afectado por las fluctuaciones del mercado.

Del resumen estadístico de los retornos trimestrales simulados del portafolio Tangencial se evidencia que el promedio y la mediana de los retornos aumentan ligeramente con el tiempo, pero la desviación estándar (SD) también crece de 0.013 a 0.036 en el trimestre 8, lo que refleja una expansión del riesgo con el tiempo. De todo el análisis anterior se concluye que el portafolio tangencial ofrece un potencial de crecimiento moderado, aunque con mayor variabilidad y sensibilidad a choques de mercado.

Parte3. Genere la valuación de las opciones europeas y americanas call y put para cada activo, cubra el 85% de la inversión con un apalancamiento con la tasa del bono del tesoro (Tenga en cuenta que invierte para 3 acciones en un paquete). Como se evidencia la cobertura en la inversión (recuerde que el pago es trimestral hasta el vencimiento del negocio del subyacente y del derivado). Como divide el dinero para la cobertura de las opciones?, justifique una estrategia valida para repartir este dinero apalancado.

# --- Parámetros iniciales ---
tickers <- c("INTC","KO","BAC")    
risk_free <- 0.040930                
investment <- 10000000                
contract_size <- 100    
coverage_prop <- 0.85 # cubrir 85%

# --- Últimos precios ---
price_last <- price_data %>%
  group_by(symbol) %>% summarize(last_price = last(close))
S0 <- setNames(price_last$last_price, price_last$symbol)

# --- Volatilidades anuales ---
sd_daily <- apply(log_ret_xts, 2, sd, na.rm = TRUE)
sigma_annual <- sd_daily * sqrt(252)
sigma_annual <- sigma_annual[names(S0)]

# --- Vencimientos trimestrales ---
quarters <- 1:40
maturities <- quarters * 0.25  # años

# --- Funciones CRR ---
CRR_european <- function(S0, K, r, sigma, T, N, type = c("call","put")) {
  type <- match.arg(type)
  dt <- T/N
  u <- exp(sigma * sqrt(dt))
  d <- 1/u
  disc <- exp(-r*dt)
  p <- (exp(r*dt) - d) / (u - d)
  ST <- S0 * u^{(N:0)} * d^{(0:N)}
  payoff <- if (type == "call") pmax(ST - K, 0) else pmax(K - ST, 0)
  for (i in seq(N, 1)) {
    payoff <- disc * (p * payoff[1:i] + (1 - p) * payoff[2:(i+1)])
  }
  return(as.numeric(payoff))
}

CRR_american <- function(S0, K, r, sigma, T, N, type = c("call","put")) {
  type <- match.arg(type)
  dt <- T/N
  u <- exp(sigma * sqrt(dt))
  d <- 1/u
  disc <- exp(-r*dt)
  p <- (exp(r*dt) - d) / (u - d)
  ST <- S0 * u^{(N:0)} * d^{(0:N)}
  payoff <- if (type == "call") pmax(ST - K, 0) else pmax(K - ST, 0)
  for (i in seq(N, 1)) {
    ST_i <- S0 * u^{(i-1):0} * d^{0:(i-1)}
    cont <- disc * (p * payoff[1:i] + (1 - p) * payoff[2:(i+1)])
    intrinsic <- if (type == "call") pmax(ST_i - K, 0) else pmax(K - ST_i, 0)
    payoff <- pmax(cont, intrinsic)
  }
  return(as.numeric(payoff))
}

# --- Pasos por año ---
steps_per_year <- 250

# --- Loop de valuación ---
results_list <- list()
for(sym in tickers) {
  S0_sym <- as.numeric(S0[sym])
  sigma <- as.numeric(sigma_annual[sym])
  r <- risk_free
  
  rows <- list()
  for(qt in quarters) {
    Tmat <- qt * 0.25
    N <- max(1, round(Tmat * steps_per_year))
    K <- S0_sym 
    e_call <- CRR_european(S0_sym, K, r, sigma, Tmat, N, "call")
    e_put  <- CRR_european(S0_sym, K, r, sigma, Tmat, N, "put")
    a_call <- CRR_american(S0_sym, K, r, sigma, Tmat, N, "call")
    a_put  <- CRR_american(S0_sym, K, r, sigma, Tmat, N, "put")
    
    rows[[length(rows)+1]] <- tibble(
      Symbol = sym, Quarter = qt, T = Tmat, Steps = N, S0 = S0_sym, K = K,
      Sigma = sigma, Euro_Call = e_call, Euro_Put = e_put, 
      Am_Call = a_call, Am_Put = a_put
    )
  }
  results_list[[sym]] <- bind_rows(rows)
}

# --- Consolidar resultados ---
options_table <- bind_rows(results_list)

# --- Gráficos ---
options_long <- options_table %>%
  pivot_longer(cols = c(Euro_Call, Euro_Put, Am_Call, Am_Put),
               names_to = "Type", values_to = "Value")

# --- Colores ---
palette_opts <- c(
  "Euro_Call" = "#1f77b4",
  "Euro_Put"  = "#2ca02c",
  "Am_Call"   = "#ff7f0e",
  "Am_Put"    = "#d62728"
)

# --- Gráfico general: evolución de todas las opciones ---
ggplot(options_long, aes(x = Quarter, y = Value, color = Type)) +
  geom_line(size = 1) +
  facet_wrap(~ Symbol, scales = "free_y") +
  scale_color_manual(values = palette_opts) +
  labs(
    title = "Evolución del valor de opciones europeas y americanas",
    subtitle = "Comparación por tipo de opción — Calls y Puts ATM para INTC, KO y BAC",
    x = "Trimestre", y = "Valor estimado (USD)", color = "Tipo de opción"
  ) +
  theme_minimal(base_size = 13) +
  theme(legend.position = "bottom")

En la gráfica se presenta la evolución del valor de las opciones europeas y americanas tipo call y put para las acciones de BAC, INTC y KO, considerando precios actuales at the money (ATM) y diferentes vencimientos expresados en trimestres. El eje horizontal muestra el tiempo al vencimiento (de 0 a 40 trimestres, equivalentes a 10 años) y el eje vertical refleja el valor estimado en dólares de las opciones según el modelo binomial de Cox-Ross-Rubinstein (CRR).

En general, se observa que el valor de las opciones aumenta con el tiempo al vencimiento. Cuanto mayor es el plazo antes de la expiración, mayor es la probabilidad de que el precio del activo subyacente se mueva de forma favorable al tenedor de la opción, incrementando así su valor. Las curvas presentan una forma cóncava creciente, lo que indica que el aumento del valor no es lineal, sino que a medida que se acerca el vencimiento, el valor adicional que aporta el tiempo se reduce.

Al comparar las calls europeas (línea azul) con las calls americanas (línea amarilla), se aprecia que ambas coinciden completamente, al punto de que la línea amarilla no es visible en el gráfico. Esto se debe a que en ausencia de dividendos, el ejercicio anticipado de una opción call no tiene sentido. Por tanto, el valor de una call americana es igual al de una call europea, y la posibilidad de ejercer antes del vencimiento no otorga ningún beneficio adicional.

En contraste, las puts americanas (línea roja) muestran valores superiores a las puts europeas (línea verde) en todos los horizontes. Esto ocurre porque la put americana otorga al tenedor el derecho de ejercer anticipadamente en caso de que el precio del subyacente caiga drásticamente, permitiendo un beneficio inmediato y evitando mayores pérdidas.

Las diferencias observadas entre las acciones BAC, INTC y KO se explican principalmente por la volatilidad de cada activo y su nivel de precio inicial. Una mayor volatilidad implica una mayor incertidumbre sobre los precios futuros, y por tanto, un mayor valor temporal de las opciones. De igual forma, un precio subyacente más alto suele generar primas más elevadas.

Se concluye de lo anterior que, en primer lugar, las opciones call americanas no justifican pagar una prima superior, dado que su valor es igual al de las europeas cuando no hay dividendos. En segundo lugar, las opciones put americanas son más adecuadas para estrategias de cobertura sobre posiciones largas, ya que ofrecen flexibilidad y una protección más efectiva ante caídas del mercado. Finalmente, la evolución ascendente de todas las curvas refleja la importancia del valor temporal y la volatilidad como factores determinantes en la valoración de opciones.

Estrategia de cobertura con opciones PUT americanas

Para proteger el portafolio ante caídas de mercado, se implementó una cobertura del 85% del valor total de la inversión mediante la compra de opciones put americanas at the money (ATM) sobre cada activo del portafolio tangencial. La elección de puts americanas se debe a su flexibilidad para el ejercicio anticipado permitiendo una protección frente a movimientos bruscos del mercado, a diferencia de las europeas que solo pueden ejercerse al vencimiento.

La cobertura se financia parcialmente mediante apalancamiento a la tasa libre de riesgo (bono del Tesoro), asumiendo pagos trimestrales hasta el vencimiento del derivado. Los resultados muestran que el costo total de la cobertura es moderado en el corto plazo (1 trimestre), pero crece exponencialmente en horizontes largos (10 años) debido al efecto acumulado de la prima y del interés compuesto del apalancamiento.

# --- Estrategia de cobertura (PUT americanas At The Money - ATM) ---
# Se usa el portafolio tangencial
w_port <- w_tang
exposure_asset <- w_port * investment
shares_exposure <- exposure_asset / S0[names(w_port)]

contracts_df <- tibble(
  Symbol = names(w_port),
  Weight = as.numeric(w_port),
  Exposure = as.numeric(exposure_asset),
  Shares = as.numeric(shares_exposure)
) %>%
  mutate(Shares_to_cover = ceiling(Shares * coverage_prop),
         Contracts = ceiling(Shares_to_cover / contract_size))

put_prices_short <- options_table %>% filter(Quarter == 1) %>% select(Symbol, Am_Put)
put_prices_long  <- options_table %>% filter(Quarter == 40) %>% select(Symbol, Am_Put)

contracts_df <- contracts_df %>%
  left_join(put_prices_short, by = "Symbol") %>%
  rename(AmPut_Q1 = Am_Put) %>%
  left_join(put_prices_long, by = "Symbol") %>%
  rename(AmPut_Q40 = Am_Put) %>%
  mutate(Cost_Q1 = Contracts * contract_size * AmPut_Q1,
         Cost_Q40 = Contracts * contract_size * AmPut_Q40)

total_cost_Q1 <- sum(contracts_df$Cost_Q1, na.rm = TRUE)
total_cost_Q40 <- sum(contracts_df$Cost_Q40, na.rm = TRUE)

interest_Q1 <- total_cost_Q1 * (exp(risk_free * 0.25) - 1)
interest_Q40 <- total_cost_Q40 * (exp(risk_free * 10.0) - 1)

summary_cov <- contracts_df %>%
  select(Symbol, Weight, Exposure, Shares_to_cover, Contracts, 
         AmPut_Q1, Cost_Q1, AmPut_Q40, Cost_Q40) %>%
  mutate(across(c(Exposure, AmPut_Q1, Cost_Q1, AmPut_Q40, Cost_Q40), round, 2))

kable(summary_cov, caption = "Cobertura 85% por activo (contratos y costos aproximados)")
Cobertura 85% por activo (contratos y costos aproximados)
Symbol Weight Exposure Shares_to_cover Contracts AmPut_Q1 Cost_Q1 AmPut_Q40 Cost_Q40
INTC 0.7255113 7255112.97 153557 1536 4.31 662483.46 18.21 2796957.34
KO 0.0001904 1903.76 24 1 1.86 186.17 5.99 598.68
BAC 0.2742983 2742983.27 43967 440 2.50 109989.46 9.63 423706.12 
cat("Costo total cobertura 1 trimestre: ", round(total_cost_Q1,2), "USD\n")
## Costo total cobertura 1 trimestre:  772659.1 USD
cat("Costo total cobertura 10 años: ", round(total_cost_Q40,2), "USD\n")
## Costo total cobertura 10 años:  3221262 USD
cat("Interés estimado (apalancamiento Tesoro): Q1 =", round(interest_Q1,2), 
    "USD; Q40 =", round(interest_Q40,2), "USD\n")
## Interés estimado (apalancamiento Tesoro): Q1 = 7946.82 USD; Q40 = 1629196 USD
# --- Gráfico comparativo del costo de cobertura ---
library(ggplot2)
library(tidyr)

contracts_df %>%
  pivot_longer(cols = c(Cost_Q1, Cost_Q40),
               names_to = "Periodo", values_to = "Costo") %>%
  mutate(Periodo = recode(Periodo,
                          "Cost_Q1" = "1 Trimestre",
                          "Cost_Q40" = "10 Años")) %>%
  ggplot(aes(x = Symbol, y = Costo / 1e6, fill = Periodo)) +
  geom_col(position = "dodge") +
  labs(
    title = "Costo estimado de cobertura (85%) por activo",
    subtitle = "Comparación del costo total de puts americanas ATM en corto y largo plazo",
    x = "Activo",
    y = "Costo (Millones USD)",
    fill = "Periodo"
  ) +
  theme_minimal() +
  theme(
    plot.title = element_text(face = "bold", size = 14),
    plot.subtitle = element_text(size = 11),
    legend.position = "top"
  )

Cada activo se cubre con un número de contratos derivados de su exposición (en USD) y del tamaño estándar del contrato de opciones (100 acciones por contrato). Se estimaron los costos de las puts para dos horizontes temporales: un trimestre (Q1) y diez años (Q40). Para INTC, que concentra la mayor parte del portafolio tangencial, el costo de cobertura trimestral asciende a 662.483 USD, mientras que a 10 años el costo acumulado se eleva a 2.796.957 USD. En contraste, KO y BAC representan proporciones mucho menores, con costos significativamente más bajos.

En conjunto, la cobertura trimestral costaría aproximadamente 772.659 USD, mientras que mantener la protección durante 10 años alcanzaría 3.221.262 USD. Además, si el financiamiento de esta cobertura se realiza mediante apalancamiento en bonos del Tesoro, el costo financiero estimado sería de unos 7.947 USD para el primer trimestre y 1.629.196 USD al décimo año. Aunque la cobertura reduce significativamente el riesgo de pérdidas, su costo a largo plazo puede volverse alto, por lo que podría justificarse solo bajo escenarios de alta volatilidad.

Conclusión general

La cobertura con opciones put americanas es una buena opci[on] para limitar pérdidas extremas sin sacrificar completamente el potencial de retorno.

El costo de la cobertura depende significativamente del horizonte temporal y la volatilidad implícita de cada activo. Se observa que, aunque la protección a corto plazo (un trimestre) implica un costo relativamente bajo, extender la cobertura a plazos largos (hasta 10 años) incrementa de manera considerable el gasto total.

La asignación del dinero para la cobertura refleja una estrategia de diversificación coherente con la exposición del portafolio. Los activos con mayor peso o volatilidad demandan un mayor monto cubierto, lo que permite una distribución eficiente del capital apalancado.