# =================== PARÁMETROS DEL EJERCICIO ===================
capital <- 35e6 # USD
f_inicio <- as.Date("2026-10-30") # fecha inicial de inversión
f_hist <- as.Date("2016-10-30") # 10 años de historia
horizonte <- 4 # años
tickers <- c("AAPL", "AMGN", "PEP")
indice <- "^NDX" # Nasdaq-100
criterio <- "max_sharpe" # "max_sharpe" (tangente) o "min_var"
rebalanceo <- TRUE # recalcular N en cada roll-over
q_ndx <- 0.007 # rendimiento por dividendo del NDX (supuesto)
nsim <- 10000 # simulaciones Monte Carlo
deriva <- "historica" # [CAMBIO] "historica" o "neutral" (mu = r - q, sin alfa)
retiro_exceso <- TRUE # [CAMBIO] retirar el saldo de margen por encima del inicial
set.seed(2026)
# Contrato de futuros: E-mini Nasdaq-100 (NQ) — CME Group
# IMPORTANTE: verificar márgenes vigentes al 30-oct-2026 en
# https://www.cmegroup.com/markets/equities/nasdaq/e-mini-nasdaq-100.margins.html
fut <- list(
nombre = "E-mini Nasdaq-100 (NQ) — CME Group (Globex)",
subyacente = "Índice Nasdaq-100 (NDX)",
vencimientos = "Trimestrales: marzo (H), junio (M), septiembre (U), diciembre (Z)",
multiplicador = 20, # USD por punto del índice
tick = 0.25, # puntos
valor_tick = 5, # USD por tick (0.25 x 20)
margen_inicial = 33000, # USD por contrato <-- ACTUALIZAR CON CME
margen_mant = 30000, # USD por contrato <-- ACTUALIZAR CON CME
liquidacion = "Financiera (cash settlement) contra la cotización especial de apertura (SOQ) del NDX el tercer viernes del mes de vencimiento",
mtm = "Diaria (mark-to-market). En este ejercicio se liquida mensualmente con fines académicos"
)
mult <- fut$multiplicador; IM <- fut$margen_inicial; MM <- fut$margen_mantdescargar <- function(t, desde, hasta, tipo = "Ad") {
x <- getSymbols(t, src = "yahoo", from = desde, to = hasta, auto.assign = FALSE)
if (tipo == "Ad") Ad(x) else Cl(x)
}
# Precios ajustados (incluyen dividendos y splits) -> retorno total
precios <- na.omit(do.call(merge, lapply(c(tickers, indice), descargar,
desde = f_hist, hasta = f_inicio + 1)))
colnames(precios) <- c(tickers, "NDX")
# Precios de cierre (solo splits) -> evolución del precio de mercado
cierres <- na.omit(do.call(merge, lapply(tickers, descargar, desde = f_hist,
hasta = f_inicio + 1, tipo = "Cl")))
colnames(cierres) <- tickers
precios_m <- precios[endpoints(precios, on = "months"), ]
ret_m <- na.omit(diff(log(precios_m))) # retornos logarítmicos mensuales
# Tasas libres de riesgo observadas en la fecha inicial
tasa <- function(t) {
x <- tryCatch(getSymbols(t, src = "yahoo", from = f_inicio - 15, to = f_inicio + 1,
auto.assign = FALSE), error = function(e) NULL)
if (is.null(x)) return(NA)
v <- as.numeric(last(na.omit(Cl(x))))
if (v > 20) v <- v / 10
v / 100
}
rf_tnx <- tasa("^TNX"); rf_fvx <- tasa("^FVX"); rf_irx <- tasa("^IRX")
rf <- rf_tnx
rf_c <- ifelse(is.na(rf_irx), rf_tnx, rf_irx) # [CAMBIO] tasa corta: carry, financiamiento y descuento
P0 <- as.numeric(last(precios)); names(P0) <- colnames(precios)
S0 <- unname(P0["NDX"])Se invierten $35,000,000 el 30 de octubre de 2026 en un portafolio de tres acciones del Nasdaq-100 —Apple (AAPL), Amgen (AMGN) y PepsiCo (PEP)— con horizonte de 4 años. Se usan 120 meses de historia (oct-2016 a oct-2026) para optimizar el portafolio, medir su riesgo y diseñar una cobertura con futuros E-mini Nasdaq-100 (NQ) con roll-over trimestral.
met <- function(tk) {
x <- as.numeric(cierres[, tk]); d <- index(cierres); p0 <- tail(x, 1)
r <- function(a) (p0 / tail(x[d <= f_inicio - round(365.25 * a)], 1))^(1 / a) - 1
ult <- x[d > f_inicio - 365]
c(`Precio 30-oct-2026` = usd(p0, 2), `Rend. 1 año` = pct(r(1)),
`Rend. anual 3 años` = pct(r(3)), `Rend. anual 5 años` = pct(r(5)),
`Máx. 52 semanas` = usd(max(ult), 2), `Mín. 52 semanas` = usd(min(ult), 2),
`Máx. caída (10 años)` = pct(max(1 - x / cummax(x))))
}
tabla(t(sapply(tickers, met)), "Evolución reciente del precio de mercado")| Precio 30-oct-2026 | Rend. 1 año | Rend. anual 3 años | Rend. anual 5 años | Máx. 52 semanas | Mín. 52 semanas | Máx. caída (10 años) | |
|---|---|---|---|---|---|---|---|
| AAPL | $344.63 | 26.98% | 26.49% | 18.13% | $348.91 | $246.63 | 38.73% |
| AMGN | $466.01 | 59.59% | 20.98% | 17.62% | $466.01 | $296.30 | 26.72% |
| PEP | $137.34 | -6.92% | -5.41% | -3.20% | $170.49 | $123.73 | 36.91% |
base <- merge(cierres, precios$NDX)
base100 <- sweep(coredata(base), 2, as.numeric(coredata(base)[1, ]), "/") * 100
fig1 <- plot_ly()
for (j in colnames(base))
fig1 <- add_lines(fig1, x = index(base), y = base100[, j], name = j)
layout(fig1, title = "Precio base 100 (oct-2016 = 100)",
yaxis = list(title = "Índice base 100", type = "log"), xaxis = list(title = ""),
hovermode = "x unified")# Completar con el último 10-Q / 10-K y el consenso de analistas (Investing.com, Yahoo Finance)
fund <- data.frame(
Indicador = c("Ingresos últimos 12 meses (USD mil M)", "Margen neto", "Deuda / Patrimonio",
"P/E (TTM)", "Precio objetivo consenso 12 m (USD)"),
AAPL = NA, AMGN = NA, PEP = NA, check.names = FALSE)
fund[is.na(fund)] <- "Por completar"
tabla(fund, "Situación financiera (fuente: último reporte trimestral y consenso de analistas)")| Indicador | AAPL | AMGN | PEP |
|---|---|---|---|
| Ingresos últimos 12 meses (USD mil M) | Por completar | Por completar | Por completar |
| Margen neto | Por completar | Por completar | Por completar |
| Deuda / Patrimonio | Por completar | Por completar | Por completar |
| P/E (TTM) | Por completar | Por completar | Por completar |
| Precio objetivo consenso 12 m (USD) | Por completar | Por completar | Por completar |
# Expectativa de precio a 1 año según el modelo (log-normal con parámetros históricos)
mu_a <- colMeans(ret_m[, tickers]) * 12
sd_a <- apply(ret_m[, tickers], 2, sd) * sqrt(12)
P0c <- as.numeric(last(cierres)); names(P0c) <- tickers
esper <- data.frame(
Acción = tickers, `Precio actual` = usd(P0c, 2),
`Precio esperado 1 año` = usd(P0c * exp(mu_a + sd_a^2 / 2), 2),
`Intervalo 95% inferior` = usd(P0c * exp(mu_a - 1.96 * sd_a), 2),
`Intervalo 95% superior` = usd(P0c * exp(mu_a + 1.96 * sd_a), 2), check.names = FALSE)
tabla(esper, "Expectativa de precio a 12 meses según el modelo histórico")| Acción | Precio actual | Precio esperado 1 año | Intervalo 95% inferior | Intervalo 95% superior | |
|---|---|---|---|---|---|
| AAPL | AAPL | $344.63 | $462.48 | $264.61 | $752.81 |
| AMGN | AMGN | $466.01 | $555.88 | $342.82 | $853.81 |
| PEP | PEP | $137.34 | $147.20 | $105.16 | $200.52 |
La expectativa del modelo extrapola el comportamiento de los últimos 10 años; por eso se contrasta con el precio objetivo de consenso. Si el consenso es muy inferior al modelo, el retorno histórico probablemente sobreestima el futuro.
Lógica de la selección: una acción de crecimiento con beta alta (AAPL) combinada con dos defensivas de sectores distintos (salud y consumo básico) busca que el optimizador encuentre un portafolio con buena relación retorno-riesgo gracias a la diversificación, no solo por la rentabilidad individual.
Frecuencia: mensual (último precio ajustado de cada mes), 120 observaciones. Se eligió mensual porque el VaR y la liquidación de futuros del ejercicio son mensuales. Retorno: logarítmico, \(r_t=\ln(P_t/P_{t-1})\). Anualización: \(\mu_{anual}=12\,\bar r_{mensual}\), \(\sigma_{anual}=\sqrt{12}\,\sigma_{mensual}\), \(\Sigma_{anual}=12\,\Sigma_{mensual}\) (supone retornos independientes entre meses, por eso la varianza escala con el tiempo y la desviación con su raíz).
est <- data.frame(
`Retorno mensual promedio` = pct(colMeans(ret_m[, tickers])),
`Retorno anual promedio` = pct(mu_a),
`Desv. estándar mensual` = pct(apply(ret_m[, tickers], 2, sd)),
`Desv. estándar anual` = pct(sd_a), check.names = FALSE)
tabla(est, "Estadísticas por acción")| Retorno mensual promedio | Retorno anual promedio | Desv. estándar mensual | Desv. estándar anual | |
|---|---|---|---|---|
| AAPL | 2.15% | 25.86% | 7.70% | 26.67% |
| AMGN | 1.24% | 14.93% | 6.72% | 23.28% |
| PEP | 0.46% | 5.58% | 4.75% | 16.46% |
S_a <- cov(ret_m[, tickers]) * 12
tabla(round(S_a, 5), "Matriz de varianzas y covarianzas anualizada")| AAPL | AMGN | PEP | |
|---|---|---|---|
| AAPL | 0.07114 | 0.01311 | 0.01288 |
| AMGN | 0.01311 | 0.05419 | 0.01574 |
| PEP | 0.01288 | 0.01574 | 0.02711 |
| AAPL | AMGN | PEP | |
|---|---|---|---|
| AAPL | 1.0000 | 0.2111 | 0.2934 |
| AMGN | 0.2111 | 1.0000 | 0.4107 |
| PEP | 0.2934 | 0.4107 | 1.0000 |
plot_ly(x = tickers, y = tickers, z = C, type = "heatmap", colorscale = "RdBu",
zmin = -1, zmax = 1, text = round(C, 2), texttemplate = "%{text}") |>
layout(title = "Mapa de calor de correlaciones")Se evalúan todas las combinaciones de pesos sin ventas en corto (\(w_i\ge 0\), \(\sum w_i=1\)) en una malla de 0.5%:
\[\mu_p=\mathbf w'\boldsymbol\mu,\qquad \sigma_p=\sqrt{\mathbf w'\Sigma\mathbf w},\qquad Sharpe=\frac{\mu_p-r_f}{\sigma_p}\]
paso <- 0.005
g <- expand.grid(a = seq(0, 1, paso), b = seq(0, 1, paso))
g <- g[g$a + g$b <= 1 + 1e-9, ]
W <- cbind(g$a, g$b, pmax(0, round(1 - g$a - g$b, 10))); colnames(W) <- tickers # [CAMBIO] evita pesos -1e-16 (PEP = -1 accion)
mu_g <- as.numeric(W %*% mu_a)
sd_g <- sqrt(rowSums((W %*% S_a) * W))
sh_g <- (mu_g - rf) / sd_g
i_tan <- which.max(sh_g); i_mvp <- which.min(sd_g)
w <- if (criterio == "max_sharpe") W[i_tan, ] else W[i_mvp, ]
mu_p <- sum(w * mu_a); sd_p <- sqrt(as.numeric(t(w) %*% S_a %*% w))
sharpe_p <- (mu_p - rf) / sd_p
comp <- data.frame(
Portafolio = c("Máximo Sharpe (tangente)", "Mínima varianza"),
AAPL = pct(c(W[i_tan, 1], W[i_mvp, 1])), AMGN = pct(c(W[i_tan, 2], W[i_mvp, 2])),
PEP = pct(c(W[i_tan, 3], W[i_mvp, 3])),
`Retorno esperado` = pct(c(mu_g[i_tan], mu_g[i_mvp])),
`Desv. estándar` = pct(c(sd_g[i_tan], sd_g[i_mvp])),
Sharpe = num(c(sh_g[i_tan], sh_g[i_mvp]), 3), check.names = FALSE)
tabla(comp, paste("Portafolios candidatos — rf =", pct(rf)))| Portafolio | AAPL | AMGN | PEP | Retorno esperado | Desv. estándar | Sharpe |
|---|---|---|---|---|---|---|
| Máximo Sharpe (tangente) | 69.50% | 30.50% | 0.00% | 22.52% | 21.20% | 0.830 |
| Mínima varianza | 16.50% | 19.00% | 64.50% | 10.70% | 15.03% | 0.384 |
asig <- data.frame(Acción = tickers, Peso = pct(w), `Monto invertido` = usd(capital * w),
`Precio de compra` = usd(P0[tickers], 2),
`N° de acciones` = num(floor(capital * w / P0[tickers]), 0), check.names = FALSE)
tabla(asig, "Portafolio seleccionado y distribución de los USD 35 millones")| Acción | Peso | Monto invertido | Precio de compra | N° de acciones | |
|---|---|---|---|---|---|
| AAPL | AAPL | 69.50% | $24,325,000 | $344.63 | 70,582 |
| AMGN | AMGN | 30.50% | $10,675,000 | $466.01 | 22,907 |
| PEP | PEP | 0.00% | $0 | $137.34 | 0 |
Portafolio elegido (máximo Sharpe): retorno esperado 22.52% anual, desviación estándar 21.20% y Sharpe 0.830.
set.seed(1); idx <- sample(length(mu_g), min(5000, length(mu_g)))
x_cml <- c(0, sd_g[i_tan] * 1.4)
plot_ly() |>
add_markers(x = sd_g[idx], y = mu_g[idx], name = "Combinaciones",
marker = list(color = sh_g[idx], colorscale = "Viridis", size = 4,
colorbar = list(title = "Sharpe")),
text = sprintf("AAPL %.1f%%<br>AMGN %.1f%%<br>PEP %.1f%%",
100 * W[idx, 1], 100 * W[idx, 2], 100 * W[idx, 3]),
hoverinfo = "text") |>
add_lines(x = x_cml, y = rf + sh_g[i_tan] * x_cml, name = "Línea del mercado de capitales",
line = list(dash = "dash", color = "gray")) |>
add_markers(x = sqrt(diag(S_a)), y = mu_a, text = tickers, name = "Acciones",
marker = list(size = 12, color = "black", symbol = "diamond")) |>
add_markers(x = sd_g[i_tan], y = mu_g[i_tan], name = "Máximo Sharpe",
marker = list(size = 15, color = "red", symbol = "star")) |>
add_markers(x = sd_g[i_mvp], y = mu_g[i_mvp], name = "Mínima varianza",
marker = list(size = 15, color = "orange", symbol = "star")) |>
layout(title = "Frontera eficiente (sin ventas en corto)",
xaxis = list(title = "Desviación estándar anual", tickformat = ".0%"),
yaxis = list(title = "Retorno esperado anual", tickformat = ".0%"))r_p <- as.numeric(coredata(ret_m[, tickers]) %*% w) # retorno mensual histórico del portafolio
mu_pm <- mean(r_p); sd_pm <- sd(r_p)
z <- qnorm(c(0.05, 0.01))
var_par <- -(exp(mu_pm + z * sd_pm) - 1)
var_hist <- -(exp(quantile(r_p, c(0.05, 0.01))) - 1)
tab_var <- data.frame(
Método = rep(c("Paramétrico (normal)", "Histórico"), each = 2),
Confianza = rep(c("95% (VaR 5%)", "99% (VaR 1%)"), 2),
`VaR mensual %` = pct(c(var_par, var_hist)),
`VaR mensual USD` = usd(capital * c(var_par, var_hist)), check.names = FALSE)
tabla(tab_var, "VaR mensual del portafolio")| Método | Confianza | VaR mensual % | VaR mensual USD |
|---|---|---|---|
| Paramétrico (normal) | 95% (VaR 5%) | 7.86% | $2,752,655 |
| Paramétrico (normal) | 99% (VaR 1%) | 11.63% | $4,070,159 |
| Histórico | 95% (VaR 5%) | 8.80% | $3,078,404 |
| Histórico | 99% (VaR 1%) | 10.69% | $3,740,071 |
plot_ly(x = r_p, type = "histogram", nbinsx = 30, name = "Retornos mensuales") |>
add_segments(x = log(1 - var_par[1]), xend = log(1 - var_par[1]), y = 0, yend = 20,
name = "VaR 95%", line = list(color = "orange", width = 3)) |>
add_segments(x = log(1 - var_par[2]), xend = log(1 - var_par[2]), y = 0, yend = 20,
name = "VaR 99%", line = list(color = "red", width = 3)) |>
layout(title = "Distribución histórica de retornos mensuales del portafolio",
xaxis = list(title = "Retorno log mensual", tickformat = ".0%"), yaxis = list(title = "Frecuencia"))Interpretación: en un mes normal, con 95% de confianza la pérdida no debería superar $2,752,655; en 1 de cada 100 meses podría superar $4,070,159. El VaR es el monto de pérdida que el gerente quiere proteger. Sin embargo, los futuros sobre el índice solo cubren la parte sistemática del riesgo (la que se mueve con el Nasdaq-100); la parte específica de cada empresa no se elimina. En la pregunta 7 se calcula cuánto del VaR es cubrible.
\[R_{i,t}-r_{f,t}=\alpha_i+\beta_i\,(R_{NDX,t}-r_{f,t})+\varepsilon_{i,t},\qquad \beta_p=\sum_i w_i\beta_i\]
La tasa libre de riesgo histórica mensual es la letra del Tesoro a 13 semanas (^IRX).
irx <- getSymbols("^IRX", src = "yahoo", from = f_hist, to = f_inicio + 1, auto.assign = FALSE)
irx_m <- na.omit(Cl(irx))[endpoints(na.omit(Cl(irx)), on = "months")]
rf_h <- xts(log(1 + as.numeric(irx_m) / 100 / 12), order.by = as.yearmon(index(irx_m)))
rf_h <- stats::lag(rf_h, 1); colnames(rf_h) <- "rf"
ret_ym <- xts(coredata(ret_m), order.by = as.yearmon(index(ret_m)))
dc <- na.omit(merge(ret_ym, rf_h))
ex <- sweep(coredata(dc[, c(tickers, "NDX")]), 1, as.numeric(dc$rf), "-")
capm <- t(sapply(tickers, function(tk) {
m <- lm(ex[, tk] ~ ex[, "NDX"]); s <- summary(m)
c(Alfa_mensual = coef(m)[1], Beta = coef(m)[2], EE = s$coefficients[2, 2],
p_valor = s$coefficients[2, 4], R2 = s$r.squared)
}))
colnames(capm) <- c("Alfa mensual", "Beta", "Error estándar beta", "p-valor beta", "R²")
beta_i <- capm[, "Beta"]; beta_p <- sum(w * beta_i)
tabla(cbind(round(capm, 4), Peso = pct(w), `Beta × peso` = round(w * beta_i, 4)),
"Regresiones CAPM contra el Nasdaq-100")| Alfa mensual | Beta | Error estándar beta | p-valor beta | R² | Peso | Beta × peso | |
|---|---|---|---|---|---|---|---|
| AAPL | 0.0066 | 1.0144 | 0.0895 | 0 | 0.5214 | 69.50% | 0.705 |
| AMGN | 0.0073 | 0.2433 | 0.1104 | 0.0295 | 0.0395 | 30.50% | 0.0742 |
| PEP | -1e-04 | 0.2128 | 0.0776 | 0.0071 | 0.0599 | 0.00% | 0 |
fig5 <- plot_ly()
for (tk in tickers) {
fig5 <- add_markers(fig5, x = ex[, "NDX"], y = ex[, tk], name = tk, opacity = 0.6)
xs <- range(ex[, "NDX"])
fig5 <- add_lines(fig5, x = xs, y = capm[tk, 1] + beta_i[tk] * xs,
name = paste0(tk, " β=", round(beta_i[tk], 2)))
}
layout(fig5, title = "Línea característica de cada acción",
xaxis = list(title = "Exceso de retorno NDX", tickformat = ".0%"),
yaxis = list(title = "Exceso de retorno acción", tickformat = ".0%"))Beta del portafolio: \(\beta_p=\) 0.7792. Por cada 1% que se mueva el Nasdaq-100, el portafolio tiende a moverse 0.78%.
\[N^*=\beta_p\,\frac{V_P}{F_0\times \text{multiplicador}}\]
nq <- tryCatch(getSymbols("NQ=F", src = "yahoo", from = f_inicio - 10, to = f_inicio + 1,
auto.assign = FALSE), error = function(e) NULL)
F0_mercado <- if (!is.null(nq)) as.numeric(last(na.omit(Cl(nq)))) else NA
T0 <- as.numeric(as.Date("2026-12-18") - f_inicio) / 365 # vence NQZ26 (3er viernes)
F0_teorico <- S0 * exp((rf_c - q_ndx) * T0) # [CAMBIO] tasa corta, no 10 años
F0 <- ifelse(is.na(F0_mercado), F0_teorico, F0_mercado)
carry <- if (is.na(F0_mercado)) rf_c - q_ndx else log(F0_mercado / S0) / T0 # [CAMBIO] carry implicito en la base observada
N_exacto <- beta_p * capital / (F0 * mult)
cand <- c(floor(N_exacto), ceiling(N_exacto))
beta_res <- beta_p - cand * F0 * mult / capital
N <- cand[which.min(abs(beta_res))]
tabla(data.frame(
Concepto = c("NDX spot", "Futuro mercado", "Futuro teorico", "F0 usado",
"Carry implicito (r - q)", # [CAMBIO]
"Nocional 1 contrato", "N* exacto", "N elegido"),
Valor = c(num(S0), num(F0_mercado), num(F0_teorico), num(F0), pct(carry, 3), # [CAMBIO]
usd(F0 * mult), num(N_exacto, 3), N)), "Contratos")| Concepto | Valor |
|---|---|
| NDX spot | 28,384.85 |
| Futuro mercado | 28,534.00 |
| Futuro teorico | 28,509.84 |
| F0 usado | 28,534.00 |
| Carry implicito (r - q) | 3.904% |
| Nocional 1 contrato | $570,680 |
| N* exacto | 47.789 |
| N elegido | 48 |
tabla(data.frame(Redondeo = c("Hacia abajo", "Hacia arriba"), Contratos = cand,
`Nocional cubierto` = usd(cand * F0 * mult),
`Beta residual` = num(beta_res, 4), check.names = FALSE),
"Comparación de redondeo")| Redondeo | Contratos | Nocional cubierto | Beta residual |
|---|---|---|---|
| Hacia abajo | 47 | $26,821,960 | 0.0129 |
| Hacia arriba | 48 | $27,392,640 | -0.0034 |
Se toman 48 contratos: es el entero que deja la beta residual más cercana a cero (-0.0034). Redondear hacia arriba sobrecubre (el portafolio quedaría levemente “corto” en mercado) y hacia abajo subcubre. Si se quisiera afinar, la fracción restante (-0.21 contratos NQ) equivale a unos -2 contratos Micro E-mini (MNQ), cuyo multiplicador es USD 2.
Decisión: el gerente posee las acciones y quiere protegerse de una caída → VENDER 48 contratos NQ. Cada tick (0.25 puntos) mueve la posición en $240.
mov <- c(-0.20, -0.10, -0.05, 0, 0.05, 0.10, 0.20)
dF <- F0 * mov # supone base constante
pnl_acc <- beta_p * mov * capital
pnl_corto <- -N * mult * dF
esc <- data.frame(`Movimiento NDX` = pct(mov, 0), `Puntos` = num(dF, 1),
Ticks = num(dF / fut$tick, 0), `G/P acciones` = usd(pnl_acc),
`G/P futuro corto` = usd(pnl_corto), `G/P futuro largo` = usd(-pnl_corto),
`Resultado neto cubierto` = usd(pnl_acc + pnl_corto), check.names = FALSE)
tabla(esc, "Escenarios: acciones vs. futuros en ticks")| Movimiento NDX | Puntos | Ticks | G/P acciones | G/P futuro corto | G/P futuro largo | Resultado neto cubierto |
|---|---|---|---|---|---|---|
| -20% | -5,706.8 | -22,827 | -$5,454,466 | $5,478,528 | -$5,478,528 | $24,062 |
| -10% | -2,853.4 | -11,414 | -$2,727,233 | $2,739,264 | -$2,739,264 | $12,031 |
| -5% | -1,426.7 | -5,707 | -$1,363,617 | $1,369,632 | -$1,369,632 | $6,015 |
| 0% | 0.0 | 0 | $0 | $0 | $0 | $0 |
| 5% | 1,426.7 | 5,707 | $1,363,617 | -$1,369,632 | $1,369,632 | -$6,015 |
| 10% | 2,853.4 | 11,414 | $2,727,233 | -$2,739,264 | $2,739,264 | -$12,031 |
| 20% | 5,706.8 | 22,827 | $5,454,466 | -$5,478,528 | $5,478,528 | -$24,062 |
plot_ly(x = pct(mov, 0), y = pnl_acc, type = "bar", name = "Acciones") |>
add_bars(y = pnl_corto, name = "Futuro corto") |>
add_lines(y = pnl_acc + pnl_corto, name = "Neto", line = list(color = "black", width = 3)) |>
layout(title = "La posición corta compensa el movimiento del portafolio",
xaxis = list(title = "Movimiento del Nasdaq-100", categoryorder = "array",
categoryarray = pct(mov, 0)),
yaxis = list(title = "USD"), barmode = "group")# Cuánto del riesgo es cubrible
var_m_ndx <- var(as.numeric(ret_m$NDX))
frac_sis <- min(1, beta_p^2 * var_m_ndx / sd_pm^2)
sd_res <- sqrt(max(sd_pm^2 - beta_p^2 * var_m_ndx, 0))
mu_cub <- mu_pm - beta_p * (mean(as.numeric(ret_m$NDX)) - carry / 12) # [CAMBIO] media mensual cubierta
var_cub <- -(exp(mu_cub + qnorm(c(0.05, 0.01)) * sd_res) - 1) # [CAMBIO] incluye la media, comparable con var_parEl 48.9% de la varianza mensual del portafolio es sistemática (explicada por el Nasdaq-100). Con la cobertura, el VaR 95% mensual pasaría de $2,752,655 a cerca de $2,111,681, y el VaR 99% de $4,070,159 a $3,078,229. Lo que queda es riesgo propio de AAPL, AMGN y PEP.
Supuestos de la simulación
nmes <- horizonte * 12
series <- c(tickers, "NDX")
mu_sim <- colMeans(ret_m[, series]) # [CAMBIO]
if (deriva == "neutral") # [CAMBIO] acciones a rf, NDX a rf - q
mu_sim <- c(rep(rf_c, 3), rf_c - q_ndx) / 12 - diag(cov(ret_m[, series])) / 2 # [CAMBIO]
set.seed(2026) # [CAMBIO] el set.seed(1) de la sec. 3 anulaba esta semilla
Z <- MASS::mvrnorm(nsim * nmes, mu_sim, cov(ret_m[, series])) # [CAMBIO] usa mu_sim
sim <- array(Z, dim = c(nsim, nmes, 4))
precio_sim <- function(k) {
cs <- t(apply(sim[, , k], 1, cumsum))
cbind(P0[series[k]], P0[series[k]] * exp(cs))
}
Psim <- lapply(1:4, precio_sim)
acciones <- capital * w / P0[tickers]
V <- Reduce(`+`, lapply(1:3, function(k) acciones[k] * Psim[[k]])) # valor portafolio
I <- Psim[[4]] # Nasdaq-100
# Calendario y contratos
fechas_ext <- c(f_inicio, seq(as.Date("2026-12-01"), by = "month", length.out = nmes + 2) - 1)
fechas <- fechas_ext[1:(nmes + 1)]
mes <- as.integer(format(fechas, "%m"))
es_venc <- mes %in% c(3, 6, 9, 12); es_venc[1] <- FALSE
venc_vec <- c(which(es_venc), max(which(es_venc)) + 3)
contrato_de <- sapply(1:(nmes + 1), function(p) min(venc_vec[venc_vec >= p]))
venc_sig <- sapply(1:(nmes + 1), function(p) min(venc_vec[venc_vec > p]))
cod <- function(pos) {
f <- fechas_ext[pos]
paste0("NQ", c(`3` = "H", `6` = "M", `9` = "U", `12` = "Z")[as.character(as.integer(format(f, "%m")))],
format(f, "%y"))
}
carry <- rf - q_ndx
tau <- function(v) matrix(rep((v - 1:(nmes + 1)) / 12, each = nsim), nsim)
F_liq <- I * exp(carry * tau(contrato_de)) # liquidación del contrato vigente
F_ape <- I * exp(carry * tau(venc_sig)) # precio del contrato que se abre
F_ape[, 1] <- F0
dFm <- cbind(0, F_liq[, -1] - F_ape[, -(nmes + 1)])
# Contratos vigentes en cada mes (con rebalanceo en cada roll)
N_ten <- matrix(N, nsim, nmes + 1)
for (p in 3:(nmes + 1)) {
N_ten[, p] <- if (es_venc[p - 1] && rebalanceo)
round(Reduce(`+`, lapply(1:3, function(k) acciones[k] * Psim[[k]][, p - 1] * beta_i[k])) / # [CAMBIO] beta con pesos vigentes
(F_ape[, p - 1] * mult)) else N_ten[, p - 1]
}
pnl_corta <- -N_ten * mult * dFm
G_fut <- matrix(0, nsim, nmes + 1) # [CAMBIO] cuenta de caja de los futuros
for (p in 2:(nmes + 1)) G_fut[, p] <- G_fut[, p - 1] * exp(rf_c / 12) + pnl_corta[, p] # [CAMBIO] financia/capitaliza a la tasa corta
V_cub <- V + G_fut
i_rep <- which.min(abs(I[, nmes + 1] - median(I[, nmes + 1])))
liquidar_margen <- function(pnl, Nt) {
n <- nrow(pnl); m <- ncol(pnl); saldo <- Nt[, 1] * IM
o <- lapply(1:7, function(i) matrix(0, n, m)) # [CAMBIO] 7 componentes
names(o) <- c("ini", "aporte", "pre", "llamado", "repo", "retiro", "fin") # [CAMBIO] agrega retiro
for (j in 1:m) {
if (j > 1) {
dep <- ifelse(Nt[, j] != Nt[, j - 1], pmax(Nt[, j] * IM - saldo, 0), 0)
saldo <- saldo + dep; o$aporte[, j] <- dep
}
o$ini[, j] <- saldo; saldo <- saldo + pnl[, j]; o$pre[, j] <- saldo
ll <- saldo < Nt[, j] * MM
rp <- ifelse(ll, Nt[, j] * IM - saldo, 0); saldo <- saldo + rp
o$llamado[, j] <- ll; o$repo[, j] <- rp
rt <- if (retiro_exceso) pmax(saldo - Nt[, j] * IM, 0) else 0 # [CAMBIO] retira excedente sobre IM
saldo <- saldo - rt; o$retiro[, j] <- rt; o$fin[, j] <- saldo # [CAMBIO]
}
o
}
p <- 2:(nmes + 1)
mg <- liquidar_margen(pnl_corta[i_rep, p, drop = FALSE], N_ten[i_rep, p, drop = FALSE])
mgA <- liquidar_margen(pnl_corta[, p], N_ten[, p])tab8 <- data.frame(
Mes = 1:nmes, Fecha = format(fechas[p], "%b-%Y"), Contrato = cod(contrato_de[p]),
N = N_ten[i_rep, p], `F inicial` = F_ape[i_rep, p - 1], `F final` = F_liq[i_rep, p],
`ΔF` = dFm[i_rep, p], Ticks = round(dFm[i_rep, p] / fut$tick),
`G/P larga` = -pnl_corta[i_rep, p], `G/P corta` = pnl_corta[i_rep, p],
`Aporte por roll` = mg$aporte[1, ], `Saldo antes del llamado` = mg$pre[1, ],
`Llamado` = ifelse(mg$llamado[1, ] == 1, "SÍ", "No"), `Reposición` = mg$repo[1, ],
`Saldo final` = mg$fin[1, ], check.names = FALSE)
datatable(tab8, rownames = FALSE, extensions = "Buttons",
options = list(pageLength = 12, scrollX = TRUE, dom = "Bfrtip",
buttons = c("copy", "csv", "excel")),
caption = "Liquidación mensual de la posición (trayectoria representativa)") |>
formatRound(c("F inicial", "F final", "ΔF"), 2) |>
formatCurrency(c("G/P larga", "G/P corta", "Aporte por roll", "Saldo antes del llamado",
"Reposición", "Saldo final"), digits = 0) |>
formatStyle("Llamado", target = "row",
backgroundColor = styleEqual(c("SÍ", "No"), c("#fdecea", "white")))trim <- contrato_de[p]
res8 <- data.frame(
Contrato = cod(unique(trim)),
`G/P posición corta` = usd(tapply(pnl_corta[i_rep, p], trim, sum)),
`Llamados al margen` = tapply(mg$llamado[1, ], trim, sum),
`Reposiciones` = usd(tapply(mg$repo[1, ], trim, sum)),
`Saldo al cierre` = usd(tapply(mg$fin[1, ], trim, function(x) tail(x, 1))), check.names = FALSE)
tabla(res8, "Flujos trimestrales de la posición en futuros (trayectoria representativa)")| Contrato | G/P posición corta | Llamados al margen | Reposiciones | Saldo al cierre | |
|---|---|---|---|---|---|
| 3 | NQZ26 | $348,779 | 0 | $0 | $1,584,000 |
| 6 | NQH27 | -$334,887 | 1 | $1,561,662 | $1,782,000 |
| 9 | NQM27 | -$1,515,272 | 2 | $3,568,793 | $1,815,000 |
| 12 | NQU27 | -$44,363 | 1 | $1,513,776 | $2,013,000 |
| 15 | NQZ27 | $3,151,195 | 0 | $0 | $1,914,000 |
| 18 | NQH28 | -$4,915,586 | 3 | $4,915,586 | $1,947,000 |
| 21 | NQM28 | -$5,548,170 | 2 | $8,814,373 | $2,376,000 |
| 24 | NQU28 | $2,399,481 | 1 | $2,106,026 | $2,046,000 |
| 27 | NQZ28 | -$3,924,587 | 2 | $4,682,797 | $2,343,000 |
| 30 | NQH29 | -$2,035,222 | 2 | $1,895,844 | $2,368,622 |
| 33 | NQM29 | -$14,624,740 | 2 | $14,839,823 | $2,475,000 |
| 36 | NQU29 | $2,839,980 | 2 | $4,849,050 | $2,640,000 |
| 39 | NQZ29 | -$8,793,270 | 2 | $10,853,216 | $2,640,000 |
| 42 | NQH30 | -$4,468,085 | 2 | $8,260,808 | $2,871,000 |
| 45 | NQM30 | -$3,780,586 | 2 | $4,072,237 | $2,607,000 |
| 48 | NQU30 | $9,352,326 | 0 | $0 | $2,739,000 |
| 51 | NQZ30 | -$2,086,843 | 1 | $2,086,843 | $3,531,000 |
cat("Prob. de al menos un llamado en 4 años:", pct(mean(rowSums(mgA$llamado) > 0), 1),
"| Llamados promedio:", num(mean(rowSums(mgA$llamado)), 1),
"| Reposicion esperada:", usd(mean(rowSums(mgA$repo))),
"| Retiro esperado:", usd(mean(rowSums(mgA$retiro))), # [CAMBIO]
"| Neto aportado:", usd(mean(rowSums(mgA$repo) + rowSums(mgA$aporte) - rowSums(mgA$retiro))), "\n") # [CAMBIO]## Prob. de al menos un llamado en 4 años: 100.0% | Llamados promedio: 26.5 | Reposicion esperada: $68,959,001 | Retiro esperado: $39,019,642 | Neto aportado: $31,355,872plot_ly(x = fechas[p], y = mg$fin[1, ], type = "scatter", mode = "lines", name = "Saldo de margen") |>
add_lines(y = N_ten[i_rep, p] * MM, name = "Margen de mantenimiento", line = list(dash = "dash")) |>
add_lines(y = N_ten[i_rep, p] * IM, name = "Margen inicial", line = list(dash = "dot")) |>
add_markers(x = fechas[p][mg$llamado[1, ] == 1], y = mg$pre[1, mg$llamado[1, ] == 1],
name = "Llamado al margen", marker = list(color = "red", size = 10)) |>
layout(title = "Cuenta de margen", yaxis = list(title = "USD"), xaxis = list(title = ""))En el conjunto de 10,000 simulaciones, la probabilidad de recibir al menos un llamado al margen en los 4 años es 100.0%, con un promedio de 26.5 llamados y reposiciones totales esperadas de $68,959,001. El gerente debe reservar liquidez para estos flujos: la cobertura no cuesta prima, pero sí exige caja cuando el mercado sube.
Al vencer cada contrato se cierra la posición (liquida al precio del índice) y se abre una posición corta en el siguiente vencimiento trimestral, recalculando el número de contratos con el valor actualizado del portafolio.
pos_r <- c(which(es_venc), nmes + 1)
ini_r <- c(1, head(pos_r, -1))
tab9 <- data.frame(
Fecha = format(fechas[pos_r], "%b-%Y"),
`Contrato cerrado` = cod(contrato_de[pos_r]),
`Precio de apertura` = num(F_ape[i_rep, ini_r]), `Precio de cierre` = num(F_liq[i_rep, pos_r]),
Contratos = N_ten[i_rep, pos_r],
`G/P realizada` = usd(sapply(seq_along(pos_r), function(k) sum(pnl_corta[i_rep, (ini_r[k] + 1):pos_r[k]]))),
`Contrato abierto` = ifelse(pos_r <= nmes, cod(venc_sig[pos_r]), "— (fin)"),
`Precio nuevo contrato` = ifelse(pos_r <= nmes, num(F_ape[i_rep, pos_r]), "—"),
`Nuevos contratos` = ifelse(pos_r <= nmes, N_ten[i_rep, pmin(pos_r + 1, nmes + 1)], NA),
`G/P acumulada` = usd(G_fut[i_rep, pos_r]),
`Valor acciones` = usd(V[i_rep, pos_r]), `Valor cubierto` = usd(V_cub[i_rep, pos_r]),
check.names = FALSE)
datatable(tab9, rownames = FALSE, options = list(pageLength = 17, scrollX = TRUE, dom = "t"),
caption = "Cierre y apertura de posiciones en cada roll-over")r_sin <- (V[, nmes + 1] / capital)^(1 / horizonte) - 1
r_con <- (pmax(V_cub[, nmes + 1], 0) / capital)^(1 / horizonte) - 1 # [CAMBIO] V_cub <= 0 es ruina (-100%), evita NaN
cat("Trayectorias con valor cubierto <= 0:", sum(V_cub[, nmes + 1] <= 0), # [CAMBIO]
"| alguna vez <= 0 en 4 años:", sum(apply(V_cub, 1, min) <= 0), "\n") # [CAMBIO]## Trayectorias con valor cubierto <= 0: 2 | alguna vez <= 0 en 4 años: 2efecto <- data.frame(
Indicador = c("Rendimiento anual promedio", "Desviación del rendimiento anual",
"Percentil 5% del rendimiento anual", "Probabilidad de pérdida a 4 años",
"Rendimiento anual trayectoria representativa"),
`Sin cobertura` = c(pct(mean(r_sin)), pct(sd(r_sin)), pct(quantile(r_sin, .05)),
pct(mean(V[, nmes + 1] < capital)), pct(r_sin[i_rep])),
`Con cobertura y roll-over` = c(pct(mean(r_con)), pct(sd(r_con)), pct(quantile(r_con, .05)),
pct(mean(V_cub[, nmes + 1] < capital)), pct(r_con[i_rep])),
check.names = FALSE)
tabla(efecto, "Efecto del roll-over sobre la rentabilidad (todas las simulaciones)")| Indicador | Sin cobertura | Con cobertura y roll-over |
|---|---|---|
| Rendimiento anual promedio | 27.72% | 16.12% |
| Desviación del rendimiento anual | 14.31% | 11.87% |
| Percentil 5% del rendimiento anual | 5.99% | -1.92% |
| Probabilidad de pérdida a 4 años | 1.57% | 6.97% |
| Rendimiento anual trayectoria representativa | 40.82% | 30.43% |
plot_ly(alpha = 0.55) |>
add_histogram(x = r_sin, name = "Sin cobertura") |>
add_histogram(x = r_con, name = "Con cobertura") |>
layout(barmode = "overlay", title = "Distribución del rendimiento anual a 4 años",
xaxis = list(title = "Rendimiento anual", tickformat = ".0%"))En cada roll la posición se cierra al precio del índice y se reabre a \(F=S\,e^{(r_f-q)\,0.25}\). Como \(r_f>q\), el futuro se vende con prima (contango) y esa prima converge a cero: el vendedor la gana trimestre a trimestre. Por eso el portafolio cubierto rinde aproximadamente \(r_f\) más el alfa de las acciones, y no cero. El costo de la cobertura es renunciar a la prima de riesgo del mercado.
tabla(data.frame(
Referencia = c("^TNX — Tesoro 10 años (indicada en el taller)", "^FVX — Tesoro 5 años",
"^IRX — Letra 13 semanas"),
`Tasa al 30-oct-2026` = pct(c(rf_tnx, rf_fvx, rf_irx), 3), check.names = FALSE),
"Tasas libres de riesgo observadas")| Referencia | Tasa al 30-oct-2026 |
|---|---|
| ^TNX — Tesoro 10 años (indicada en el taller) | 4.929% |
| ^FVX — Tesoro 5 años | 4.721% |
| ^IRX — Letra 13 semanas | 3.973% |
El taller describe ^TNX como el índice del Tesoro de 1 a 3 años, pero en Yahoo Finance ^TNX corresponde al rendimiento del bono del Tesoro a 10 años. Se usa ^TNX como indica el docente (4.929%); como el horizonte es de 4 años, ^FVX (5 años) sería la referencia de plazo más cercana y se reporta para comparar.
En teoría, un portafolio con beta cubierta a cero no tiene riesgo sistemático y debe rendir la tasa libre de riesgo: \(E[V_t^{cub}]\approx V_0\,e^{r_f t}\).
q_pos <- 1 + 3 * (1:(nmes / 3)); t_q <- (q_pos - 1) / 12
tab10 <- data.frame(
Trimestre = 1:length(q_pos), Fecha = format(fechas[q_pos], "%b-%Y"),
`E[V] sin cobertura` = usd(colMeans(V[, q_pos])),
`E[V] cubierto (simulado)` = usd(colMeans(V_cub[, q_pos])),
`V0·e^(rf·t) teórico` = usd(capital * exp(rf * t_q)), VP_E_GP_fut = round(colMeans(G_fut[, q_pos]) * exp(-rf_c * t_q)), # [CAMBIO] descuento a la tasa corta
`E[G/P futuros]` = usd(colMeans(G_fut[, q_pos])),
`VP de E[G/P futuros]` = usd(colMeans(G_fut[, q_pos]) * exp(-rf * t_q)),
`Desv. sin cobertura` = usd(apply(V[, q_pos], 2, sd)),
`Desv. cubierto` = usd(apply(V_cub[, q_pos], 2, sd)), check.names = FALSE)
datatable(tab10, rownames = FALSE, options = list(pageLength = 16, scrollX = TRUE, dom = "t"),
caption = "Valor esperado trimestral: portafolio sin cobertura vs. cubierto")banda <- function(M, nombre, col) {
list(x = fechas, m = colMeans(M), lo = apply(M, 2, quantile, .05),
hi = apply(M, 2, quantile, .95), n = nombre, c = col)
}
b1 <- banda(V, "Sin cobertura", "rgba(31,119,180,0.2)")
b2 <- banda(V_cub, "Cubierto", "rgba(214,39,40,0.2)")
fig10 <- plot_ly()
for (b in list(b1, b2)) {
fig10 <- fig10 |>
add_ribbons(x = b$x, ymin = b$lo, ymax = b$hi, name = paste(b$n, "(5%–95%)"),
fillcolor = b$c, line = list(width = 0)) |>
add_lines(x = b$x, y = b$m, name = paste(b$n, "— media"))
}
fig10 |> add_lines(x = fechas, y = capital * exp(rf * (0:nmes) / 12), name = "V0·e^(rf·t)",
line = list(dash = "dash", color = "black")) |>
layout(title = "Valor esperado y bandas de confianza", yaxis = list(title = "USD"))A 4 años el valor esperado sin cobertura es $100,441,823 y el cubierto $67,682,198, frente a $42,627,861 que daría la tasa libre de riesgo. La desviación estándar del valor final baja de $48,066,175 a $28,629,050. Conclusión: la cobertura reduce el riesgo y también la rentabilidad esperada, porque se cede la prima de riesgo del mercado a cambio de estabilidad.
r1_sin <- V[, 2] / capital - 1; r1_con <- V_cub[, 2] / capital - 1
rm_sin <- (mean(V[, nmes + 1]) / capital)^(1 / nmes) - 1
rm_con <- (mean(V_cub[, nmes + 1]) / capital)^(1 / nmes) - 1
tab11 <- data.frame(
Enfoque = c("Sin cobertura", "Cubierto", "Cuantil 5% sin cob.", "Cuantil 1% sin cob.", # [CAMBIO] son cuantiles de
"Cuantil 5% cubierto", "Cuantil 1% cubierto"),
`Rendimiento mensual` = pct(c(mean(r1_sin), mean(r1_con), quantile(r1_sin, c(.05, .01)),
quantile(r1_con, c(.05, .01)))),
`Valor a 1 mes` = usd(capital * (1 + c(mean(r1_sin), mean(r1_con), quantile(r1_sin, c(.05, .01)),
quantile(r1_con, c(.05, .01))))),
`Rend. mensual equivalente 4 años` = c(pct(rm_sin), pct(rm_con), rep("—", 4)),
`Valor a 4 años` = usd(c(mean(V[, nmes + 1]), mean(V_cub[, nmes + 1]),
quantile(V[, nmes + 1], c(.05, .01)), quantile(V_cub[, nmes + 1], c(.05, .01)))),
check.names = FALSE)
tabla(tab11, "Rendimiento y valor esperado del portafolio")| Enfoque | Rendimiento mensual | Valor a 1 mes | Rend. mensual equivalente 4 años | Valor a 4 años |
|---|---|---|---|---|
| Sin cobertura | 2.22% | $35,775,429 | 2.22% | $100,441,823 |
| Cubierto | 1.10% | $35,385,365 | 1.38% | $67,682,198 |
| Cuantil 5% sin cob. | -7.72% | $32,298,595 | — | $44,176,536 |
| Cuantil 1% sin cob. | -11.28% | $31,050,521 | — | $32,607,969 |
| Cuantil 5% cubierto | -6.07% | $32,874,913 | — | $32,393,709 |
| Cuantil 1% cubierto | -8.84% | $31,906,226 | — | $23,257,420 |
divs <- sapply(tickers, function(tk) {
d <- tryCatch(getDividends(tk, from = f_inicio - 365, to = f_inicio, auto.assign = FALSE),
error = function(e) NULL)
if (is.null(d) || NROW(d) == 0) 0 else sum(d)
})
yld <- divs / P0c
anios <- as.numeric(f_inicio - as.Date(index(precios)[1])) / 365.25
r_tot <- (as.numeric(last(precios[, tickers])) / as.numeric(precios[1, tickers]))^(1 / anios) - 1
r_pre <- (as.numeric(last(cierres)) / as.numeric(cierres[1, ]))^(1 / anios) - 1
tabla(data.frame(Acción = tickers, `Dividendo 12 m por acción` = usd(divs, 2),
`Rendimiento por dividendo` = pct(yld), `Dividendos anuales en el portafolio` = usd(capital * w * yld),
`Rend. anual solo precio (10 a.)` = pct(r_pre), `Rend. anual total (10 a.)` = pct(r_tot),
`Aporte del dividendo` = pct(r_tot - r_pre), check.names = FALSE),
"Dividendos y su efecto en el rendimiento total")| Acción | Dividendo 12 m por acción | Rendimiento por dividendo | Dividendos anuales en el portafolio | Rend. anual solo precio (10 a.) | Rend. anual total (10 a.) | Aporte del dividendo | |
|---|---|---|---|---|---|---|---|
| AAPL | AAPL | $1.06 | 0.31% | $74,818 | 28.37% | 29.52% | 1.15% |
| AMGN | AMGN | $9.94 | 2.13% | $227,698 | 12.69% | 16.10% | 3.41% |
| PEP | PEP | $5.81 | 4.23% | $0 | 2.51% | 5.74% | 3.23% |
Las tres empresas pagan dividendos, por eso los cálculos usan precios ajustados: el retorno total = variación del precio + dividendo reinvertido. El portafolio recibe cerca de **\(302,516** al año (**0.86%** del capital), equivalente a **0.072%** mensual adicional al rendimiento por precio. En la cobertura, el dueño de las acciones **conserva los dividendos**, mientras que el futuro sobre el índice ya descuenta el dividendo esperado del NDX en su precio (\)F=S,e^{(r-q)T}$): a mayor \(q\), menor precio del futuro y menor la ganancia por convergencia de la posición corta.
bets <- c(0.6, beta_p, 1.5)
Nb <- round(bets * capital / (F0 * mult))
tab12 <- data.frame(
Beta = c("0.60 (hipotética)", paste0(num(beta_p, 2), " (portafolio)"), "1.50 (hipotética)"),
`N* exacto` = num(bets * capital / (F0 * mult), 2), `Contratos` = Nb,
`Exposición sistemática` = usd(bets * capital),
`Cambio por 1% del NDX` = usd(bets * capital * 0.01),
`Cambio por punto del NDX` = usd(bets * capital / S0),
`Compensa la cobertura por punto` = usd(Nb * mult),
`Beta residual` = num(bets - Nb * F0 * mult / capital, 4), check.names = FALSE)
tabla(tab12, "Número de contratos según la beta")| Beta | N* exacto | Contratos | Exposición sistemática | Cambio por 1% del NDX | Cambio por punto del NDX | Compensa la cobertura por punto | Beta residual |
|---|---|---|---|---|---|---|---|
| 0.60 (hipotética) | 36.80 | 37 | $21,000,000 | $210,000 | $740 | $740 | -0.0033 |
| 0.78 (portafolio) | 47.79 | 48 | $27,272,332 | $272,723 | $961 | $960 | -0.0034 |
| 1.50 (hipotética) | 92.00 | 92 | $52,500,000 | $525,000 | $1,850 | $1,840 | -0.0001 |
m <- seq(-0.25, 0.25, 0.01)
fig12 <- plot_ly()
for (k in 1:3) {
fig12 <- fig12 |>
add_lines(x = m, y = bets[k] * m * capital, name = paste0("β=", num(bets[k], 2), " sin cobertura"),
line = list(dash = "dot")) |>
add_lines(x = m, y = bets[k] * m * capital - Nb[k] * mult * F0 * m,
name = paste0("β=", num(bets[k], 2), " cubierto"))
}
layout(fig12, title = "G/P del portafolio frente a movimientos del índice",
xaxis = list(title = "Movimiento del Nasdaq-100", tickformat = ".0%"), yaxis = list(title = "USD"))Limitaciones: retornos normales e independientes (subestiman colas gruesas), parámetros históricos constantes, base del futuro modelada con costo de acarreo constante, liquidación mensual en lugar de diaria y vencimientos al cierre de mes.