Opciones - Arboles Binomiales
Juliana Morales and Felipe Tejada
2024-04-26
Base de datos
tick = read.table("C:/Users/Felipe/OneDrive - INSTITUTO TECNOLOGICO METROPOLITANO - ITM/Derivados Financieros/Opciones/opciones.txt", header = TRUE)Se realizo el analisis con los activos correspondientes al mercado NasDaq, acorde a unas tendencias del activo desde el 2014 hasta la fecha del 17 de abril del 2024. Las acciones corresponden a:
-EBAY: eBay es un sitio destinado a la subasta y comercio electrónico de productos a través de internet.
-ADBE: Adobe Inc., antes Adobe Systems Incorporated, es una empresa de software estadounidense.
-FTNT: Fortinet es una empresa multinacional de Estados Unidos. Se dedica al desarrollo y la comercialización de software, dispositivos y servicios de ciberseguridad.
Se descargan los paquetes requeridos para el analisis
options(warn = -1)
suppressPackageStartupMessages({
library(tidyquant)
library(plotly)
library(timetk)
library(tidyverse)
library(quantmod)
library(gower)
library(tseries)
library(xts)
library(TTR)
library(ROCR)
library(ROCR)
library(RQuantLib)
library(Deriv)
library(ggplot2)
})Fijar la base de datos
attach(tick)
names(tick)## [1] "Date" "EBAY" "ADBE" "FTNT"options(scipen = 999)
head(tick)## Date EBAY ADBE FTNT
## 1 1/6/2017 31.87507 141.38 7.842
## 2 2/6/2017 32.36065 143.48 7.810
## 3 5/6/2017 32.57138 143.59 7.874
## 4 6/6/2017 32.49809 143.03 7.818
## 5 7/6/2017 32.77294 143.62 7.840
## 6 8/6/2017 33.11194 142.63 7.904Creación del portafolio óptimo de inversión
Optimización del portafolio, utilizando el óptimo de Markowitz
tick <- c('EBAY', 'ADBE', 'FTNT')
price_data <- tq_get(tick, from = '2017-06-01', to = '2024-04-17', get = 'stock.prices')
log_ret_tidy <- price_data %>%
group_by(symbol) %>%
tq_transmute(select = adjusted,
mutate_fun = periodReturn,
period = 'daily',
col_rename = 'ret',
type = 'log')
head(na.omit(log_ret_tidy))## # A tibble: 6 × 3
## # Groups: symbol [1]
## symbol date ret
## <chr> <date> <dbl>
## 1 EBAY 2017-06-01 0
## 2 EBAY 2017-06-02 0.0151
## 3 EBAY 2017-06-05 0.00649
## 4 EBAY 2017-06-06 -0.00225
## 5 EBAY 2017-06-07 0.00842
## 6 EBAY 2017-06-08 0.0103log_ret_xts <- log_ret_tidy %>%
spread(symbol, value = ret) %>%
tk_xts()## Using column `date` for date_var.#log_ret_xts[is.na(log_ret_xts)] <- 0
head(log_ret_xts)## ADBE EBAY FTNT
## 2017-06-01 0.0000000000 0.000000000 0.000000000
## 2017-06-02 0.0147442876 0.015119470 -0.004088948
## 2017-06-05 0.0007663679 0.006490622 0.008161245
## 2017-06-06 -0.0039076009 -0.002252725 -0.007137455
## 2017-06-07 0.0041164988 0.008422407 0.002810107
## 2017-06-08 -0.0069169899 0.010290669 0.008130082Analisis técnico
Datos y acciones utilizadas
actions<-c('EBAY', 'ADBE', 'FTNT')
getSymbols(actions, from = '2017-06-01', to = '2024-04-17', src="yahoo")## [1] "EBAY" "ADBE" "FTNT"Medias Moviles
for (action in actions) {
# Media movil para 50 dÃas
SMA50<-SMA(Cl(get(action)), n=50)
# Media movil para 200 dÃas
SMA200<-SMA(Cl(get(action)), n=200)
# Calculo de MACD
MACD<-MACD(Cl(get(action)))
# Calculo de Bandas de Bollinger
BBands<-BBands(Cl(get(action)))
}Resumen de Indicadores
cat("Ultimo precio de cierre", as.numeric(Cl(get(action))[nrow(get(action))]), "\n" )## Ultimo precio de cierre 64.48cat("Media movil para 50 dÃas", as.numeric(SMA50[nrow(SMA50)]), "\n")## Media movil para 50 dÃas 68.7618cat("Media movil para 200 dÃas", as.numeric(SMA200[nrow(SMA200)]), "\n")## Media movil para 200 dÃas 63.02745El ultimo precio de cierre es 64.48. Se puede analizar que en la media móvil de 50 dias se destaca una tendencia bajista, en un corto plazo de 50 dias. La cual permite analizar que las fluctuaciones diarias del precio baja, al compararlo con la media móvil a los 200 dias se percibe que se encuentra un poco por encima del promedio, la cual nos permite analizar como será la tendencia en un largo plazo.
cat("MACD:\n")## MACD:print(summary(MACD))## Index macd signal
## Min. :2017-06-01 Min. :-9.9680 Min. :-8.0214
## 1st Qu.:2019-02-20 1st Qu.:-0.8637 1st Qu.:-0.7765
## Median :2020-11-04 Median : 1.2320 Median : 1.1941
## Mean :2020-11-06 Mean : 0.8382 Mean : 0.8414
## 3rd Qu.:2022-07-26 3rd Qu.: 2.5728 3rd Qu.: 2.4530
## Max. :2024-04-16 Max. : 8.7621 Max. : 7.7135
## NA's :25 NA's :33cat("Bandas de Bollinger:\n")## Bandas de Bollinger:print(summary(BBands))## Index dn mavg up
## Min. :2017-06-01 Min. : 6.87 Min. : 7.361 Min. : 7.497
## 1st Qu.:2019-02-20 1st Qu.:14.55 1st Qu.:15.862 1st Qu.:17.038
## Median :2020-11-04 Median :25.12 Median :27.386 Median :29.607
## Mean :2020-11-06 Mean :32.91 Mean :35.834 Mean :38.760
## 3rd Qu.:2022-07-26 3rd Qu.:52.52 3rd Qu.:58.402 3rd Qu.:62.819
## Max. :2024-04-16 Max. :74.61 Max. :77.595 Max. :89.757
## NA's :19 NA's :19 NA's :19
## pctB
## Min. :-0.5461
## 1st Qu.: 0.3504
## Median : 0.6624
## Mean : 0.6021
## 3rd Qu.: 0.8542
## Max. : 1.4448
## NA's :19Con el indicador MACD se analiza que se encuentra por encima de la señal, lo cual puede dar un mensaje de compra en los activos, la media se encuentra muy cercana a la señal lo cual denota que no se tiene una volatilidad muy amplia. Ademas, con el indicador de Bandas de Bollinger se analiza un comportamiento de unos min muy cercanos, lo cual da a enteder que los precios pueden estar muy cercanos.
Retornos
mean_ret <- colMeans(log_ret_xts)
print(round(mean_ret, 5))## ADBE EBAY FTNT
## 0.00070 0.00026 0.00122Los 3 activos generan una rentabilidad, es decir, una ganancia la cual no en una medida muy grande pero eso aporta al portafolio creado por los activos, debido a que se tienen en cuenta que son activos que están teniendo una tendencia bajista en sus comportamientos en el pasar del tiempo
Datos estadisticos
# Covarianza
cov_mat <- cov(log_ret_xts) * 252
print(round(cov_mat,4))## ADBE EBAY FTNT
## ADBE 0.1304 0.0460 0.0861
## EBAY 0.0460 0.0978 0.0448
## FTNT 0.0861 0.0448 0.1754#crear pesos aleatorios
wts <- runif(n = length(tick))
print(wts)## [1] 0.4555286 0.8185722 0.9006349print(sum(wts))## [1] 2.174736#suma de los pesos aleatorios para ser 1
wts <- wts/sum(wts)
print(wts)## [1] 0.2094639 0.3764008 0.4141353sum(wts)## [1] 1# rentabilidad anualizada del portafolio
port_returns <- (sum(wts * mean_ret) + 1)^252 - 1
print(port_returns)## [1] 0.208085# riesgo del portaflio
port_risk <- sqrt(t(wts) %*% (cov_mat %*% wts))
print(port_risk)## [,1]
## [1,] 0.2929468# asumir rf es 0%
sharpe_ratio <- port_returns/port_risk
print(sharpe_ratio)## [,1]
## [1,] 0.7103166Covarianza: sobre los activos se tiene que sus variaciones son positivas, lo que indica que si un activo aumenta es muy probable que el otro activo tenga similar comportamiento, es decir que aumente, ya que muestra la relación que tienen entre los dos activos que se analizan. Dado que entre mayor sea el valor en positivo mayor es la relación entre ellos.
Rentabilidad anualizada del portafolio: La rentabilidad anualizada del portafolio corresponde a 0.3501, lo cual se puede interpretar como el rendimiento promedio esperado de la cartera de acciones en el portafolio de inversión que permite analizar una visión general del rendimiento a largo durante cierto periodo de tiempo.
Analisis de inversión del Portafolio
Inversión destinada
num_port <- 10000
# matrix de desarrollo
all_wts <- matrix(nrow = num_port,
ncol = length(tick))Analisis de rentabilidad y riesgo del Portafolio
Retornos y datos estadisticos del Portafolio
# Retornos del Portafolio
port_returns <- vector('numeric', length = num_port)
# Desviación del Portafolio
port_risk <- vector('numeric', length = num_port)
# Portfolio Sharpe Ratio
sharpe_ratio <- vector('numeric', length = num_port)
for (i in seq_along(port_returns)) {
wts <- runif(length(tick))
wts <- wts/sum(wts)
all_wts[i,] <- wts
port_ret <- sum(wts * mean_ret)
port_ret <- ((port_ret + 1)^252) - 1
port_returns[i] <- port_ret
port_sd <- sqrt(t(wts) %*% (cov_mat %*% wts))
port_risk[i] <- port_sd
sr <- port_ret/port_sd
sharpe_ratio[i] <- sr
}
portfolio_values <- tibble(Return = port_returns,
Risk = port_risk,
SharpeRatio = sharpe_ratio)
# Convertir la matrix y renombrar las columnas
all_wts <- tk_tbl(all_wts)
colnames(all_wts) <- colnames(log_ret_xts)
# Combinar
portfolio_values <- tk_tbl(cbind(all_wts, portfolio_values))
head(portfolio_values)## # A tibble: 6 × 6
## ADBE EBAY FTNT Return Risk SharpeRatio
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.477 0.314 0.209 0.184 0.289 0.637
## 2 0.123 0.410 0.467 0.212 0.297 0.713
## 3 0.224 0.361 0.415 0.210 0.294 0.715
## 4 0.177 0.143 0.680 0.283 0.345 0.821
## 5 0.372 0.0940 0.534 0.266 0.333 0.799
## 6 0.436 0.165 0.399 0.234 0.313 0.749# Vairaicion minima
min_var <- portfolio_values[which.min(portfolio_values$Risk),]
print(min_var)## # A tibble: 1 × 6
## ADBE EBAY FTNT Return Risk SharpeRatio
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.286 0.578 0.136 0.140 0.275 0.508# El Portafolio con mayor Sharpe Ratio
max_sr <- portfolio_values[which.max(portfolio_values$SharpeRatio),]
print(max_sr)## # A tibble: 1 × 6
## ADBE EBAY FTNT Return Risk SharpeRatio
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.0489 0.00185 0.949 0.350 0.408 0.857Graficos descriptivos
Variación del Portafolio
var_porta <- min_var %>%
gather(ADBE:FTNT, key = Accion,
value = Peso) %>%
mutate(Asset = as.factor(Accion)) %>%
ggplot(aes(x = fct_reorder(Accion,Peso), y = Peso, fill = Accion)) +
geom_bar(stat = 'identity') +
theme_minimal() +
labs(x = 'Accion', y = 'Peso', title = "Varianza Minima del Portafolio") +
scale_y_continuous(labels = scales::percent)
ggplotly(var_porta)El activo con la minima variazion es FTNT y el mayor es EBAY
Tendencia del Portafolio
tangency_porta <- max_sr %>%
gather(ADBE:FTNT, key = Accion,
value = Peso) %>%
mutate(Accion = as.factor(Accion)) %>%
ggplot(aes(x = fct_reorder(Accion,Peso), y = Peso, fill = Accion)) +
geom_bar(stat = 'identity') +
theme_minimal() +
labs(x = 'Accion', y = 'Peso', title = "Tangencia del Portafolio") +
scale_y_continuous(labels = scales::percent)
ggplotly(tangency_porta)Optimización del Portafolio
opti_porta <- portfolio_values %>%
ggplot(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 = 'Riesgo anuliazado',
y = 'Retornos anualizados',
title = "Optimización del portafolio y frontera eficiente") +
geom_point(aes(x = Risk,
y = Return), data = min_var, color = 'red') +
geom_point(aes(x = Risk,
y = Return), data = max_sr, color = 'red') +
annotate('text', x = 0.35, y = 0.40, label = "Tangencia Portafolio") +
annotate('text', x = 0.35, y = 0.05, label = "Var Min Porta") +
annotate(geom = 'segment', x = 0.30, xend = 0.27, y = 0.05,
yend = 0.1, color = 'red', arrow = arrow(type = "open")) +
annotate(geom = 'segment', x = 0.38, xend = 0.4136, y = 0.40,
yend = 0.365, color = 'red', arrow = arrow(type = "open"))
ggplotly(opti_porta)Creación de Arboles binomiales a través del modelo Cox-Ross-Rubinstein (CRR)
Calculo de Varianzad, Volatilidades y Retornos
# Varianza 1. Precio strike de EBAY y su Volatilidad Implicita
precio_strike <- 50.25
vol_impl <- 3.541# Varianza 2 EBAY
opcion<-c("EBAY")
data_opcion <- lapply(opcion, FUN = function(x){
ROC(Ad(getSymbols(x, from="2023-06-01", to = "2024-04-17", auto.assign = FALSE)),
type = "continuous")
}) #%returns
ret_opcion<-as.data.frame(do.call(merge,data_opcion))
colnames(ret_opcion) <- gsub(".Adjusted", "", colnames(ret_opcion))
ret_opcion<-ret_opcion[-1,]
# Volatilidad de EBAY
var_opcion <-var(ret_opcion)
desve_opcion <- sqrt(var_opcion)
print(desve_opcion)## [1] 0.01717442# Varianza 3
#Volatilidad del portafolio
# Retornos EBAY
opcion_EBAY<-c("EBAY")
data_opcion_EBAY <- lapply(opcion_EBAY, FUN = function(x){
ROC(Ad(getSymbols(x, from="2023-06-01", to = "2024-04-17", auto.assign = FALSE)),
type = "continuous")
}) #%returns
ret_opcion_EBAY<-as.data.frame(do.call(merge,data_opcion_EBAY))
colnames(ret_opcion_EBAY) <- gsub(".Adjusted", "", colnames(ret_opcion_EBAY))
ret_opcion_EBAY<-ret_opcion_EBAY[-1,]
# Retornos ADBE
opcion_ADBE<-c("ADBE")
data_opcion_ADBE <- lapply(opcion_ADBE, FUN = function(x){
ROC(Ad(getSymbols(x, from="2023-06-01", to = "2024-04-17", auto.assign = FALSE)),
type = "continuous")
}) #%returns
ret_opcion_ADBE<-as.data.frame(do.call(merge,data_opcion_ADBE))
colnames(ret_opcion_ADBE) <- gsub(".Adjusted", "", colnames(ret_opcion_ADBE))
ret_opcion_ADBE<-ret_opcion_ADBE[-1,]
# Retornos FTNT
opcion_FTNT<-c("FTNT")
data_opcion_FTNT <- lapply(opcion_FTNT, FUN = function(x){
ROC(Ad(getSymbols(x, from="2023-06-01", to = "2024-04-17", auto.assign = FALSE)),
type = "continuous")
}) #%returns
ret_opcion_FTNTE<-as.data.frame(do.call(merge,data_opcion_FTNT))
colnames(ret_opcion_FTNTE) <- gsub(".Adjusted", "", colnames(ret_opcion_FTNTE))
ret_opcion_FTNTE<-ret_opcion_FTNTE[-1,]
rentabilidad_port<-cbind(ret_opcion_EBAY,ret_opcion_ADBE,ret_opcion_FTNTE)Análisis mediante el Black-Scholes
Datos
opcions <- c('EBAY', 'ADBE', 'FTNT')
start_date <- "2023-06-01"
end_date <- Sys.Date()
getSymbols("EBAY", src = "yahoo", from = "2023-06-01", to = "2024-04-17")## [1] "EBAY"getSymbols("ADBE", src = "yahoo", from = "2023-06-01", to = "2024-04-17")## [1] "ADBE"getSymbols("FTNT", src = "yahoo", from = "2023-06-01", to = "2024-04-17")## [1] "FTNT"tail(EBAY)## EBAY.Open EBAY.High EBAY.Low EBAY.Close EBAY.Volume EBAY.Adjusted
## 2024-04-09 51.80 52.01 51.51 51.96 3566500 51.96
## 2024-04-10 51.96 52.54 51.90 52.46 4901300 52.46
## 2024-04-11 52.60 52.65 51.81 51.89 3650900 51.89
## 2024-04-12 51.71 52.00 51.05 51.31 4246600 51.31
## 2024-04-15 51.62 51.90 50.74 50.89 3878400 50.89
## 2024-04-16 50.63 50.75 49.87 50.25 5161500 50.25tail(ADBE)## ADBE.Open ADBE.High ADBE.Low ADBE.Close ADBE.Volume ADBE.Adjusted
## 2024-04-09 486.00 493.31 483.31 492.55 2548600 492.55
## 2024-04-10 489.39 491.77 480.28 487.22 2487900 487.22
## 2024-04-11 487.36 488.67 479.74 484.28 2978500 484.28
## 2024-04-12 477.95 478.78 468.60 474.09 5620000 474.09
## 2024-04-15 477.02 478.52 468.35 470.10 3353200 470.10
## 2024-04-16 470.00 478.98 468.49 476.22 2660100 476.22tail(FTNT)## FTNT.Open FTNT.High FTNT.Low FTNT.Close FTNT.Volume FTNT.Adjusted
## 2024-04-09 69.14 69.14 67.80 68.22 2799600 68.22
## 2024-04-10 67.08 68.50 67.08 68.13 3641300 68.13
## 2024-04-11 68.61 68.86 67.44 68.22 2917900 68.22
## 2024-04-12 67.47 67.72 65.93 66.45 5132600 66.45
## 2024-04-15 67.08 67.19 64.58 64.73 4911100 64.73
## 2024-04-16 64.62 65.57 64.26 64.48 3015000 64.48Black-Scholes Call Option Price for EBAY
ebay_option_price_quantmod <- function(type, underlying, strike, expire, rate, volatility, div = 0) {
T <- expire
S <- underlying
K <- strike
r <- rate
sigma <- volatility
D <- div
d1 <- (log(S / K) + (r - D + 0.5 * sigma^2) * T) / (sigma * sqrt(T))
d2 <- d1 - sigma * sqrt(T)
if (type == "call") {
option_price <- S * exp(-D * T) * pnorm(d1) - K * exp(-r * T) * pnorm(d2)
} else if (type == "put") {
option_price <- K * exp(-r * T) * pnorm(-d2) - S * exp(-D * T) * pnorm(-d1)
} else {
stop("Invalid option type. Use 'call' or 'put'.")
}
return(option_price)
}Datos obtenidos de los comportamiento de la acción en el mercado de acciones
underlying_price <- 50.25 # Current stock price
strike_price <- 47.5 # Strike price
time_to_expiry <- 3/12
risk_free_rate <- 0.0544 # Risk-free rate (current 3-month bond rate)
dividend_yield <- 1.08 # Dividend yield
volatility <- 0.6104 # Volatility (Blended)
ebay_bs_call_price <- ebay_option_price_quantmod(type = "call",
underlying = underlying_price,
strike = strike_price,
expire = time_to_expiry,
rate = risk_free_rate,
volatility = volatility,
div = dividend_yield)Precio de opción de compra
Opción in-the-money, el precio de ejercicio (47.5) es menor al precio de la acción (50.25)
print(paste("Precio de opción de compra EBAY:", ebay_bs_call_price))## [1] "Precio de opción de compra EBAY: 1.97870515839798"Efecto hipotético de la evolución de los precios ante variaciones de los tipos de interés para un valor determinado
Calcular el precio de la opción Black-Scholes con tipo de interés variable
black_scholes_with_rate_change <- function(S, K, T, r, r_new, sigma, type = "call") {
d1 <- (log(S / K) + ((r_new + (sigma^2) / 2) * T)) / (sigma * sqrt(T))
d2 <- d1 - sigma * sqrt(T)
if (type == "call") {
option_price <- S * pnorm(d1) - K * exp(-r_new * T) * pnorm(d2)
} else {
option_price <- K * exp(-r_new * T) * pnorm(-d2) - S * pnorm(-d1)
}
return(option_price)
}
# Parametros
S <- 50.25 # Current stock price
K <- 47 # Strike price
r <- 0.0544 # Initial risk-free rate
sigma <- 3.541 # Volatility (Blended)
# Definir rango
T <- seq(0, 1, 0.1)
# Calcular los precios de las opciones en diferentes momentos con el tipo de interés inicial
option_prices_initial_rate <- sapply(T, function(t) black_scholes_with_rate_change(S, K, t, r, r, sigma))
# Nuevo tipo de interés (bajada de 25 puntos básicos)
r_new <- r - 0.0025 # Adjusting for 25 basis points drop
# Calculo con el nuevo interes
option_prices_new_rate <- sapply(T, function(t) black_scholes_with_rate_change(S, K, t, r, r_new, sigma))
# Macro de los datos
df_initial_rate <- data.frame(Time = T, OptionPrice = option_prices_initial_rate, RateType = "Initial Rate")
df_new_rate <- data.frame(Time = T, OptionPrice = option_prices_new_rate, RateType = "New Rate")
# Combinar
df_combined <- rbind(df_initial_rate, df_new_rate)Evolución del Precio de la opción con los interes calculados en el tiempo
ggplot(df_combined, aes(x = Time, y = OptionPrice, color = RateType)) +
geom_line() +
labs(title = "Evolución del Precio de la opción con los interes calculados en el tiempo",
x = "Time to Maturity (Years)",
y = "Option Price") +
theme_minimal() +
scale_color_manual(values = c("aquamarine", "red"))
Obtener el precio de la opción de compra ADBE
Función para calcular el precio de la opción Black-Scholes
black_scholes <- function(S, K, T, r, sigma, type = "call") {
d1 <- (log(S / K) + (r + sigma^2 / 2) * T) / (sigma * sqrt(T))
d2 <- d1 - sigma * sqrt(T)
if (type == "call") {
option_price <- S * pnorm(d1) - K * exp(-r * T) * pnorm(d2)
} else {
option_price <- K * exp(-r * T) * pnorm(-d2) - S * pnorm(-d1)
}
return(option_price)
}Datos obtenidos de los comportamiento de la acción en el mercado de acciones
S_adbe <- 476.220001 # Current stock price
K_adbe <- 480 # Strike price
T_adbe <- 0.25 # Time to maturity or expiry (in years)
r_adbe <- 0.0544 # Risk-free rate (current 3-month bond rate)
D_adbe <- 0 # Dividend yield
sigma_adbe <- 0.1836 # Volatility (Blended) Precio de la opción de compra ADBE mediante la fórmula Black-Schole
adbe_bs_price <- black_scholes(S_adbe, K_adbe, T_adbe, r_adbe, sigma_adbe, type = "call")
print(paste("Opción de Compra de ADBE:", adbe_bs_price))## [1] "Opción de Compra de ADBE: 18.7702540654244"La accion ADBE nos indica que presenta una opcion de compra de 18.7702, la cual es un valor en el que el titular tiene derecho a comprar la accion subyacente en el periodo de su validez
Obtener el precio de la opción de compra FTNT
black_scholes <- function(S, K, T, r, sigma, type = "call") {
d1 <- (log(S / K) + (r + sigma^2 / 2) * T) / (sigma * sqrt(T))
d2 <- d1 - sigma * sqrt(T)
if (type == "call") {
option_price <- S * pnorm(d1) - K * exp(-r * T) * pnorm(d2)
} else {
option_price <- K * exp(-r * T) * pnorm(-d2) - S * pnorm(-d1)
}
return(option_price)
}Datos obtenidos de los comportamiento de la acción en el mercado de acciones
S_ftnt <- 64.480003 # Current stock price
K_ftnt <- 60 # Strike price
T_ftnt <- 0.25 # Time to maturity or expiry (in years)
r_ftnt <- 0.0544 # Risk-free rate (current 3-month bond rate)
D_ftnt <- 0 # Dividend yield
sigma_ftnt <- 0.6948 # Volatility (Blended)Precio de la opción de compra FTNT mediante la fórmula Black-Schole
ftnt_bs_price <- black_scholes(S_ftnt, K_ftnt, T_ftnt, r_ftnt, sigma_ftnt, type = "call")
print(paste("Opción de Compra de FTNT:", ftnt_bs_price))## [1] "Opción de Compra de FTNT: 11.4270153583501"Cox Ross Rubinstein Model para EBAY
Modelo de datos
crr_option_price <- function(S0, X, T, r, sigma, n, type = "call") {
delta_t <- T / n
u <- exp(sigma * sqrt(delta_t))
d <- 1 / u
p <- (exp(r * delta_t) - d) / (u - d)
# Generate stock prices at expiration
ST <- S0 * u^(n:0) * d^(0:n)
# Calculate option payoffs at expiration
payoff <- pmax(ST - X, 0) # For a call option
# Backward induction to calculate option price at t=0
for (i in (n - 1):0) {
payoff <- exp(-r * delta_t) * (p * payoff[2:(i + 2)] + (1 - p) * payoff[1:(i + 1)])
}
return(payoff[1])
}
underlying_price <- 50.25 # Current stock price
strike_price <- 47.5 # Strike price
time_to_expiry <- 3/12
risk_free_rate <- 0.0544 # Risk-free rate (current 3-month bond rate)
dividend_yield <- 1.08 # Dividend yield
volatility <- 0.6104 # Volatility (Blended)
n <- 5Precio de la opción de compra EBAY mediante un modelo similar al CRR
ebay_crr_price <- crr_option_price(underlying_price, strike_price, time_to_expiry, risk_free_rate, volatility, n)
cat("Precio de la opción de compra EBAY (tipo CRR):", ebay_crr_price, "\n")## Precio de la opción de compra EBAY (tipo CRR): 10.26548Cox Ross Rubinstein Model para ADBE
underlying_price_adbe <- 476.220001 # Current stock price
strike_price_adbe <- 480 # Strike price
time_to_expiry_adbe <- 0.25 # Time to maturity or expiry (in years)
risk_free_rate_adbe <- 0.0544 # Risk-free rate (current 3-month bond rate)
dividend_yield_adbe <- 0 # Dividend yield
volatility_adbe <- 0.1836 # Volatility (Blended)
n_adbe <- 5Precio de la opción de compra ABDE mediante un modelo similar al CRR
adbe_crr_price <- crr_option_price(underlying_price_adbe, strike_price_adbe,
time_to_expiry_adbe, risk_free_rate_adbe, volatility_adbe, n_adbe)
cat("Precio de la opción de compra ADBE (tipo CRR):", adbe_crr_price, "\n")## Precio de la opción de compra ADBE (tipo CRR): 15.12879El modelo CRR utiliza un enfoque de árbol binomial para valorar opciones, considerando varios factores como el precio actual de la acción, el precio de ejercicio, el tiempo hasta la expiración de la opción, la tasa de interés libre de riesgo y la volatilidad del activo subyacente. De acuerdo con el modelo CRR y las condiciones de mercado proporcionadas, el valor intrÃnseco de la opción de compra de ADBE es de aproximadamente $15.13. Esto indica que se espera que el precio de la acción de ADBE aumente lo suficiente antes del vencimiento de la opción para que el titular pueda obtener ganancias al ejercer la opción de compra.
Cox Ross Rubinstein Model para FTNT
underlying_price_ftnt <- 64.480003 # Current stock price
strike_price_ftnt <- 60 # Strike price
time_to_expiry_ftnt <- 0.25 # Time to maturity or expiry (in years)
risk_free_rate_ftnt <- 0.0544 # Risk-free rate (current 3-month bond rate)
dividend_yield_ftnt <- 0 # Dividend yield
volatility_ftnt <- 0.6948 # Volatility (Blended)
n_ftnt <- 5Precio de la opción de compra FTNT mediante un modelo similar al CRR
ftnt_crr_price <- crr_option_price(underlying_price_ftnt, strike_price_ftnt,
time_to_expiry_ftnt, risk_free_rate_ftnt, volatility_ftnt, n_ftnt)
cat("Precio de la opción de compra FTNT (tipo CRR):", ftnt_crr_price, "\n")## Precio de la opción de compra FTNT (tipo CRR): 16.10385Opciones Europeas EBAY
s <- 50.25 # Current stock price
k <- 47.5 # Strike price
tt <- 3/12
r <- 0.0544 # Risk-free rate (current 3-month bond rate)
d <- 1.08 # Dividend yield
n <- 0.6104 # Volatility (Blended)
nstep <- 5
# Calcular el precio de la opción call europea de EBAY
european_call_option_price <- EuropeanOption(type = "call", underlying = s,
strike = k, dividendYield = d,
riskFreeRate = r, maturity = tt,
volatility = n)$value
# Calcular el precio de la opción put europea de EBAY
european_put_option_price <- EuropeanOption(type = "put", underlying = s,
strike = k, dividendYield = d,
riskFreeRate = r, maturity = tt,
volatility = n)$value
cat("Precio de opción call europea de EBAY:", european_call_option_price, "\n")## Precio de opción call europea de EBAY: 1.978705cat("Precio de opción put europea de EBAY:", european_put_option_price, "\n")## Precio de opción put europea de EBAY: 10.47726El precio de opción call ebay es de 1.9787, el cual indica que es el precio al cual se tiene derecho para comprar el activo subyacente, se debe de tener en cuenta que un factor importante que influye en el valor del precio es la volatilidad debido a que si esta aumenta también aumentara la volatilidad de la opción call.
El precio de opcion put de ebay es de 10.47726, este es el precio en el que el titular de la opcion tiene derecho de vender la accion subyacente, recordado que como es una opcion europea solo se puede realizar en la fecha de vencimiento lo que en cierta medida puede afectar su precio ya que el tiempo restante influye en la prima de la opcion dejando claro que en cualquiera de los escenarios posibles se cumple cierto riesgo
Modelo de árbol binomial CRR para EBAY
calculate_option_prices <- function(s, k, tt, r, d, n, nstep, crr = TRUE) {
dt <- tt / nstep # Paso de tiempo
u <- exp(n * sqrt(dt)) # Factor de aumento
d <- 1 / u # Factor de reducción
p <- (exp((r - d) * dt) - d) / (u - d) # Probabilidad de subida
# Inicializar una matriz para almacenar los precios de la opción en cada nodo del árbol
option_prices <- matrix(0, nrow = nstep + 1, ncol = nstep + 1)
# Calcular los precios de las opciones en los nodos finales del árbol
for (j in 0:nstep) {
option_prices[nstep + 1, j + 1] <- max(s * u^j * d^(nstep - j) - k, 0)
}
# Calcular los precios de las opciones en los nodos anteriores del árbol
for (i in (nstep - 1):0) {
for (j in 0:i) {
option_prices[i + 1, j + 1] <- exp(-r * dt) * (p * option_prices[i + 2, j + 2] + (1 - p) * option_prices[i + 2, j + 1])
}
}
return(option_prices)
}
# Función para mostrar la matriz del árbol binomial de forma más definida
binomial_tree_ebay <- function(option_prices) {
# Obtener dimensiones de la matriz
nrow <- nrow(option_prices)
ncol <- ncol(option_prices)
# Iterar sobre la matriz y mostrar los precios de la opción
for (i in 1:nrow) {
cat(rep(" ", nrow - i)) # Agregar espacios al principio de cada fila
for (j in 1:ncol) {
if (option_prices[i, j] != 0) { # Solo imprimir valores no nulos
cat(sprintf("%8.2f", option_prices[i, j])) # Imprimir valores de la fila actual
} else {
cat(rep(" ", 1)) # Imprimir espacios en blanco para valores nulos
}
}
cat("\n") # Nueva lÃnea para la siguiente fila
}
}
# Calcular los precios de las opciones en cada nodo del árbol binomial
option_prices <- calculate_option_prices(s, k, tt, r, d, n, nstep)
# Mostrar la matriz del árbol binomial de forma más definida
binomial_tree_ebay(option_prices)## 2.66
## 1.18 5.85
## 0.33 3.00 11.95
## 1.03 7.23 22.11
## 3.22 15.83 35.67
## 10.10 28.18 51.93Opciones Europeas ADBE
s <- 476.220001 # Current stock price
k <- 480 # Strike price
tt <- 3/12
r <- 0.0544 # Risk-free rate (current 3-month bond rate)
d <- 1.08 # Dividend yield
n <- 0.6948 # Volatility (Blended)
nstep <- 5
# Calcular el precio de la opción call europea de ADBE
european_call_option_price_adbe <- EuropeanOption(type = "call", underlying = s,
strike = k, dividendYield = d,
riskFreeRate = r, maturity = tt,
volatility = n)$value
# Calcular el precio de la opción put europea de ADBE
european_put_option_price_adbe <- EuropeanOption(type = "put", underlying = s,
strike = k, dividendYield = d,
riskFreeRate = r, maturity = tt,
volatility = n)$value
cat("Precio de opción call europea de ADBE:", european_call_option_price_adbe, "\n")## Precio de opción call europea de ADBE: 18.39353cat("Precio de opción put europea de ADBE:", european_put_option_price_adbe, "\n")## Precio de opción put europea de ADBE: 128.3731El elevado precio de la opción de venta europea de ADBE indica una expectativa de un posible descenso del precio de la acción, mientras que el precio relativamente bajo de la opción de compra europea indica una menor expectativa de un aumento significativo del precio de la acción. En resumen, los precios de estas opciones reflejan las perspectivas del mercado sobre la evolución futura del precio de la acción de ADBE.
Modelo de árbol binomial CRR para ADBE
calculate_option_prices_adbe <- function(s, k, tt, r, d, n, nstep, crr = TRUE) {
dt <- tt / nstep # Paso de tiempo
u <- exp(n * sqrt(dt)) # Factor de aumento
d <- 1 / u # Factor de reducción
p <- (exp((r - d) * dt) - d) / (u - d) # Probabilidad de subida
# Inicializar una matriz para almacenar los precios de la opción en cada nodo del árbol
option_prices <- matrix(0, nrow = nstep + 1, ncol = nstep + 1)
# Calcular los precios de las opciones en los nodos finales del árbol
for (j in 0:nstep) {
option_prices[nstep + 1, j + 1] <- max(s * u^j * d^(nstep - j) - k, 0)
}
# Calcular los precios de las opciones en los nodos anteriores del árbol
for (i in (nstep - 1):0) {
for (j in 0:i) {
option_prices[i + 1, j + 1] <- exp(-r * dt) * (p * option_prices[i + 2, j + 2] + (1 - p) * option_prices[i + 2, j + 1])
}
}
return(option_prices)
}
# Función para mostrar la matriz del árbol binomial de forma más definida
binomial_tree_adbe <- function(option_prices) {
# Obtener dimensiones de la matriz
nrow <- nrow(option_prices)
ncol <- ncol(option_prices)
# Iterar sobre la matriz y mostrar los precios de la opción
for (i in 1:nrow) {
cat(rep(" ", nrow - i)) # Agregar espacios al principio de cada fila
for (j in 1:ncol) {
if (option_prices[i, j] != 0) { # Solo imprimir valores no nulos
cat(sprintf("%8.2f", option_prices[i, j])) # Imprimir valores de la fila actual
} else {
cat(rep(" ", 1)) # Imprimir espacios en blanco para valores nulos
}
}
cat("\n") # Nueva lÃnea para la siguiente fila
}
}
# Calcular los precios de las opciones en cada nodo del árbol binomial
option_prices <- calculate_option_prices_adbe(s, k, tt, r, d, n, nstep)
# Mostrar la matriz del árbol binomial de forma más definida
binomial_tree_adbe(option_prices)## 26.41
## 11.05 57.08
## 2.85 27.39 116.42
## 8.53 65.00 219.30
## 25.50 143.84 370.70
## 76.26 278.97 555.55Opciones Europeas FTNT
s <- 64.480003 # Current stock price
k <- 60 # Strike price
tt <- 0.25 # Time to maturity or expiry (in years)
r <- 0.0544 # Risk-free rate (current 3-month bond rate)
d <- 0 # Dividend yield
n <- 0.6948 # Volatility (Blended)
nstep <- 5
# Calcular el precio de la opción call europea de FTNT
european_call_option_price_ftnt <- EuropeanOption(type = "call", underlying = s,
strike = k, dividendYield = d,
riskFreeRate = r, maturity = tt,
volatility = n)$value
# Calcular el precio de la opción put europea de FTNT
european_put_option_price_ftnt <- EuropeanOption(type = "put", underlying = s,
strike = k, dividendYield = d,
riskFreeRate = r, maturity = tt,
volatility = n)$value
# Imprimir los resultados
cat("Precio de opción call europea de FTNT:", european_call_option_price_ftnt, "\n")## Precio de opción call europea de FTNT: 11.42702cat("Precio de opción put europea de FTNT:", european_put_option_price_ftnt, "\n")## Precio de opción put europea de FTNT: 6.136536El precio de una opción call europea tiende a aumentar cuando el precio del activo subyacente aumenta, mientras que el precio de una opción put europea tiende a aumentar cuando el precio del activo subyacente disminuye. Además, ambos precios son influenciados por factores como el tiempo hasta la expiración, la tasa de interés y la volatilidad del activo subyacente. En el caso del activo, el precio de la opción call europea de FTNT es de 11.42702, lo que sugiere una expectativa de un aumento en el precio de FTNT, mientras que el precio de la opción put europea de FTNT es de 6.136536, indicando una expectativa de una posible disminución en el precio de FTNT.
Modelo de árbol binomial CRR para FTNT
calculate_option_prices_ftnt <- function(s, k, tt, r, d, n, nstep, crr = TRUE) {
dt <- tt / nstep # Paso de tiempo
u <- exp(n * sqrt(dt)) # Factor de aumento
d <- 1 / u # Factor de reducción
p <- (exp((r - d) * dt) - d) / (u - d) # Probabilidad de subida
# Inicializar una matriz para almacenar los precios de la opción en cada nodo del árbol
option_prices <- matrix(0, nrow = nstep + 1, ncol = nstep + 1)
# Calcular los precios de las opciones en los nodos finales del árbol
for (j in 0:nstep) {
option_prices[nstep + 1, j + 1] <- max(s * u^j * d^(nstep - j) - k, 0)
}
# Calcular los precios de las opciones en los nodos anteriores del árbol
for (i in (nstep - 1):0) {
for (j in 0:i) {
option_prices[i + 1, j + 1] <- exp(-r * dt) * (p * option_prices[i + 2, j + 2] + (1 - p) * option_prices[i + 2, j + 1])
}
}
return(option_prices)
}
# Función para mostrar la matriz del árbol binomial de forma más definida
binomial_tree_ftnt <- function(option_prices) {
# Obtener dimensiones de la matriz
nrow <- nrow(option_prices)
ncol <- ncol(option_prices)
# Iterar sobre la matriz y mostrar los precios de la opción
for (i in 1:nrow) {
cat(rep(" ", nrow - i)) # Agregar espacios al principio de cada fila
for (j in 1:ncol) {
if (option_prices[i, j] != 0) { # Solo imprimir valores no nulos
cat(sprintf("%8.2f", option_prices[i, j])) # Imprimir valores de la fila actual
} else {
cat(rep(" ", 1)) # Imprimir espacios en blanco para valores nulos
}
}
cat("\n") # Nueva lÃnea para la siguiente fila
}
}
# Calcular los precios de las opciones en cada nodo del árbol binomial
option_prices <- calculate_option_prices_ftnt(s, k, tt, r, d, n, nstep)
# Mostrar la matriz del árbol binomial de forma más definida
binomial_tree_ftnt(option_prices)## 4.62
## 2.05 9.76
## 0.57 5.00 19.26
## 1.71 11.57 34.66
## 5.12 24.45 55.17
## 15.32 42.76 80.21Creación de coberturas
# Long Straddle payoff Ebay
prices <- seq(40,55,1) # Vector of prices
strike <- 47 # strike price for both put and call
premium_call <- 1.978705 # option price call
premium_put <- 10.47726 # option price put
# call option payoff at expiration
intrinsicValuesCall <- prices - strike - premium_call
payoffLongCall <- pmax(-premium_call,intrinsicValuesCall)
# put option payoff at expiration
intrinsicValuesPut <- strike - prices - premium_put
payoffLongPut <- pmax(-premium_put,intrinsicValuesPut)
# The payoff of the Strategy is the sum of the call and put payoff. Need
# to sum wise element by element between the two vectors
payoff <- rowSums(cbind(payoffLongCall,payoffLongPut))
# Make a DataFrame with all the variable to plot it with ggplot
results <- data.frame(cbind(prices,payoffLongCall,payoffLongPut,payoff))
ggplot(results, aes(x=prices)) +
geom_line(aes(y = payoffLongCall, color = "LongCall")) +
geom_line(aes(y = payoffLongPut, color="LongPut"))+
geom_line(aes(y=payoff, color = 'Payoff')) +
scale_colour_manual("",
breaks = c("LongCall", "LongPut", "Payoff"),
values = c("red", "blue", "black")) + ylab("Payoff")+
ggtitle("Long Straddle Payoff")
Cobertura simulada del activo FTNT
s <- 64.480003 # Current stock price
k <- 60 # Strike price
tt <- 0.25 # Time to maturity or expiry (in years)
r <- 0.0544 # Risk-free rate (current 3-month bond rate)
d <- 0 # Dividend yield
n <- 0.6948 # Volatility (Blended)
nstep <- 5
# Valor de las opciones de compra (call) y venta (put)
d1 <- (log(s/k) + (r + 0.5 * n^2) * tt) / (n * sqrt(tt))
d2 <- d1 - n * sqrt(tt)
call_price <- s * pnorm(d1) - k * exp(-r * tt) * pnorm(d2)
put_price <- k * exp(-r * tt) * pnorm(-d2) - s * pnorm(-d1)
# Payoff de la estrategia Long Straddle
prices <- seq(50,70,1) # Vector of prices
strike <- 60 # strike price for both put and call
premium_call <- 11.42702 # option price call
premium_put <- 6.136536 # option price put
# Payoff de la opci??n de compra (call) al vencimiento
intrinsicValuesCall <- prices - k - premium_call
payoffLongCall <- pmax(-premium_call, intrinsicValuesCall)
# Payoff de la opci??n de venta (put) al vencimiento
intrinsicValuesPut <- k - prices - premium_put
payoffLongPut <- pmax(-premium_put, intrinsicValuesPut)
# Payoff de la estrategia Long Straddle
payoff <- payoffLongCall + payoffLongPut
# Crear un DataFrame con los resultados para graficar
results <- data.frame(prices, payoffLongCall, payoffLongPut, payoff)
# Graficar el payoff de la estrategia Long Straddle
library(ggplot2)
ggplot(results, aes(x = prices)) +
geom_line(aes(y = payoffLongCall, color = "LongCall")) +
geom_line(aes(y = payoffLongPut, color = "LongPut")) +
geom_line(aes(y = payoff, color = "Straddle Payoff")) +
scale_color_manual("",
breaks = c("LongCall", "LongPut", "Straddle Payoff"),
values = c("red", "blue", "black")) +
ylab("Payoff") +
ggtitle("Long Straddle Payoff")