Cobertura con Futuros sobre Índice Bursátil

Portafolio: PG · SYK · WM | Capital: USD 20,000,000

---

Objetivo: Construir un portafolio accionario óptimo con PG (Procter & Gamble), SYK (Stryker) y WM (Waste Management), pertenecientes al S&P 500, y diseñar una estrategia de cobertura mediante futuros E-mini S&P 500 con horizonte de 4 años.

1 Introducción

El informe presenta una estrategia de inversión y cobertura financiera para un capital de USD 20.000.000, presentando un horizonte de inversión de 4 años desde 30 de abril de 2026. Conformado por tres acciones que pertenecen al índice S&P 500, seleccionadas con base a su solidez fundamental:

• PG — Procter & Gamble (Consumo básico defensivo)
• SYK — Stryker Corporation (Sector salud / dispositivos médicos)
• WM — Waste Management (Servicios ambientales / utilidades)

La estrategia de cobertura se lleva a cabo por medio de contratos de futuros E-mini S&P 500 (ES) los cuales son negociados en el CME Group (Chicago Mercantile Exchange).

---

2 Parámetros Globales

CAPITAL       <- 20e6
FECHA_INI     <- as.Date("2026-04-30")
FECHA_HIST    <- as.Date("2016-04-30")   # 10 años históricos
TICKERS       <- c("PG", "SYK", "WM")
INDICE        <- "^GSPC"
N_ANUAL       <- 252                     # días hábiles
RF_ANUAL      <- 0.0436                  # ^TNX al 30/04/2026
HORIZONTE     <- 4                       # años
N_MESES       <- HORIZONTE * 12
N_MES         <- 21                      # días hábiles por mes
N_SIM         <- 5000                    # simulaciones GBM

# Contrato E-mini S&P 500 (CME) — actualizar con datos reales al 30/04/2026
MULTIPLICADOR  <- 50
MARGEN_INI     <- 14000
MARGEN_MANT    <- 12700
precio_futuro_ini <- 7168               # ← ACTUALIZAR con precio CME real

params_df <- data.frame(
  Parámetro = c("Capital inicial","Fecha inicial","Horizonte","Tickers",
                "Índice","Días hábiles/año","Tasa libre de riesgo (^TNX)",
                "Multiplicador E-mini","Margen inicial/contrato","Margen mantenimiento/contrato",
                "Precio futuro inicial (F0)"),
  Valor = c(
    scales::dollar(CAPITAL), as.character(FECHA_INI),
    paste(HORIZONTE,"años"), paste(TICKERS, collapse=" · "),
    "S&P 500 (^GSPC)", N_ANUAL,
    paste0(RF_ANUAL*100,"% anual"),
    paste0("USD ",MULTIPLICADOR," / punto"),
    scales::dollar(MARGEN_INI), scales::dollar(MARGEN_MANT),
    paste(precio_futuro_ini,"puntos")
  )
)

kable(params_df, align = c("l","r"), caption = "Tabla 1. Parámetros del ejercicio") %>%
  kable_styling(bootstrap_options = c("striped","hover","condensed"), full_width = FALSE)

Tabla 1. Parámetros del ejercicio

Parámetro	Valor
Capital inicial	$20,000,000
Fecha inicial	2026-04-30
Horizonte	4 años
Tickers	PG · SYK · WM
Índice	S&P 500 (^GSPC)
Días hábiles/año	252
Tasa libre de riesgo (^TNX)	4.36% anual
Multiplicador E-mini	USD 50 / punto
Margen inicial/contrato	$14,000
Margen mantenimiento/contrato	$12,700
Precio futuro inicial (F0)	7168 puntos

---

3 Datos Históricos y Retornos

3.1 Descarga de precios

descargar <- function(tickers, desde, hasta) {
  lst <- lapply(tickers, function(tk) {
    tryCatch({
      raw <- getSymbols(tk, src="yahoo", from=desde, to=hasta,
                        auto.assign=FALSE, warnings=FALSE)
      Ad(raw)
    }, error = function(e) { message("Error: ",tk); NULL })
  })
  names(lst) <- tickers
  lst <- lst[!sapply(lst, is.null)]
  do.call(merge, lst)
}

precios_acc <- descargar(TICKERS, FECHA_HIST, FECHA_INI)
precios_idx <- descargar(INDICE,  FECHA_HIST, FECHA_INI)
colnames(precios_acc) <- TICKERS
colnames(precios_idx) <- "GSPC"

datos <- na.omit(merge(precios_acc, precios_idx))

cat(sprintf("Observaciones: %d | Desde: %s | Hasta: %s",
            nrow(datos),
            as.character(index(datos)[1]),
            as.character(tail(index(datos),1))))

## Observaciones: 2513 | Desde: 2016-05-02 | Hasta: 2026-04-29

3.2 Evolución de precios (base 100)

df_norm <- as.data.frame(datos[, TICKERS])
df_norm <- sweep(df_norm, 2, as.numeric(df_norm[1,]), "/") * 100
df_norm$fecha <- index(datos)

df_long <- pivot_longer(df_norm, -fecha, names_to="Accion", values_to="Precio")

ggplot(df_long, aes(x=fecha, y=Precio, color=Accion)) +
  geom_line(linewidth=0.75) +
  scale_color_manual(values=c(PG="#003087", SYK="#E31837", WM="#00703C")) +
  scale_x_date(date_breaks="1 year", date_labels="%Y") +
  geom_hline(yintercept=100, linetype="dashed", color="gray60") +
  labs(title="Evolución de precios históricos (base 100 = abril 2016)",
       subtitle="Fuente: Yahoo Finance | Precios ajustados por dividendos y splits",
       x=NULL, y="Precio normalizado", color="Acción",
       caption="Datos: 10 años hasta 30/04/2026") +
  theme_minimal(base_size=12) +
  theme(legend.position="bottom",
        axis.text.x=element_text(angle=45, hjust=1))

En la gráfica observamos la evolución desde el año 2016 de las tres acciones: WM (en verde), SYK (en rojo) y PG (en azul)

• WM muestra un crecimiento sostenido alcanzando un valor cercano a 480 y una pequeña disminución en los momentos de crisis.

• SYK tiene un crecimiento significativo, aunque con mayor volatilidad, sobre todo en 2020 y 2022 con un rendimiento promedio con riesgo moderado.

• PG muestra el crecimiento más bajo entre 200 y 270. Es un activo más defensivo y estable, aunque menos rentable.

3.3 Cálculo de retornos y estadísticas anualizadas

ret_d    <- na.omit(diff(log(datos)))
ret_acc  <- ret_d[, TICKERS]
ret_idx  <- ret_d[, "GSPC"]

# ── ANUALIZACIÓN ──────────────────────────────────────────────
mu_anual  <- colMeans(ret_acc)  * N_ANUAL          # μ anual
sd_anual  <- apply(ret_acc, 2, sd) * sqrt(N_ANUAL) # σ anual
cov_anual <- cov(ret_acc) * N_ANUAL                # Σ anual
cor_mat   <- cor(ret_acc)

# Tabla estadísticas
est_df <- data.frame(
  Acción              = TICKERS,
  `μ diario (%)`      = round(colMeans(ret_acc)*100, 4),
  `μ anual (%)`       = round(mu_anual*100, 2),
  `σ diaria (%)`      = round(apply(ret_acc,2,sd)*100, 4),
  `σ anual (%)`       = round(sd_anual*100, 2),
  check.names         = FALSE
)

kable(est_df, align="c", digits=4,
      caption="Tabla 2. Retornos y volatilidades (252 días hábiles/año)") %>%
  kable_styling(bootstrap_options=c("striped","hover","condensed"), full_width=FALSE) %>%
  column_spec(3, bold=TRUE, color="darkblue") %>%
  column_spec(5, bold=TRUE, color="darkred")

Tabla 2. Retornos y volatilidades (252 días hábiles/año)

	Acción	μ diario (%)	μ anual (%)	σ diaria (%)	σ anual (%)
PG	PG	0.0345	8.68	1.1909	18.90
SYK	SYK	0.0463	11.68	1.6470	26.15
WM	WM	0.0608	15.33	1.2260	19.46

Riesgo (σ anual):

• SYK: indica mayor incertidumbre en los retornos con un 26.15% mostrando alta volatilidad.

• WM: presenta un riesgo moderado con un19.46% relacionado con su crecimiento estable.

• PG: tiene una baja volatilidad relativa con un 18.90% asociado a activos defensivos.

Observamos que WM es el activo más eficaz de la muestra, debido a la relación entre el riesgo y el rendimiento. SYK presenta una prima de riesgo negativa dado su elevada volatilidad por lo que no se traduce en un aumento conveniente del rendimiento. PG muestra un activo refugio, que se distingue por la volatilidad baja apropiada para proteger y cubrir el capital, sacrificando una mayor tasa de crecimiento.

3.4 Matrices de covarianzas y correlaciones

# Covarianzas anualizadas
kable(round(cov_anual*1e4, 4), caption="Tabla 3. Matriz de covarianzas anualizadas (×10⁴)") %>%
  kable_styling(bootstrap_options=c("striped","hover","condensed"), full_width=FALSE)

Tabla 3. Matriz de covarianzas anualizadas (×10⁴)

	PG	SYK	WM
PG	357.3682	192.6067	183.2490
SYK	192.6067	683.5973	239.2145
WM	183.2490	239.2145	378.7502

# Correlaciones
kable(round(cor_mat, 4), caption="Tabla 4. Matriz de correlaciones") %>%
  kable_styling(bootstrap_options=c("striped","hover","condensed"), full_width=FALSE) %>%
  column_spec(2:4, color=ifelse(round(cor_mat,4) > 0.5, "darkgreen", "black"))

Tabla 4. Matriz de correlaciones

	PG	SYK	WM
PG	1.0000	0.3897	0.4981
SYK	0.3897	1.0000	0.4701
WM	0.4981	0.4701	1.0000

corrplot(cor_mat, method="color", type="upper", tl.col="black",
         tl.srt=45, addCoef.col="black", number.cex=1.1,
         col=colorRampPalette(c("#E31837","white","#003087"))(200),
         mar=c(0,0,1.5,0), title="Figura 2. Correlaciones entre retornos diarios")

---

4 Optimización Media-Varianza

4.1 Construcción de la frontera eficiente

n <- length(TICKERS)

# ── Barrido de retornos objetivo (200 portafolios) ───────────
mu_seq   <- seq(min(mu_anual), max(mu_anual), length.out=200)
frontera <- data.frame(mu=numeric(0), sigma=numeric(0))

for (mu_t in mu_seq) {
  tryCatch({
    Dmat <- 2 * cov_anual
    dvec <- rep(0, n)
    Amat <- cbind(rep(1,n), mu_anual, diag(n))
    bvec <- c(1, mu_t, rep(0,n))
    sol  <- solve.QP(Dmat, dvec, Amat, bvec, meq=2)
    w    <- sol$solution
    if (all(w >= -1e-8) && abs(sum(w)-1) < 1e-6) {
      sp <- sqrt(as.numeric(t(w) %*% cov_anual %*% w))
      frontera <- rbind(frontera, data.frame(mu=mu_t, sigma=sp))
    }
  }, error=function(e) NULL)
}

# ── Portafolio de máximo Sharpe (tangencia) ───────────────────
sharpe_v <- (frontera$mu - RF_ANUAL) / frontera$sigma
idx_opt  <- which.max(sharpe_v)
mu_opt   <- frontera$mu[idx_opt]

Dmat <- 2*cov_anual; dvec <- rep(0,n)
Amat <- cbind(rep(1,n), mu_anual, diag(n))
bvec <- c(1, mu_opt, rep(0,n))
sol_opt    <- solve.QP(Dmat, dvec, Amat, bvec, meq=2)
w_opt      <- sol_opt$solution / sum(sol_opt$solution)

mu_port    <- as.numeric(t(w_opt) %*% mu_anual)
sigma_port <- as.numeric(sqrt(t(w_opt) %*% cov_anual %*% w_opt))
sharpe_opt <- (mu_port - RF_ANUAL) / sigma_port
monto_opt  <- w_opt * CAPITAL

# ── Portafolio mínima varianza ────────────────────────────────
idx_mv  <- which.min(frontera$sigma)
mu_mv   <- frontera$mu[idx_mv]
sigma_mv <- frontera$sigma[idx_mv]

cat(sprintf("✔ Retorno portafolio óptimo : %.2f%% anual\n", mu_port*100))

## ✔ Retorno portafolio óptimo : 15.23% anual

cat(sprintf("✔ Volatilidad portafolio    : %.2f%% anual\n", sigma_port*100))

## ✔ Volatilidad portafolio    : 19.28% anual

cat(sprintf("✔ Sharpe Ratio              : %.4f\n", sharpe_opt))

## ✔ Sharpe Ratio              : 0.5639

4.2 Gráfico de la frontera eficiente

# Puntos de acciones individuales
pts_acc <- data.frame(
  ticker = TICKERS,
  sigma  = sqrt(diag(cov_anual)) * 100,
  mu     = mu_anual * 100
)

# Capital Market Line
cml_x <- seq(0, max(frontera$sigma)*1.15, length.out=100)
cml_y <- RF_ANUAL + sharpe_opt * cml_x
cml_df <- data.frame(sigma=cml_x*100, mu=cml_y*100)

ggplot() +
  # CML
  geom_line(data=cml_df, aes(x=sigma, y=mu),
            color="darkorange", linetype="dashed", linewidth=1.1) +
  # Frontera eficiente
  geom_path(data=data.frame(sigma=frontera$sigma*100, mu=frontera$mu*100),
            aes(x=sigma, y=mu),
            color="steelblue", linewidth=1.5) +
  # Acciones individuales
  geom_point(data=pts_acc, aes(x=sigma, y=mu, color=ticker),
             size=5, shape=17) +
  geom_label(data=pts_acc, aes(x=sigma, y=mu, label=ticker, color=ticker),
             nudge_y=0.4, fontface="bold", size=4, show.legend=FALSE) +
  # Mínima varianza
  geom_point(aes(x=sigma_mv*100, y=mu_mv*100),
             color="purple", size=4, shape=15) +
  annotate("text", x=sigma_mv*100+0.3, y=mu_mv*100-0.4,
           label="Mín. Varianza", color="purple", size=3.2, hjust=0) +
  # Portafolio óptimo
  geom_point(aes(x=sigma_port*100, y=mu_port*100),
             color="red", size=6, shape=18) +
  annotate("label", x=sigma_port*100+0.3, y=mu_port*100+0.5,
           label=sprintf("Óptimo\nSharpe=%.3f", sharpe_opt),
           color="red", size=3.2, hjust=0, fill="white", label.size=0.3) +
  # RF
  geom_point(aes(x=0, y=RF_ANUAL*100), color="black", size=3) +
  annotate("text", x=0.2, y=RF_ANUAL*100+0.2,
           label=sprintf("rf = %.2f%%", RF_ANUAL*100), size=3, hjust=0) +
  scale_color_manual(values=c(PG="#003087", SYK="#E31837", WM="#00703C")) +
  scale_x_continuous(labels=function(x) paste0(x,"%")) +
  scale_y_continuous(labels=function(x) paste0(x,"%")) +
  labs(
    title    = "Frontera Eficiente — PG, SYK, WM",
    subtitle = sprintf("Portafolio óptimo: μ=%.2f%% | σ=%.2f%% | Sharpe=%.4f | rf=%.2f%%",
                       mu_port*100, sigma_port*100, sharpe_opt, RF_ANUAL*100),
    x        = "Riesgo — Desviación estándar anual (%)",
    y        = "Retorno esperado anual (%)",
    color    = "Acción",
    caption  = "Línea naranja: Capital Market Line | ◆ Portafolio tangente | ■ Mínima varianza"
  ) +
  theme_minimal(base_size=13) +
  theme(legend.position="bottom",
        plot.title=element_text(face="bold", color="#003087"),
        plot.subtitle=element_text(color="gray40"))

4.3 Pesos óptimos y asignación de capital

pesos_df <- data.frame(
  Acción            = TICKERS,
  `Peso (%)`        = round(w_opt*100, 2),
  `Monto (USD)`     = scales::dollar(round(monto_opt)),
  `μ anual (%)`     = round(mu_anual*100, 2),
  `σ anual (%)`     = round(sd_anual*100, 2),
  check.names       = FALSE
)

kable(pesos_df, align=c("l","c","r","c","c"),
      caption="Tabla 5. Pesos óptimos y asignación de capital (USD 20,000,000)") %>%
  kable_styling(bootstrap_options=c("striped","hover","condensed"), full_width=FALSE) %>%
  row_spec(which.max(w_opt), bold=TRUE, background="#eef4fb")

Tabla 5. Pesos óptimos y asignación de capital (USD 20,000,000)

	Acción	Peso (%)	Monto (USD)	μ anual (%)	σ anual (%)
PG	PG	0.00	$0	8.68	18.90
SYK	SYK	2.75	$549,099	11.68	26.15
WM	WM	97.25	$19,450,901	15.33	19.46

cat(sprintf("\nRetorno esperado portafolio : %.4f%% anual\n", mu_port*100))

## 
## Retorno esperado portafolio : 15.2290% anual

cat(sprintf("Desviación estándar         : %.4f%% anual\n", sigma_port*100))

## Desviación estándar         : 19.2751% anual

cat(sprintf("Sharpe Ratio                : %.4f\n", sharpe_opt))

## Sharpe Ratio                : 0.5639

---

5 Simulación — Movimiento Browniano Geométrico (GBM)

GBM por acción: Se simulan 5000 trayectorias independientes para PG, SYK y WM usando el proceso: \[S_t = S_0 \exp\!\left[\left(\mu - \frac{\sigma^2}{2}\right)t + \sigma\sqrt{t}\,Z\right], \quad Z\sim\mathcal{N}(0,1)\]

S0       <- as.numeric(tail(datos[, TICKERS], 1))
names(S0) <- TICKERS
mu_d     <- colMeans(ret_acc)
sd_d     <- apply(ret_acc, 2, sd)

simular_gbm <- function(s0, mu_d, sigma_d, n_sim, n_pasos) {
  paths <- matrix(NA, nrow=n_sim, ncol=n_pasos+1)
  paths[,1] <- s0
  for (t in 2:(n_pasos+1)) {
    Z <- rnorm(n_sim)
    paths[,t] <- paths[,t-1] * exp((mu_d - 0.5*sigma_d^2) + sigma_d*Z)
  }
  paths
}

sim_precios <- lapply(TICKERS, function(tk)
  simular_gbm(S0[tk], mu_d[tk], sd_d[tk], N_SIM, N_MES))
names(sim_precios) <- TICKERS

# Retornos simulados del portafolio
ret_sim_port <- vapply(seq_len(N_SIM), function(i) {
  r <- sapply(TICKERS, function(tk)
    log(sim_precios[[tk]][i, N_MES+1] / sim_precios[[tk]][i, 1]))
  sum(w_opt * r)
}, numeric(1))

colores <- c(PG="#003087", SYK="#E31837", WM="#00703C")
n_show  <- 80

par(mfrow=c(1,3), mar=c(4,4,3,1), bg="white")
for (tk in TICKERS) {
  paths <- sim_precios[[tk]]
  med   <- apply(paths, 2, median)
  p05   <- apply(paths, 2, quantile, 0.05)
  p95   <- apply(paths, 2, quantile, 0.95)
  ylim  <- range(p05, p95)

  plot(0:N_MES, paths[1,], type="l",
       col=adjustcolor(colores[tk], 0.08),
       ylim=ylim, xlab="Días hábiles", ylab="Precio (USD)",
       main=paste0("GBM — ", tk), cex.main=1.1, font.main=2)
  for (i in 2:n_show)
    lines(0:N_MES, paths[i,], col=adjustcolor(colores[tk], 0.08))
  polygon(c(0:N_MES, rev(0:N_MES)), c(p05, rev(p95)),
          col=adjustcolor(colores[tk], 0.15), border=NA)
  lines(0:N_MES, med, col=colores[tk], lwd=2.5)
  lines(0:N_MES, p05, col="gray30", lwd=1.2, lty=2)
  lines(0:N_MES, p95, col="gray30", lwd=1.2, lty=2)
  legend("topleft", legend=c("Mediana","IC 90%"),
         lty=c(1,2), col=c(colores[tk],"gray30"), lwd=c(2.5,1.2), bty="n", cex=0.8)
}

par(mfrow=c(1,1))

---

6 VaR Mensual del Portafolio

# ── Paramétrico ───────────────────────────────────────────────
mu_m   <- mu_port / 12
sig_m  <- sigma_port / sqrt(12)
VaR_99_par <- -(mu_m + qnorm(0.01)*sig_m)
VaR_95_par <- -(mu_m + qnorm(0.05)*sig_m)

# ── Histórico ─────────────────────────────────────────────────
ret_ph <- as.numeric(ret_acc %*% w_opt)
n_bl   <- floor(length(ret_ph)/N_MES)
ret_pm <- sapply(1:n_bl, function(i)
  sum(ret_ph[((i-1)*N_MES+1):(i*N_MES)]))
VaR_99_hist <- -quantile(ret_pm, 0.01)
VaR_95_hist <- -quantile(ret_pm, 0.05)

# ── Monte Carlo GBM ───────────────────────────────────────────
VaR_99_mc <- -quantile(ret_sim_port, 0.01)
VaR_95_mc <- -quantile(ret_sim_port, 0.05)

var_df <- data.frame(
  Método       = c("Paramétrico","Histórico","Monte Carlo GBM"),
  `VaR 99% (%)` = round(c(VaR_99_par, VaR_99_hist, VaR_99_mc)*100, 3),
  `VaR 99% (USD)` = scales::dollar(round(c(VaR_99_par, VaR_99_hist, VaR_99_mc)*CAPITAL)),
  `VaR 95% (%)` = round(c(VaR_95_par, VaR_95_hist, VaR_95_mc)*100, 3),
  `VaR 95% (USD)` = scales::dollar(round(c(VaR_95_par, VaR_95_hist, VaR_95_mc)*CAPITAL)),
  check.names  = FALSE
)

kable(var_df, align=c("l","c","r","c","r"),
      caption="Tabla 6. VaR mensual del portafolio — tres métodos") %>%
  kable_styling(bootstrap_options=c("striped","hover","condensed"), full_width=FALSE) %>%
  row_spec(3, bold=TRUE, background="#eef4fb")

Tabla 6. VaR mensual del portafolio — tres métodos

Método	VaR 99% (%)	VaR 99% (USD)	VaR 95% (%)	VaR 95% (USD)
Paramétrico	11.675	$2,335,052	7.883	$1,576,653
Histórico	10.715	$2,142,905	6.408	$1,281,603
Monte Carlo GBM	12.004	$2,400,838	8.015	$1,602,971

ggplot(data.frame(ret=ret_sim_port*100), aes(x=ret)) +
  geom_histogram(aes(y=after_stat(density)), bins=80,
                 fill="steelblue", alpha=0.65, color="white") +
  geom_density(color="navy", linewidth=1.1) +
  geom_vline(xintercept=-VaR_99_mc*100, color="red",    linetype="dashed", linewidth=1.1) +
  geom_vline(xintercept=-VaR_95_mc*100, color="orange", linetype="dashed", linewidth=1.1) +
  annotate("label", x=-VaR_99_mc*100, y=Inf,
           label=sprintf("VaR 99%%\n%.2f%%", VaR_99_mc*100),
           color="red", vjust=1.5, size=3.2, fill="white", label.size=0.3) +
  annotate("label", x=-VaR_95_mc*100, y=Inf,
           label=sprintf("VaR 95%%\n%.2f%%", VaR_95_mc*100),
           color="darkorange", vjust=1.5, size=3.2, fill="white", label.size=0.3) +
  labs(title="Distribución de retornos mensuales del portafolio (Monte Carlo GBM)",
       subtitle=sprintf("N = %s simulaciones | VaR 99%% = USD %s | VaR 95%% = USD %s",
                        format(N_SIM, big.mark=","),
                        scales::dollar(round(VaR_99_mc*CAPITAL)),
                        scales::dollar(round(VaR_95_mc*CAPITAL))),
       x="Retorno mensual (%)", y="Densidad") +
  theme_minimal(base_size=12) +
  theme(plot.title=element_text(face="bold"))

---

7 Betas CAPM

betas <- sapply(TICKERS, function(tk)
  cov(as.numeric(ret_acc[,tk]), as.numeric(ret_idx)) / var(as.numeric(ret_idx)))

beta_port <- sum(w_opt * betas)

# Regresiones OLS
reg_df <- data.frame(
  Acción = TICKERS,
  Alpha  = sapply(TICKERS, function(tk)
    round(coef(lm(as.numeric(ret_acc[,tk]) ~ as.numeric(ret_idx)))[1]*N_ANUAL, 5)),
  Beta   = round(betas, 4),
  `R²`   = sapply(TICKERS, function(tk)
    round(summary(lm(as.numeric(ret_acc[,tk]) ~ as.numeric(ret_idx)))$r.squared, 4)),
  Peso   = round(w_opt*100, 2),
  check.names = FALSE
)

kable(reg_df, align="c",
      caption="Tabla 7. Betas CAPM — regresión OLS sobre S&P 500") %>%
  kable_styling(bootstrap_options=c("striped","hover","condensed"), full_width=FALSE) %>%
  add_footnote(sprintf("Beta del portafolio (ponderado): %.4f", beta_port),
               notation="symbol")

Tabla 7. Betas CAPM — regresión OLS sobre S&P 500

	Acción	Alpha	Beta	R²	Peso
PG.(Intercept)	PG	0.02688	0.4849	0.2159	0.00
SYK.(Intercept)	SYK	-0.00312	0.9701	0.4518	2.75
WM.(Intercept)	WM	0.08367	0.5633	0.2749	97.25
* Beta del portafolio (ponderado): 0.5744

Beta del portafolio ponderado: \(\beta_p = \sum_i w_i \beta_i =\) 0.5744

Un \(\beta_p\) < 1 indica que el portafolio es más defensivo que el mercado.

---

8 Instrumento de Cobertura — E-mini S&P 500

F0 <- precio_futuro_ini
QF <- MULTIPLICADOR
VP <- CAPITAL

contrato_df <- data.frame(
  Característica = c("Activo subyacente","Bolsa / Plataforma","Multiplicador",
                     "Precio inicial F₀","Valor nocional F₀",
                     "Vencimientos","Margen inicial","Margen mantenimiento",
                     "Liquidación","Ajuste mark-to-market"),
  Valor = c(
    "Índice S&P 500","CME Group (Chicago Mercantile Exchange)",
    paste0("USD ", QF, " por punto"),
    paste0(F0, " puntos"),
    scales::dollar(F0 * QF),
    "Trimestral: Mar / Jun / Sep / Dic",
    scales::dollar(MARGEN_INI), scales::dollar(MARGEN_MANT),
    "Entrega en efectivo (cash settlement)",
    "Diario en práctica; mensual en este ejercicio"
  )
)

kable(contrato_df, align=c("l","r"),
      caption="Tabla 8. Parámetros del contrato E-mini S&P 500 (CME)") %>%
  kable_styling(bootstrap_options=c("striped","hover","condensed"), full_width=FALSE)

Tabla 8. Parámetros del contrato E-mini S&P 500 (CME)

Característica	Valor
Activo subyacente	Índice S&P 500
Bolsa / Plataforma	CME Group (Chicago Mercantile Exchange)
Multiplicador	USD 50 por punto
Precio inicial F₀	7168 puntos
Valor nocional F₀	$358,400
Vencimientos	Trimestral: Mar / Jun / Sep / Dic
Margen inicial	$14,000
Margen mantenimiento	$12,700
Liquidación	Entrega en efectivo (cash settlement)
Ajuste mark-to-market	Diario en práctica; mensual en este ejercicio

---

9 Número Óptimo de Contratos

\[N^* = \frac{\beta_p \times V_p}{F_0 \times Q_F}\]

N_star_exacto <- beta_port * VP / (F0 * QF)
N_star_round  <- round(N_star_exacto)

cat(sprintf("β_portafolio          = %.4f\n", beta_port))

## β_portafolio          = 0.5744

cat(sprintf("V_p (capital)         = USD %s\n", format(VP, big.mark=",")))

## V_p (capital)         = USD 2e+07

cat(sprintf("F₀ × Q_F              = %d × %d = USD %s\n", F0, QF, format(F0*QF, big.mark=",")))

## F₀ × Q_F              = 7168 × 50 = USD 358,400

cat(sprintf("N* exacto             = %.4f contratos\n", N_star_exacto))

## N* exacto             = 32.0561 contratos

cat(sprintf("N* redondeado         = %d contratos\n", N_star_round))

## N* redondeado         = 32 contratos

cat(sprintf("Nocional cubierto     = USD %s\n", format(N_star_round*F0*QF, big.mark=",")))

## Nocional cubierto     = USD 11,468,800

cat(sprintf("Margen inicial total  = USD %s\n", format(N_star_round*MARGEN_INI, big.mark=",")))

## Margen inicial total  = USD 448,000

Justificación del redondeo: Se usa round() (entero más cercano) para minimizar el error de cobertura. Redondear hacia arriba sobreprotege (sobre-hedging) mientras que hacia abajo subprotege (under-hedging). El error residual es de 0.18%.

---

10 Posición en Futuros: Corta vs Larga

Tabla 9. Análisis de la posición en futuros

Situación	Descripción
Inversionista largo en acciones (nuestro caso)	Portafolio de USD 20M en PG, SYK, WM
¿Qué riesgo se cubre?	Caída del índice → pérdida en valor de las acciones
Posición adoptada	CORTA en 32 contratos E-mini S&P 500
Si el mercado BAJA	Ganancia en futuros cortos compensa pérdida en acciones ✔
Si el mercado SUBE	Pérdida en futuros cortos reduce la ganancia en acciones (costo de la cobertura)
Cuándo se usaría posición LARGA	Cuando se anticipa compra futura de acciones y se teme alza de precios

---

11 Flujos Mensuales — Mark-to-Market

# Simulación del precio del índice mes a mes (GBM mensual)
mu_idx_d  <- as.numeric(mean(ret_idx))
sd_idx_d  <- as.numeric(sd(ret_idx))
S0_idx    <- as.numeric(tail(datos[,"GSPC"], 1))

set.seed(99)
precio_idx_mes <- numeric(N_MESES + 1)
precio_idx_mes[1] <- S0_idx
for (m in 2:(N_MESES+1)) {
  Z <- rnorm(N_MES)
  precio_idx_mes[m] <- precio_idx_mes[m-1] *
    exp(sum((mu_idx_d - 0.5*sd_idx_d^2) + sd_idx_d*Z))
}

# Precio del futuro (aproximación cost-of-carry trimestral)
T_trim <- 0.25
precio_fut_mes <- precio_idx_mes * exp(RF_ANUAL * T_trim)

# Mark-to-market mensual
saldo_margen <- MARGEN_INI * N_CONT
mtm_lst <- vector("list", N_MESES)

for (m in 1:N_MESES) {
  F_ini  <- precio_fut_mes[m]
  F_fin  <- precio_fut_mes[m+1]
  dF     <- F_fin - F_ini
  GP_l   <-  dF * QF * N_CONT
  GP_c   <- -GP_l
  saldo_margen <- saldo_margen + GP_c
  mc     <- 0
  if (saldo_margen < MARGEN_MANT * N_CONT) {
    mc <- MARGEN_INI * N_CONT - saldo_margen
    saldo_margen <- MARGEN_INI * N_CONT
  }
  mtm_lst[[m]] <- data.frame(
    Mes=m, Trim=ceiling(m/3),
    F_ini=round(F_ini,2), F_fin=round(F_fin,2), dF=round(dF,2),
    GP_larga=round(GP_l), GP_corta=round(GP_c),
    Saldo_margen=round(saldo_margen), Margin_call=round(mc)
  )
}
mtm_tabla <- do.call(rbind, mtm_lst)

# Mostrar primeros 12 meses
kable(
  mtm_tabla[1:12, c("Mes","F_ini","F_fin","dF","GP_corta","Saldo_margen","Margin_call")],
  col.names=c("Mes","F ini","F fin","ΔF","G/P Corta","Saldo Margen","Margin Call"),
  align="c", format.args=list(big.mark=","),
  caption="Tabla 10. Flujos mensuales — primeros 12 meses (posición corta)"
) %>%
  kable_styling(bootstrap_options=c("striped","hover","condensed"), full_width=FALSE) %>%
  row_spec(which(mtm_tabla$Margin_call[1:12] > 0), background="#ffe0e0", bold=TRUE)

Tabla 10. Flujos mensuales — primeros 12 meses (posición corta)

Mes	F ini	F fin	ΔF	G/P Corta	Saldo Margen	Margin Call
1	7,214.16	6,801.74	-412.42	659,873	1,107,873	0
2	6,801.74	6,721.30	-80.43	128,694	1,236,567	0
3	6,721.30	6,097.52	-623.78	998,045	2,234,612	0
4	6,097.52	6,134.33	36.80	-58,885	2,175,727	0
5	6,134.33	6,304.92	170.59	-272,944	1,902,783	0
6	6,304.92	5,968.52	-336.39	538,231	2,441,014	0
7	5,968.52	6,351.68	383.16	-613,053	1,827,962	0
8	6,351.68	6,661.69	310.00	-496,007	1,331,955	0
9	6,661.69	6,560.09	-101.60	162,560	1,494,515	0
10	6,560.09	5,799.05	-761.04	1,217,664	2,712,178	0
11	5,799.05	5,898.64	99.60	-159,355	2,552,823	0
12	5,898.64	6,113.57	214.92	-343,878	2,208,945	0

ggplot(mtm_tabla, aes(x=Mes)) +
  geom_col(aes(y=GP_corta/1e3, fill=GP_corta >= 0), alpha=0.75, width=0.8) +
  geom_line(aes(y=Saldo_margen/1e3), color="navy", linewidth=1, linetype="solid") +
  geom_hline(yintercept=MARGEN_MANT*N_CONT/1e3, linetype="dashed",
             color="red", linewidth=0.9) +
  geom_point(data=mtm_tabla[mtm_tabla$Margin_call>0,],
             aes(x=Mes, y=Margin_call/1e3), color="red", size=3, shape=8) +
  scale_fill_manual(values=c("TRUE"="forestgreen","FALSE"="firebrick"),
                    labels=c("Pérdida","Ganancia"),
                    name="G/P posición corta") +
  scale_x_continuous(breaks=seq(0,N_MESES,6)) +
  labs(title="Flujos mensuales — posición corta en futuros (4 años)",
       x="Mes", y="Miles USD",
       caption="— Línea azul: saldo de margen  |  — — Línea roja: margen de mantenimiento  |  ✱ Margin call") +
  theme_minimal(base_size=12) + theme(legend.position="bottom")

---

12 Estrategia de Roll-Over Trimestral

gp_roll <- data.frame()
for (q in 1:16) {
  mi <- (q-1)*3+1; mf <- q*3
  if (mf > N_MESES) break
  Fa  <- precio_fut_mes[mi]
  Fc  <- precio_fut_mes[mf+1]
  GPc <- (Fa - Fc) * QF * N_CONT
  base <- precio_idx_mes[mf+1] - Fc
  gp_roll <- rbind(gp_roll, data.frame(
    Trimestre=q, F_apertura=round(Fa,2), F_cierre=round(Fc,2),
    GP_corta=round(GPc), Riesgo_base=round(base,2),
    Efecto_pct=round(GPc/CAPITAL*100, 3)
  ))
}

kable(gp_roll,
      col.names=c("Trim.","F Apertura","F Cierre","G/P Corta (USD)","Base (pts)","Efecto (%)"),
      align="c", format.args=list(big.mark=","),
      caption="Tabla 11. Ganancias/pérdidas por roll-over trimestral") %>%
  kable_styling(bootstrap_options=c("striped","hover","condensed"), full_width=FALSE) %>%
  row_spec(which(gp_roll$GP_corta > 0), background="#e8f5e9") %>%
  row_spec(which(gp_roll$GP_corta < 0), background="#ffebee")

Tabla 11. Ganancias/pérdidas por roll-over trimestral

Trim.	F Apertura	F Cierre	G/P Corta (USD)	Base (pts)	Efecto (%)
1	7,214.16	6,097.52	1,786,612	-66.10	8.933
2	6,097.52	5,968.52	206,402	-64.70	1.032
3	5,968.52	6,560.09	-946,500	-71.12	-4.732
4	6,560.09	6,113.57	714,431	-66.28	3.572
5	6,113.57	6,460.23	-554,668	-70.03	-2.773
6	6,460.23	6,123.81	538,272	-66.39	2.691
7	6,123.81	6,329.75	-329,496	-68.62	-1.647
8	6,329.75	6,888.56	-894,101	-74.68	-4.471
9	6,888.56	6,235.83	1,044,374	-67.60	5.222
10	6,235.83	6,757.88	-835,278	-73.26	-4.176
11	6,757.88	6,796.37	-61,591	-73.68	-0.308
12	6,796.37	6,445.66	561,136	-69.88	2.806
13	6,445.66	7,565.57	-1,791,860	-82.02	-8.959
14	7,565.57	7,833.21	-428,213	-84.92	-2.141
15	7,833.21	8,744.68	-1,458,356	-94.80	-7.292
16	8,744.68	8,445.63	478,478	-91.56	2.392

Riesgo de base: La diferencia entre el precio spot del índice y el precio del futuro al momento del cierre no es cero. Este riesgo de base genera una cobertura imperfecta y es el principal costo oculto del roll-over.

---

13 Valor Esperado de la Cobertura Trimestral

RF_mens <- RF_ANUAL / 12

VE_sin_cob  <- CAPITAL * exp(mu_port * T_trim)
VE_fut_teo  <- F0 * exp(RF_ANUAL * T_trim)
VE_pos_corta <- (F0 - VE_fut_teo) * QF * N_CONT
VE_cubierto  <- VE_sin_cob + VE_pos_corta

ve_df <- data.frame(
  Concepto = c(
    "Tasa libre de riesgo anual (^TNX)",
    "VE portafolio sin cobertura (1 trimestre)",
    "Precio teórico del futuro F₀ × e^(rf×T)",
    "VE posición corta en futuros",
    "VE portafolio CUBIERTO"
  ),
  Valor = c(
    paste0(RF_ANUAL*100,"% anual"),
    scales::dollar(round(VE_sin_cob)),
    round(VE_fut_teo, 2),
    scales::dollar(round(VE_pos_corta)),
    scales::dollar(round(VE_cubierto))
  )
)

kable(ve_df, align=c("l","r"),
      caption="Tabla 12. Valor esperado de la cobertura trimestral") %>%
  kable_styling(bootstrap_options=c("striped","hover","condensed"), full_width=FALSE) %>%
  row_spec(5, bold=TRUE, background="#eef4fb")

Tabla 12. Valor esperado de la cobertura trimestral

Concepto	Valor
Tasa libre de riesgo anual (^TNX)	4.36% anual
VE portafolio sin cobertura (1 trimestre)	$20,776,133
Precio teórico del futuro F₀ × e^(rf×T)	7246.56
VE posición corta en futuros	-$125,694
VE portafolio CUBIERTO	$20,650,439

---

14 Rendimiento Mensual y Valor de la Cartera

# Tres escenarios
valor_sc  <- CAPITAL * exp(mu_port  * (1:N_MESES)/12)
valor_cub <- numeric(N_MESES)
for (m in 1:N_MESES) {
  q <- ceiling(m/3)
  aj <- if (q <= nrow(gp_roll)) gp_roll$GP_corta[q]/3 else 0
  valor_cub[m] <- valor_sc[m] + aj
}
valor_var <- CAPITAL * exp((mu_port - VaR_99_mc) * (1:N_MESES)/12)

df_ev <- data.frame(
  Mes=1:N_MESES,
  `Sin cobertura`=valor_sc/1e6,
  `Cubierto`=valor_cub/1e6,
  `Escenario VaR 99%`=valor_var/1e6,
  check.names=FALSE
)

df_ev_long <- pivot_longer(df_ev, -Mes, names_to="Escenario", values_to="Valor_MM")

ggplot(df_ev_long, aes(x=Mes, y=Valor_MM, color=Escenario)) +
  geom_line(linewidth=1.1) +
  geom_hline(yintercept=CAPITAL/1e6, linetype="dashed", color="gray50") +
  scale_color_manual(values=c("Sin cobertura"="steelblue",
                               "Cubierto"="forestgreen",
                               "Escenario VaR 99%"="firebrick")) +
  scale_x_continuous(breaks=seq(0,N_MESES,6)) +
  scale_y_continuous(labels=scales::dollar_format(suffix=" M")) +
  labs(title="Evolución del valor de la cartera — 4 años (48 meses)",
       subtitle="Comparación: portafolio libre, cubierto y escenario pesimista VaR 99%",
       x="Mes", y="Valor (millones USD)", color="Escenario") +
  theme_minimal(base_size=12) +
  theme(legend.position="bottom", plot.title=element_text(face="bold"))

res_df <- data.frame(
  Escenario = c("Sin cobertura","Cubierto","VaR 99%"),
  `Mes 12`  = scales::dollar(round(c(valor_sc[12], valor_cub[12], valor_var[12]))),
  `Mes 24`  = scales::dollar(round(c(valor_sc[24], valor_cub[24], valor_var[24]))),
  `Mes 48`  = scales::dollar(round(c(valor_sc[48], valor_cub[48], valor_var[48]))),
  check.names = FALSE
)
kable(res_df, align=c("l","r","r","r"),
      caption="Tabla 13. Valor esperado de la cartera por escenario") %>%
  kable_styling(bootstrap_options=c("striped","hover","condensed"), full_width=FALSE)

Tabla 13. Valor esperado de la cartera por escenario

Escenario	Mes 12	Mes 24	Mes 48
Sin cobertura	$23,289,965	$27,121,124	$36,777,768
Cubierto	$23,528,109	$26,823,090	$36,937,261
VaR 99%	$20,655,481	$21,332,445	$22,753,660

Dividendos: PG (~2.4%/año), WM (~1.5%/año) y SYK (~1.0%/año) pagan dividendos. Al usar precios ajustados de Yahoo Finance los dividendos ya están incorporados en los retornos calculados, por lo que no se deben sumar de forma adicional para evitar doble conteo.

---

15 Sensibilidad de la Cobertura: β = 0.5 y β = 2

betas_hip <- c(0.5, beta_port, 2.0)
etiquetas <- c("β = 0.5 (defensivo)","β actual del portafolio","β = 2.0 (agresivo)")

sens_df <- data.frame(
  Escenario           = etiquetas,
  Beta                = betas_hip,
  `N* exacto`         = round(betas_hip * VP / (F0*QF), 4),
  `N* contratos`      = round(betas_hip * VP / (F0*QF)),
  `Nocional cubierto` = scales::dollar(round(round(betas_hip*VP/(F0*QF)) * F0*QF)),
  `Exp. sistemática`  = scales::dollar(round(betas_hip * VP)),
  check.names         = FALSE
)

kable(sens_df, align=c("l","c","c","c","r","r"),
      caption="Tabla 14. Sensibilidad del número de contratos según beta") %>%
  kable_styling(bootstrap_options=c("striped","hover","condensed"), full_width=FALSE) %>%
  row_spec(2, bold=TRUE, background="#eef4fb") %>%
  row_spec(3, background="#fff3cd")

Tabla 14. Sensibilidad del número de contratos según beta

Escenario	Beta	N* exacto	N* contratos	Nocional cubierto	Exp. sistemática
β = 0.5 (defensivo)	0.5000000	27.9018	28	$10,035,200	$10,000,000
β actual del portafolio	0.5744457	32.0561	32	$11,468,800	$11,488,915
β = 2.0 (agresivo)	2.0000000	111.6071	112	$40,140,800	$40,000,000

beta_rango <- seq(0.3, 2.5, by=0.05)
n_rango    <- beta_rango * VP / (F0*QF)

ggplot(data.frame(beta=beta_rango, N=n_rango), aes(x=beta, y=N)) +
  geom_line(color="steelblue", linewidth=1.3) +
  geom_point(aes(x=0.5,       y=0.5*VP/(F0*QF)), color="forestgreen", size=4) +
  geom_point(aes(x=beta_port, y=N_CONT),          color="red",         size=4) +
  geom_point(aes(x=2.0,       y=2.0*VP/(F0*QF)), color="orange",      size=4) +
  annotate("text", x=0.5,       y=0.5*VP/(F0*QF)+3,  label="β=0.5",         color="forestgreen", size=3.5) +
  annotate("text", x=beta_port, y=N_CONT+3,           label=sprintf("β=%.2f\n(actual)",beta_port), color="red", size=3.2) +
  annotate("text", x=2.0,       y=2.0*VP/(F0*QF)+3,  label="β=2.0",         color="darkorange",  size=3.5) +
  labs(title="Número óptimo de contratos en función de la beta del portafolio",
       x="Beta del portafolio (β)", y="N* contratos",
       caption="N* = β × Vp / (F₀ × Q_F)") +
  theme_minimal(base_size=12) +
  theme(plot.title=element_text(face="bold"))

---

16 Resumen Ejecutivo

resumen_df <- data.frame(
  Indicador = c(
    "Capital inicial",
    "Acciones seleccionadas",
    "Horizonte de inversión",
    "Retorno esperado portafolio",
    "Volatilidad portafolio",
    "Sharpe Ratio",
    "Beta portafolio",
    "VaR mensual 99% (MC GBM)",
    "VaR mensual 95% (MC GBM)",
    "Contratos E-mini (posición corta)",
    "Nocional cubierto",
    "Margen inicial total",
    "Tasa libre de riesgo (^TNX)"
  ),
  Valor = c(
    scales::dollar(CAPITAL),
    paste(TICKERS, collapse=" | "),
    paste(HORIZONTE, "años"),
    paste0(round(mu_port*100,2), "% anual"),
    paste0(round(sigma_port*100,2), "% anual"),
    round(sharpe_opt, 4),
    round(beta_port, 4),
    paste0(round(VaR_99_mc*100,2), "% = ", scales::dollar(round(VaR_99_mc*CAPITAL))),
    paste0(round(VaR_95_mc*100,2), "% = ", scales::dollar(round(VaR_95_mc*CAPITAL))),
    paste0(N_CONT, " contratos"),
    scales::dollar(N_CONT*F0*QF),
    scales::dollar(N_CONT*MARGEN_INI),
    paste0(RF_ANUAL*100, "% anual")
  )
)

kable(resumen_df, align=c("l","r"),
      caption="Tabla 15. Resumen ejecutivo del ejercicio") %>%
  kable_styling(bootstrap_options=c("striped","hover","condensed"), full_width=FALSE) %>%
  row_spec(c(4,5,6,8,9,10), bold=TRUE)

Tabla 15. Resumen ejecutivo del ejercicio

Indicador	Valor
Capital inicial	$20,000,000
Acciones seleccionadas	PG | SYK | WM
Horizonte de inversión	4 años
Retorno esperado portafolio	15.23% anual
Volatilidad portafolio	19.28% anual
Sharpe Ratio	0.5639
Beta portafolio	0.5744
VaR mensual 99% (MC GBM)	12% = $2,400,838
VaR mensual 95% (MC GBM)	8.01% = $1,602,971
Contratos E-mini (posición corta)	32 contratos
Nocional cubierto	$11,468,800
Margen inicial total	$448,000
Tasa libre de riesgo (^TNX)	4.36% anual

---

Informe generado en R Markdown | Datos: Yahoo Finance | Futuros: CME Group

Referencia: Hull, J.C. (2022). Options, Futures, and Other Derivatives (11th ed.). Pearson.