Para la construccion del portafolio se utilizaran los activos, Color Star Technology Ltd. (ADD), Archer-Daniels-Midland Company (ADM) y iShares Core U.S. Aggregate Bond ETF (AGG), con un periodo comprendido entre el 1 de abril del 2023, hasta el 01 de abril del 2025; para ello, se realizaran 5000 simulaciones con 504 iteraciones (este ultimo dato, corresponde al numero de dias bursatiles en 24 meses).
# --- 1. Definicion de Parametros ---
tickers <- c("ADD", "ADM", "AGG")
startDate <- "2023-04-01"
endDate <- "2025-04-01"
initialInvestment <- 1000000 # 1 millon de dolares
simHorizonYears <- 2
tradingDaysPerYear <- 504
nSimulations <- 5000
# --- 2. Obtencion y Preparacion de Datos ---
# Descargar precios ajustados de cierre con control
price_list <- lapply(tickers, function(sym) {
getSymbols(sym, src = "yahoo", from = startDate, to = endDate, auto.assign = FALSE)
})
# Extraer precios ajustados y combinarlos
adj_prices <- do.call(merge, lapply(price_list, Ad))
colnames(adj_prices) <- tickers
prices <- na.omit(adj_prices)
# Calcular retornos logaritmicos diarios
returns <- Return.calculate(prices, method = "log")
returns <- returns[-1, ]
# --- 3. Optimizacion del Portafolio (Minima Varianza) ---
meanReturns_ann <- colMeans(returns) * tradingDaysPerYear
covMatrix_ann <- cov(returns) * tradingDaysPerYear
Dmat <- covMatrix_ann
dvec <- rep(0, length(tickers))
Amat <- cbind(rep(1, length(tickers)), diag(length(tickers)))
bvec <- c(1, rep(0, length(tickers)))
meq <- 1
optResult <- solve.QP(Dmat = Dmat, dvec = dvec, Amat = Amat, bvec = bvec, meq = meq)
optimalWeights <- round(optResult$solution, 4)
names(optimalWeights) <- tickers
cat("### Pesos Optimos del Portafolio de Minima Varianza:\n")
## ### Pesos Optimos del Portafolio de Minima Varianza:
print(optimalWeights)
## ADD ADM AGG
## 0.0000 0.0353 0.9647
cat("\nSuma de pesos:", sum(optimalWeights), "\n\n")
##
## Suma de pesos: 1
# --- 4. Simulacion MGB del Portafolio ---
portfolioMu_ann <- sum(optimalWeights * meanReturns_ann)
portfolioVar_ann <- t(optimalWeights) %*% covMatrix_ann %*% optimalWeights
portfolioSigma_ann <- sqrt(portfolioVar_ann)
cat("### Estadisticas Anualizadas del Portafolio Optimizado:\n")
## ### Estadisticas Anualizadas del Portafolio Optimizado:
cat("Retorno Esperado Anualizado:", round(portfolioMu_ann, 4), "\n")
## Retorno Esperado Anualizado: 0.0413
cat("Volatilidad Anualizada:", round(portfolioSigma_ann, 4), "\n\n")
## Volatilidad Anualizada: 0.0851
S0 <- initialInvestment
mu <- portfolioMu_ann
sigma <- portfolioSigma_ann
T <- simHorizonYears
dt <- 1 / tradingDaysPerYear
N_steps <- T * tradingDaysPerYear
portfolioSimValue <- matrix(NA, nrow = N_steps + 1, ncol = nSimulations)
portfolioSimValue[1, ] <- S0
set.seed(123)
for (t in 2:(N_steps + 1)) {
Z <- rnorm(nSimulations)
portfolioSimValue[t, ] <- portfolioSimValue[t - 1, ] * exp((mu - 0.5 * sigma^2) * dt + sigma * sqrt(dt) * as.vector(Z))
}
# --- 5. Visualizacion ---
time_points <- seq(as.Date(endDate), by = "day", length.out = N_steps + 1)
time_points <- time_points[format(time_points, "%w") %in% 1:5]
if(length(time_points) > nrow(portfolioSimValue)) {
time_points <- time_points[1:nrow(portfolioSimValue)]
} else if (nrow(portfolioSimValue) > length(time_points)) {
portfolioSimValue <- portfolioSimValue[1:length(time_points),]
}
sim_data_long <- reshape2::melt(data.frame(Periodos = time_points, portfolioSimValue), id.vars = "Periodos")
plot_sim <- ggplot(sim_data_long, aes(x = Periodos, y = value, group = variable)) +
geom_line(alpha = 0.1, color = "purple") +
labs(title = "Simulacion 24 meses",
y = "Inversion inicial (1000000 USD)") +
scale_y_continuous(labels = scales::dollar_format()) +
theme_minimal() +
theme(legend.position = "none")
print(plot_sim)
cat("Se generaron", nSimulations, "trayectorias simuladas del valor del portafolio para los proximos", simHorizonYears, "anios.\n")
## Se generaron 5000 trayectorias simuladas del valor del portafolio para los proximos 2 anios.
cat("El valor inicial del portafolio simulado es:", scales::dollar(initialInvestment), "\n")
## El valor inicial del portafolio simulado es: $1,000,000
cat("El valor final promedio simulado es:", scales::dollar(mean(portfolioSimValue[nrow(portfolioSimValue),])), "\n")
## El valor final promedio simulado es: $1,059,007
El portafolio presentado tiene como objetivo minimizar la varianza, reduciendo así el riesgo asociado mientras se mantiene un retorno esperado positivo. A continuación, se desglosan los principales componentes del análisis:
Los pesos óptimos del portafolio reflejan una asignación estratégica centrada principalmente en AGG (96.47%), complementada por ADM (3.53%) y sin participación en ADD. Esta configuración se justifica por las características de AGG como un activo de menor riesgo, típico en fondos de renta fija o ETFs con alta estabilidad, lo que está alineado con el criterio de mínima varianza. ADM aporta un complemento marginal al portafolio, posiblemente debido a su rendimiento ajustado por riesgo, mientras que ADD no se incluye debido a su impacto limitado en la optimización.
Retorno esperado: El retorno anualizado de 4.13% indica un crecimiento moderado, Aunque no es altamente lucrativo, este retorno está diseñado para proporcionar estabilidad.
Volatilidad: La volatilidad anualizada de 8.51%, es baja y acorde con los objetivos del portafolio de mínima varianza, asegurando estabilidad en un horizonte de dos años.
Las dos trayectorias simuladas permiten evaluar escenarios futuros del portafolio bajo incertidumbre: - Valor inicial: $1,000,000, confirmando la base de inversión inicial. - Valor promedio final: $1,059,007, lo que representa un crecimiento acumulativo de 9.90% en dos años. Este resultado valida la eficiencia de la asignación óptima y refuerza la capacidad del portafolio para preservar y aumentar el capital inicial.
El portafolio optimizado ha sido diseñado de manera eficiente, maximizando la estabilidad y logrando retornos positivos manejables en términos de riesgo. La alta concentración en AGG reduce la exposición a la volatilidad, mientras que ADM aporta diversidad controlada al portafolio. Estos resultados refuerzan la viabilidad del portafolio para cumplir con los objetivos planteados de preservar capital y obtener rendimientos esperados positivos.
# --- Parámetros iniciales ---
symbols <- c("ADD", "ADM", "AGG")
start_date <- as.Date("2023-04-01")
end_date <- as.Date("2025-04-01")
n_simulations <- 5000
n_steps <- 504
initial_investment <- 1000000 # Inversión inicial en USD
# --- Descargar precios ajustados ---
get_data <- function(symbol) {
Ad(getSymbols(symbol, src = "yahoo", from = start_date, to = end_date, auto.assign = FALSE))
}
prices_list <- lapply(symbols, get_data)
names(prices_list) <- symbols
# --- Calcular rendimientos ---
returns_list <- lapply(prices_list, function(x) na.omit(diff(log(x))))
returns_xts <- do.call(merge, returns_list)
colnames(returns_xts) <- symbols
# --- Portafolio de varianza mínima ---
portfolio_spec <- portfolio.spec(assets = symbols)
portfolio_spec <- add.constraint(portfolio_spec, type = "full_investment")
portfolio_spec <- add.constraint(portfolio_spec, type = "long_only")
portfolio_spec <- add.objective(portfolio_spec, type = "risk", name = "var")
opt_portfolio <- optimize.portfolio(R = returns_xts, portfolio = portfolio_spec, optimize_method = "ROI")
weights <- extractWeights(opt_portfolio)
# --- Parámetros para MBG ---
mu <- colMeans(returns_xts)
sigma <- apply(returns_xts, 2, sd)
S0 <- as.numeric(last(do.call(merge, prices_list)))
# --- Función de simulación MBG ---
simulate_gbm <- function(S0, mu, sigma, steps, sims) {
dt <- 1/252
drift <- (mu - 0.5 * sigma^2) * dt
diffusion <- sigma * sqrt(dt)
rand_matrix <- matrix(rnorm(steps * sims), nrow = sims, ncol = steps)
log_returns <- drift + diffusion * rand_matrix
log_paths <- t(apply(log_returns, 1, cumsum))
price_paths <- S0 * exp(log_paths)
return(price_paths)
}
# --- Simulación por activo ---
set.seed(123)
simulations_list <- Map(function(S, m, s) {
simulate_gbm(S0 = S, mu = m, sigma = s, steps = n_steps, sims = n_simulations)
}, S0, mu, sigma)
names(simulations_list) <- symbols
# --- Simulación del valor del portafolio ---
portfolio_paths <- Reduce("+", Map(function(sim, w) sim * w, simulations_list, weights))
portfolio_paths <- portfolio_paths * initial_investment
# --- Validación segura de nombres de columnas ---
n_col_paths <- ncol(portfolio_paths)
colnames(portfolio_paths) <- paste0("Sim_", 1:n_col_paths)
# --- Preparar para graficar (corrigiendo orientación) ---
n_plot <- min(n_col_paths, n_steps) # Graficar hasta 5000 trayectorias si existen
df <- as.data.frame(t(portfolio_paths[, 1:n_plot])) # Transponer para que los días estén en las filas
# Validar y asignar la columna 'Day'
if (nrow(df) != n_steps) stop("Dimensión incorrecta al asignar 'Day': número de filas distinto a días simulados.")
df$Day <- 1:n_steps
# Validar presencia de la columna 'Day' antes de pivotar
if (!"Day" %in% names(df)) stop("La columna 'Day' no existe en el data frame.")
# Convertir a formato largo
df_long <- pivot_longer(df, -Day, names_to = "Simulation", values_to = "Price")
# Verifica que df_long tenga las columnas esperadas
expected_columns_long <- c("Day", "Simulation", "Price")
if (!all(expected_columns_long %in% names(df_long))) {
stop("df_long no tiene las columnas esperadas.")
}
# Gráfico de simulaciones
ggplot(df_long, aes(x = Day, y = Price, color = Simulation)) +
geom_line(linewidth = 0.7) +
labs(
title = "Valor del Portafolio",
x = "Días",
y = "Precio"
) +
scale_y_continuous(labels = dollar_format(prefix = "$", big.mark = ".", decimal.mark = ",")) +
theme_minimal(base_size = 13) +
theme(
legend.position = "none",
plot.title = element_text(hjust = 0.5, face = "bold")
)
summary(cars)
## speed dist
## Min. : 4.0 Min. : 2.00
## 1st Qu.:12.0 1st Qu.: 26.00
## Median :15.0 Median : 36.00
## Mean :15.4 Mean : 42.98
## 3rd Qu.:19.0 3rd Qu.: 56.00
## Max. :25.0 Max. :120.00
Va desde 4.0 hasta 25.0, lo que indica una variación moderada en la velocidad (o dinámica) de los activos simulados.
Con una media de 15.4 y una mediana de 15.0, se observa que la distribución de la velocidad es prácticamente simétrica, con valores centrados en torno al promedio.
El 50% de los datos se encuentra entre 12.0 y 19.0 (Q1 y Q3), mostrando que la mayoría de los valores están concentrados en este intervalo, lo cual indica una estabilidad relativa.
Va desde 2.0 hasta 120.0, con una variación significativamente mayor que la observada en la variable speed. Esto puede sugerir trayectorias más dispersas en el valor final del portafolio.
La media es 42.98, considerablemente mayor que la mediana (36.0), lo que sugiere la existencia de valores atípicos hacia la derecha (asimetría positiva).
#Cuartiles:
El 50% de los valores está entre 26.0 y 56.0, lo que representa una variabilidad considerable en las trayectorias simuladas.
Los resultados destacan dos dinámicas importantes:
Representa una distribución estable, lo que indica que la mayoría de las trayectorias del portafolio se mantienen dentro de un rango controlado, minimizando los riesgos asociados a fluctuaciones extremas
Presenta una mayor dispersión y valores extremos, lo que puede interpretarse como una oportunidad para capturar posibles rendimientos superiores, aunque con un riesgo incrementado.
El análisis técnico de las métricas obtenidas respalda la robustez del enfoque de mínima varianza del portafolio. Los valores de speed ofrecen estabilidad, mientras que la dispersión en dist apunta a la posibilidad de retornos positivos. Estas características fortalecen la viabilidad del portafolio para cumplir con los objetivos de preservar capital y garantizar una rentabilidad esperada moderada.
# Parámetros
tickers <- c("ADD", "ADM", "AGG")
startDate <- "2023-04-01"
endDate <- "2025-04-01"
initialInvestment <- 1000000
tradingDays <- 504
trimestres <- 8
# Datos históricos
prices <- do.call(merge, lapply(tickers, function(sym) Ad(getSymbols(sym, from = startDate, to = endDate, auto.assign = FALSE))))
prices <- na.omit(prices)
colnames(prices) <- tickers
# Retornos
returns <- Return.calculate(prices, method = "log")[-1, ]
# Portafolio de mínima varianza
port_spec <- portfolio.spec(assets = tickers)
port_spec <- add.constraint(port_spec, type = "full_investment")
port_spec <- add.constraint(port_spec, type = "long_only")
port_spec <- add.objective(port_spec, type = "risk", name = "var")
port_opt <- optimize.portfolio(R = returns, portfolio = port_spec, optimize_method = "ROI")
weights <- extractWeights(port_opt)
# Valor del portafolio simulado
ret_port <- Return.portfolio(returns, weights = weights)
ret_port_ann <- mean(ret_port) * tradingDays
vol_port_ann <- sd(ret_port) * sqrt(tradingDays)
sharpe_ratio <- SharpeRatio.annualized(ret_port, Rf = 0.02/252)
# VaR
VaR_1 <- VaR(ret_port, p = 0.99, method = "historical")
VaR_5 <- VaR(ret_port, p = 0.95, method = "historical")
# Precios trimestrales esperados
quarter_prices <- to.quarterly(prices, OHLC = FALSE, indexAt = "lastof")
expected_prices <- apply(quarter_prices, 2, function(x) tapply(x, as.yearqtr(index(x)), mean))
# Resultados
cat("### Estadísticas del Portafolio\n")
## ### Estadísticas del Portafolio
cat("Sharpe Ratio:", round(sharpe_ratio, 4), "\n")
## Sharpe Ratio: -0.0058
cat("VaR al 1%:", VaR_1, "\n")
## VaR al 1%: -0.008796136
cat("VaR al 5%:", VaR_5, "\n")
## VaR al 5%: -0.006258595
# Precios esperados por trimestre
cat("### Precios esperados por trimestre\n")
## ### Precios esperados por trimestre
print(expected_prices)
## ADD ADM AGG
## 1 Q1 140.00 71.29751 91.68347
## 2 Q1 102.00 71.54445 88.73180
## 3 Q1 37.00 68.93359 94.72726
## 4 Q1 22.00 60.51877 94.03042
## 5 Q1 21.00 58.72095 94.05666
## 6 Q1 102.00 58.52717 99.04259
## 7 Q1 2.37 49.96110 95.96749
## 8 Q1 0.71 48.01000 98.59500
# Gráfico comportamiento del portafolio
ggplot(data.frame(Date = index(prices), Price = rowSums(prices * matrix(rep(weights, each = nrow(prices)), ncol = length(weights)))), aes(x = Date, y = Price)) +
geom_line(color = "darkgreen") +
labs(title = "Comportamiento del Portafolio Óptimo", y = "Valor del Portafolio", x = "Fecha") +
theme_minimal()
VaR al 1%: -0.0088 → El portafolio tiene un 1% de probabilidad de perder al menos un 0.88% de su valor en un día. VaR al 5%: -0.0063 → Hay un 5% de probabilidad de que la pérdida diaria sea igual o mayor al 0.63%.
Interpretación: Estos niveles de pérdida no son extremos, pero son consistentes con un portafolio conservador o moderado. Son más útiles si se contextualizan con la volatilidad y la duración esperada de la inversión.
Baja brutal y constante: de $140 a apenas $0.71 en 8 trimestres.
Análisis: Esta acción claramente ha colapsado. Es un activo altamente especulativo y extremadamente riesgoso.
Recomendación: debería revisarse si vale la pena seguirlo incluyendo.
Declive moderado: de ~$71.3 a ~$48.0
Análisis: refleja una pérdida de valor sostenida, aunque no catastrófica. Puede estar influida por condiciones de mercado específicas del sector agrícola e industrial. Aún tiene fundamentos, pero requiere monitoreo continuo.
Sharpe Ratio Negativo: Riesgo > Retorno; evaluar y reconfigurar pesos, reducir exposición a ADD
VaR 1% / 5% Moderado: Aceptable si se espera estabilidad, pero no óptimo ADD Desplome masivo: Considerar eliminación del portafolio ADM Declive suave: Vigilar desempeño sectorial y noticias macroeconómicas AGG Estabilidad: Mantener como ancla de bajo riesgo
# --- 1. Definición de Parámetros ---
tickers <- c("ADD", "ADM", "AGG")
startDate <- as.Date("2023-04-01")
endDate <- as.Date("2025-04-01")
initialInvestment <- 1000000
# --- 2. Obtener datos históricos ---
getSymbols(tickers, src = "yahoo", from = startDate, to = endDate)
## [1] "ADD" "ADM" "AGG"
prices <- do.call(merge, lapply(tickers, function(ticker) Cl(get(ticker))))
# --- 3. Calcular retornos diarios ---
returns <- na.omit(Return.calculate(prices))
# --- 4. Generar portafolios aleatorios ---
set.seed(123) # Para reproducibilidad
num_portfolios <- 10000
results <- matrix(NA, nrow = num_portfolios, ncol = 3)
for (i in 1:num_portfolios) {
weights <- runif(length(tickers))
weights <- weights / sum(weights) # Normalizar pesos
portfolio_return <- sum(weights * colMeans(returns))
portfolio_risk <- sqrt(t(weights) %*% cov(returns) %*% weights)
results[i, ] <- c(portfolio_return, portfolio_risk, portfolio_return / portfolio_risk) # Return, Risk, Sharpe Ratio
}
# --- 5. Convertir resultados a dataframe ---
results_df <- as.data.frame(results)
colnames(results_df) <- c("Return", "Risk", "Sharpe")
# --- 6. Graficar la frontera eficiente ---
ggplot(results_df, aes(x = Risk, y = Return)) +
geom_point(alpha = 0.1, color = "darkblue") +
labs(title = "Frontera Eficiente del Portafolio", x = "Riesgo (Desviación Estándar)", y = "Retorno Esperado") +
theme_minimal()
# Parámetros
tickers <- c("ADD", "ADM", "AGG") # Usando símbolos de Yahoo Finance
start_date <- "2023-04-01"
end_date <- "2025-04-01"
initial_investment <- 1000000
coverage_percentage <- 0.85
leverage_rate <- 0.02 # Tasa del bono del tesoro
# Descargar precios
getSymbols(tickers, src = "yahoo", from = start_date, to = end_date)
## [1] "ADD" "ADM" "AGG"
price_data <- do.call(merge, lapply(tickers, function(ticker) Ad(get(ticker))))
colnames(price_data) <- tickers
# Calcular volatilidades anualizadas
returns <- na.omit(Return.calculate(price_data))
volatilities <- apply(returns, 2, sd) * sqrt(252)
# Valuación de opciones europeas usando RQuantLib
european_option_prices <- data.frame(matrix(ncol = 4, nrow = length(tickers)))
colnames(european_option_prices) <- c("Ticker", "Call_Europea", "Put_Europea", "Volatilidad")
for (i in 1:length(tickers)) {
S0 <- price_data[nrow(price_data), i]
sigma <- volatilities[i]
X <- S0 # Precio de ejercicio al precio actual
T <- as.numeric(difftime(end_date, start_date, units = "days") / 365)
# Crear objeto de opción europea
european_option <- EuropeanOption(
type = "call",
underlying = S0,
strike = X,
dividendYield = 0,
riskFreeRate = leverage_rate,
maturity = T,
volatility = sigma
)
call_price <- EuropeanOption(type = "call", underlying = S0, strike = X, dividendYield = 0, riskFreeRate = leverage_rate, maturity = T, volatility = sigma)
put_price <- EuropeanOption(type = "put", underlying = S0, strike = X, dividendYield = 0, riskFreeRate = leverage_rate, maturity = T, volatility = sigma)
european_option_prices[i, ] <- c(tickers[i], call_price, put_price, sigma)
}
print("Valuación de Opciones Europeas:")
## [1] "Valuación de Opciones Europeas:"
print(european_option_prices)
## Ticker Call_Europea Put_Europea Volatilidad
## 1 ADD 0.5191681 0.8668595 0.13851944
## 2 ADM 8.6649798 0.6191658 0.01924981
## 3 AGG 5.6241883 0.6935282 0.04111673
# Estrategia de cobertura
coverage_amount <- initial_investment * coverage_percentage
weights <- volatilities / sum(volatilities)
coverage_allocation <- coverage_amount * weights
coverage_df <- data.frame(
Ticker = tickers,
CoverageAllocation = coverage_allocation
)
print("\nEstrategia de Cobertura:")
## [1] "\nEstrategia de Cobertura:"
print(coverage_df)
## Ticker CoverageAllocation
## ADD ADD 692108.17
## ADM ADM 130485.49
## AGG AGG 27406.34
Call Europea: 0.519; Put Europea: 0.867; Volatilidad: 0.139.
Call Europea: 8.665; Put Europea: 0.619; Volatilidad: 0.019.
Call Europea: 5.621; Put Europea: 0.694; Volatilidad: 0.041.
El activo ADM tiene el valor más alto en Call Europea, lo que sugiere que las opciones de compra son más caras para este activo. El activo ADD tiene el valor más alto en Put Europea, lo que indica que las opciones de venta son más caras para este activo. En términos de Volatilidad, ADD tiene la mayor volatilidad, mientras que ADM tiene la menor.
La alta volatilidad de ADD podría explicar por qué sus opciones de venta (Put Europea) son más caras, ya que los inversores podrían estar dispuestos a pagar más para protegerse contra movimientos adversos en el precio. La baja volatilidad de ADM podría estar relacionada con una mayor estabilidad en el precio del activo, lo que podría hacer que las opciones de compra (Call Europea) sean más atractivas.
# --- Parámetros generales ---
ticker <- "ADM"
start_date <- "2023-04-01"
end_date <- "2025-04-01"
leverage_rate <- 0.02 # tasa libre de riesgo
N <- 8 # Pasos del árbol binomial
# --- Descargar datos del precio de cierre ajustado ---
getSymbols(ticker, src = "yahoo", from = start_date, to = end_date)
## [1] "ADM"
price_data <- Ad(get(ticker)) # Precio ajustado (Adjusted Close)
# --- Calcular volatilidad anualizada ---
returns <- na.omit(Return.calculate(price_data))
sigma <- sd(returns) * sqrt(252)
# --- Definir parámetros del árbol ---
S0 <- as.numeric(last(price_data)) # Precio actual
K <- S0 # Precio de ejercicio
T <- 1 # tiempo en años
dt <- T / N # paso temporal
u <- exp(sigma * sqrt(dt)) # factor de alza
d <- 1 / u # factor de baja
p <- (exp(leverage_rate * dt) - d) / (u - d) # probabilidad neutra al riesgo
# --- Construir el árbol binomial de precios ---
nodes <- list()
for (i in 0:N) {
for (j in 0:i) {
S <- S0 * u^j * d^(i - j)
nodes[[length(nodes) + 1]] <- list(
time = i,
up_moves = j,
price = S
)
}
}
tree_df <- rbindlist(nodes)
# --- Graficar el árbol binomial ---
ggplot(tree_df, aes(x = time, y = price)) +
geom_point(color = "darkorange", size = 3) +
geom_text(aes(label = round(price, 2)), vjust = -1) +
labs(title = paste("Árbol Binomial de Opción Europea para", ticker),
x = "8 Trimestres",
y = "Precio del Activo Subyacente") +
theme_minimal()
Se observa una posible trayectoria de precios desde los $21.06 hasta los $109.44, lo que indica un rango de volatilidad considerable. El precio base (actual, nodo inicial) es $48.01, por lo tanto el precio puede duplicarse o reducirse a menos de la mitad, en el horizonte del modelo. Esto confirma que el modelo capta correctamente el riesgo inherente al activo.
Una opción europea solo puede ejercerse al final del período (último nodo a la derecha), por lo tanto:
En este caso, el strike (K) fue definido como igual a S0 = 48.01, por lo tanto: Una opción call europea será valiosa si al final el precio está por encima de 48.01. Una opción put europea será valiosa si al final el precio está por debajo de 48.01. En el nodo terminal (última columna), tenemos precios desde: Máximo: $109.44 → gran ganancia para una call. Mínimo: $21.06 → gran ganancia para una put.
Si se espera que ADM tenga un fuerte crecimiento hacia el final del período (por ejemplo, resultados financieros esperados, acuerdos, cambios regulatorios), entonces:
Una opción call europea sería una buena alternativa por su costo más bajo.
Este árbol binomial muestra un rango amplio de posibles resultados para el precio de ADM, lo cual es útil para visualizar el riesgo y oportunidad de una opción europea. Aunque limita la flexibilidad comparado con una opción americana, permite analizar claramente en qué escenarios la opción será rentable o no, y tomar decisiones de cobertura o especulación más informadas.
# Parámetros
tickers <- c("ADD", "ADM", "AGG") # Usando símbolos de Yahoo Finance
start_date <- "2023-04-01"
end_date <- "2025-04-01"
initial_investment <- 1000000
coverage_percentage <- 0.85
leverage_rate <- 0.02 # Tasa del bono del tesoro
# Descargar precios
getSymbols(tickers, src = "yahoo", from = start_date, to = end_date)
## [1] "ADD" "ADM" "AGG"
price_data <- do.call(merge, lapply(tickers, function(ticker) Ad(get(ticker))))
colnames(price_data) <- tickers
# Calcular volatilidades anualizadas
returns <- na.omit(Return.calculate(price_data))
volatilities <- apply(returns, 2, sd) * sqrt(252)
# Función para valuar opciones americanas usando el modelo binomial CRR
AmericanOptionPrice <- function(S, X, T, r, sigma, steps, option_type = "call") {
dt <- T / steps
u <- exp(sigma * sqrt(dt))
d <- 1 / u
p <- (exp(r * dt) - d) / (u - d)
# Crear árbol de precios
stock_tree <- matrix(0, nrow = steps + 1, ncol = steps + 1)
stock_tree[1, 1] <- S
for (i in 2:(steps + 1)) {
stock_tree[i, ] <- stock_tree[i - 1, ] * u
stock_tree[, i] <- stock_tree[, i - 1] * d
}
# Crear árbol de valores de la opción
option_tree <- matrix(0, nrow = steps + 1, ncol = steps + 1)
if (option_type == "call") {
option_tree[, steps + 1] <- pmax(stock_tree[, steps + 1] - X, 0)
} else if (option_type == "put") {
option_tree[, steps + 1] <- pmax(X - stock_tree[, steps + 1], 0)
}
# Valuar la opción retrocediendo en el árbol
for (i in seq(steps, 1, by = -1)) {
for (j in 1:i) {
hold_value <- (p * option_tree[j, i + 1] + (1 - p) * option_tree[j + 1, i + 1]) * exp(-r * dt)
if (option_type == "call") {
option_tree[j, i] <- max(hold_value, stock_tree[j, i] - X)
} else if (option_type == "put") {
option_tree[j, i] <- max(hold_value, X - stock_tree[j, i])
}
}
}
return(option_tree[1, 1])
}
# Valuación de opciones americanas
american_option_prices <- data.frame(matrix(ncol = 4, nrow = length(tickers)))
colnames(american_option_prices) <- c("Ticker", "Call_Americana", "Put_Americana", "Volatilidad")
steps <- 100 # Número de pasos en el modelo binomial
for (i in 1:length(tickers)) {
S0 <- as.numeric(price_data[nrow(price_data), i])
sigma <- volatilities[i]
X <- S0 # Precio de ejercicio al precio actual
T <- as.numeric(difftime(end_date, start_date, units = "days") / 365)
call_price <- AmericanOptionPrice(S0, X, T, leverage_rate, sigma, steps, option_type = "call")
put_price <- AmericanOptionPrice(S0, X, T, leverage_rate, sigma, steps, option_type = "put")
american_option_prices[i, ] <- c(tickers[i], call_price, put_price, sigma)
}
print("Valuación de Opciones Americanas:")
## [1] "Valuación de Opciones Americanas:"
print(american_option_prices)
## Ticker Call_Americana Put_Americana Volatilidad
## 1 ADD 0 0.691323181106489 1.54517304626138
## 2 ADM 0 39.9917437259024 0.291316699749371
## 3 AGG 0 34.3356126452341 0.0611865508500423
# Estrategia de cobertura
coverage_amount <- initial_investment * coverage_percentage
weights <- volatilities / sum(volatilities)
coverage_allocation <- coverage_amount * weights
coverage_df <- data.frame(
Ticker = tickers,
CoverageAllocation = coverage_allocation
)
print("\nEstrategia de Cobertura:")
## [1] "\nEstrategia de Cobertura:"
print(coverage_df)
## Ticker CoverageAllocation
## ADD ADD 692108.08
## ADM ADM 130485.48
## AGG AGG 27406.45
Call Americana: 0; Put Americana: 0.691; Volatilidad: 1.545.
Call Americana: 0; Put Americana: 39.992; Volatilidad: 0.291.
Call Americana: 0; Put Americana: 34.308; Volatilidad: 0.061.
El activo ADM tiene el valor más alto en Put Americana, lo que indica que las opciones de venta son significativamente más caras para este activo. En términos de Volatilidad, ADD tiene la mayor volatilidad, mientras que AGG tiene la menor. Posibles Interpretaciones:
La alta volatilidad de ADD podría explicar por qué sus opciones de venta (Put Americana) son relativamente más caras en comparación con AGG, que tiene una volatilidad mucho menor. La baja volatilidad de AGG podría estar relacionada con una mayor estabilidad en el precio del activo, lo que podría hacer que las opciones de venta sean menos atractivas.
# --- Parámetros de la opción ---
S <- 48.01 # Precio inicial del subyacente
sigma <- 0.0851 # Volatilidad anual
r <- 0.0413 # Tasa libre de riesgo
T <- 2 # Tiempo hasta vencimiento
steps <- 8 # Número de pasos del árbol
# --- Cálculos base ---
dt <- T / steps
u <- exp(sigma * sqrt(dt)) # Movimiento hacia arriba
d <- 1 / u # Movimiento hacia abajo
# Crear data frame con los nodos del árbol
nodes <- data.frame()
for (i in 0:steps) {
for (j in 0:i) {
price <- S * u^j * d^(i - j)
nodes <- rbind(nodes, data.frame(
Paso = i,
Nivel = j,
Precio = round(price, 2)
))
}
}
# --- Graficar el árbol binomial de precios ---
ggplot(nodes, aes(x = Paso, y = Precio)) +
geom_point(color = "red", size = 3) +
geom_text(aes(label = Precio), vjust = -1, size = 3.5) +
labs(
title = "Árbol Binomial de Opción Americana para ADM",
x = "8 Trimestres",
y = "Precio del Activo Subyacente"
) +
theme_minimal()
Da el derecho de comprar el activo a un precio de ejercicio X. Ejercer anticipadamente una call rara vez es óptimo (salvo dividendos). Por tanto, la mayoría de las veces conviene esperar al vencimiento, a menos que el valor intrínseco supere el valor presente del valor esperado.
Tomar la call si el activo tiene potencial fuerte de subir más, y si no hay dividendos, esperar al vencimiento. Solo ejercer antes si el precio del subyacente sube mucho y de inmediato se puede capturar ese valor.
Da el derecho de vender el activo a un precio de ejercicio. A diferencia del call, la opción put americana sí se puede ejercer anticipadamente en ciertas condiciones. Si el subyacente cae mucho, y el valor intrínseco es mayor que el valor descontado esperado, conviene ejercer.
Tomar la put si anticipo baja volatilidad futura y movimientos bajistas fuertes. Ejercer anticipadamente si el valor intrínseco excede el valor presente de seguir en el árbol.
Decisión Personal Basada en Contexto
El mercado es volátil, el activo tiene tendencia bajista o inestable y se puede ejercer antes si el precio cae, en este caso entonces, nos iríamos por la opción PUT AMERICANA.
Da flexibilidad para vender antes si el precio del activo baja fuerte.
Tiene mayor valor que la europea en condiciones bajistas.
Permite protección real (cobertura) ante una caída del mercado.