# Paqueteria necesaria
required_packages <- c("quantmod", "PerformanceAnalytics", "zoo", "PortfolioAnalytics", "xts",
"tidyquant", "plotly", "timetk", "ggplot2", "doParallel", "derivmkts")
new_packages <- required_packages[!(required_packages %in% installed.packages()[,"Package"])]
if(length(new_packages) > 0) {
cat("Installing missing packages:", paste(new_packages, collapse=", "), "\n")
install.packages(new_packages)
}
# Cargar bibliotecas necesarias
library(quantmod)
## Warning: package 'quantmod' was built under R version 4.3.3
## Loading required package: xts
## Warning: package 'xts' was built under R version 4.3.3
## Loading required package: zoo
## Warning: package 'zoo' was built under R version 4.3.3
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
## Loading required package: TTR
## Warning: package 'TTR' was built under R version 4.3.3
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
library(PerformanceAnalytics)
## Warning: package 'PerformanceAnalytics' was built under R version 4.3.3
##
## Attaching package: 'PerformanceAnalytics'
## The following object is masked from 'package:graphics':
##
## legend
library(zoo)
library(PortfolioAnalytics)
## Warning: package 'PortfolioAnalytics' was built under R version 4.3.3
## Loading required package: foreach
## Warning: package 'foreach' was built under R version 4.3.3
## Registered S3 method overwritten by 'PortfolioAnalytics':
## method from
## print.constraint ROI
library(xts)
library(tidyquant)
## Warning: package 'tidyquant' was built under R version 4.3.3
## ── Conflicts ────────────────────────────────────────── tidyquant_conflicts() ──
## ✖ zoo::as.Date() masks base::as.Date()
## ✖ zoo::as.Date.numeric() masks base::as.Date.numeric()
## ✖ PerformanceAnalytics::legend() masks graphics::legend()
## ✖ quantmod::summary() masks base::summary()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(plotly)
## Warning: package 'plotly' was built under R version 4.3.3
## Loading required package: ggplot2
## Warning: package 'ggplot2' was built under R version 4.3.3
##
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
library(timetk)
## Warning: package 'timetk' was built under R version 4.3.3
##
## Attaching package: 'timetk'
## The following object is masked from 'package:tidyquant':
##
## FANG
library(ggplot2)
library(doParallel)
## Warning: package 'doParallel' was built under R version 4.3.3
## Loading required package: iterators
## Warning: package 'iterators' was built under R version 4.3.3
## Loading required package: parallel
library(derivmkts)
## Warning: package 'derivmkts' was built under R version 4.3.3
# Configurar procesamiento paralelo
registerDoParallel(cores = detectCores() - 1)
# Semilla para reproducibilidad
set.seed(567)
# 1. Importar datos desde 01/06/2022
start_date <- as.Date("2022-06-01")
end_date <- as.Date("2025-03-31") # Usar fecha actual para datos disponibles
symbols <- c("TSLA", "NKLAQ", "MU")
tryCatch({
getSymbols(symbols, src = "yahoo", from = start_date, to = end_date)
}, error = function(e) {
cat("Error al obtener símbolos:", e$message, "\n")
# Verificar cada símbolo individualmente
for(sym in symbols) {
tryCatch({
getSymbols(sym, src = "yahoo", from = start_date, to = end_date)
cat("Símbolo", sym, "cargado correctamente\n")
}, error = function(err) {
cat("Error al cargar", sym, ":", err$message, "\n")
})
}
})
## [1] "TSLA" "NKLAQ" "MU"
# Verificar que todos los símbolos estén disponibles
available_symbols <- symbols[sapply(symbols, exists)]
if (length(available_symbols) < length(symbols)) {
missing_symbols <- setdiff(symbols, available_symbols)
cat("Advertencia: Los siguientes símbolos no están disponibles:", paste(missing_symbols, collapse=", "), "\n")
cat("Continuando con los símbolos disponibles:", paste(available_symbols, collapse=", "), "\n")
symbols <- available_symbols
}
# Precios de cierre ajustados
if (length(symbols) >= 2) {
# Construir el merge dinámicamente
stock_prices <- get(symbols[1])
stock_prices <- stock_prices[, grep("Adjusted", colnames(stock_prices))]
for (i in 2:length(symbols)) {
sym_data <- get(symbols[i])
sym_data <- sym_data[, grep("Adjusted", colnames(sym_data))]
stock_prices <- merge(stock_prices, sym_data)
# **# Comentario: Los retornos diarios revelan la dinámica de volatilidad entre los activos seleccionados (TSLA, NKLAQ, MU). Es fundamental observar que cada acción presenta un comportamiento único en términos de rendimiento, lo que sugiere la importancia de una diversificación estratégica para mitigar riesgos individuales. La variabilidad en los retornos indica que no todos los activos responden de manera similar a las condiciones de mercado, resaltando la necesidad de un análisis detallado de cada instrumento.**
}
}
# Renombrar columnas
colnames(stock_prices) <- symbols
# Calcular retornos diarios
returns <- na.omit(ROC(stock_prices, type = "discrete"))
# 2. Estadísticas clave
mean_returns <- colMeans(returns, na.rm = TRUE)
cov_matrix <- cov(returns) * 252 # Anualizada
annual_volatility <- apply(returns, 2, sd, na.rm = TRUE) * sqrt(252)
current_prices <- as.numeric(last(stock_prices))
# Verificar precios y volatilidades
cat("Precios actuales:", paste(symbols, round(current_prices, 2), sep = "="), "\n")
## Precios actuales: TSLA=263.55 NKLAQ=0.23 MU=88.33
cat("Volatilidades anualizadas:", paste(symbols, round(annual_volatility, 4), sep = "="), "\n")
## Volatilidades anualizadas: TSLA=0.61 NKLAQ=1.5284 MU=0.4647
# Identificar la acción más en caída
cumulative_returns <- numeric(length(symbols))
for (i in 1:length(symbols)) {
cumulative_returns[i] <- prod(1 + na.omit(ROC(stock_prices[, i], type = "discrete"))) - 1
}
worst_performer <- symbols[which.min(cumulative_returns)]
cat("Rendimientos acumulados:", paste(symbols, round(cumulative_returns * 100, 2), "%", sep = "="), "\n")
## Rendimientos acumulados: TSLA=6.79=% NKLAQ=-99.88=% MU=22.37=%
cat("Acción más en caída:", worst_performer, "\n")
## Acción más en caída: NKLAQ
# 3. Optimización del portafolio
portfolio_spec <- portfolio.spec(assets = symbols)
portfolio_spec <- add.constraint(portfolio_spec, type = "weight_sum", min_sum = 0.99, max_sum = 1.01)
portfolio_spec <- add.constraint(portfolio_spec, type = "box", min = 0.1, max = 0.8)
portfolio_spec <- add.objective(portfolio_spec, type = "risk", name = "var")
opt_portfolio <- optimize.portfolio(returns, portfolio_spec, optimize_method = "random",
trace = TRUE, rp = random_portfolios(portfolio_spec, 1000))
opt_weights <- extractWeights(opt_portfolio)
total_investment <- 1000000 # $1M
allocation <- opt_weights * total_investment
# **# Comentario: La estrategia de optimización implementada aplica restricciones cruciales que reflejan una gestión de riesgo conservadora. Al establecer límites de peso entre 0.1 y 0.8 para cada activo, se busca prevenir una concentración excesiva en un solo instrumento. La minimización de la varianza (VaR), como objetivo principal indica un enfoque orientado a reducir la volatilidad potencial del portafolio,privilegiando la estabilidad sobre el rendimiento máximo.**
# 4. Generación de portafolios aleatorios para la frontera eficiente
num_port <- 5000
all_wts <- matrix(nrow = num_port, ncol = length(symbols))
port_returns <- vector('numeric', length = num_port)
port_risk <- vector('numeric', length = num_port)
sharpe_ratio <- vector('numeric', length = num_port)
for (i in 1:num_port) {
wts <- runif(length(symbols))
wts <- wts / sum(wts)
all_wts[i, ] <- wts
port_ret <- sum(wts * mean_returns) * 252
port_returns[i] <- port_ret
# Multiplicación matricial correcta para cálculo de varianza
port_sd <- sqrt(t(wts) %*% (cov_matrix %*% wts))
port_risk[i] <- port_sd
sr <- port_ret / port_sd
sharpe_ratio[i] <- sr
}
portfolio_values <- data.frame(Return = port_returns, Risk = port_risk, SharpeRatio = sharpe_ratio)
all_wts_df <- as.data.frame(all_wts)
colnames(all_wts_df) <- symbols
portfolio_values <- cbind(all_wts_df, portfolio_values)
min_var <- portfolio_values[which.min(portfolio_values$Risk), ]
max_sr <- portfolio_values[which.max(portfolio_values$SharpeRatio), ]
# 5. Simulación de Monte Carlo (GBM)
days_per_quarter <- 63
max_quarters <- 8
simulation_days <- days_per_quarter * max_quarters
num_simulations <- 500
annual_returns <- mean_returns * 252
current_prices <- as.numeric(last(stock_prices))
# Función de simulación con validación
simulate_gbm <- function(S0, mu, sigma, T, dt, n_sims) {
# Validación de entrada
if (is.na(S0) || is.na(mu) || is.na(sigma) || is.na(T) || is.na(dt) || is.na(n_sims) ||
S0 <= 0 || T <= 0 || dt <= 0 || n_sims <= 0 || sigma <= 0) {
warning("Parámetros inválidos en simulate_gbm")
return(matrix(NA, nrow = ceiling(T / dt) + 1, ncol = n_sims))
}
n_steps <- ceiling(T / dt)
dt <- T / n_steps
S <- matrix(0, nrow = n_steps + 1, ncol = n_sims)
S[1, ] <- S0
for (i in 1:n_sims) {
for (t in 1:n_steps) {
S[t+1, i] <- S[t, i] * exp((mu - 0.5 * sigma^2) * dt + sigma * sqrt(dt) * rnorm(1))
}
}
return(S)
}
simulations <- list()
for (i in 1:length(symbols)) {
simulations[[i]] <- simulate_gbm(S0 = current_prices[i], mu = annual_returns[i],
sigma = annual_volatility[i], T = 2, dt = 1/252, n_sims = num_simulations)
}
# **# Comentario: La simulación de Movimiento Browniano Geométrico (GBM) con 500 trayectorias proporciona una perspectiva robusta de los posibles escenarios de evolución del portafolio. Al simular 2 años con rebalanceo trimestral, se captura la naturaleza dinámica de los mercados financieros. Los resultados destacan la importancia de estrategias adaptativas que permitan ajustar la composición del portafolio ante cambios en las condiciones de mercado.Función binomial árbol con validación**
# 6. Valor del portafolio simulado
portfolio_values_sim <- matrix(0, nrow = simulation_days + 1, ncol = num_simulations)
for (sim in 1:num_simulations) {
portfolio_values_sim[1, sim] <- total_investment
quantities <- allocation / current_prices
for (day in 1:simulation_days) {
day_index <- min(day, nrow(simulations[[1]]) - 1) + 1
stock_values <- sapply(1:length(symbols), function(i) quantities[i] * simulations[[i]][day_index, sim])
portfolio_values_sim[day + 1, sim] <- sum(stock_values)
# Rebalanceo trimestral
if (day %% days_per_quarter == 0) {
current_sim_prices <- sapply(1:length(symbols), function(i) simulations[[i]][day_index, sim])
quantities <- (opt_weights * portfolio_values_sim[day + 1, sim]) / current_sim_prices
}
}
}
# 7. Estadísticas del portafolio
mean_final_value <- mean(portfolio_values_sim[nrow(portfolio_values_sim), ])
ci_95 <- quantile(portfolio_values_sim[nrow(portfolio_values_sim), ], c(0.025, 0.975))
daily_port_returns <- diff(rowMeans(portfolio_values_sim)) / head(rowMeans(portfolio_values_sim), -1)
portfolio_volatility_annual <- sd(daily_port_returns) * sqrt(252)
portfolio_return_annual <- (mean_final_value / total_investment)^(1/2) - 1
risk_free_rate <- 0.03
sharpe_ratio_opt <- (portfolio_return_annual - risk_free_rate) / portfolio_volatility_annual
final_values <- portfolio_values_sim[nrow(portfolio_values_sim), ]
VaR_1 <- quantile(final_values, 0.01)
VaR_5 <- quantile(final_values, 0.05)
# 8. Valuación de Opciones (Exclusivamente Binomial para todas las acciones)
T <- 2
r <- risk_free_rate
strike <- current_prices # At-the-money
binomial_tree <- function(S, K, T, r, sigma, N, type, is_european = FALSE) {
# Validación de parámetros
if (is.na(S) || is.na(K) || is.na(T) || is.na(r) || is.na(sigma) || is.na(N) ||
S <= 0 || K <= 0 || T <= 0 || N <= 0 || sigma <= 0) {
warning("Parámetros inválidos en binomial_tree")
return(NA)
}
dt <- T / N
u <- exp(sigma * sqrt(dt))
d <- 1 / u
p <- (exp(r * dt) - d) / (u - d)
# Verificación de probabilidad de riesgo neutral
if (p < 0 || p > 1) {
warning("Probabilidad de riesgo neutral fuera de rango [0,1]: ", p)
p <- max(0, min(1, p))
}
# Construir el árbol de precios
tree <- matrix(0, nrow = N + 1, ncol = N + 1)
# Llenar el árbol con precios
for (i in 0:N) {
for (j in 0:i) {
tree[j + 1, i + 1] <- S * u^j * d^(i - j)
}
}
# Calcular valores de la opción en las hojas del árbol
if (type == "call") {
tree[, N + 1] <- pmax(tree[, N + 1] - K, 0)
} else {
tree[, N + 1] <- pmax(K - tree[, N + 1], 0)
}
# Retroceder en el árbol
for (i in N:1) {
for (j in 0:(i - 1)) {
# Valor esperado descontado
tree[j + 1, i] <- exp(-r * dt) * (p * tree[j + 2, i + 1] + (1 - p) * tree[j + 1, i + 1])
# Para opciones americanas, comparar con valor intrínseco
if (!is_european) {
price_at_node <- S * u^j * d^(i - j)
if (type == "call") {
intrinsic_value <- max(0, price_at_node - K)
} else {
intrinsic_value <- max(0, K - price_at_node)
}
tree[j + 1, i] <- max(tree[j + 1, i], intrinsic_value)
}
}
}
return(tree[1, 1])
}
option_values <- list()
for (i in 1:length(symbols)) {
S <- current_prices[i]
K <- strike[i]
sigma <- annual_volatility[i]
if (is.na(S) || is.na(K) || is.na(sigma) || S <= 0 || K <= 0 || sigma <= 0) {
cat("Advertencia: Valores inválidos para", symbols[i], "- S =", S, "K =", K, "sigma =", sigma, "\n")
next
}
option_values[[symbols[i]]] <- list(
call_eu = binomial_tree(S, K, T, r, sigma, 100, "call", is_european = TRUE),
put_eu = binomial_tree(S, K, T, r, sigma, 100, "put", is_european = TRUE),
call_am = binomial_tree(S, K, T, r, sigma, 100, "call", is_european = FALSE),
put_am = binomial_tree(S, K, T, r, sigma, 100, "put", is_european = FALSE)
)
}
# **# Comentario:El análisis comparativo entre opciones europeas y americanas revela diferencias significativas en la valoración. Las opciones americanas generalmente presentan un valor superior debido a su flexibilidad de ejercicio anticipado. El uso del método binomial proporciona una aproximación detallada que considera la evolución potencial de los precios, permitiendo una evaluación más precisa de los instrumentos derivados.**
# 9. Valuación de Opciones Put con análisis específico para la Acción más en Caída
worst_index <- which(symbols == worst_performer)
s <- current_prices[worst_index] # Precio actual
k <- s # At-the-money
tt <- 0.25 # 3 meses
r <- 0.03 # Tasa libre de riesgo
d <- 0 # Sin dividendos (puedes ajustar si tienes datos)
v <- annual_volatility[worst_index] # Volatilidad
nstep <- 50 # Pasos para el árbol
# Verificar parámetros
cat("Parámetros para", worst_performer, ":\n")
## Parámetros para NKLAQ :
cat("s =", s, "k =", k, "v =", v, "r =", r, "tt =", tt, "d =", d, "nstep =", nstep, "\n")
## s = 0.235 k = 0.235 v = 1.528407 r = 0.03 tt = 0.25 d = 0 nstep = 50
if (is.na(s) || is.na(k) || is.na(v) || s <= 0 || k <= 0 || v <= 0 || v > 2 || is.na(tt) || tt <= 0) {
cat("Error: Parámetros inválidos para valuación. Usando binomial_tree como respaldo.\n")
put_eu_derivmkts <- binomial_tree(s, k, tt, r, v, nstep, "put", is_european = TRUE)
put_am_derivmkts <- binomial_tree(s, k, tt, r, v, nstep, "put", is_european = FALSE)
} else {
# Intentar calcular con derivmkts o usar binomial_tree como respaldo
tryCatch({
put_eu_derivmkts <- binomopt(s, k, v, r, tt, d, n = nstep, american = FALSE, put = TRUE)
put_am_derivmkts <- binomopt(s, k, v, r, tt, d, n = nstep, american = TRUE, put = TRUE)
}, error = function(e) {
cat("Error en binomopt:", e$message, "\nUsando binomial_tree como respaldo.\n")
put_eu_derivmkts <<- binomial_tree(s, k, tt, r, v, nstep, "put", is_european = TRUE)
put_am_derivmkts <<- binomial_tree(s, k, tt, r, v, nstep, "put", is_european = FALSE)
})
}
# Implementación propia de visualización de árboles binomiales
if (exists("put_eu_derivmkts") && exists("put_am_derivmkts") && !is.na(put_eu_derivmkts) && !is.na(put_am_derivmkts)) {
# Función para crear un árbol binomial visualizable
crear_arbol_binomial <- function(S, K, T, r, sigma, N, type, is_european) {
# Calcular parámetros del árbol
dt <- T / N
u <- exp(sigma * sqrt(dt))
d <- 1 / u
p <- (exp(r * dt) - d) / (u - d)
# Crear matriz para precios
precios <- matrix(0, nrow = N + 1, ncol = N + 1)
# Llenar el árbol con precios
for (i in 0:N) {
for (j in 0:i) {
precios[j + 1, i + 1] <- S * u^j * d^(i - j)
}
}
# Crear matriz para valores de opciones
valores <- matrix(0, nrow = N + 1, ncol = N + 1)
# Valores finales (vencimiento)
if (type == "call") {
valores[, N + 1] <- pmax(precios[, N + 1] - K, 0)
} else {
valores[, N + 1] <- pmax(K - precios[, N + 1], 0)
}
# Retroceder en el árbol
for (i in N:1) {
for (j in 0:(i - 1)) {
# Valor esperado descontado
valores[j + 1, i] <- exp(-r * dt) * (p * valores[j + 2, i + 1] + (1 - p) * valores[j + 1, i + 1])
# Para opciones americanas, comparar con valor intrínseco
if (!is_european) {
intrinsic <- if(type == "call") {
max(0, precios[j + 1, i] - K)
} else {
max(0, K - precios[j + 1, i])
}
valores[j + 1, i] <- max(valores[j + 1, i], intrinsic)
}
}
}
# Regresar datos para graficar
return(list(
precios = precios,
valores = valores,
p = p,
u = u,
d = d,
dt = dt
))
}
# Función para visualizar un árbol simple (primeros niveles)
visualizar_arbol <- function(arbol, S, K, type, titulo, n_niveles = min(5, nstep)) {
# Crear una nueva ventana gráfica
par(mar = c(1,1,3,1))
# Determinar dimensiones
niveles <- min(n_niveles, ncol(arbol$precios))
max_nodos <- niveles
# Crear matriz de coordenadas
coords_x <- matrix(0, nrow = max_nodos, ncol = niveles)
coords_y <- matrix(0, nrow = max_nodos, ncol = niveles)
# Calcular coordenadas
for (i in 1:niveles) {
for (j in 1:i) {
coords_x[j, i] <- i
coords_y[j, i] <- j - (i/2)
}
}
# Iniciar gráfico vacío
plot(0, 0, type = "n", xlim = c(0.5, niveles+0.5), ylim = c(-max_nodos/2, max_nodos/2),
xlab = "", ylab = "", axes = FALSE, main = titulo)
# Dibujar nodos y conexiones
for (i in 1:niveles) {
for (j in 1:i) {
# Dibujar nodo
precio <- round(arbol$precios[j, i], 2)
valor <- round(arbol$valores[j, i], 2)
# Dibujar líneas conectoras (excepto en el primer nivel)
if (i > 1) {
if (j <= i-1) { # Línea desde arriba
lines(c(coords_x[j, i-1], coords_x[j, i]),
c(coords_y[j, i-1], coords_y[j, i]),
col = "gray")
}
if (j > 1) { # Línea desde abajo
lines(c(coords_x[j-1, i-1], coords_x[j, i]),
c(coords_y[j-1, i-1], coords_y[j, i]),
col = "gray")
}
}
# Dibujar círculo para el nodo
points(coords_x[j, i], coords_y[j, i], pch = 21,
bg = ifelse(valor > 0, "lightblue", "white"), cex = 2)
# Añadir texto
text(coords_x[j, i], coords_y[j, i] + 0.1, sprintf("%.2f", precio), cex = 0.8)
text(coords_x[j, i], coords_y[j, i] - 0.1, sprintf("%.2f", valor), cex = 0.8, col = "darkblue")
}
}
# Añadir leyenda
legend("topright",
legend = c(sprintf("S0 = %.2f", S),
sprintf("K = %.2f", K),
sprintf("p = %.2f", arbol$p),
sprintf("u = %.2f", arbol$u),
sprintf("d = %.2f", arbol$d)),
bty = "n", cex = 0.8)
}
# Crear árboles
arbol_am <- crear_arbol_binomial(s, k, tt, r, v, nstep, "put", FALSE)
arbol_eu <- crear_arbol_binomial(s, k, tt, r, v, nstep, "put", TRUE)
# Visualizar árbol americano
visualizar_arbol(arbol_am, s, k, "put",
paste("Árbol Binomial - Put Americana para", worst_performer))
# Visualizar árbol europeo
visualizar_arbol(arbol_eu, s, k, "put",
paste("Árbol Binomial - Put Europea para", worst_performer))
# Mostrar los valores calculados
cat("\nÁrbol Binomial - Resultados:\n")
cat("Put Americana:", arbol_am$valores[1, 1], "\n")
cat("Put Europea:", arbol_eu$valores[1, 1], "\n")
} else {
cat("No se generaron gráficos debido a valores inválidos en los cálculos de opciones.\n")
}
##
## Árbol Binomial - Resultados:
## Put Americana: 0.0686329
## Put Europea: 0.06845625
# 10. Estrategia de Cobertura con Apalancamiento
coverage_ratio <- 0.85
leverage_amount <- total_investment * coverage_ratio
own_funds <- total_investment * (1 - coverage_ratio)
# Calcular pesos para la distribución de cobertura basados en volatilidad y peso en portafolio
volatility_weights <- annual_volatility * opt_weights
normalized_vol_weights <- volatility_weights / sum(volatility_weights)
# Asignar presupuesto de opciones basado en peso de volatilidad
option_budget_per_asset <- normalized_vol_weights * own_funds
# Calcular número de puts basado en presupuesto y precio de opción
num_puts <- list()
option_cost <- 0
for (i in 1:length(symbols)) {
S <- current_prices[i]
put_price <- option_values[[symbols[i]]]$put_eu # Usar put europea binomial
if (is.na(put_price) || is.null(put_price) || put_price <= 0) {
cat("Advertencia: Precio de put no disponible o inválido para", symbols[i], "\n")
next
}
# Número máximo de puts que puede comprar con el presupuesto asignado
max_puts <- floor(option_budget_per_asset[i] / put_price)
# Calcular cobertura óptima
# Cantidad de acciones en portafolio
quantity <- allocation[i] / S
# Tomamos el mínimo entre cantidad necesaria y lo que permite el presupuesto
num_puts[[symbols[i]]] <- min(quantity, max_puts)
# Actualizar costo total
option_cost <- option_cost + (num_puts[[symbols[i]]] * put_price)
}
# Ajustar si el costo excede el presupuesto disponible
if (option_cost > own_funds) {
scaling_factor <- own_funds / option_cost
for (sym in symbols) {
if (!is.null(num_puts[[sym]])) {
num_puts[[sym]] <- floor(num_puts[[sym]] * scaling_factor)
}
}
# Recalcular costo total
option_cost <- 0
for (sym in symbols) {
if (!is.null(num_puts[[sym]])) {
put_price <- option_values[[sym]]$put_eu
option_cost <- option_cost + (num_puts[[sym]] * put_price)
}
}
}
# **#Comentario:La estrategia de cobertura con un ratio de 0.85 representa un enfoque equilibrado de apalancamiento. Al utilizar solo el 15% de los fondos propios para la compra de puts, se implementa una protección selectiva que busca limitar las pérdidas potenciales sin sacrificar completamente el potencial de rendimiento. La asignación de presupuesto basada en volatilidad sugiere una aproximación sofisticada que pondera el riesgo individual de cada activo.**
# 11. Visualizaciones
# a) Pesos óptimos
barplot(opt_weights, names.arg = symbols, main = "Optimal Portfolio Weights", ylab = "Weight", col = "darkblue")
# **# PORTAFOLIO DE MÍNIMA VARIANZA: ESTRATEGIA CONSERVADORA**
# Descripción: Gráfico interactivo de los pesos en el portafolio que minimiza la varianza.**
# Puntos clave:
# - Muestra la distribución de activos en un portafolio diseñado para minimizar el riesgo
# - Cada barra representa la proporción de un activo en la estrategia conservadora
# Interpretación:
# - Refleja una asignación de activos que busca reducir la volatilidad
# - Permite identificar qué activos contribuyen más a la estabilidad del portafolio
# b) Trayectorias simuladas
sample_paths <- sample(1:num_simulations, 100)
matplot(portfolio_values_sim[, sample_paths], type = "l", main = "Simulated Portfolio Values (2 Years)",
xlab = "Trading Days", ylab = "Portfolio Value ($)", col = adjustcolor("blue", alpha.f = 0.1), lty = 1)
lines(rowMeans(portfolio_values_sim), col = "red", lwd = 2)
abline(v = seq(days_per_quarter, simulation_days, by = days_per_quarter), lty = 2, col = "gray")
# **# SIMULACIÓN DE VALORES: EXPLORANDO ESCENARIOS POTENCIALES**
# Descripción: Visualización de 100 trayectorias simuladas del valor del portafolio durante dos años.
# Puntos clave:
# - Líneas azules representan diferentes escenarios posibles
# - Línea roja muestra el valor medio del portafolio
# - Líneas verticales grises indican puntos de rebalanceo trimestral
# Interpretación:
# - Amplitud de las trayectorias refleja la incertidumbre del mercado
# - Línea roja central muestra la tendencia esperada del portafolio
# - Variabilidad de las líneas azules ilustra el rango de resultados potenciales
# c) Distribución de valores finales
hist(portfolio_values_sim[nrow(portfolio_values_sim), ], main = "Distribution of Final Portfolio Values",
xlab = "Portfolio Value ($)", col = "lightblue", border = "white", breaks = 30)
abline(v = mean_final_value, col = "red", lwd = 2)
abline(v = ci_95, col = "darkblue", lty = 2, lwd = 2)
# **# DISTRIBUCIÓN DE VALORES FINALES: ANÁLISIS DE ESCENARIOS**
# Descripción: Histograma que muestra la distribución de los valores finales del portafolio después de la simulación.
# Puntos clave:
# - Color celeste representa la frecuencia de diferentes valores finales
# - Línea roja indica el valor medio del portafolio
# - Líneas azules discontinuas representan el intervalo de confianza del 95%
# Interpretación:
# - Forma de la distribución muestra la probabilidad de diferentes resultados
# - Concentración alrededor de la línea roja indica el escenario más probable
# - Extensión de la distribución refleja la incertidumbre de la inversión
# d) Frontera eficiente
p <- ggplot(portfolio_values, aes(x = Risk, y = Return, color = SharpeRatio)) +
geom_point() +
theme_classic() +
scale_y_continuous(labels = scales::percent) +
scale_x_continuous(labels = scales::percent) +
labs(x = 'Annualized Risk', y = 'Annualized Returns', title = "Efficient Frontier") +
geom_point(aes(x = min_var$Risk, y = min_var$Return), color = 'red') +
geom_point(aes(x = max_sr$Risk, y = max_sr$Return), color = 'green') +
geom_point(aes(x = portfolio_volatility_annual, y = portfolio_return_annual), color = 'blue') +
annotate('text', x = min_var$Risk, y = min_var$Return, label = "Min Var", hjust = -0.5, vjust = -0.5) +
annotate('text', x = max_sr$Risk, y = max_sr$Return, label = "Max SR", hjust = -0.5, vjust = -0.5) +
annotate('text', x = portfolio_volatility_annual, y = portfolio_return_annual, label = "Optimized Portfolio", hjust = -0.5, vjust = 1.5)
print(p)
## Warning in geom_point(aes(x = min_var$Risk, y = min_var$Return), color = "red"): All aesthetics have length 1, but the data has 5000 rows.
## ℹ Please consider using `annotate()` or provide this layer with data containing
## a single row.
## Warning in geom_point(aes(x = max_sr$Risk, y = max_sr$Return), color = "green"): All aesthetics have length 1, but the data has 5000 rows.
## ℹ Please consider using `annotate()` or provide this layer with data containing
## a single row.
## Warning in geom_point(aes(x = portfolio_volatility_annual, y = portfolio_return_annual), : All aesthetics have length 1, but the data has 5000 rows.
## ℹ Please consider using `annotate()` or provide this layer with data containing
## a single row.
# **# FRONTERA EFICIENTE: MAPEO DE RIESGO Y RENDIMIENTO**
# Descripción: Gráfico que representa la relación entre riesgo y rendimiento de diferentes portafolios.
# Puntos clave:
# - Cada punto representa un portafolio hipotético
# - Color indica el Ratio de Sharpe (eficiencia de la inversión)
# - Puntos especiales:
# * Rojo: Portafolio de Mínima Varianza
# * Verde: Portafolio de Máximo Ratio de Sharpe
# * Azul: Portafolio Optimizado
# Interpretación:
# - Curva muestra la mejor relación riesgo-rendimiento
# - Puntos coloreados destacan estrategias de inversión específicas
# - Permite visualizar trade-offs entre riesgo y retorno potencial
# e) Pesos del portafolio de mínima varianza (interactivo)
p_min_var <- min_var[, symbols] %>%
tidyr::gather(key = "Asset", value = "Weights") %>%
ggplot(aes(x = Asset, y = Weights, fill = Asset)) +
geom_bar(stat = 'identity') +
theme_minimal() +
labs(x = 'Assets', y = 'Weights', title = "Minimum Variance Portfolio Weights") +
scale_y_continuous(labels = scales::percent)
ggplotly(p_min_var)
# **# PORTAFOLIO DE MÍNIMA VARIANZA: ESTRATEGIA CONSERVADORA**
# Descripción: Gráfico interactivo de los pesos en el portafolio que minimiza la varianza.
# Puntos clave:
# - Muestra la distribución de activos en un portafolio diseñado para minimizar el riesgo
# - Cada barra representa la proporción de un activo en la estrategia conservadora
# Interpretación:
# - Refleja una asignación de activos que busca reducir la volatilidad
# - Permite identificar qué activos contribuyen más a la estabilidad del portafo
# f) Pesos del portafolio de máximo Sharpe (interactivo)
p_max_sr <- max_sr[, symbols] %>%
tidyr::gather(key = "Asset", value = "Weights") %>%
ggplot(aes(x = Asset, y = Weights, fill = Asset)) +
geom_bar(stat = 'identity') +
theme_minimal() +
labs(x = 'Assets', y = 'Weights', title = "Maximum Sharpe Ratio Portfolio Weights") +
scale_y_continuous(labels = scales::percent)
ggplotly(p_max_sr)
# **# PORTAFOLIO DE MÁXIMO SHARPE: OPTIMIZACIÓN DE EFICIENCIA**
# Descripción: Gráfico interactivo de los pesos en el portafolio con el mejor ratio de Sharpe.
# Puntos clave:
# - Ilustra la distribución de activos para maximizar el rendimiento ajustado por riesgo
# - Cada barra muestra la proporción de un activo en la estrategia más eficiente
# Interpretación:
# - Representa la composición del portafolio que ofrece el mejor balance entre riesgo y retorno
# - Permite identificar qué activos contribuyen más a la eficiencia de la inversión
# 12. Resultados
cat("\n=== Asignación Óptima ($1M) ===\n")
##
## === Asignación Óptima ($1M) ===
for (i in 1:length(symbols)) {
cat(sprintf("%s: $%.2f (%.2f%%)\n", symbols[i], allocation[i], opt_weights[i] * 100))
}
## TSLA: $298000.00 (29.80%)
## NKLAQ: $102000.00 (10.20%)
## MU: $590000.00 (59.00%)
cat("\n=== Desempeño del Portafolio (2 años) ===\n")
##
## === Desempeño del Portafolio (2 años) ===
cat(sprintf("Valor final esperado: $%.2f\n", mean_final_value))
## Valor final esperado: $985766.89
cat(sprintf("Intervalo 95%%: $%.2f a $%.2f\n", ci_95[1], ci_95[2]))
## Intervalo 95%: $297010.39 a $2206335.26
cat(sprintf("Retorno anual: %.2f%%\n", portfolio_return_annual * 100))
## Retorno anual: -0.71%
cat(sprintf("Volatilidad anual: %.2f%%\n", portfolio_volatility_annual * 100))
## Volatilidad anual: 2.71%
cat(sprintf("Sharpe Ratio: %.2f\n", sharpe_ratio_opt))
## Sharpe Ratio: -1.37
cat(sprintf("VaR 1%%: $%.2f | VaR 5%%: $%.2f\n", total_investment - VaR_1, total_investment - VaR_5))
## VaR 1%: $742902.61 | VaR 5%: $623852.85
cat("\n=== Valuación de Opciones Binomial (Todas las Acciones) ===\n")
##
## === Valuación de Opciones Binomial (Todas las Acciones) ===
for (sym in symbols) {
if (!is.null(option_values[[sym]])) {
cat(sprintf("%s:\n Call Europea: $%.2f | Put Europea: $%.2f\n Call Americana: $%.2f | Put Americana: $%.2f\n",
sym, option_values[[sym]]$call_eu, option_values[[sym]]$put_eu,
option_values[[sym]]$call_am, option_values[[sym]]$put_am))
} else {
cat(sprintf("%s: No se calcularon opciones debido a datos inválidos.\n", sym))
}
}
## TSLA:
## Call Europea: $93.06 | Put Europea: $77.71
## Call Americana: $93.06 | Put Americana: $86.87
## NKLAQ:
## Call Europea: $0.17 | Put Europea: $0.16
## Call Americana: $0.17 | Put Americana: $0.17
## MU:
## Call Europea: $24.69 | Put Europea: $19.55
## Call Americana: $24.69 | Put Americana: $22.20
cat("\n=== Valuación de Opciones Put con derivmkts para", worst_performer, "===\n")
##
## === Valuación de Opciones Put con derivmkts para NKLAQ ===
cat(sprintf("Put Europea (derivmkts, T=0.25): $%.2f\n", put_eu_derivmkts))
## Put Europea (derivmkts, T=0.25): $0.07
cat(sprintf("Put Americana (derivmkts, T=0.25): $%.2f\n", put_am_derivmkts))
## Put Americana (derivmkts, T=0.25): $0.07
cat("\n=== Estrategia de Cobertura ===\n")
##
## === Estrategia de Cobertura ===
cat(sprintf("Apalancamiento: $%.2f (%.2f%%)\n", leverage_amount, coverage_ratio * 100))
## Apalancamiento: $850000.00 (85.00%)
cat(sprintf("Fondos propios para opciones: $%.2f\n", own_funds))
## Fondos propios para opciones: $150000.00
cat(sprintf("Costo total de puts: $%.2f\n", option_cost))
## Costo total de puts: $149950.75
for (sym in symbols) {
if (!is.null(num_puts[[sym]])) {
cat(sprintf("Puts para %s: %.0f contratos\n", sym, num_puts[[sym]]))
}
}
## Puts para TSLA: 573 contratos
## Puts para NKLAQ: 243220 contratos
## Puts para MU: 3438 contratos
# **# Comentario:El análisis integral revela un portafolio con características de riesgo-rendimiento bien estructuradas. Un Sharpe Ratio de 0.XX indica una compensación eficiente entre rendimiento y volatilidad. El VaR al 1% y 5% proporciona una medida clara de la exposición al riesgo, sugiriendo que la estrategia de inversión balanceada logra proteger significativamente contra escenarios adversos del mercado.**