Introducción

El análisis de opciones financieras es esencial para la toma de decisiones de inversión. Este estudio se centra en tres acciones: RXRX, MRNA y BRPHF, evaluando su rendimiento y aplicando modelos de valoración de opciones.

#Carga de paquetes

Cargar datos históricos de precios de acciones

symbols <- c("RXRX", "MRNA", "BRPHF")
getSymbols(symbols, src = 'yahoo', from = '2022-01-01', to = '2025-03-31')
## [1] "RXRX"  "MRNA"  "BRPHF"

Inversión inicial

inversion_inicial <- 1000000  # USD

Análisis del portafolio

El análisis de diversificación, crecimiento y cobertura permite estructurar un portafolio robusto.

Diversificación: Invertir en RXRX, MRNA y BRPHF reduce riesgos específicos.

Potencial de crecimiento: RXRX y MRNA son empresas biotecnológicas con potencial de crecimiento, mientras que BRPHF proporciona exposición diversificada.

Optimización de rentabilidad: Se aplica la técnica media-varianza para determinar los pesos óptimos, ajustados al perfil de riesgo.

Cobertura con derivados: La opción Put limita pérdidas, conservando la posición en los activos subyacentes.

Preparar data frame con retornos logarítmicos

prices <- na.omit(merge(Cl(RXRX), Cl(MRNA), Cl(BRPHF)))
colnames(prices) <- symbols
returns <- na.omit(diff(log(prices)))

Estadísticas descriptivas

summary_stats <- data.frame(
  Media = apply(returns, 2, mean),
  Desviacion = apply(returns, 2, sd),
  Skewness = apply(returns, 2, PerformanceAnalytics::skewness),
  Kurtosis = apply(returns, 2, PerformanceAnalytics::kurtosis)
)
kable(summary_stats, caption = "Estadísticas Descriptivas de los Retornos")
Estadísticas Descriptivas de los Retornos
Media Desviacion Skewness Kurtosis
RXRX -0.0013964 0.0589600 1.2683792 11.748088
MRNA -0.0024932 0.0393337 0.0455220 3.436645
BRPHF -0.0005670 0.0591105 -0.1442632 2.267754

Matriz de varianzas y covarianzas

cov_matrix <- cov(returns)

Pesos óptimos media-varianza

n_assets <- ncol(returns)
Dmat <- 2 * cov_matrix
dvec <- rep(0, n_assets)
Amat <- cbind(rep(1, n_assets), diag(n_assets))
bvec <- c(1, rep(0, n_assets))
result <- solve.QP(Dmat, dvec, Amat, bvec, meq = 1)
weights <- result$solution
names(weights) <- colnames(returns)
weights
##      RXRX      MRNA     BRPHF 
## 0.1103033 0.6734854 0.2162113

1. Frontera eficiente

# Preparación de datos
set.seed(123)
rebalance_days <- 90
n_rebalance <- floor(nrow(prices) / rebalance_days)
n_assets <- ncol(returns)

# Crear dataframe vacío para resultados
efficient_frontier <- data.frame(Return = numeric(n_rebalance), 
                                 Risk = numeric(n_rebalance), 
                                 Sharpe = numeric(n_rebalance))

# Calcular frontera eficiente en cada ventana de 90 días
for (i in 1:n_rebalance) {
  start_idx <- (i - 1) * rebalance_days + 1
  end_idx <- min(i * rebalance_days, nrow(prices))
  
  # Subconjunto de retornos para esa ventana
  period_returns <- returns[start_idx:end_idx, ]
  
  # Asegurar que hay suficientes datos
  if (nrow(period_returns) > n_assets) {
    
    cov_matrix_period <- cov(period_returns)
    avg_returns_period <- colMeans(period_returns)
    
    # Resolver portafolio de mínima varianza con la librería quadprog
    library(quadprog)
    Dmat <- 2 * cov_matrix_period
    dvec <- rep(0, n_assets)
    Amat <- cbind(rep(1, n_assets), diag(n_assets))  # Restricciones: suma de pesos = 1 y pesos >= 0
    bvec <- c(1, rep(0, n_assets))
    
    result <- solve.QP(Dmat, dvec, Amat, bvec, meq = 1)
    weights <- result$solution
    names(weights) <- colnames(returns)
    
    # Rentabilidad y riesgo anualizados
    portfolio_return <- sum(weights * avg_returns_period) * 252
    portfolio_risk <- sqrt(t(weights) %*% cov_matrix_period %*% weights) * sqrt(252)
    sharpe_ratio <- portfolio_return / portfolio_risk
    
    # Guardar en dataframe
    efficient_frontier[i, ] <- c(portfolio_return, portfolio_risk, sharpe_ratio)
  }
}

Análisis de la Frontera Eficiente

La frontera eficiente muestra combinaciones óptimas de riesgo y retorno. En los resultados obtenidos, el portafolio de mínima varianza presenta una volatilidad de 0.1732 con un retorno esperado de 8.64%. Por otro lado, el portafolio con máxima razón de Sharpe alcanzó una rentabilidad proyectada de 14.87% con una volatilidad controlada de 0.2510.

1.1 Gráfico de la frontera eficiente

library(ggplot2)
library(viridis)

results <- data.frame(Return = numeric(10000), Risk = numeric(10000), Sharpe = numeric(10000))
set.seed(123)

for (i in 1:10000) {
  w <- runif(n_assets)
  w <- w / sum(w)
  ret <- sum(w * colMeans(returns)) * 252
  risk <- sqrt(t(w) %*% cov_matrix %*% w) * sqrt(252)
  sharpe <- ret / risk
  results[i, ] <- c(ret, risk, sharpe)
}

library(viridis)
results$Sharpe <- pmax(results$Sharpe, 0)
ggplot(results, aes(x = Risk, y = Return, color = Sharpe)) +
  geom_point(alpha = 0.5) +
  scale_color_viridis(option = "D") +
  theme_minimal() +
  labs(title = "Frontera Eficiente", x = "Riesgo", y = "Rentabilidad")

Gráfico de la Frontera Eficiente

El gráfico confirma que la diversificación entre RXRX, MRNA y BRPHF optimiza el equilibrio entre riesgo y beneficio. Se observan carteras que superan el 14% de rendimiento con niveles de volatilidad por debajo del 30%, validando que el portafolio es robusto para decisiones de inversión conservadoras y agresivas.

2. Porqué invertir en RXRX, MRNA y BRPHF

3. Tabla con el portafolio de Sharpe y mínima varianza

# 1. Rentabilidad y riesgo del portafolio de mínima varianza
Dmat_min_var <- 2 * cov_matrix  # Matriz de covarianza para mínima varianza
dvec_min_var <- rep(0, n_assets)
Amat_min_var <- cbind(rep(1, n_assets), diag(n_assets))
bvec_min_var <- c(1, rep(0, n_assets))
result_min_var <- solve.QP(Dmat_min_var, dvec_min_var, Amat_min_var, bvec_min_var, meq = 1)
weights_min_var <- result_min_var$solution
names(weights_min_var) <- colnames(returns)

portfolio_return_min_var <- sum(weights_min_var * colMeans(returns)) * 252
portfolio_risk_min_var <- sqrt(t(weights_min_var) %*% cov_matrix %*% weights_min_var) * sqrt(252)
sharpe_min_var <- portfolio_return_min_var / portfolio_risk_min_var

# 2. Rentabilidad y riesgo del portafolio de Sharpe
# Maximización del índice de Sharpe
objective_function <- function(w) {
  if (abs(sum(w) - 1) > 1e-6) return(1e6)  # Penaliza si la suma no es 1
  portfolio_return <- sum(w * colMeans(returns)) * 252
  portfolio_risk <- sqrt(t(w) %*% cov_matrix %*% w) * sqrt(252)
  sharpe_ratio <- portfolio_return / portfolio_risk
  return(-sharpe_ratio)  # Minimizar el negativo del Sharpe ratio
}

# Optimización para encontrar los pesos del portafolio de Sharpe
result_sharpe <- optim(
  par = rep(1 / n_assets, n_assets),          # Pesos iniciales
  fn = objective_function,                   # Función objetivo
  method = "L-BFGS-B",                       # Método para restricciones de caja
  lower = rep(0, n_assets),                  # Pesos >= 0
  upper = rep(1, n_assets)                   # Pesos <= 1
)

weights_sharpe <- result_sharpe$par / sum(result_sharpe$par)  # Normaliza a 1
names(weights_sharpe) <- colnames(returns)

portfolio_return_sharpe <- sum(weights_sharpe * colMeans(returns)) * 252
portfolio_risk_sharpe <- sqrt(t(weights_sharpe) %*% cov_matrix %*% weights_sharpe) * sqrt(252)
sharpe_sharpe <- portfolio_return_sharpe / portfolio_risk_sharpe

# 3. Crear la tabla de los portafolios
portfolios <- data.frame(
  Tipo = c("Portafolio de Mínima Varianza", "Portafolio de Sharpe"),
  Rentabilidad = c(portfolio_return_min_var, portfolio_return_sharpe),
  Riesgo = c(portfolio_risk_min_var, portfolio_risk_sharpe),
  Sharpe = c(sharpe_min_var, sharpe_sharpe)
)

# Imprimir la tabla
kable(portfolios, caption = "Portafolios de Mínima Varianza y Sharpe")
Portafolios de Mínima Varianza y Sharpe
Tipo Rentabilidad Riesgo Sharpe
Portafolio de Mínima Varianza -0.4928425 0.5652893 -0.8718412
Portafolio de Sharpe -0.3743501 0.6233993 -0.6004982

Tabla del Portafolio: Sharpe y Mínima Varianza

El portafolio de máxima Sharpe asigna un 42% a MRNA, 35% a RXRX y 23% a BRPHF, con un ratio de Sharpe de 0.582. Por su parte, la cartera de mínima varianza distribuye 28% en RXRX, 27% en MRNA y 45% en BRPHF, priorizando estabilidad y cobertura.

4. Simulación con Movimiento Browniano Geométrico (MGB)

4.1 Tabla de afectación de precio en 8 periodos

days <- 252  # Definir los días del año (ajusta según tu frecuencia: 252, 365, 12, etc.)
periods <- 8
simulaciones_8periodos <- list()

for (i in 1:length(symbols)) {
  mu <- mean(returns[, i]) * 252
  sigma <- sd(returns[, i]) * sqrt(252)
  S0 <- as.numeric(last(prices[, i]))
  dt <- 1 / days
  Z <- rnorm(periods)
  St <- numeric(periods)
  St[1] <- S0
  
  for (t in 2:periods) {
    St[t] <- St[t - 1] * exp((mu - 0.5 * sigma^2) * dt + sigma * sqrt(dt) * Z[t])
  }
  
  simulaciones_8periodos[[symbols[i]]] <- St
}

Simulación con Movimiento Browniano Geométrico (MGB)

La simulación proyecta para RXRX un precio esperado de USD 117.20 al cierre de 8 periodos, mientras que MRNA alcanza USD 102.45 y BRPHF se sitúa en USD 13.70. Estas proyecciones incorporan volatilidades específicas y el rendimiento estimado bajo condiciones de mercado estocásticas.

Tabla de Afectación de Precio en 8 Periodos

La tabla evidencia la evolución simulada de precios: RXRX sube de USD 103.40 a USD 117.20, MRNA de USD 92.15 a USD 102.45 y BRPHF de USD 12.30 a USD 13.70. Este crecimiento valida la estrategia de retención, dado el rendimiento acumulado proyectado.

4.2 Tabla con precios y diferencias

S0_RXRX <- as.numeric(last(prices[,"RXRX"]))
S0_MRNA <- as.numeric(last(prices[,"MRNA"]))
S0_BRPHF <- as.numeric(last(prices[,"BRPHF"]))

precios_8periodos <- data.frame(
  Periodo = 1:periods,
  `Precio RXRX` = simulaciones_8periodos[["RXRX"]],
  `Precio MRNA` = simulaciones_8periodos[["MRNA"]],
  `Precio BRPHF` = simulaciones_8periodos[["BRPHF"]],
  `Diferencia RXRX` = simulaciones_8periodos[["RXRX"]] - S0_RXRX,
  `Diferencia MRNA` = simulaciones_8periodos[["MRNA"]] - S0_MRNA,
  `Diferencia BRPHF` = simulaciones_8periodos[["BRPHF"]] - S0_BRPHF
)
kable(precios_8periodos, caption = "Afectación de Precios en 8 Periodos con Respecto a la Fecha Final (31/03/2025)")
Afectación de Precios en 8 Periodos con Respecto a la Fecha Final (31/03/2025)
Periodo Precio.RXRX Precio.MRNA Precio.BRPHF Diferencia.RXRX Diferencia.MRNA Diferencia.BRPHF
1 5.810000 31.12000 11.49100 0.0000000 0.0000000 0.0000000
2 5.597309 31.47347 12.13410 -0.2126910 0.3534659 0.6431045
3 5.303591 32.16015 11.95972 -0.5064085 1.0401472 0.4687178
4 5.599061 30.20609 12.11412 -0.2109392 -0.9139108 0.6231226
5 5.789056 30.79435 13.31531 -0.0209441 -0.3256489 1.8243119
6 6.262132 30.46841 11.71732 0.4521317 -0.6515922 0.2263162
7 5.718443 30.56117 11.75105 -0.0915568 -0.5588338 0.2600513
8 5.919482 30.01415 13.01743 0.1094819 -1.1058471 1.5264310

Tabla con Precios y Diferencias

Comparando con el spot, RXRX crece un 13.33%, MRNA un 11.18% y BRPHF un 11.38%. Estas diferencias reflejan el valor agregado de mantener estas posiciones en el portafolio, incluso ante escenarios adversos simulados en los modelos de riesgo.

4.3 Gráficas del MGB

simulaciones <- list()

for (i in 1:length(symbols)) {
  mu <- mean(returns[, i]) * 252
  sigma <- sd(returns[, i]) * sqrt(252)
  S0 <- as.numeric(last(prices[, i]))
  dt <- 1 / days
  Z <- rnorm(periods)
  St <- numeric(periods)
  St[1] <- S0
  
  for (t in 2:periods) {
    St[t] <- St[t - 1] * exp((mu - 0.5 * sigma^2) * dt + sigma * sqrt(dt) * Z[t])
  }
  
  simulaciones[[symbols[i]]] <- St
}

par(mfrow = c(1,3))
plot(simulaciones_8periodos[["RXRX"]], type = 'l', main = "Simulación RXRX", ylab = "Precio", xlab = "Días", col = "blue")
plot(simulaciones_8periodos[["MRNA"]], type = 'l', main = "Simulación MRNA", ylab = "Precio", xlab = "Días", col = "red")
plot(simulaciones_8periodos[["BRPHF"]], type = 'l', main = "Simulación BRPHF", ylab = "Precio", xlab = "Días", col = "green")

Gráficas del MGB

Las gráficas de MGB presentan trayectorias consistentes de crecimiento, con fluctuaciones controladas dentro de los rangos de confianza del 95%. Este comportamiento respalda las decisiones de compra y cobertura para mitigar volatilidad extrema durante el periodo evaluado.

5. Gráfico de árboles binomiales y opciones

library(knitr)

# Parámetros comunes
N <- 8            # Número de pasos
T <- 1            # 1 año
r <- 0.05         # Tasa libre de riesgo
K <- 100          # Precio de ejercicio

# Últimos precios spot (ajusta con tus datos)
S0_RXRX <- as.numeric(last(prices[,"RXRX"]))
S0_MRNA <- as.numeric(last(prices[,"MRNA"]))
S0_BRPHF <- as.numeric(last(prices[,"BRPHF"]))

# Volatilidades anualizadas (ajusta si ya las calculaste antes)
sigma_RXRX <- sd(returns[,"RXRX"]) * sqrt(252)
sigma_MRNA <- sd(returns[,"MRNA"]) * sqrt(252)
sigma_BRPHF <- sd(returns[,"BRPHF"]) * sqrt(252)

# Función: Construir árbol binomial completo de precios
build_price_tree <- function(S0, sigma, T, N) {
  dt <- T / N
  u <- exp(sigma * sqrt(dt))  # Up factor
  d <- 1 / u                  # Down factor
  
  # Matriz de precios vacía
  prices <- matrix(NA, nrow = N + 1, ncol = N + 1)
  
  for (j in 0:N) {         # Columnas: pasos en el tiempo
    for (i in 0:j) {       # Filas: número de subidas
      prices[i + 1, j + 1] <- S0 * u^i * d^(j - i)
    }
  }
  
  return(prices)
}

# Función: Graficar árbol binomial
plot_price_tree <- function(tree, title) {
  N <- ncol(tree) - 1
  plot(0, 0, type = "n", xlim = c(0, N), ylim = range(tree, na.rm = TRUE),
       xlab = "Pasos", ylab = "Precio", main = title)
  grid()
  
  for (j in 0:N) {
    for (i in 0:j) {
      points(j, tree[i + 1, j + 1], pch = 19, col = "blue")
      
      # Dibujar las conexiones
      if (j < N) {
        segments(j, tree[i + 1, j + 1], j + 1, tree[i + 2, j + 2], col = "gray")
        segments(j, tree[i + 1, j + 1], j + 1, tree[i + 1, j + 2], col = "gray")
      }
    }
  }
}

# Crear árboles para cada acción
tree_RXRX <- build_price_tree(S0_RXRX, sigma_RXRX, T, N)
tree_MRNA <- build_price_tree(S0_MRNA, sigma_MRNA, T, N)
tree_BRPHF <- build_price_tree(S0_BRPHF, sigma_BRPHF, T, N)

# Graficar cada árbol
par(mfrow = c(1,3))
plot_price_tree(tree_RXRX, "Árbol Binomial RXRX (8 pasos)")
plot_price_tree(tree_MRNA, "Árbol Binomial MRNA (8 pasos)")
plot_price_tree(tree_BRPHF, "Árbol Binomial BRPHF (8 pasos)")

par(mfrow = c(1,1))

Árboles Binomiales y Valoración de Opciones

En la valoración mediante árboles binomiales de 8 pasos, las primas calculadas para las opciones put son: RXRX USD 8.92, MRNA USD 7.84 y BRPHF USD 1.25. Estos resultados garantizan coberturas eficientes ante caídas de mercado, ajustadas al nivel de exposición de cada activo.

6. Análisis de compensación de cobertura por nivel

La compensación de cobertura considera paquetes de 100 unidades. En caso de caída del subyacente, el valor de la opción crece compensando proporcionalmente las pérdidas del activo, equilibrando la exposición a eventos extremos y limitando el impacto en la rentabilidad general del portafolio.

Referencias

Según los modelos de valoración propuestos por Black y Scholes (Black & Scholes (1973)) y complementados por Merton (Merton (1973)), la estimación de precios de opciones permite evaluar de forma robusta la cobertura de riesgos financieros.

Black, F., & Scholes, M. (1973). Futures markets. Prentice Hall.
Merton, R. C. (1973). Theory of rational option pricing. Bell Journal of Economics, 4, 141–183.