Laboratorio 3

##Práctica sobre Opciones y Árboles Binomiales

Se planea invertir 10,000 USD, en tres acciones pertenecientes al mismo indice bursatil, por lo que se requiere crear un portafolio optimo de inversión, con un limite de fecha establecida en el 01/06/2023

Instalamos y llamamos las librerias necesarias

#install.packages("rlang") 
#install.packages("tidyquant")
#install.packages("plotly")
#install.packages("timetk")
#install.packages("htmltools")
#install.packages("roptions")
#install.packages("FinancialMath")
library(rlang)
library(tidyquant) # To download the data
library(plotly) # To create interactive charts
library(timetk) # To manipulate the data series
library(dplyr)
library(tidyr)
library(forcats)
library(quantmod)
library(ggplot2)
library(roptions)
library(FinancialMath)

Para la creación de la cartera, elegiremos las acciones de Landstar System, Inc. (LSTR), Ormat Technologies, Inc. (ORA), Smartsheet Inc. (SMAR), de las cuales descargaremos los datos de precio para el periodo de 5 años (01 de junio de 2018 al 01 de junio de 2023)

tick <- c('SMAR', 'LSTR', 'ORA')

price_data <- tq_get(tick,
                     from = '2018-06-01',
                     to = '2023-06-01',
                     get = 'stock.prices')

Calculamos los rendimientos diarios de estas acciones y visualizamos las primeras filas

log_ret_tidy <- price_data %>%
  group_by(symbol) %>%
  tq_transmute(select = adjusted,
               mutate_fun = periodReturn,
               period = 'daily',
               col_rename = 'ret',
               type = 'log')


log_ret_xts <- log_ret_tidy %>%
  spread(symbol, value = ret) %>%
  tk_xts()

head(log_ret_xts)
##                    LSTR           ORA         SMAR
## 2018-06-01  0.000000000  0.0000000000  0.000000000
## 2018-06-04 -0.029813714 -0.0066251795  0.010225442
## 2018-06-05 -0.004907462 -0.0048995409  0.086917167
## 2018-06-06  0.005352527  0.0017666977 -0.006932463
## 2018-06-07  0.005766085 -0.0043238748 -0.010489580
## 2018-06-08  0.010121122  0.0009842497 -0.028522473

Calculamos la media diaria de cada acción

mean_ret <- colMeans(log_ret_xts)
print(round(mean_ret, 5))
##    LSTR     ORA    SMAR 
## 0.00040 0.00042 0.00050

Calculamos la varianza historica de cada acción

Var_ret <- apply(log_ret_xts, 2, var)
print(round(Var_ret, 5))
##    LSTR     ORA    SMAR 
## 0.00034 0.00055 0.00144

Calculamos la desviación estandar de cada acción

Desviación <- apply(log_ret_xts, 2, sd)
print(round(Desviación, 5))
##    LSTR     ORA    SMAR 
## 0.01832 0.02346 0.03790

Calculamos la matriz de covarianza anualizada para todas las acciones

cov_mat <- cov(log_ret_xts) * 252

print(round(cov_mat,4))
##        LSTR    ORA   SMAR
## LSTR 0.0846 0.0395 0.0474
## ORA  0.0395 0.1386 0.0502
## SMAR 0.0474 0.0502 0.3619

Calculas pesos aleatorios para comprobar los pasos de 1 sola cartera, con el fin de calcular la rentabilidad y el riesgo de la cartera

wts <- runif(n = length(tick))
wts <- wts/sum(wts)

print(wts)
## [1] 0.5655156 0.3153954 0.1190890
sum(wts)
## [1] 1

Calculamos los rendimientos anualizados

port_returns <- (sum(wts * mean_ret) + 1)^252 - 1

print(port_returns)
## [1] 0.1116573

Calculamos el riesgo de la cartera

port_risk <- sqrt(t(wts) %*% (cov_mat %*% wts))

print(port_risk)
##           [,1]
## [1,] 0.2649577

Para calcular el Ratio Sharpe, asumimos una tasa libre de riesgo 0%

sharpe_ratio <- port_returns/port_risk

print(sharpe_ratio)
##           [,1]
## [1,] 0.4214155

Ahora para realizar la optimización ejecutaremos 5000 carteras aleatorias, por lo que crearemos vectores vacios y matrices para almacenar los valores

num_port <- 5000

# Creamos la matrix

all_wts <- matrix(nrow = num_port,
                  ncol = length(tick))

# Creamos los vectores vacios para el retorno, la desviación estandar y el Ratio Sharpe del portafolio

port_returns <- vector('numeric', length = num_port)

port_risk <- vector('numeric', length = num_port)

sharpe_ratio <- vector('numeric', length = num_port)

Ejecutamos la simulación de las 5000 carteras

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
  
}

Creamos una tabla para almacenar todos los valores, donde tendremos las ponderaciones de cada accion, el riesgo, la rentabilidad y el Ratio Sharpe de cada acción.

portfolio_values <- tibble(Return = port_returns,
                  Risk = port_risk,
                  SharpeRatio = sharpe_ratio)


all_wts <- tk_tbl(all_wts)

colnames(all_wts) <- colnames(log_ret_xts)

# Combing all the values together
portfolio_values <- tk_tbl(cbind(all_wts, portfolio_values))

head(portfolio_values)
## # A tibble: 6 × 6
##    LSTR    ORA  SMAR Return  Risk SharpeRatio
##   <dbl>  <dbl> <dbl>  <dbl> <dbl>       <dbl>
## 1 0.133 0.615  0.253  0.118 0.320       0.368
## 2 0.684 0.152  0.164  0.112 0.272       0.412
## 3 0.604 0.0834 0.313  0.116 0.303       0.382
## 4 0.129 0.475  0.396  0.121 0.344       0.352
## 5 0.428 0.223  0.349  0.118 0.310       0.380
## 6 0.202 0.417  0.381  0.120 0.332       0.362

Hallamos la cartera de minima varianza y la cartera con el Ratio Sharpe mas alto

min_var <- portfolio_values[which.min(portfolio_values$Risk),]

head(min_var)
## # A tibble: 1 × 6
##    LSTR   ORA   SMAR Return  Risk SharpeRatio
##   <dbl> <dbl>  <dbl>  <dbl> <dbl>       <dbl>
## 1 0.654 0.282 0.0638  0.110 0.263       0.418
max_sr <- portfolio_values[which.max(portfolio_values$SharpeRatio),]

head(max_sr)
## # A tibble: 1 × 6
##    LSTR   ORA  SMAR Return  Risk SharpeRatio
##   <dbl> <dbl> <dbl>  <dbl> <dbl>       <dbl>
## 1 0.575 0.307 0.118  0.112 0.265       0.421

Graficamos la cartera de varianza minima

p <- min_var %>%
  gather(LSTR:SMAR, key = Asset,
         value = Weights) %>%
  mutate(Asset = as.factor(Asset)) %>%
  ggplot(aes(x = fct_reorder(Asset,Weights), y = Weights, fill = Asset)) +
  geom_bar(stat = 'identity') +
  theme_minimal() +
  labs(x = 'Acciones', y = 'Dolares', title = "Cartera de minima varianza") +
  scale_y_continuous(labels = scales::percent) 

ggplotly(p)

Graficamos la cartera con el Ratio Sharpe mas alto

p <- max_sr %>%
  gather(LSTR:SMAR, key = Asset,
         value = Weights) %>%
  mutate(Asset = as.factor(Asset)) %>%
  ggplot(aes(x = fct_reorder(Asset,Weights), y = Weights, fill = Asset)) +
  geom_bar(stat = 'identity') +
  theme_minimal() +
  labs(x = 'Acciones', y = 'Dolares', title = "Cartera con Ratio Sharpe mas alto") +
  scale_y_continuous(labels = scales::percent) 

ggplotly(p)

Graficamos todas las carteras aleatorias y visualizar la frontera eficiente.

p <- 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 Anualizado',
       y = 'Retornos Anualizados',
       title = "Optimización del portafolio y cartera eficiente") +
  geom_point(aes(x = Risk,
                 y = Return), data = min_var, color = 'gray') +
  geom_point(aes(x = Risk,
                 y = Return), data = max_sr, color = 'red') +
  annotate('text', x = 0.25, y = 0.162, label = "Tangency Portfolio") +
  annotate('text', x = 0.27, y = 0.05, label = "Minimum variance portfolio") +
  annotate(geom = 'segment', x = 0.25, xend = 0.2627,  y = 0.13, 
           yend = 0.11, color = 'red', arrow = arrow(type = "open")) +
  annotate(geom = 'segment', x = 0.27, xend = 0.2644,  y = 0.105, 
           yend = 0.1116, color = 'gray', arrow = arrow(type = "open"))
  

ggplotly(p)

Con base a lo expuesto, el Sharpe Ratio óptimo de inversión se sitúa en 0.4214653. Esto se fundamenta en la desviación estándar histórica de las acciones, que asciende a 0.00034 para Landstar System, Inc. (LSTR), 0.00055 para Ormat Technologies, Inc. (ORA) y 0.00144 para Smartsheet Inc. (SMAR) Este análisis revela una dispersión mínima en los retornos de las acciones en torno a la media, la cual también es notablemente baja, registrando valores de 0.00040 para Landstar System, Inc. (LSTR), 0.00042 para Ormat Technologies, Inc. (ORA) y 0.00050 para Smartsheet Inc. (SMAR)

Tomando en cuenta el Sharpe Ratio óptimo de inversión mencionado anteriormente, se concluye que la distribución óptima de los 10,000 USD sería invertir 5,727.076 dólares en Landstar System, Inc. (LSTR), 3,083.227 en Ormat Technologies, Inc. (ORA) y 1,189.697 en Smartsheet Inc. (SMAR)

Creacion del modelo del arbol binomial para ORA

Opcion de compra riesgo 1

r<- 0.0462
sigma=0.3706
T=1
N= 4
delta_t=T/N
tree = matrix(0, nrow=N+1, ncol=N+1)
build_stock_tree <- function(S, sigma, delta_t, N) {
  tree = matrix(0, nrow=N+1, ncol=N+1)
  U = exp(sigma*sqrt(delta_t))
  D = exp(-sigma*sqrt(delta_t))
  for (i in 1:(N+1)) {
    for (j in 1:i) {
      tree[i, j] = S * U^(j-1) * D^((i-1)-(j-1))
    }  }
  return(tree)
}
riesgo1 <- build_stock_tree(S=37.87, sigma=0.3706, delta_t=1/4, N=4)
riesgo1
##          [,1]     [,2]     [,3]     [,4]     [,5]
## [1,] 37.87000  0.00000  0.00000  0.00000  0.00000
## [2,] 31.46448 45.57955  0.00000  0.00000  0.00000
## [3,] 26.14242 37.87000 54.85862  0.00000  0.00000
## [4,] 21.72056 31.46448 45.57955 66.02670  0.00000
## [5,] 18.04664 26.14242 37.87000 54.85862 79.46838
k <- 40
intrinsecValue <- riesgo1[5,] - k
intrinsecValue[intrinsecValue<0] <- 0
intrinsecValue
## [1]  0.00000  0.00000  0.00000 14.85862 39.46838
q_prob <- function(r, delta_t, sigma) {
  u = exp(sigma*sqrt(delta_t))
  d = exp(-sigma*sqrt(delta_t))
    return((exp(r*delta_t) - d)/(u-d))
}
value_binomial_option <- function(tree, sigma, delta_t, r, X, type) {
  q = q_prob(r, delta_t, sigma)
  option_tree = matrix(0, nrow=nrow(tree), ncol=ncol(tree))
  if(type == 'put') {
    option_tree[nrow(option_tree),] = pmax(X - tree[nrow(tree),], 0)
  } else {  option_tree[nrow(option_tree),] = pmax(tree[nrow(tree),] - X, 0)
  }
  for (i in (nrow(tree)-1):1) {
    for(j in 1:i) {
     option_tree[i,j]=((1-q)*option_tree[i+1,j] +        q*option_tree[i+1,j+1])/exp(r*delta_t)
    }
  }
  return(option_tree)
  
option_tree[i, j] = ((1-q)*option_tree[i+1,j] +q*option_tree[i+1,j+1])/exp(r*delta_t)  
}
binomial_option <- function(type, sigma, T, r, X, S, N) {
  q <- q_prob(r=r, delta_t=T/N, sigma=sigma)
  tree <- build_stock_tree(S=S, sigma=sigma, delta_t=T/N, N=N)
  option <- value_binomial_option(tree, sigma=sigma, delta_t=T/N, r=r, X=X, type=type)
  return(list(q=q, stock=tree, option=option, price=option[1,1]))
}
Arbol <- binomial_option(type="call", sigma, T, r, X=k, 37.87, 4)
Arbol
## $q
## [1] 0.4849748
## 
## $stock
##          [,1]     [,2]     [,3]     [,4]     [,5]
## [1,] 37.87000  0.00000  0.00000  0.00000  0.00000
## [2,] 31.46448 45.57955  0.00000  0.00000  0.00000
## [3,] 26.14242 37.87000 54.85862  0.00000  0.00000
## [4,] 21.72056 31.46448 45.57955 66.02670  0.00000
## [5,] 18.04664 26.14242 37.87000 54.85862 79.46838
## 
## $option
##          [,1]     [,2]      [,3]     [,4]     [,5]
## [1,] 5.418743 0.000000  0.000000  0.00000  0.00000
## [2,] 1.637146 9.564456  0.000000  0.00000  0.00000
## [3,] 0.000000 3.414951 16.324108  0.00000  0.00000
## [4,] 0.000000 0.000000  7.123303 26.48604  0.00000
## [5,] 0.000000 0.000000  0.000000 14.85862 39.46838
## 
## $price
## [1] 5.418743

1. K=40 Sigma= 37.06%

# Define an array with strike prices between 80 and 120

strikes <- seq(20, 60)

option_price_vary_function <- function(strike) { option = binomial_option(type='call', sigma=sigma, T=1, r=r, X=strike, S=k, N=4)
  return(option$price)
}

# Use the sapply command to pass each value of the strikes array into the option_price_vary_strike function:

values <- sapply(strikes, option_price_vary_function)

# Create a data frame with the Strikes prices and the option prices (values) from above

data <- as.data.frame(list(strikes=strikes, values=values)) 

head(data)
##   strikes   values
## 1      20 20.96602
## 2      21 20.07835
## 3      22 19.19068
## 4      23 18.30301
## 5      24 17.41534
## 6      25 16.52767
ggplot(data=data) + geom_line(aes(x=strikes, y=values)) + labs(title="Call Value", x="Strikes", y="Value") +   geom_vline(xintercept = 40, linetype="dotted",  color = "red", size=1.5)
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

2. k=25 sigma=5.6660

sigma=5.6660
k=25

strikes <- seq(5, 45)

option_price_vary_function <- function(strike) { option = binomial_option(type='call', sigma=sigma, T=1, r=r, X=strike, S=k, N=4)
  return(option$price)
}

# Use the sapply command to pass each value of the strikes array into the option_price_vary_strike function:

values <- sapply(strikes, option_price_vary_function)

# Create a data frame with the Strikes prices and the option prices (values) from above

data <- as.data.frame(list(strikes=strikes, values=values)) 

head(data)
##   strikes   values
## 1       5 24.90015
## 2       6 24.88336
## 3       7 24.86656
## 4       8 24.84976
## 5       9 24.83296
## 6      10 24.81617
ggplot(data=data) + geom_line(aes(x=strikes, y=values)) + labs(title="Call Value", x="Strikes", y="Value") +   geom_vline(xintercept = 25, linetype="dotted",  color = "red", size=1.5)

3. k=70 sigma=1.4854

sigma=1.4854
k=70

strikes <- seq(50, 90)

option_price_vary_function <- function(strike) { option = binomial_option(type='call', sigma=sigma, T=1, r=r, X=strike, S=k, N=4)
  return(option$price)
}

# Use the sapply command to pass each value of the strikes array into the option_price_vary_strike function:

values <- sapply(strikes, option_price_vary_function)

# Create a data frame with the Strikes prices and the option prices (values) from above

data <- as.data.frame(list(strikes=strikes, values=values)) 

head(data)
##   strikes   values
## 1      50 44.16553
## 2      51 43.78292
## 3      52 43.40031
## 4      53 43.01770
## 5      54 42.63510
## 6      55 42.25249
ggplot(data=data) + geom_line(aes(x=strikes, y=values)) + labs(title="Call Value", x="Strikes", y="Value") +   geom_vline(xintercept = 70, linetype="dotted",  color = "red", size=1.5)

4. k=40 sigma=0.3286

sigma=0.3286
k=40

strikes <- seq(20, 60)

option_price_vary_function <- function(strike) { option = binomial_option(type='put', sigma=sigma, T=1, r=r, X=strike, S=k, N=4)
  return(option$price)
}

# Use the sapply command to pass each value of the strikes array into the option_price_vary_strike function:

values <- sapply(strikes, option_price_vary_function)

# Create a data frame with the Strikes prices and the option prices (values) from above

data <- as.data.frame(list(strikes=strikes, values=values)) 

head(data)
##   strikes     values
## 1      20 0.00000000
## 2      21 0.01674599
## 3      22 0.07923613
## 4      23 0.14172626
## 5      24 0.20421639
## 6      25 0.26670653
ggplot(data=data) + geom_line(aes(x=strikes, y=values)) + labs(title="Put Value", x="Strikes", y="Value") +   geom_vline(xintercept = 40, linetype="dotted",  color = "red", size=1.5)

5. k=20 sigma=1.6738

sigma=1.6738
k=20

strikes <- seq(0, 40)

option_price_vary_function <- function(strike) { option = binomial_option(type='put', sigma=sigma, T=1, r=r, X=strike, S=k, N=4)
  return(option$price)
}

# Use the sapply command to pass each value of the strikes array into the option_price_vary_strike function:

values <- sapply(strikes, option_price_vary_function)

# Create a data frame with the Strikes prices and the option prices (values) from above

data <- as.data.frame(list(strikes=strikes, values=values)) 

head(data)
##   strikes     values
## 1       0 0.00000000
## 2       1 0.06480615
## 3       2 0.28328316
## 4       3 0.50176018
## 5       4 0.81739404
## 6       5 1.42552980
ggplot(data=data) + geom_line(aes(x=strikes, y=values)) + labs(title="put Value", x="Strikes", y="Value") +   geom_vline(xintercept = 20, linetype="dotted",  color = "red", size=1.5)

6. k=55 sigma=1.3604

sigma=1.3604
k=55

strikes <- seq(35, 75)

option_price_vary_function <- function(strike) { option = binomial_option(type='put', sigma=sigma, T=1, r=r, X=strike, S=k, N=4)
  return(option$price)
}

# Use the sapply command to pass each value of the strikes array into the option_price_vary_strike function:

values <- sapply(strikes, option_price_vary_function)

# Create a data frame with the Strikes prices and the option prices (values) from above

data <- as.data.frame(list(strikes=strikes, values=values)) 

head(data)
##   strikes   values
## 1      35 13.29068
## 2      36 13.83819
## 3      37 14.38570
## 4      38 14.93322
## 5      39 15.48073
## 6      40 16.02824
ggplot(data=data) + geom_line(aes(x=strikes, y=values)) + labs(title="put Value", x="Strikes", y="Value") +   geom_vline(xintercept = 55, linetype="dotted",  color = "red", size=1.5)

7. k=40 sigma=0.3152694

sigma=0.3152694
k=40

strikes <- seq(20, 60)

option_price_vary_function <- function(strike) { option = binomial_option(type='call', sigma=sigma, T=1, r=r, X=strike, S=k, N=4)
  return(option$price)
}

# Use the sapply command to pass each value of the strikes array into the option_price_vary_strike function:

values <- sapply(strikes, option_price_vary_function)

# Create a data frame with the Strikes prices and the option prices (values) from above

data <- as.data.frame(list(strikes=strikes, values=values)) 

head(data)
##   strikes   values
## 1      20 20.90298
## 2      21 19.94813
## 3      22 19.03642
## 4      23 18.14251
## 5      24 17.24860
## 6      25 16.35470
ggplot(data=data) + geom_line(aes(x=strikes, y=values)) + labs(title="Call Value", x="Strikes", y="Value") +   geom_vline(xintercept = 40, linetype="dotted",  color = "red", size=1.5)

8. k=40 sigma=0.3152694

sigma=0.3152694
k=40

strikes <- seq(20, 60)

option_price_vary_function <- function(strike) { option = binomial_option(type='put', sigma=sigma, T=1, r=r, X=strike, S=k, N=4)
  return(option$price)
}

# Use the sapply command to pass each value of the strikes array into the option_price_vary_strike function:

values <- sapply(strikes, option_price_vary_function)

# Create a data frame with the Strikes prices and the option prices (values) from above

data <- as.data.frame(list(strikes=strikes, values=values)) 

head(data)
##   strikes     values
## 1      20 0.00000000
## 2      21 0.00000000
## 3      22 0.04313678
## 4      23 0.10408137
## 5      24 0.16502595
## 6      25 0.22597054
ggplot(data=data) + geom_line(aes(x=strikes, y=values)) + labs(title="put Value", x="Strikes", y="Value") +   geom_vline(xintercept = 40, linetype="dotted",  color = "red", size=1.5)

9. k=40 sigma=0.03790

sigma=0.03790
k=40

strikes <- seq(20, 60)

option_price_vary_function <- function(strike) { option = binomial_option(type='call', sigma=sigma, T=1, r=r, X=strike, S=k, N=4)
  return(option$price)
}

# Use the sapply command to pass each value of the strikes array into the option_price_vary_strike function:

values <- sapply(strikes, option_price_vary_function)

# Create a data frame with the Strikes prices and the option prices (values) from above

data <- as.data.frame(list(strikes=strikes, values=values)) 

head(data)
##   strikes   values
## 1      20 20.90298
## 2      21 19.94813
## 3      22 18.99328
## 4      23 18.03843
## 5      24 17.08358
## 6      25 16.12873
ggplot(data=data) + geom_line(aes(x=strikes, y=values)) + labs(title="Call Value", x="Strikes", y="Value") +   geom_vline(xintercept = 40, linetype="dotted",  color = "red", size=1.5)

10. k=40 sigma=0.03790

sigma=0.03790
k=40

strikes <- seq(20, 60)

option_price_vary_function <- function(strike) { option = binomial_option(type='put', sigma=sigma, T=1, r=r, X=strike, S=k, N=4)
  return(option$price)
}

# Use the sapply command to pass each value of the strikes array into the option_price_vary_strike function:

values <- sapply(strikes, option_price_vary_function)

# Create a data frame with the Strikes prices and the option prices (values) from above

data <- as.data.frame(list(strikes=strikes, values=values)) 

head(data)
##   strikes values
## 1      20      0
## 2      21      0
## 3      22      0
## 4      23      0
## 5      24      0
## 6      25      0
ggplot(data=data) + geom_line(aes(x=strikes, y=values)) + labs(title="put Value", x="Strikes", y="Value") +   geom_vline(xintercept = 40, linetype="dotted",  color = "red", size=1.5)

Creación de las Coberturas

Para la creación de las coberturas descargaremos los datos de precio desde el 01 de junio de 2023, hasta la fecha, de las acciones de Landstar System, Inc. (LSTR), Ormat Technologies, Inc. (ORA), Smartsheet Inc. (SMAR)

tick <- c('SMAR', 'LSTR', 'ORA')

price_data <- tq_get(tick,
                     from = '2023-06-01',
                     to = '2024-04-19',
                     get = 'stock.prices')

Calculamos los rendimientos diarios de estas acciones y visualizamos las primeras filas

log_ret_tidy <- price_data %>%
  group_by(symbol) %>%
  tq_transmute(select = adjusted,
               mutate_fun = periodReturn,
               period = 'daily',
               col_rename = 'ret',
               type = 'log')


log_ret_xts <- log_ret_tidy %>%
  spread(symbol, value = ret) %>%
  tk_xts()

head(log_ret_xts)
##                    LSTR           ORA         SMAR
## 2023-06-01  0.000000000  0.0000000000  0.000000000
## 2023-06-02  0.019088239  0.0151207952 -0.009622374
## 2023-06-05 -0.030966373 -0.0001163467  0.013891956
## 2023-06-06  0.030966373  0.0085728593  0.046962545
## 2023-06-07  0.026743142  0.0090716578 -0.052863487
## 2023-06-08 -0.001011487  0.0025115870 -0.192000938

Definimos los rendimientos diarios de cada activo y los porcentajes de inversión

# Crear vector para almacenar el capital actual al final de cada trimestre

capital_inicial <- 10000
porcentajes_inversion <- c(0.5755869, 0.3078440, 0.1165691)
inversion_inicial <- porcentajes_inversion*capital_inicial
LSTR <- as.vector(log_ret_xts$LSTR)
ORA <- as.vector(log_ret_xts$ORA)
SMAR <- as.vector(log_ret_xts$SMAR)



valor_inversion1 <- c()
valor_inversion2 <- c()
valor_inversion3 <- c()
valor <- c()
inversion_inicial <- as.vector(inversion_inicial)



# Simulación
p_y_g <- data.frame(Trimestre = numeric(), Pyg = numeric())
for (i in 1:length(log_ret_xts$LSTR)) {
    
    valor_inversion1[i] <- inversion_inicial[1]*(1 + LSTR[i])
    valor_inversion2[i] <- inversion_inicial[2]*(1 + ORA[i])
    valor_inversion3[i] <- inversion_inicial[3]*(1 + SMAR[i])

 }

 trimestre1<- sum(valor_inversion1[63],valor_inversion2[63],valor_inversion3[63]) - sum(inversion_inicial)
     trimestre2<- sum(valor_inversion1[126],valor_inversion2[126],valor_inversion3[126]) - sum(inversion_inicial)
      trimestre3<- sum(valor_inversion1[189],valor_inversion2[189],valor_inversion3[189]) - sum(inversion_inicial)
       trimestre4<- sum(valor_inversion1[222],valor_inversion2[222],valor_inversion3[222]) - sum(inversion_inicial)
  
# Crear los vectores con los datos
trimestre <- c("trimestre1", "trimestre2", "trimestre3", "trimestre4")
PyG <- c(
  sum(valor_inversion1[63], valor_inversion2[63], valor_inversion3[63]) - capital_inicial,
  sum(valor_inversion1[126], valor_inversion2[126], valor_inversion3[126]) - capital_inicial,
  sum(valor_inversion1[189], valor_inversion2[189], valor_inversion3[189]) - capital_inicial,
  sum(valor_inversion1[222], valor_inversion2[222], valor_inversion3[222]) - capital_inicial
)

# Crear la tabla
tabla_trimestres <- data.frame(Trimestre = trimestre, PyG = PyG)

# Imprimir la tabla
print(tabla_trimestres)
##    Trimestre         PyG
## 1 trimestre1 -10.3793000
## 2 trimestre2 -15.2430418
## 3 trimestre3 -53.0266630
## 4 trimestre4  -0.7479878

Utilizamos la Funicion Bullspread

bullspread.call <- function(S,K1,K2,precio1,precio2){
  
  if(K1>=S) stop("K1 debe ser menor a S.")
  if(S>=K2) stop("K2 debe ser mayor a S.")
  
  #larga
  callP1 = precio1
  #corto
  callP2 = precio2
  
  stock=unique(round(seq(0,K1,length.out=6)))
  stock=c(stock,round(seq(K1,K2,length.out=4)))
  stock=c(stock,round(seq(K2,K2+K1,length.out=6)))
  stock=unique(stock)
  payoff=rep(0,length(stock))
  profit=rep(0,length(stock))
  
  
  for(i in 1:length(stock)){
    if(stock[i]<=K1) payoff[i]=0
    if(stock[i]>=K2) payoff[i]=K2-K1
    if(stock[i]<K2 & stock[i]>K1) payoff[i]=stock[i]-K1
    profit[i]=payoff[i]+(callP2-callP1)
  }
  
  data <- data.frame(stock,payoff,profit)
  return(data)
}

Posición call Larga & Corta Para el Bull Spread Call

# Posición larga en call
long.callpayoff <- function(s,k,v,r,t){
  data.frame("payoff" = pmax(0,s-k), "stock" = s) %>% 
    mutate("profit" = payoff - v*exp(-r*t))
}

# Posición corta en call
short.callpayoff <- function(s,k,v,r,t){
  data.frame("payoff" = pmin(k-s,0),"stock" = s) %>% 
    mutate("profit" = payoff + v*exp(-r*t))}

Construcción de la Bull Spread Call

bull.spread <- bullspread.call(38.28,35,43.75,0.0462,0.25)
# Extraemos la St
s <- bull.spread$stock

# Call larga
long.call <- long.callpayoff(s,35,1,0,0)
# Call corta
short.call <- short.callpayoff(s,40,1,0,0)

Gráfico Bull Spread Call

g1 <- ggplot(bull.spread[4:10,]) + geom_line(aes(long.call$stock[4:10],long.call$profit[4:10],color = "blue"),linetype="dashed"
                                             ,size=1) 
g1 <- g1 + geom_line(aes(short.call$stock[4:10],short.call$profit[4:10], color = "red"),linetype="dashed",size=1) 
g1 <- g1 + geom_line(aes(bull.spread$stock[4:10],bull.spread$profit[4:10],color = "green"),size=1)
g1 <- g1 + ggtitle("Estrategia Bull Spreads") + xlab("stock") + ylab("Profit") + theme_bw()
g1 <- g1 + geom_hline(yintercept=0, linetype="dashed",color = "orange", size=1)
g1 <- g1 + scale_color_manual(name = " ",labels = c("Call larga", "Bull Spread", "Call corta"),values =                                      c("blue"="blue","green"="green","red" = "red"))
g1 <- g1 + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),legend.position="bottom") 
g1