Laboratorio 1_Derivados Financieros
Isabel cristina Villada_Yessica Giraldo M.
2026-09-27
Criterio de inversión
llevarán a cabo una inversión a 2 años sobre un portafolio de acciones compuesto por tres activos, la inversión debe ser de 10 millones de dólares, con tasa de bonos, para generar la simulación use información desde el 01/10/2021, se tendrá en cuenta la tasa de dividendo de la empresa. para cubrir esta inversión deben realizar un análisis de cobertura al 85% por medio de estrategias de opciones que paguen de forma trimestral.
BLOQUE I – Construcción del portafolio
rm(list = ls())
rm(list = ls())
invisible(Sys.setlocale("LC_TIME", "C"))
paquetes <- c("quantmod", "xts", "zoo", "rugarch", "ggplot2", "scales")
nuevos <- paquetes[!paquetes %in% rownames(installed.packages())]
if (length(nuevos)) install.packages(nuevos)
invisible(lapply(paquetes, library, character.only = TRUE))
dir.create("salidas", showWarnings = FALSE)
dir.create("graficos", showWarnings = FALSE)Seleccion y documentacion de activos
tickers <- c("HD", "FTNT", "FANG")
capital <- 10e6 # USD 10 millones
w_min <- 0.15 # peso minimo por accion
horizonte_anios <- 2cobertura_obj <- 0.85
fecha_inicio_analisis <- as.Date("2021-10-01")
fecha_inicio_garch <- Sys.Date() - round(365.25 * 10)
n_sim <- 10000
semilla <- 2026
info_activos <- data.frame(
ticker = tickers,
empresa = c("The Home Depot", "Fortinet", "Diamondback Energy"),
sector = c("Consumo discrecional (retail mejoramiento del hogar)",
"Tecnologia (ciberseguridad)",
"Energia (petroleo y gas, exploracion y produccion)"),
mercado = c("NYSE", "NASDAQ", "NASDAQ"), # verificar en Yahoo Finance
stringsAsFactors = FALSE
)LOS TRES ACTIVOS SELECCIONADOS FUERON
HD:“The Home Depot”,(retail mejoramiento del hogar), FTNT:“fortinet” Tecnologia (ciberseguridad), FANG:“Diamondback Energy” Energia (petroleo y gas, exploracion y produccion)“)
Descarga de precios y dividendos
hora_descarga <- format(Sys.time(), "%Y-%m-%d %H:%M:%S %Z")
datos <- lapply(tickers, function(tk) {
px <- getSymbols(tk, src = "yahoo", from = fecha_inicio_garch,
to = Sys.Date() + 1, auto.assign = FALSE)
dv <- tryCatch(getDividends(tk, from = fecha_inicio_garch, to = Sys.Date() + 1),
error = function(e) NULL)
list(px = px, dv = dv)
})
names(datos) <- tickersPrecio ajustado (retornos historicos) y cierre no ajustado por dividendos
precios_aj <- do.call(merge, lapply(datos, function(x) Ad(x$px)))
precios_cl <- do.call(merge, lapply(datos, function(x) Cl(x$px)))
colnames(precios_aj) <- colnames(precios_cl) <- tickers
# ---------------------- LIMPIEZA -------------------------------------
na_antes <- colSums(is.na(precios_aj))
precios_aj <- na.locf(precios_aj, na.rm = FALSE) # huecos aislados: ultimo precio
precios_cl <- na.locf(precios_cl, na.rm = FALSE)
precios_aj <- na.omit(precios_aj)
precios_cl <- precios_cl[index(precios_aj)]RETORNOS LOGARITMICOS: son aditivos en el tiempo y consistentes con el MGB
TASA DE DIVIDENDO: dividendos de los ultimos 12 meses / spot (FTNT no paga)
CURVA TREASURY
plazos <- c(DGS3MO = 0.25, DGS6MO = 0.5, DGS1 = 1, DGS2 = 2)
curva <- tryCatch({
tasas <- sapply(names(plazos), function(id) {
x <- getSymbols(id, src = "FRED", auto.assign = FALSE)
as.numeric(last(na.omit(x))) / 100
})
data.frame(serie = names(plazos), plazo = as.numeric(plazos), tasa = as.numeric(tasas))
}, error = function(e) {
warning("No se pudo bajar FRED: REEMPLAZA estas tasas con datos de treasury.gov")
data.frame(serie = names(plazos), plazo = as.numeric(plazos),
tasa = c(NA, NA, NA, NA)) # <- ESCRIBE AQUI las tasas (ej. 0.041)
})## getSymbols.FRED: requests without an API key are not guaranteed to succeed.
## Register for a free key at https://fredaccount.stlouisfed.org/apikeys and set it with
## setDefaults(getSymbols.FRED, api.key = "your key").DOCUMENTACION DE DATOS
doc <- data.frame(
ticker = tickers, empresa = info_activos$empresa,
sector = info_activos$sector, mercado = info_activos$mercado,
fecha_hora_descarga = hora_descarga,
fuente_precios = "Yahoo Finance via quantmod::getSymbols",
fuente_dividendos = "Yahoo Finance via quantmod::getDividends",
obs_10anios = NROW(ret_log), obs_desde_2021_10_01 = NROW(ret_an),
datos_faltantes_antes = as.integer(na_antes),
tratamiento = "na.locf en huecos aislados; filas iniciales incompletas eliminadas",
retornos = "logaritmicos sobre precio ajustado (aditivos, coherentes con MGB)",
tasa_dividendo_12m = round(as.numeric(q_div), 4),
spot_cierre_no_ajustado = round(as.numeric(spot), 2),
fecha_valoracion = as.character(fecha_val)
)
print(t(doc))## [,1]
## ticker "HD"
## empresa "The Home Depot"
## sector "Consumo discrecional (retail mejoramiento del hogar)"
## mercado "NYSE"
## fecha_hora_descarga "2026-09-30 22:36:05 -05"
## fuente_precios "Yahoo Finance via quantmod::getSymbols"
## fuente_dividendos "Yahoo Finance via quantmod::getDividends"
## obs_10anios "2512"
## obs_desde_2021_10_01 "1254"
## datos_faltantes_antes "0"
## tratamiento "na.locf en huecos aislados; filas iniciales incompletas eliminadas"
## retornos "logaritmicos sobre precio ajustado (aditivos, coherentes con MGB)"
## tasa_dividendo_12m "0.0327"
## spot_cierre_no_ajustado "284.49"
## fecha_valoracion "2026-09-30"
## [,2]
## ticker "FTNT"
## empresa "Fortinet"
## sector "Tecnologia (ciberseguridad)"
## mercado "NASDAQ"
## fecha_hora_descarga "2026-09-30 22:36:05 -05"
## fuente_precios "Yahoo Finance via quantmod::getSymbols"
## fuente_dividendos "Yahoo Finance via quantmod::getDividends"
## obs_10anios "2512"
## obs_desde_2021_10_01 "1254"
## datos_faltantes_antes "0"
## tratamiento "na.locf en huecos aislados; filas iniciales incompletas eliminadas"
## retornos "logaritmicos sobre precio ajustado (aditivos, coherentes con MGB)"
## tasa_dividendo_12m "0.0000"
## spot_cierre_no_ajustado "178.76"
## fecha_valoracion "2026-09-30"
## [,3]
## ticker "FANG"
## empresa "Diamondback Energy"
## sector "Energia (petroleo y gas, exploracion y produccion)"
## mercado "NASDAQ"
## fecha_hora_descarga "2026-09-30 22:36:05 -05"
## fuente_precios "Yahoo Finance via quantmod::getSymbols"
## fuente_dividendos "Yahoo Finance via quantmod::getDividends"
## obs_10anios "2512"
## obs_desde_2021_10_01 "1254"
## datos_faltantes_antes "0"
## tratamiento "na.locf en huecos aislados; filas iniciales incompletas eliminadas"
## retornos "logaritmicos sobre precio ajustado (aditivos, coherentes con MGB)"
## tasa_dividendo_12m "0.0231"
## spot_cierre_no_ajustado "183.81"
## fecha_valoracion "2026-09-30"write.csv(doc, "salidas/documentacion_datos.csv", row.names = FALSE)
cat("\nCurva Treasury usada:\n"); print(curva)##
## Curva Treasury usada:## serie plazo tasa
## 1 DGS3MO 0.25 0.0425
## 2 DGS6MO 0.50 0.0436
## 3 DGS1 1.00 0.0458
## 4 DGS2 2.00 0.0489## Rf para Sharpe (T-note 2 anios): 0.0489save(list = setdiff(ls(), "datos"), file = "salidas/datos.RData")
cat("\nListo: salidas/datos.RData\n")##
## Listo: salidas/datos.RDataPara la curva de treasury se sacaron datos de FRED (Federal Reserve Economic Data, la base de datos del Banco de la Reserva Federal de St. Louis). Cada una corresponde a la tasa de los bonos del Tesoro de EE. UU. (Treasury) a un plazo constante. Cómo leer el nombre:
• D = Daily (dato diario) • GS = Government Securities (títulos del gobierno) • 3MO / 6MO = meses; 1 / 2 = años • tasa: el rendimiento (yield) en forma decimal.
Nos indica que a: • 3 MESES el rendimiento Yield va ser de 4,25% • 6 MESES el rendimiento Yield va ser de 4.36% • 1 AÑO el rendimiento Yield va ser de 4.58% • 2 AÑO el rendimiento Yield va ser de 4.89% Esto nos muestra que es una curva con pendiente positiva la cual implica que el mercado pida más rendimiento por prestar más tiempo al Tesoro, y eso afecta directamente cómo se valorara un forward, un swap o una opción.
BLOQUE I (parte 2) PORTAFOLIO MEDIA VARIANZA
Portafolio de 3 acciones, pesos >= 15 %, criterio: maximo Sharpe
load("salidas/datos.RData")
suppressMessages({library(xts); library(ggplot2); library(scales)})
R <- coredata(ret_an) # retornos log desde 01/10/2021
mu_log <- colMeans(R) * 252
vol_a <- apply(R, 2, sd) * sqrt(252)
mu_a <- mu_log + 0.5 * vol_a^2 # esperanza aritmetica anualizada
cov_a <- cov(R) * 252
cor_m <- cor(R)
cat("\n== Matriz de correlaciones ==\n"); print(round(cor_m, 3))##
## == Matriz de correlaciones ==## HD FTNT FANG
## HD 1.000 0.225 0.101
## FTNT 0.225 1.000 0.168
## FANG 0.101 0.168 1.000La matriz de correlaciones nos muestra que todas son positivas pero bajas entre 0.101 y 0.225, ósea que el portafolio se diversifica bien, la pareja más correlacionada es HD–FTNT (0.225) y la menos es HD–FANG (0.101), teniendo sentido ya que la primera es más a la economía en general, mientras que la FANG es de energía la cual influye mucho el tema del petróleo ya que es de su dependencia.es una matriz que se puede usar sin problema en la descomposición de cholesky para la simulación de MGB correlacionada.
Busqueda en malla (paso 0.5 %) con w_i >= 15 % y suma = 1
paso <- 0.005
g <- expand.grid(w1 = seq(w_min, 1 - 2 * w_min, by = paso),
w2 = seq(w_min, 1 - 2 * w_min, by = paso))
g$w3 <- round(1 - g$w1 - g$w2, 6)
g <- g[g$w3 >= w_min - 1e-9, ]
W <- as.matrix(g[, c("w1", "w2", "w3")])
g$ret <- as.numeric(W %*% mu_a)
g$vol <- sqrt(rowSums((W %*% cov_a) * W))
g$sharpe <- (g$ret - rf_sharpe) / g$vol
i_opt <- which.max(g$sharpe)
i_mv <- which.min(g$vol)
w_opt <- setNames(as.numeric(W[i_opt, ]), tickers)
w_mv <- setNames(as.numeric(W[i_mv, ]), tickers)Portafolio elegido: max Sharpe
Metricas del portafolio y contribucion al riesgo
ret_p <- sum(w_opt * mu_a)
vol_p <- sqrt(as.numeric(t(w_opt) %*% cov_a %*% w_opt))
sharpe_p <- (ret_p - rf_sharpe) / vol_p
mcr <- as.numeric(cov_a %*% w_opt) / vol_p # contribucion marginal
contrib_pct <- setNames(w_opt * mcr / vol_p, tickers) # suma 100 %
asset_riesgo <- names(which.max(contrib_pct)) # activo que domina el riesgo
tabla_activos <- data.frame(
ticker = tickers,
ret_esperado_anual = mu_a, vol_anual = vol_a,
sharpe_individual = (mu_a - rf_sharpe) / vol_a,
peso_optimo = w_opt, contrib_riesgo_pct = contrib_pct,
tasa_dividendo = as.numeric(q_div), row.names = NULL
)
tabla_activos <- rbind(tabla_activos,
data.frame(ticker = "PORTAFOLIO", ret_esperado_anual = ret_p, vol_anual = vol_p,
sharpe_individual = sharpe_p, peso_optimo = 1, contrib_riesgo_pct = 1,
tasa_dividendo = sum(w_opt * q_div)))
cat("\n== Portafolio elegido (max Sharpe), Rf =", round(rf_sharpe, 4), "==\n")##
## == Portafolio elegido (max Sharpe), Rf = 0.0489 ==## ticker ret_esperado_anual vol_anual sharpe_individual peso_optimo
## 1 HD 0.0271 0.247 -0.0883 0.15
## 2 FTNT 0.3269 0.452 0.6151 0.43
## 3 FANG 0.2435 0.368 0.5291 0.42
## 4 PORTAFOLIO 0.2469 0.278 0.7113 1.00
## contrib_riesgo_pct tasa_dividendo
## 1 0.0459 0.0327
## 2 0.5735 0.0000
## 3 0.3806 0.0231
## 4 1.0000 0.0146##
## Activo que domina el riesgo: FTNTHD (15 %): su retorno esperado (2.71 %) está por debajo de la tasa libre de riesgo (4.89 %), por eso su Sharpe es negativo y es la acción menos volátil (24.7 %). FTNT (43 %): tiene el mejor Sharpe individual, pero también la mayor volatilidad (45.2 %). Su peso de 43 % se traduce en 57 % del riesgo del portafolio por eso se dice que a dominando en riesgo. FANG (42 %): Sharpe algo menor, pero con menos volatilidad (36.8 %) y baja correlación con las otras dos. Su contribución al riesgo (38 %) es menor que su peso (42 %).
El Sharpe del portafolio (0.711) supera al de las tres acciones por separado. La volatilidad ponderada de las tres sería 38.6 %, pero el portafolio tiene 27.8 %, es decir, cerca de 28 % menos riesgo gracias a las correlaciones bajas. Además, ninguna acción llegó al tope de 70 % la diversificación hace que el portafolio quede repartido. Hay que tener encuenta que aunque puede ser optimo el 85 % del dinero está en dos acciones, FANG y FTNT y una de ellas tiene el mayor riesgo trataria de buscar una cobertura.
Asignacion en acciones (numero entero de acciones)
acciones <- floor(w_opt * capital / spot)
valor_pos <- acciones * spot
valor0 <- sum(valor_pos)
cat("\nAcciones a comprar:\n"); print(acciones)##
## Acciones a comprar:## HD FTNT FANG
## 5272 24054 22849## Valor inicial del portafolio: USD 9,999,599HD 15% inversión en dólares USD 1,500,000 FTNT 43% inversión en dólares USD 4,300,000 FANG 42% inversión en dólares USD 4,200,000
para un total de 10.000.000 USD con un restante de 401 de sobrante por temas de redondeo.
Graficos
g$bin <- cut(g$vol, breaks = 80)
front <- do.call(rbind, lapply(split(g, g$bin), function(d) d[which.max(d$ret), ]))
front <- front[order(front$vol), ]
front <- front[front$ret >= g$ret[i_mv], ]
front <- front[front$ret >= cummax(front$ret) - 1e-12, ]
activos_df <- data.frame(ticker = tickers, vol = vol_a, ret = mu_a)
p1 <- ggplot(g, aes(vol, ret)) +
geom_point(aes(color = sharpe), size = 0.7, alpha = 0.6) +
geom_line(data = front, color = "black", linewidth = 1) +
geom_point(data = activos_df, shape = 17, size = 3) +
geom_text(data = activos_df, aes(label = ticker), vjust = -1) +
annotate("point", x = vol_p, y = ret_p, shape = 8, size = 5, color = "red") +
annotate("text", x = vol_p, y = ret_p, label = "Portafolio elegido",
color = "red", vjust = 2) +
scale_x_continuous(labels = percent) + scale_y_continuous(labels = percent) +
labs(title = "Frontera eficiente (pesos >= 15 %)",
x = "Volatilidad anualizada", y = "Retorno esperado anualizado", color = "Sharpe") +
theme_minimal()
ggsave("graficos/01_frontera_eficiente.png", p1, width = 8, height = 5.5, dpi = 200)
cm <- as.data.frame(as.table(cor_m))
p2 <- ggplot(cm, aes(Var1, Var2, fill = Freq)) + geom_tile() +
geom_text(aes(label = sprintf("%.2f", Freq))) +
scale_fill_gradient2(low = "steelblue", mid = "white", high = "firebrick",
midpoint = 0, limits = c(-1, 1)) +
labs(title = "Matriz de correlaciones (retornos log diarios)", x = NULL, y = NULL, fill = "rho") +
theme_minimal()
ggsave("graficos/02_correlaciones.png", p2, width = 5.5, height = 4.5, dpi = 200)
print(p1); print(p2)
save(list = c("mu_a", "vol_a", "cov_a", "cor_m", "w_opt", "w_mv", "ret_p", "vol_p",
"sharpe_p", "contrib_pct", "asset_riesgo", "tabla_activos",
"acciones", "valor_pos", "valor0"),
file = "salidas/portafolio.RData")1.1 RETORNO ESPERADO ANUALIZADO VS VOLATILIDAD ANUALIZADA El portafolio elegido (punto rojo) se ubica sobre la curva de la frontera eficiente, en la zona de mayor Sharpe (color más claro). Se observa que ninguno de los tres activos individuales (triángulos negros) toca la frontera eficiente — todos quedan por debajo o a la derecha de ella —, lo que confirma visualmente el beneficio de diversificar: la combinación de los tres activos logra una mejor relación retorno-riesgo que cualquiera de ellos por separado. FTNT aparece como el triángulo más alto a la derecha (mayor retorno, pero también mayor volatilidad), mientras que HD queda muy abajo, reflejando su Sharpe individual negativo.
1.2 MATRIZ DE CORRELACIONES El mapa de calor muestra las tres correlaciones cruzadas en tonos de rojo claro, muy alejados del rojo intenso que correspondería a activos que se mueven casi juntos. Esto refuerza visualmente que los sectores elegidos (retail, ciberseguridad y energía) están bien diversificados entre sí: si los tres cuadros fuera de la diagonal se vieran en rojo oscuro, sería señal de que el portafolio en realidad no diversifica tanto como sugieren los pesos.
BLOQUE II _ SIMULACION GARCH VAR, MGB.
GARCH(1,1) con 10 años -> varianza; MGB correlacionado; VaR sin cobertura
# =====================================================================
# funciones.R - Funciones auxiliares (se cargan con source())
# =====================================================================
# Black-Scholes-Merton con dividendo continuo q (europea). S puede ser vector.
bsm <- function(S, K, T, r, q, sigma, tipo = "put") {
if (T <= 0) {
return(if (tipo == "put") pmax(K - S, 0) else pmax(S - K, 0))
}
d1 <- (log(S / K) + (r - q + 0.5 * sigma^2) * T) / (sigma * sqrt(T))
d2 <- d1 - sigma * sqrt(T)
if (tipo == "put") {
K * exp(-r * T) * pnorm(-d2) - S * exp(-q * T) * pnorm(-d1)
} else {
S * exp(-q * T) * pnorm(d1) - K * exp(-r * T) * pnorm(d2)
}
}
# Arbol binomial CRR (europeo o americano) con dividendo continuo q
binomial_crr <- function(S0, K, T, r, q, sigma, n = 500,
tipo = "put", americana = TRUE) {
if (is.na(q)) {
warning(sprintf("q (tasa de dividendo) llego en NA para S0=%s K=%s T=%s; se uso q=0.",
S0, K, T))
q <- 0
}
if (is.na(r) || is.na(S0) || is.na(K) || is.na(T)) {
stop(sprintf("Valores NA en la valoracion: S0=%s K=%s T=%s r=%s (revisa esa fila de 'ct').",
S0, K, T, r))
}
if (is.na(sigma) || sigma <= 1e-4) {
warning(sprintf("IV invalida (%.4f) para S0=%.2f K=%.2f T=%.2f; se uso un piso de 1%% anual.",
sigma, S0, K, T))
sigma <- 0.01
}
dt <- T / n
u <- exp(sigma * sqrt(dt))
d <- 1 / u
p <- (exp((r - q) * dt) - d) / (u - d)
if (!(p > 0 && p < 1)) {
warning(sprintf("p fuera de (0,1) con sigma=%.4f r=%.4f q=%.4f T=%.2f; se ajusto sigma al minimo necesario.",
sigma, r, q, T))
sigma <- abs(r - q) * sqrt(dt) * 1.05 / sqrt(dt) + 0.01 # sigma minimo que garantiza p valido
u <- exp(sigma * sqrt(dt)); d <- 1 / u
p <- (exp((r - q) * dt) - d) / (u - d)
}
disc <- exp(-r * dt)
j <- 0:n
ST <- S0 * u^j * d^(n - j)
V <- if (tipo == "put") pmax(K - ST, 0) else pmax(ST - K, 0)
for (i in (n - 1):0) {
V <- disc * (p * V[2:(i + 2)] + (1 - p) * V[1:(i + 1)])
if (americana) {
Sj <- S0 * u^(0:i) * d^(i - (0:i))
ex <- if (tipo == "put") pmax(K - Sj, 0) else pmax(Sj - K, 0)
V <- pmax(V, ex)
}
}
V[1]
}# VaR = -cuantil(P&L)
var_pl <- function(pl, alfa) -as.numeric(quantile(pl, alfa, names = FALSE))
suppressMessages({library(rugarch); library(ggplot2); library(scales)})
n_trim <- horizonte_anios * 4 # 8 trimestres
dias_trim <- 63 # dias habiles por trimestre
n_dias <- n_trim * dias_trim # 504 diasGARCH(1,1) por activo (10 años de retornos log diarios)
espec <- ugarchspec(variance.model = list(model = "sGARCH", garchOrder = c(1, 1)),
mean.model = list(armaOrder = c(0, 0), include.mean = TRUE),
distribution.model = "norm")
ajustes <- lapply(tickers, function(tk) ugarchfit(espec, data = ret_log[, tk], solver = "hybrid"))
names(ajustes) <- tickers
for (tk in tickers) cat(tk, "- convergencia (0 = OK):", convergence(ajustes[[tk]]), "\n")## HD - convergencia (0 = OK): 0
## FTNT - convergencia (0 = OK): 0
## FANG - convergencia (0 = OK): 0Trayectoria de volatilidad diaria pronosticada por el GARCH (n_dias x 3)
sig_d <- sapply(tickers, function(tk)
as.numeric(sigma(ugarchforecast(ajustes[[tk]], n.ahead = n_dias))))
tab_garch <- t(sapply(tickers, function(tk) {
cf <- coef(ajustes[[tk]])
pers <- unname(cf["alpha1"] + cf["beta1"])
c(omega = unname(cf["omega"]), alpha1 = unname(cf["alpha1"]), beta1 = unname(cf["beta1"]),
persistencia = pers,
vol_anual_hoy = as.numeric(tail(sigma(ajustes[[tk]]), 1)) * sqrt(252),
vol_anual_largo_plazo = sqrt(unname(cf["omega"]) / (1 - pers) * 252))
}))
cat("\n== Parametros GARCH(1,1) ==\n"); print(round(tab_garch, 5))##
## == Parametros GARCH(1,1) ==## omega alpha1 beta1 persistencia vol_anual_hoy vol_anual_largo_plazo
## HD 0.00001 0.08155 0.89794 0.97948 0.23960 0.25296
## FTNT 0.00013 0.19555 0.64777 0.84332 0.36860 0.46349
## FANG 0.00002 0.12261 0.85618 0.97880 0.37611 0.53599La varianza usada en la simulación se modeló con un GARCH(1,1) por activo, estimado con aproximadamente 10 años de historia (2,513 observaciones),nos muestra que la varianza es estacionaria y tiene un nivel de largo plazo definido, HD y FANG muestran persistencia muy alta (0.98), un choque de volatilidad tarda mucho en disiparse. FTNT tiene menor persistencia (0.84), pero su volatilidad de largo plazo estimada (46.3%) es mayor que la actual (39.6%), es decir que el modelo espera que su volatilidad suba, reforzando por qué es el activo de mayor riesgo.
SIMULACION MGB CORRELACIONADO
dlnS = [(mu - q)/252 - 0.5*sigma_t^2] + sigma_t * Z ; sigma_t viene del GARCH;Z correlacionado con la matriz de correlaciones (Cholesky).
L <- chol(cor_m)
set.seed(semilla)
S <- matrix(rep(spot, each = n_sim), n_sim, 3)
S_trim <- array(NA_real_, dim = c(n_sim, n_trim + 1, 3),
dimnames = list(NULL, paste0("Q", 0:n_trim), tickers))
S_trim[, 1, ] <- S
n_tray <- 200 # trayectorias diarias guardadas (grafico)
V_diario <- matrix(NA_real_, n_tray, n_dias + 1)
V_diario[, 1] <- sum(acciones * spot)
for (d in 1:n_dias) {
Z <- matrix(rnorm(n_sim * 3), n_sim, 3) %*% L
sg <- sig_d[d, ]
dr <- (mu_a - q_div) / 252 - 0.5 * sg^2
S <- S * exp(sweep(sweep(Z, 2, sg, "*"), 2, dr, "+"))
V_diario[, d + 1] <- S[1:n_tray, ] %*% acciones
if (d %% dias_trim == 0) S_trim[, d / dias_trim + 1, ] <- S
}VALOR DEL PORTAFOLIO EN CIERRES TRIMESTRALES
Valor = acciones a precio simulado + dividendos cobrados (en caja, sin reinvertir)
V_acc <- sapply(1:(n_trim + 1), function(k) as.numeric(S_trim[, k, ] %*% acciones))
div_q <- cbind(0, sapply(2:(n_trim + 1), function(k)
as.numeric(S_trim[, k - 1, ] %*% (acciones * q_div / 4))))
V_trim <- V_acc + t(apply(div_q, 1, cumsum))
V0 <- V_trim[1, 1]
PL <- V_trim - V0 # P&L sin cobertura
pcts <- c(0.05, 0.25, 0.50, 0.75, 0.95)
bandas <- data.frame(trimestre = 0:n_trim, t(apply(V_trim, 2, quantile, probs = pcts)),
media = colMeans(V_trim))
colnames(bandas)[2:6] <- c("P5", "P25", "P50", "P75", "P95")
cat("\n== Valor del portafolio (USD) en cierres trimestrales ==\n")##
## == Valor del portafolio (USD) en cierres trimestrales ==## trimestre P5 P25 P50 P75 P95 media
## 1 0 9,999,599 9,999,599 9,999,599 9,999,599 9,999,599 9,999,599
## 2 1 8,174,029 9,484,031 10,487,676 11,644,374 13,611,374 10,644,030
## 3 2 7,665,708 9,444,340 11,011,647 12,878,218 16,133,141 11,330,927
## 4 3 7,291,036 9,503,877 11,488,610 13,987,673 18,813,883 12,066,339
## 5 4 7,093,886 9,632,642 12,017,132 15,016,291 21,338,255 12,821,613
## 6 5 6,894,777 9,808,608 12,581,951 16,333,801 23,929,983 13,657,163
## 7 6 6,870,185 9,965,275 13,201,764 17,694,919 26,865,554 14,597,214
## 8 7 6,806,241 10,264,584 13,837,325 18,886,842 30,215,824 15,600,653
## 9 8 6,718,583 10,550,155 14,484,801 20,463,101 34,126,345 16,713,734La Tabla muestra la evolución de la distribución del valor del portafolio en cada cierre trimestral, a partir de un valor inicial de USD 9,999,599 a final de los 2 años, la mediana llega a USD 14.48 millones (44.9 %, cerca de 20 % anual) y la media a USD 16.71 millones (67.1 %). La media supera a la mediana porque los precios siguen una distribución lognormal hacia la derecha.
La dispersión aumenta con el horizonte: entre P5 y P95, el valor pasa de USD 7.09-21.34 millones al año a USD 6.72-34.13 millones a los 2 años. Esto implica una volatilidad anual del portafolio cercana a 35 %, mayor que el 27.8 % de la optimización. La diferencia se debe sobre todo a FANG (42 % del portafolio), cuya volatilidad proyectada por GARCH (≈ 52 %) supera la histórica (36.8 %).
En cuanto al riesgo a la baja, el percentil 5 indica una pérdida máxima de USD 3.28 millones (32.8 %) con 95 % de confianza. El percentil 25 ya supera el valor inicial (5.5 %), así que la probabilidad de terminar con pérdida es menor a 25 % la cual sugerimos aplicar una cobertura de opción.
VAR SIN COBERTURA
tab_var <- data.frame(
trimestre = 1:n_trim,
VaR95 = sapply(2:(n_trim + 1), function(k) var_pl(PL[, k], 0.05)),
VaR99 = sapply(2:(n_trim + 1), function(k) var_pl(PL[, k], 0.01)))
tab_var$VaR95_pct <- tab_var$VaR95 / V0
tab_var$VaR99_pct <- tab_var$VaR99 / V0
cat("\n== VaR sin cobertura (USD) ==\n"); print(format(round(tab_var, 3), big.mark = ","))##
## == VaR sin cobertura (USD) ==## trimestre VaR95 VaR99 VaR95_pct VaR99_pct
## 1 1 1,825,570 2,608,852 0.183 0.261
## 2 2 2,333,891 3,414,421 0.233 0.341
## 3 3 2,708,563 3,824,112 0.271 0.382
## 4 4 2,905,713 4,149,322 0.291 0.415
## 5 5 3,104,822 4,519,532 0.310 0.452
## 6 6 3,129,413 4,625,168 0.313 0.463
## 7 7 3,193,358 4,821,491 0.319 0.482
## 8 8 3,281,016 5,000,029 0.328 0.500var sin cobertura fue medido respecto al valor inicial del portafolio, el var al 95 % aumenta de USD 1.83 millones (18.3 %) al primer trimestre a USD 3.28 millones (32.8 %) a los 2 años, y el var al 99 % de USD 2.61 millones (26.1 %) a USD 5.00 millones (50.0 %). esto significa que existe una probabilidad de 1 % de perder la mitad del capital en el horizonte. el crecimiento del var se desacelera con el tiempo porque los retornos esperados positivos compensan parcialmente el aumento de la incertidumbre, la amplia brecha entre ambos niveles de confianza evidencia una cola izquierda pesada y justifica la cobertura con opciones.
GRAFICO
idx <- 1:50
tray <- data.frame(anio = rep(0:n_dias, times = length(idx)) / 252,
id = rep(idx, each = n_dias + 1),
valor = as.vector(t(V_diario[idx, ])))
bandas$anio <- bandas$trimestre * 0.25
p3 <- ggplot() +
geom_line(data = tray, aes(anio, valor, group = id), color = "grey75", linewidth = 0.2) +
geom_ribbon(data = bandas, aes(anio, ymin = P5, ymax = P95), fill = "steelblue", alpha = 0.25) +
geom_ribbon(data = bandas, aes(anio, ymin = P25, ymax = P75), fill = "steelblue", alpha = 0.35) +
geom_line(data = bandas, aes(anio, P50), color = "navy", linewidth = 1) +
geom_point(data = bandas, aes(anio, P50), color = "navy") +
geom_hline(yintercept = V0, linetype = "dashed") +
scale_y_continuous(labels = label_number(scale = 1e-6, suffix = " M")) +
labs(title = "Portafolio sin cobertura: escenarios MGB (no es una prediccion)",
subtitle = "Bandas P5-P95 y P25-P75, mediana en azul oscuro; 50 trayectorias de ejemplo",
x = "Anios", y = "Valor del portafolio (USD)") + theme_minimal()
ggsave("graficos/03_bandas_mgb.png", p3, width = 9, height = 5.5, dpi = 200)
graf_pl <- function(x, titulo) {
v95 <- var_pl(x, 0.05); v99 <- var_pl(x, 0.01)
ggplot(data.frame(pl = x / 1e6), aes(pl)) +
geom_histogram(bins = 80, fill = "grey70", color = "white") +
geom_vline(xintercept = -v95 / 1e6, color = "orange", linewidth = 1) +
geom_vline(xintercept = -v99 / 1e6, color = "red", linewidth = 1) +
labs(title = titulo,
subtitle = sprintf("VaR 95 %% (naranja) = USD %.2f M | VaR 99 %% (rojo) = USD %.2f M",
v95 / 1e6, v99 / 1e6),
x = "P&L (millones USD)", y = "Frecuencia") + theme_minimal()
}
p4a <- graf_pl(PL[, 2], "Distribucion de P&L sin cobertura - trimestre 1")
p4b <- graf_pl(PL[, n_trim + 1], "Distribucion de P&L sin cobertura - trimestre 8 (2 anios)")
ggsave("graficos/04a_pl_trim1.png", p4a, width = 8, height = 5, dpi = 200)
ggsave("graficos/04b_pl_trim8.png", p4b, width = 8, height = 5, dpi = 200)
print(p3); print(p4a); print(p4b)
save(list = c("S_trim", "V_trim", "PL", "V0", "tab_var", "bandas", "sig_d", "tab_garch",
"n_trim", "dias_trim", "n_dias", "graf_pl"),
file = "salidas/simulacion.RData")1.3 portafolio sin cobertura simulación MGB: Esta gráfica parece un “embudo” que solo crece, pero lo clave está en la forma asimétrica de las bandas: se abren mucho más hacia arriba que hacia abajo. Eso es la firma de un GBM: como el precio de una acción no puede ser negativo, las pérdidas están limitadas, pero las ganancias no tienen techo. La línea azul oscura (mediana) sube de forma suave y constante, mientras que las líneas grises finas son 50 trayectorias individuales de ejemplo, para mostrar que cada “camino” simulado es distinto, aunque todos parten del mismo punto (USD 10M en t=0).
1.4 Distribución de P&L sin cobertura 1 trimestre: En el trimestre 1 el histograma es angosto y está centrado cerca de cero. Las líneas naranja y roja marcan el VaR 95% y 99% (USD 1.91M y USD 2.72M respectivamente): quedan relativamente cerca del centro de la distribución, porque a un solo trimestre todavía no se ha acumulado mucha incertidumbre.
1.5 Distribución de P&L sin cobertura 8 trimestre (2 años): Al comparar esta gráfica con la del trimestre 1, el histograma es mucho más ancho y está desplazado hacia la derecha (el portafolio crece en promedio con el tiempo). Nota que las líneas de VaR 95% y 99% quedan más lejos de cero en términos absolutos (USD 3.34M y USD 5.04M) — eso es visualmente lo que sustenta que el VaR casi se duplica entre el primer trimestre y el cierre de los 2 años. También cambia la escala del eje X, reflejando cuánto más dispersos son los resultados a mayor horizonte.
BLOQUE III (parte 1) SELECCION OPCIONES
Cadenas de opciones (Yahoo Finance), vencimiento comun 12-24 meses,>= 3 strikes candidatos por activo y criterios de liquidez.
load("salidas/datos.RData"); load("salidas/portafolio.RData")
suppressMessages(library(quantmod))
Sys.setlocale("LC_TIME", "C")## [1] "C"Descarga de todas las cadenas disponibles.
Vencimiento comun entre 12 y 24 meses.
meses_hasta <- function(d) as.numeric(d - fecha_val) / 30.4375
venc_disp <- lapply(cadenas, function(ch) as.Date(names(ch), format = "%b.%d.%Y"))
if (any(sapply(venc_disp, function(v) all(is.na(v)))))
stop("No se pudieron leer las fechas de vencimiento; revisa names(cadenas[[1]]).")
ventana <- lapply(venc_disp, function(v) as.character(v[meses_hasta(v) >= 12 & meses_hasta(v) <= 24]))
comunes <- as.Date(Reduce(intersect, ventana))
if (length(comunes) > 0) {
f_comun <- comunes[which.min(abs(meses_hasta(comunes) - 24))] # la mas cercana a 24 m
venc_sel <- setNames(rep(f_comun, length(tickers)), tickers)
} else {
cat("\nNo hay fecha comun en 12-24 meses: se usa la mas cercana a 24 meses por activo.\n")
venc_sel <- setNames(as.Date(sapply(tickers, function(tk) {
v <- venc_disp[[tk]]; as.character(v[which.min(abs(meses_hasta(v) - 24))])
})), tickers)
}
cat("\n== Vencimientos seleccionados ==\n")##
## == Vencimientos seleccionados ==print(data.frame(ticker = tickers, vencimiento = venc_sel,
meses = round(meses_hasta(venc_sel), 1),
diferencia_vs_mas_lejano_dias = as.numeric(max(venc_sel) - venc_sel)))## ticker vencimiento meses diferencia_vs_mas_lejano_dias
## HD HD 2028-01-21 15.7 0
## FTNT FTNT 2028-01-21 15.7 0
## FANG FANG 2028-01-21 15.7 0Limpieza de cadenas y funcion de candidatos.
limpiar <- function(df, S0) {
df <- as.data.frame(df)
for (v in c("Strike", "Bid", "Ask", "Vol", "OI", "IV")) {
if (is.null(df[[v]])) df[[v]] <- NA_real_
df[[v]] <- suppressWarnings(as.numeric(gsub("%", "", as.character(df[[v]]))))
}
df$Vol[is.na(df$Vol)] <- 0; df$OI[is.na(df$OI)] <- 0
df$IV <- ifelse(df$IV > 5, df$IV / 100, df$IV) # a decimal
df <- df[!is.na(df$Bid) & !is.na(df$Ask) & df$Bid > 0 & df$Ask >= df$Bid, ]
df$Mid <- (df$Ask + df$Bid) / 2
df$spread_rel <- (df$Ask - df$Bid) / df$Mid # bid-ask relativo
df$moneyness <- df$Strike / S0
df
}
candidatos <- function(df, m_obj) {
idx <- unique(sapply(m_obj, function(m) which.min(abs(df$moneyness - m))))
out <- df[idx, c("Strike", "moneyness", "Bid", "Ask", "Mid", "spread_rel", "Vol", "OI", "IV")]
# puntaje de liquidez: menor spread, mayor OI, mayor volumen (rangos)
out$score <- rank(-out$spread_rel) + rank(out$OI) + rank(out$Vol)
rownames(out) <- NULL
out
}
tipo_money <- function(m, tipo) {
if (abs(m - 1) <= 0.03) "ATM" else if ((tipo == "put" && m < 1) || (tipo == "call" && m > 1)) "OTM" else "ITM"
}Candidatos y seleccion
K_put_manual <- c(HD = NA, FTNT = NA, FANG = NA)
K_call_manual <- c(HD = NA, FTNT = NA, FANG = NA)
evidencia <- list(); contratos <- list()
for (tk in tickers) {
k <- which(venc_disp[[tk]] == venc_sel[tk])
ch <- cadenas[[tk]][[k]]
S0 <- spot[tk]; Tanios <- as.numeric(venc_sel[tk] - fecha_val) / 365
puts <- limpiar(ch$puts, S0)
calls <- limpiar(ch$calls, S0)
cp <- candidatos(puts, c(1.00, 0.95, 0.90)) # puts: ATM, 5 % OTM, 10 % OTM
cc <- candidatos(calls, c(1.05, 1.10, 1.15)) # calls: 5, 10, 15 % OTM
evidencia[[paste0(tk, "_put")]] <- cbind(ticker = tk, tipo = "put", cp)
evidencia[[paste0(tk, "_call")]] <- cbind(ticker = tk, tipo = "call", cc)
pick <- function(cand, manual, df) {
if (!is.na(manual)) return(df[which.min(abs(df$Strike - manual)), ])
best <- cand$Strike[order(-cand$score, -cand$OI)[1]]
df[df$Strike == best, ][1, ]
}
put_sel <- pick(cp, K_put_manual[tk], puts)
call_sel <- pick(cc, K_call_manual[tk], calls)
fila <- function(x, tipo, rol) data.frame(
ticker = tk, rol = rol, tipo = tipo, strike = x$Strike, moneyness = x$moneyness,
posicion_moneyness = tipo_money(x$moneyness, tipo), bid = x$Bid, ask = x$Ask,
mid = x$Mid, spread_rel = x$spread_rel, vol = x$Vol, OI = x$OI, IV = x$IV,
vencimiento = venc_sel[tk], T_anios = Tanios, row.names = NULL)
contratos[[tk]] <- rbind(fila(put_sel, "put", "put"), fila(call_sel, "call", "call"))
# pata corta del bear put spread (solo se usa en el activo de mayor riesgo):
# strike mas cercano al 80 % del spot y por debajo del strike de la put larga
inf <- puts[puts$Strike < put_sel$Strike, ]
if (nrow(inf) > 0) {
corta <- inf[which.min(abs(inf$moneyness - 0.80)), ]
contratos[[tk]] <- rbind(contratos[[tk]], fila(corta, "put", "put_corta"))
}
}
contratos <- do.call(rbind, contratos)
evidencia <- do.call(rbind, evidencia)
cat("\n== Candidatos evaluados (evidencia; score mas alto = mas liquido) ==\n")##
## == Candidatos evaluados (evidencia; score mas alto = mas liquido) ==## ticker tipo Strike moneyness Bid Ask Mid spread_rel Vol OI IV score
## HD put 280 0.984 29.8 33.5 31.6 0.1186 1 405 0.278 7.0
## HD put 270 0.949 24.5 27.4 25.9 0.1118 1 50 0.271 6.0
## HD put 260 0.914 20.3 24.2 22.2 0.1753 1 179 0.284 5.0
## HD call 300 1.055 32.4 35.3 33.8 0.0872 362 658 0.321 9.0
## HD call 310 1.090 28.0 32.5 30.2 0.1488 3 243 0.327 5.0
## HD call 330 1.160 21.9 25.5 23.7 0.1519 7 192 0.320 4.0
## FTNT put 180 1.007 35.5 40.5 38.0 0.1316 1 15 0.494 4.5
## FTNT put 170 0.951 30.0 35.0 32.5 0.1538 1 125 0.500 4.5
## FTNT put 160 0.895 26.5 29.2 27.9 0.0987 2 141 0.497 9.0
## FTNT call 190 1.063 41.5 46.0 43.8 0.1029 51 80 0.595 8.0
## FTNT call 195 1.091 39.5 44.0 41.8 0.1078 1 17 0.591 4.0
## FTNT call 210 1.175 34.5 39.0 36.8 0.1224 49 539 0.585 6.0
## FANG put 180 0.979 23.0 27.5 25.2 0.1782 7 86 0.356 5.0
## FANG put 175 0.952 20.5 25.0 22.8 0.1978 141 190 0.359 6.5
## FANG put 165 0.898 16.2 21.0 18.6 0.2581 141 890 0.373 6.5
## FANG call 195 1.061 25.5 30.5 28.0 0.1786 1 39 0.418 4.5
## FANG call 200 1.088 24.0 28.0 26.0 0.1538 500 1778 0.409 9.0
## FANG call 210 1.142 20.5 25.0 22.8 0.1978 1 117 0.412 4.5##
## == Contratos seleccionados ==## ticker rol tipo strike moneyness posicion_moneyness bid ask mid
## HD put put 280 0.984 ATM 29.8 33.5 31.6
## HD call call 300 1.055 OTM 32.4 35.3 33.8
## HD put_corta put 230 0.808 OTM 11.3 14.2 12.7
## FTNT put put 160 0.895 OTM 26.5 29.2 27.9
## FTNT call call 190 1.063 OTM 41.5 46.0 43.8
## FTNT put_corta put 145 0.811 OTM 27.1 29.2 28.2
## FANG put put 165 0.898 OTM 16.2 21.0 18.6
## FANG call call 200 1.088 OTM 24.0 28.0 26.0
## FANG put_corta put 145 0.789 OTM 9.0 13.1 11.1
## spread_rel vol OI IV vencimiento T_anios
## 0.1186 1 405 0.278 2028-01-21 1.31
## 0.0872 362 658 0.321 2028-01-21 1.31
## 0.2240 101 122 0.299 2028-01-21 1.31
## 0.0987 2 141 0.497 2028-01-21 1.31
## 0.1029 51 80 0.595 2028-01-21 1.31
## 0.0763 1 11 0.595 2028-01-21 1.31
## 0.2581 141 890 0.373 2028-01-21 1.31
## 0.1538 500 1778 0.409 2028-01-21 1.31
## 0.3710 1 111 0.383 2028-01-21 1.31cat("\n: la IV de Yahoo en vencimientos largos con poco OI puede ser poco confiable.\n",
"Justifica en el informe por que cada strike protege (moneyness) y no elijas solo por menor IV.\n")##
## : la IV de Yahoo en vencimientos largos con poco OI puede ser poco confiable.
## Justifica en el informe por que cada strike protege (moneyness) y no elijas solo por menor IV.write.csv(evidencia, "salidas/evidencia_candidatos_opciones.csv", row.names = FALSE)
write.csv(contratos, "salidas/contratos_seleccionados.csv", row.names = FALSE)
save(list = c("contratos", "evidencia", "venc_sel", "hora_opciones"),
file = "salidas/opciones.RData")Con la moneyness se recuperan los precios spot HD ≈ 284.5, FTNT ≈ 178.8, FANG ≈ 183.8, evidenciamos que el punto débil es FTNT y es el activo que tiene el 57 % del riesgo.
VALORACION BINOMIAL
Arbol binomial CRR europeo (benchmark) vs americano, mismos S0, K, T,sigma, r y q. Compara ademas con Black-Scholes y con el precio de mercado.
# funciones.R - Funciones auxiliares (se cargan con source())
# =====================================================================
# Black-Scholes-Merton con dividendo continuo q (europea). S puede ser vector.
bsm <- function(S, K, T, r, q, sigma, tipo = "put") {
if (T <= 0) {
return(if (tipo == "put") pmax(K - S, 0) else pmax(S - K, 0))
}
d1 <- (log(S / K) + (r - q + 0.5 * sigma^2) * T) / (sigma * sqrt(T))
d2 <- d1 - sigma * sqrt(T)
if (tipo == "put") {
K * exp(-r * T) * pnorm(-d2) - S * exp(-q * T) * pnorm(-d1)
} else {
S * exp(-q * T) * pnorm(d1) - K * exp(-r * T) * pnorm(d2)
}
}
# Arbol binomial CRR (europeo o americano) con dividendo continuo q
binomial_crr <- function(S0, K, T, r, q, sigma, n = 500,
tipo = "put", americana = TRUE) {
if (is.na(q)) {
warning(sprintf("q (tasa de dividendo) llego en NA para S0=%s K=%s T=%s; se uso q=0.",
S0, K, T))
q <- 0
}
if (is.na(r) || is.na(S0) || is.na(K) || is.na(T)) {
stop(sprintf("Valores NA en la valoracion: S0=%s K=%s T=%s r=%s (revisa esa fila de 'ct').",
S0, K, T, r))
}
if (is.na(sigma) || sigma <= 1e-4) {
warning(sprintf("IV invalida (%.4f) para S0=%.2f K=%.2f T=%.2f; se uso un piso de 1%% anual.",
sigma, S0, K, T))
sigma <- 0.01
}
dt <- T / n
u <- exp(sigma * sqrt(dt))
d <- 1 / u
p <- (exp((r - q) * dt) - d) / (u - d)
if (!(p > 0 && p < 1)) {
warning(sprintf("p fuera de (0,1) con sigma=%.4f r=%.4f q=%.4f T=%.2f; se ajusto sigma al minimo necesario.",
sigma, r, q, T))
sigma <- abs(r - q) * sqrt(dt) * 1.05 / sqrt(dt) + 0.01 # sigma minimo que garantiza p valido
u <- exp(sigma * sqrt(dt)); d <- 1 / u
p <- (exp((r - q) * dt) - d) / (u - d)
}
disc <- exp(-r * dt)
j <- 0:n
ST <- S0 * u^j * d^(n - j)
V <- if (tipo == "put") pmax(K - ST, 0) else pmax(ST - K, 0)
for (i in (n - 1):0) {
V <- disc * (p * V[2:(i + 2)] + (1 - p) * V[1:(i + 1)])
if (americana) {
Sj <- S0 * u^(0:i) * d^(i - (0:i))
ex <- if (tipo == "put") pmax(K - Sj, 0) else pmax(Sj - K, 0)
V <- pmax(V, ex)
}
}
V[1]
}##VAR = - CUARTIL (P&L)
var_pl <- function(pl, alfa) -as.numeric(quantile(pl, alfa, names = FALSE))
ct <- contratos
ct$S0 <- as.numeric(spot[ct$ticker])
ct$q <- as.numeric(q_div[ct$ticker])
ct$r <- sapply(ct$T_anios, r_cc) # tasa libre de riesgo segun el plazo
n_pasos <- 500
val <- function(americana) mapply(function(S0, K, T, r, q, s, tp)
binomial_crr(S0, K, T, r, q, s, n = n_pasos, tipo = tp, americana = americana),
ct$S0, ct$strike, ct$T_anios, ct$r, ct$q, ct$IV, ct$tipo)
ct$europea_binomial <- val(FALSE)
ct$americana_binomial <- val(TRUE)
ct$bsm_europea <- mapply(function(S0, K, T, r, q, s, tp) bsm(S0, K, T, r, q, s, tp),
ct$S0, ct$strike, ct$T_anios, ct$r, ct$q, ct$IV, ct$tipo)
ct$prima_ejercicio_anticipado <- ct$americana_binomial - ct$europea_binomial
ct$dif_americana_vs_mid <- ct$americana_binomial - ct$mid
cols <- c("ticker", "rol", "strike", "T_anios", "r", "q", "IV", "mid",
"europea_binomial", "americana_binomial", "bsm_europea",
"prima_ejercicio_anticipado", "dif_americana_vs_mid")
cat("\n== Valoracion binomial (", n_pasos, "pasos) ==\n"); print(format(ct[, cols], digits = 4), row.names = FALSE)##
## == Valoracion binomial ( 500 pasos) ==## ticker rol strike T_anios r q IV mid europea_binomial
## HD put 280 1.31 0.0457 0.03265 0.2784 31.62 29.71
## HD call 300 1.31 0.0457 0.03265 0.3211 33.83 35.68
## HD put_corta 230 1.31 0.0457 0.03265 0.2992 12.73 12.37
## FTNT put 160 1.31 0.0457 0.00000 0.4973 27.88 24.48
## FTNT call 190 1.31 0.0457 0.00000 0.5955 43.75 47.58
## FTNT put_corta 145 1.31 0.0457 0.00000 0.5949 28.18 24.03
## FANG put 165 1.31 0.0457 0.02312 0.3732 18.60 18.19
## FANG call 200 1.31 0.0457 0.02312 0.4092 26.00 29.13
## FANG put_corta 145 1.31 0.0457 0.02312 0.3831 11.05 11.23
## americana_binomial bsm_europea prima_ejercicio_anticipado dif_americana_vs_mid
## 30.45 29.70 0.73767 -1.17608
## 35.78 35.66 0.10007 1.95132
## 12.58 12.38 0.21151 -0.14070
## 25.26 24.47 0.78101 -2.61693
## 47.58 47.60 0.00000 3.82620
## 24.64 24.01 0.61184 -3.53727
## 18.64 18.19 0.44799 0.03848
## 29.14 29.14 0.01809 3.14366
## 11.46 11.24 0.23087 0.40892las opciones se valoraron con un árbol binomial de 500 pasos, con tasa libre de riesgo según el plazo, el precio europeo del árbol coincide con el de black-scholes-merton, con diferencias menores a USD 0.06 (menos de 0.3 %), la americana vale igual o más que la europea, porque incluye el derecho a ejercer antes del vencimiento. en los puts la prima es apreciable (1.7 % a 3.2 %). ejercer antes permite recibir el strike de inmediato y ganar intereses sobre ese dinero (r = 4.57 %). el ejercicio anticipado del put puede ser óptimo, y por eso la americana vale más.
CONVERGENCIA DEL ARBOL (contrato: put del activo de mayor riesgo)
fila <- ct[ct$ticker == asset_riesgo & ct$rol == "put", ][1, ]
conv <- data.frame(pasos = c(25, 50, 100, 200, 500, 1000))
conv$europea <- sapply(conv$pasos, function(n) binomial_crr(fila$S0, fila$strike, fila$T_anios, fila$r, fila$q, fila$IV, n, "put", FALSE))
conv$americana <- sapply(conv$pasos, function(n) binomial_crr(fila$S0, fila$strike, fila$T_anios, fila$r, fila$q, fila$IV, n, "put", TRUE))
conv$bsm <- fila$bsm_europea
cat("\n== Convergencia (", asset_riesgo, "put ) ==\n"); print(round(conv, 4))##
## == Convergencia ( FTNT put ) ==## pasos europea americana bsm
## 1 25 24.1581 25.0637 24.4749
## 2 50 24.5942 25.3917 24.4749
## 3 100 24.4039 25.2145 24.4749
## 4 200 24.5107 25.2897 24.4749
## 5 500 24.4771 25.2581 24.4749
## 6 1000 24.4710 25.2523 24.4749write.csv(conv, "salidas/convergencia_binomial.csv", row.names = FALSE)
save(list = c("ct"), file = "salidas/binomial.RData")La prueba de convergencia del árbol binomial para el put de FTNT (strike 160): se valora con distinto número de pasos y se compara con Black-Scholes (BSM), que es el valor exacto para la opción europea (24.4749).
BLOQUE III (parte 2) COBERTURAS VAR CUBIERTO
A: Protective put 85 % | B: Collar 85 % | C: overlay en el activo de mayor riesgo
Revalua las opciones (mark-to-market) en cada cierre trimestral con Black-Scholes-Merton (IV constante = IV del contrato) sobre las trayectorias simuladas; en el vencimiento vale el payoff. El arbol binomial,usa la valoracion inicial europea vs americana.
load("salidas/datos.RData"); load("salidas/portafolio.RData")
load("salidas/simulacion.RData"); load("salidas/opciones.RData")
# =====================================================================
# funciones.R - Funciones auxiliares (se cargan con source())
# =====================================================================
# Black-Scholes-Merton con dividendo continuo q (europea). S puede ser vector.
bsm <- function(S, K, T, r, q, sigma, tipo = "put") {
if (T <= 0) {
return(if (tipo == "put") pmax(K - S, 0) else pmax(S - K, 0))
}
d1 <- (log(S / K) + (r - q + 0.5 * sigma^2) * T) / (sigma * sqrt(T))
d2 <- d1 - sigma * sqrt(T)
if (tipo == "put") {
K * exp(-r * T) * pnorm(-d2) - S * exp(-q * T) * pnorm(-d1)
} else {
S * exp(-q * T) * pnorm(d1) - K * exp(-r * T) * pnorm(d2)
}
}
# Arbol binomial CRR (europeo o americano) con dividendo continuo q
binomial_crr <- function(S0, K, T, r, q, sigma, n = 500,
tipo = "put", americana = TRUE) {
if (is.na(q)) {
warning(sprintf("q (tasa de dividendo) llego en NA para S0=%s K=%s T=%s; se uso q=0.",
S0, K, T))
q <- 0
}
if (is.na(r) || is.na(S0) || is.na(K) || is.na(T)) {
stop(sprintf("Valores NA en la valoracion: S0=%s K=%s T=%s r=%s (revisa esa fila de 'ct').",
S0, K, T, r))
}
if (is.na(sigma) || sigma <= 1e-4) {
warning(sprintf("IV invalida (%.4f) para S0=%.2f K=%.2f T=%.2f; se uso un piso de 1%% anual.",
sigma, S0, K, T))
sigma <- 0.01
}
dt <- T / n
u <- exp(sigma * sqrt(dt))
d <- 1 / u
p <- (exp((r - q) * dt) - d) / (u - d)
if (!(p > 0 && p < 1)) {
warning(sprintf("p fuera de (0,1) con sigma=%.4f r=%.4f q=%.4f T=%.2f; se ajusto sigma al minimo necesario.",
sigma, r, q, T))
sigma <- abs(r - q) * sqrt(dt) * 1.05 / sqrt(dt) + 0.01 # sigma minimo que garantiza p valido
u <- exp(sigma * sqrt(dt)); d <- 1 / u
p <- (exp((r - q) * dt) - d) / (u - d)
}
disc <- exp(-r * dt)
j <- 0:n
ST <- S0 * u^j * d^(n - j)
V <- if (tipo == "put") pmax(K - ST, 0) else pmax(ST - K, 0)
for (i in (n - 1):0) {
V <- disc * (p * V[2:(i + 2)] + (1 - p) * V[1:(i + 1)])
if (americana) {
Sj <- S0 * u^(0:i) * d^(i - (0:i))
ex <- if (tipo == "put") pmax(K - Sj, 0) else pmax(Sj - K, 0)
V <- pmax(V, ex)
}
}
V[1]
}# VaR = -cuantil(P&L)
var_pl <- function(pl, alfa) -as.numeric(quantile(pl, alfa, names = FALSE))
suppressMessages({library(ggplot2); library(scales)})
mult <- 100 # multiplicador del contrato
estrategia_C <- "bear_put_spread" # o "covered_call" (justificar en el informe)
criterio_reparto <- "riesgo" # "valor", "riesgo" o "eficiencia"Cobertura base: numero de contratos y % efectivo
n_contr <- floor(cobertura_obj * acciones / mult)
acc_cub <- n_contr * mult
cob_efectiva <- acc_cub / acciones
cob_tab <- data.frame(ticker = tickers, acciones = as.numeric(acciones),
contratos = as.numeric(n_contr), acciones_cubiertas = as.numeric(acc_cub),
cobertura_efectiva = as.numeric(cob_efectiva), row.names = NULL)
cat("\n== Cobertura efectiva (objetivo 85 %) ==\n"); print(cob_tab)##
## == Cobertura efectiva (objetivo 85 %) ==## ticker acciones contratos acciones_cubiertas cobertura_efectiva
## 1 HD 5272 44 4400 0.8345979
## 2 FTNT 24054 204 20400 0.8480918
## 3 FANG 22849 194 19400 0.8490525la cobertura al 85 % de cada posición con opciones put fue 44 para HD, 204 para FTNT y 194 para FANG, que cubren 4,400, 20,400 y 19,400 acciones. La cobertura efectiva fue de 83.5 %, 84.8 % y 84.9 % con una desviación que es mayor en HD por ser la posición más pequeña, cada contrato representa una fracción mayor de ella (1.9 % frente a 0.4 % en FTNT y FANG). El ≈ 15 % restante, lo que la cobertura reduce el VaR pero no lo elimina.
Armado de posiciones de opciones
armar <- function(est) { # est: vector nombrado por ticker
filas <- list()
for (tk in names(est)) {
n <- as.numeric(n_contr[tk])
add <- function(rol, signo) {
x <- contratos[contratos$ticker == tk & contratos$rol == rol, ][1, ]
data.frame(ticker = tk, tipo = x$tipo, strike = x$strike, qty = signo * n,
iv = x$IV, T_exp = x$T_anios, r = r_cc(x$T_anios), q = as.numeric(q_div[tk]),
mid = x$mid, stringsAsFactors = FALSE)
}
filas[[tk]] <- switch(est[[tk]],
none = NULL,
put = add("put", 1),
collar = rbind(add("put", 1), add("call", -1)),
bear_put_spread = rbind(add("put", 1), add("put_corta", -1)),
covered_call = add("call", -1))
}
if (length(filas) == 0) NULL else do.call(rbind, filas)
}
prima_neta <- function(pos) if (is.null(pos)) 0 else sum(pos$qty * mult * pos$mid)
prima_tk <- function(pos, tk) if (is.null(pos)) 0 else
sum(pos$qty[pos$ticker == tk] * mult * pos$mid[pos$ticker == tk])
# Valor de las opciones en el cierre del trimestre k (0..n_trim) para cada trayectoria
valor_opciones <- function(pos, k) {
if (is.null(pos)) return(rep(0, n_sim))
if (k == 0) return(rep(sum(pos$qty * mult * pos$mid), n_sim)) # a precio de mercado
tot <- rep(0, n_sim)
for (j in seq_len(nrow(pos))) {
p <- pos[j, ]
T_rem <- max(p$T_exp - 0.25 * k, 0)
S <- S_trim[, k + 1, p$ticker]
tot <- tot + p$qty * mult * bsm(S, p$strike, T_rem, p$r, p$q, p$iv, p$tipo)
}
tot
}
# P&L del portafolio cubierto: acciones + dividendos + opciones - (V0 + prima neta pagada)
pl_cubierto <- function(pos, k) V_trim[, k + 1] + valor_opciones(pos, k) - (V0 + prima_neta(pos))
# Ventana de cobertura: hasta el primer vencimiento (max. 8 trimestres)
T_min <- min(contratos$T_anios[contratos$rol == "put"])
q_fin <- min(floor(T_min * 4 + 1e-9), n_trim)
cat("\nVentana de cobertura: hasta el trimestre", q_fin, "(vencimiento mas cercano:",
round(T_min, 2), "años)\n")##
## Ventana de cobertura: hasta el trimestre 5 (vencimiento mas cercano: 1.31 años)est_none <- setNames(rep("none", 3), tickers)
est_A <- setNames(rep("put", 3), tickers)
est_B <- setNames(rep("collar", 3), tickers)
est_C <- setNames(ifelse(tickers == asset_riesgo, estrategia_C, "put"), tickers)
# SUPUESTO: en C el activo de mayor riesgo usa la estrategia adicional y los otros dos
# mantienen la protective put base. Cambia est_C si tu tesis es otra.
estr <- list("Sin cobertura" = est_none, "A: Protective put 85%" = est_A,
"B: Collar 85%" = est_B, "C: Overlay" = est_C)
posiciones <- lapply(estr, armar)Costos de las primas.
tab_costos <- data.frame(ticker = tickers, valor_posicion = as.numeric(valor_pos),
prima_A = sapply(tickers, function(tk) prima_tk(posiciones[[2]], tk)),
prima_B = sapply(tickers, function(tk) prima_tk(posiciones[[3]], tk)),
prima_C = sapply(tickers, function(tk) prima_tk(posiciones[[4]], tk)), row.names = NULL)
tab_costos$A_pct_posicion <- tab_costos$prima_A / tab_costos$valor_posicion
tab_costos$B_pct_posicion <- tab_costos$prima_B / tab_costos$valor_posicion
tab_costos$C_pct_posicion <- tab_costos$prima_C / tab_costos$valor_posicion
tot <- c(sum(tab_costos$prima_A), sum(tab_costos$prima_B), sum(tab_costos$prima_C))
cat("\n== Costo de primas (USD; negativo = credito) ==\n"); print(format(tab_costos, digits = 3, big.mark = ","))##
## == Costo de primas (USD; negativo = credito) ==## ticker valor_posicion prima_A prima_B prima_C A_pct_posicion B_pct_posicion
## 1 HD 1,499,831 139,150 -9,680 139,150 0.0928 -0.00645
## 2 FTNT 4,299,893 568,650 -323,850 -6,120 0.1322 -0.07532
## 3 FANG 4,199,875 360,840 -143,560 360,840 0.0859 -0.03418
## C_pct_posicion
## 1 0.09278
## 2 -0.00142
## 3 0.08592cat("Costo total de primas como % del portafolio -> A:", percent(tot[1] / V0, 0.01),
"| B:", percent(tot[2] / V0, 0.01), "| C:", percent(tot[3] / V0, 0.01), "\n")## Costo total de primas como % del portafolio -> A: 10.69% | B: -4.77% | C: 4.94%en resumen tenemos Costo total de primas en % del portafolio -> A: 10.69% | B: -4.77% | C: 4.94%
En A: podemos comprar solo los puts. En B: el collar: compro el put y vendo un call para que me paguen algo. En C: el put spread: compro el put y vendo otro put más abajo al menos para no perder tanto.
P&L CUBIERTO VS NO CUBIERTO EN CIERRES TRIMESTRALES
PLs <- lapply(posiciones, function(pos) sapply(0:q_fin, function(k) pl_cubierto(pos, k)))
comp_trim <- do.call(rbind, lapply(names(PLs), function(nm) {
v <- V0 + PLs[[nm]]
data.frame(estrategia = nm, trimestre = 0:q_fin, media = colMeans(v),
P5 = apply(v, 2, quantile, 0.05), P50 = apply(v, 2, quantile, 0.50),
P95 = apply(v, 2, quantile, 0.95), row.names = NULL)
}))
cat("\n== Valor del portafolio (USD) por estrategia y trimestre ==\n")##
## == Valor del portafolio (USD) por estrategia y trimestre ==tmp <- comp_trim; tmp[, -1] <- round(tmp[, -1])
print(format(tmp, big.mark = ","), row.names = FALSE)## estrategia trimestre media P5 P50 P95
## Sin cobertura 0 9,999,599 9,999,599 9,999,599 9,999,599
## Sin cobertura 1 10,644,030 8,174,029 10,487,676 13,611,374
## Sin cobertura 2 11,330,927 7,665,708 11,011,647 16,133,141
## Sin cobertura 3 12,066,339 7,291,036 11,488,610 18,813,883
## Sin cobertura 4 12,821,613 7,093,886 12,017,132 21,338,255
## Sin cobertura 5 13,657,163 6,894,777 12,581,951 23,929,983
## A: Protective put 85% 0 9,999,599 9,999,599 9,999,599 9,999,599
## A: Protective put 85% 1 10,458,559 8,632,082 10,254,379 12,941,396
## A: Protective put 85% 2 11,076,407 8,324,757 10,651,104 15,312,124
## A: Protective put 85% 3 11,760,150 8,124,598 11,025,315 17,946,718
## A: Protective put 85% 4 12,461,991 8,004,072 11,429,395 20,448,209
## A: Protective put 85% 5 13,251,368 7,895,522 11,979,295 22,976,243
## B: Collar 85% 0 9,999,599 9,999,599 9,999,599 9,999,599
## B: Collar 85% 1 10,050,551 9,390,600 10,014,595 10,825,550
## B: Collar 85% 2 10,342,326 9,359,158 10,285,781 11,530,436
## B: Collar 85% 3 10,641,060 9,363,740 10,557,303 12,200,941
## B: Collar 85% 4 10,944,727 9,407,987 10,850,622 12,781,797
## B: Collar 85% 5 11,260,809 9,417,471 11,172,852 13,306,910
## C: Overlay 0 9,999,599 9,999,599 9,999,599 9,999,599
## C: Overlay 1 10,625,030 8,547,369 10,439,055 13,327,580
## C: Overlay 2 11,323,033 8,224,206 10,938,924 15,763,286
## C: Overlay 3 12,078,393 8,001,844 11,403,560 18,449,710
## C: Overlay 4 12,849,264 7,927,284 11,897,404 20,990,532
## C: Overlay 5 13,697,309 7,946,329 12,496,704 23,551,013La comparación con cobertura y sin cobertura de cierres trimestrales mostro que al cierre del trimestre 5 (15 meses), el portafolio sin cobertura tiene un valor medio de USD 13.66 millones y un percentil 5 de USD 6.89 millones (pérdida de 31.0 % respecto a la inversión inicial). • El put (A) eleva el percentil 5 a USD 7.90 millones (pérdida de 21.0 %) y reduce la media en solo 3%, conservando de cierta manera la ganancia. • El collar (B) ofrece la mayor protección (percentil 5 de USD 9.42 millones, pérdida de 5.8 %), pero limita el percentil 95 a USD 13.31 millones y reduce la media a USD 11.26 millones, ya que renuncia a las ganancias por encima de los strikes de los calls vendidos, pero garantiza que no será una perdida muy grande. • La estrategia C muestra una media superior a la del portafolio sin cobertura.
VAR DEL PORTAFOLIO CUBIERTO
tab_var_cob <- do.call(rbind, lapply(names(PLs), function(nm) {
m <- PLs[[nm]]
data.frame(estrategia = nm,
VaR95_T1 = var_pl(m[, 2], 0.05), VaR99_T1 = var_pl(m[, 2], 0.01),
VaR95_fin = var_pl(m[, q_fin + 1], 0.05), VaR99_fin = var_pl(m[, q_fin + 1], 0.01))
}))
tab_var_cob$red_VaR95_fin_pct <- 1 - tab_var_cob$VaR95_fin / tab_var_cob$VaR95_fin[1]
tab_var_cob$red_VaR99_fin_pct <- 1 - tab_var_cob$VaR99_fin / tab_var_cob$VaR99_fin[1]
cat("\n== VaR (USD): trimestre 1 y fin de la ventana (trimestre", q_fin, ") ==\n")##
## == VaR (USD): trimestre 1 y fin de la ventana (trimestre 5 ) ==## estrategia VaR95_T1 VaR99_T1 VaR95_fin VaR99_fin
## Sin cobertura 1,825,570 2,608,852 3,104,822 4,519,532
## A: Protective put 85% 1,367,517 1,814,638 2,104,076 2,405,066
## B: Collar 85% 608,998 802,427 582,127 860,586
## C: Overlay 1,452,230 2,045,118 2,053,270 2,993,002
## red_VaR95_fin_pct red_VaR99_fin_pct
## 0.000 0.000
## 0.322 0.468
## 0.813 0.810
## 0.339 0.338reducción del var por estrategia funciona en el collar (b) es la estrategia que más reduce el riesgo, con una caída de 81 % en ambos niveles, y mantiene el var prácticamente constante en el tiempo gracias al piso que fija el put. el put (a) reduce el var en 32 % al 95 % y en 47 % al 99 %, lo que indica una mayor protección frente a pérdidas extremas, y conserva el potencial de ganancia, la estrategia (c) reduce el var en 34 % en ambos niveles, lo que sugiere una protección limitada en la cola extrema. la elección entre a y b depende del objetivo: b maximiza la preservación del capital, mientras que a mantiene mayor potencial de ganancia a un costo menor en rentabilidad esperada.
reparto del costo de cobertura (3 criterios)
prima_put_activo <- sapply(tickers, function(tk) prima_tk(posiciones[[2]], tk))
var_sin <- var_pl(PLs[["Sin cobertura"]][, q_fin + 1], 0.05)
efic <- sapply(tickers, function(tk) { # reduccion de VaR95 por USD de prima (solo ese activo)
e <- setNames(ifelse(tickers == tk, "put", "none"), tickers)
(var_sin - var_pl(pl_cubierto(armar(e), q_fin), 0.05)) / prima_put_activo[tk]
})
crit_valor <- as.numeric(valor_pos / sum(valor_pos))
crit_riesgo <- as.numeric(contrib_pct)
crit_efic <- pmax(efic, 0) / sum(pmax(efic, 0))
presupuesto <- sum(prima_put_activo) # presupuesto total = costo de la put 85 %
tab_reparto <- data.frame(ticker = tickers,
prima_real_put85 = as.numeric(prima_put_activo),
pct_valor = crit_valor, pct_riesgo = crit_riesgo, pct_eficiencia = as.numeric(crit_efic),
usd_valor = presupuesto * crit_valor, usd_riesgo = presupuesto * crit_riesgo,
usd_eficiencia = presupuesto * as.numeric(crit_efic),
reduccion_VaR_por_USD = as.numeric(efic), row.names = NULL)
cat("\n== Reparto del presupuesto de primas (USD", format(round(presupuesto), big.mark = ","), ") ==\n")##
## == Reparto del presupuesto de primas (USD 1,068,640 ) ==## ticker prima_real_put85 pct_valor pct_riesgo pct_eficiencia usd_valor
## HD 139,150 0.15 0.0459 0.2976 160,284
## FTNT 568,650 0.43 0.5735 0.0928 459,522
## FANG 360,840 0.42 0.3806 0.6097 448,833
## usd_riesgo usd_eficiencia reduccion_VaR_por_USD
## 49,092 317,990 0.891
## 612,857 99,125 0.278
## 406,691 651,526 1.826col_sel <- paste0("usd_", criterio_reparto)
cat("Criterio elegido:", criterio_reparto, "-> mayor presupuesto de proteccion:",
tickers[which.max(tab_reparto[[col_sel]])], "\n")## Criterio elegido: riesgo -> mayor presupuesto de proteccion: FTNTcomo lo indica la tabla el mayor presupuesto se va para la accion la cual mostro mayor riesgo por lo tanto plicariamos proteccion con coberturas.
GRAFICOS
nombres_est <- c(none = "Sin cobertura", put = "A: Protective put", collar = "B: Collar",
bear_put_spread = "C: Bear put spread", covered_call = "C: Covered call")
pyg_accion <- function(tk, est, S) { # P&L por accion al vencimiento
h <- as.numeric(cob_efectiva[tk]); S0 <- as.numeric(spot[tk])
gc <- function(rol) contratos[contratos$ticker == tk & contratos$rol == rol, ][1, ]
cp <- gc("put"); cc <- gc("call"); cs <- gc("put_corta")
opt <- switch(est,
none = 0 * S,
put = pmax(cp$strike - S, 0) - cp$mid,
collar = (pmax(cp$strike - S, 0) - cp$mid) + (cc$mid - pmax(S - cc$strike, 0)),
bear_put_spread = (pmax(cp$strike - S, 0) - cp$mid) + (cs$mid - pmax(cs$strike - S, 0)),
covered_call = cc$mid - pmax(S - cc$strike, 0))
(S - S0) + h * opt
}
pyg <- do.call(rbind, lapply(tickers, function(tk) {
S <- seq(0.5 * spot[tk], 1.5 * spot[tk], length.out = 200)
ests <- c("none", "put", "collar"); if (tk == asset_riesgo) ests <- c(ests, estrategia_C)
do.call(rbind, lapply(ests, function(e)
data.frame(ticker = tk, S = S, estrategia = unname(nombres_est[e]), pyg = pyg_accion(tk, e, S))))
}))
g1 <- ggplot(pyg, aes(S, pyg, color = estrategia)) + geom_line(linewidth = 0.9) +
geom_hline(yintercept = 0, linetype = "dashed") + facet_wrap(~ticker, scales = "free") +
labs(title = "P&L por accion al vencimiento (85 % cubierto)",
x = "Precio de la accion al vencimiento (USD)", y = "P&L por accion (USD)", color = NULL) +
theme_minimal() + theme(legend.position = "bottom")
ggsave("graficos/05_payoffs_estrategias.png", g1, width = 11, height = 5, dpi = 200)
cmp <- rbind(data.frame(comp_trim[, c("estrategia", "trimestre")], medida = "Mediana", valor = comp_trim$P50),
data.frame(comp_trim[, c("estrategia", "trimestre")], medida = "Percentil 5", valor = comp_trim$P5))
g2 <- ggplot(cmp, aes(trimestre, valor, color = estrategia)) + geom_line(linewidth = 0.9) + geom_point() +
facet_wrap(~medida, scales = "free_y") +
scale_y_continuous(labels = label_number(scale = 1e-6, suffix = " M")) +
labs(title = "Portafolio cubierto vs no cubierto en cierres trimestrales",
x = "Trimestre", y = "Valor del portafolio (USD)", color = NULL) +
theme_minimal() + theme(legend.position = "bottom")
ggsave("graficos/06_cubierto_vs_no_cubierto.png", g2, width = 11, height = 5, dpi = 200)
dens <- do.call(rbind, lapply(names(PLs), function(nm)
data.frame(estrategia = nm, pl = PLs[[nm]][, q_fin + 1] / 1e6)))
v95 <- data.frame(estrategia = names(PLs), row.names = NULL,
v = -as.numeric(sapply(names(PLs), function(nm) var_pl(PLs[[nm]][, q_fin + 1], 0.05))) / 1e6)
g3 <- ggplot(dens, aes(pl, color = estrategia)) + geom_density(linewidth = 0.9) +
geom_vline(data = v95, aes(xintercept = v, color = estrategia), linetype = "dashed") +
labs(title = paste0("Distribucion de P&L al trimestre ", q_fin, " (lineas punteadas = VaR 95 %)"),
x = "P&L (millones USD)", y = "Densidad", color = NULL) +
theme_minimal() + theme(legend.position = "bottom")
ggsave("graficos/07_pl_cubierto_var.png", g3, width = 9, height = 5.5, dpi = 200)
print(g1); print(g2); print(g3)
save(list = c("PLs", "tab_var_cob", "tab_costos", "tab_reparto", "comp_trim", "cob_tab", "q_fin"),
file = "salidas/coberturas.RData")1.6. Payoffs por acción al vencimiento (85% cubierto): esta gráfica es clave para explicar cada estrategia con solo mirarla. en los tres paneles (FANG, FTNT, HD) se repite el mismo patrón: la línea morada (“sin cobertura”), la línea roja (protective put) es igual a la morada por encima de cierto precio, pero se “aplana” hacia abajo — ese aplanamiento es el piso que da la put comprada. la línea verde (collar) se aplana por ambos lados: abajo por la put, y arriba también, porque a partir del strike de la call vendida ya no gana más, aunque la acción siga subiendo — por eso es la línea más “baja” de las cuatro. en el panel de FTNT se ve además la línea con dos quiebres en vez de uno, porque se compró una put y se vendió otra con strike más bajo.
1.7. Portafolio cubierto vs. no cubierto en cierres trimestrales este gráfico tiene dos paneles que hay que leer en conjunto, no por separado. en “mediana” (el escenario típico), el orden de mejor a peor es: sin cobertura – a cobertura put collar — es decir que pagar por protección cuesta parte de la ganancia esperada. pero en “percentil 5” (el mal escenario), el orden se invierte casi por completo: el collar queda arriba de todos los demás, prácticamente plano, mientras que sin cobertura es la línea que más se desploma. esta es la evidencia gráfica más fuerte para justificar por qué recomendamos el collar: en el peor caso, es el que mejor protege, aunque en el caso típico sea el que menos gana.
1.8. Distribución de p&l cubierto al trimestre 5 aquí se ve claramente por qué el collar reduce tanto el riesgo: su curva verde es angosta y con un pico muy alto y puntiagudo cerca de cero — casi no hay dispersión, la mayoría de los escenarios terminan parecidos. las curvas de protective put (roja) y overlay (cian) son más anchas que el collar pero bastante más angostas que “sin cobertura” (morada), que es la más aplanada y con la cola derecha más larga (mayor dispersión, mayor potencial de ganancia extrema, pero también mayor riesgo). las líneas punteadas verticales marcan el var 95% de cada estrategia: la línea verde (collar) es la que está más cerca de cero, confirmando numéricamente lo que ya se ve en la forma de la curva.
CONCLUSIONES
En conclusión, la Construcción del portafolio y diversificación Con los activos HD, FTNT y FANG, mostro un máximo Sharpe quedó con 15 % en HD, 43 % en FTNT y 42 % en FANG. Su Sharpe es de 0.711 y su volatilidad de 27.8 %, frente a 38.6 % al promediar las volatilidades individuales da cerca de 28 % menos riesgo. Esto se explica porque las correlaciones son bajas (entre 0.101 y 0.225), ya que los tres sectores (retail, ciberseguridad y energía) responden a factores distintos y se puede nivelar una con otra. Pero el activo FTNT concentra cerca del 57 % del riesgo con el 43 % del capital, por lo que el portafolio es eficiente pero no está libre de riesgo y eso justifica cubrirlo. Se llega a la conclusión que el Riesgo sin cobertura muestra que depender solo de los datos históricos subestima el riesgo y que la cola izquierda es pesada, como la Cobertura con opciones se vuelve efectiva nos confirma que con las tres estrategias teniendo sus variaciones claro está en costo, todas llevan a reducir el riesgo y se toma la acción FTNT por ser la que concentra más riesgo.
ANEXO REPRODUCIBILIDAD
load("salidas/datos.RData"); load("salidas/opciones.RData")
parametros <- data.frame(
parametro = c("Activos", "Capital (USD)", "Peso minimo por accion", "Cobertura objetivo",
"Inicio muestra media-varianza", "Inicio muestra GARCH (10 anios)",
"Fecha de valoracion (ultimo cierre)", "Trayectorias MGB", "Semilla",
"Descarga precios/dividendos", "Descarga cadenas de opciones", "Rf Sharpe (T-note 2 anios)"),
valor = c(paste(tickers, collapse = ", "), format(capital, big.mark = ","), w_min, cobertura_obj,
as.character(fecha_inicio_analisis), as.character(fecha_inicio_garch),
as.character(fecha_val), n_sim, semilla, hora_descarga, hora_opciones,
round(rf_sharpe, 5)))
print(parametros, row.names = FALSE)## parametro valor
## Activos HD, FTNT, FANG
## Capital (USD) 1e+07
## Peso minimo por accion 0.15
## Cobertura objetivo 0.85
## Inicio muestra media-varianza 2021-10-01
## Inicio muestra GARCH (10 anios) 2016-09-30
## Fecha de valoracion (ultimo cierre) 2026-09-30
## Trayectorias MGB 10000
## Semilla 2026
## Descarga precios/dividendos 2026-09-30 22:36:05 -05
## Descarga cadenas de opciones 2026-09-30 22:38:56 -05
## Rf Sharpe (T-note 2 anios) 0.0489