Parte 1

En busca de realizar una inversión prudente de 10.000 USD se busca invertir en el índice Dow Jones, teniendo como prioridad las acciones de Nike, Walmart y Home Depot Se analiza el posible resultado que se puede obtener al invertir estas acciones para lo cual se obtienen los precios históricos para las acciones elegidas. Se instalan las librerías necesarias para descarga de datos y series de tiempo.

options(warn = -1)
suppressPackageStartupMessages({
library(tidyquant) 
library(plotly) 
library(timetk)
library(forcats)
library(tidyr)
})
tick <- c('NKE', 'WMT', 'HD')

price_data <- tq_get(tick,
                     from = '2019-04-17',
                     to = '2023-05-31',
                     get = 'stock.prices')

Una vez se obtienen los precios del portafolios se calculan los rendimientos logarítmicos de cada acción haciendo:

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

head(log_ret_tidy)
## # A tibble: 6 × 3
## # Groups:   symbol [1]
##   symbol date             ret
##   <chr>  <date>         <dbl>
## 1 NKE    2019-04-17  0       
## 2 NKE    2019-04-18  0.00528 
## 3 NKE    2019-04-22 -0.0208  
## 4 NKE    2019-04-23  0.000801
## 5 NKE    2019-04-24  0.0109  
## 6 NKE    2019-04-25 -0.00943

Se ordenan los datos, para la visualización en columnas:

log_ret_xts <- log_ret_tidy %>%
  spread(symbol, value = ret) %>%
  tk_xts()
## Using column `date` for date_var.
head(log_ret_xts)
##                      HD           NKE           WMT
## 2019-04-17  0.000000000  0.0000000000  0.000000e+00
## 2019-04-18 -0.004318084  0.0052829804  1.938060e-04
## 2019-04-22 -0.004288167 -0.0208434042 -7.881342e-03
## 2019-04-23  0.006182771  0.0008008875  6.814764e-03
## 2019-04-24  0.003246150  0.0109204856  4.452836e-03
## 2019-04-25 -0.001064578 -0.0094348096 -9.651076e-05

A continuación, evidenciamos un Histograma de los rendimientos:

#A continuación evidenciamos un Histograma de los rendimientos
if (!requireNamespace("plotly", quietly = TRUE)) {
  install.packages("plotly")
}

# Cargar la librería plotly
library(plotly)

# Convertir log_ret_xts a un dataframe para plotly
log_ret_df <- as.data.frame(log_ret_xts)

# Graficar las series de tiempo de los rendimientos
plot_ly(data = log_ret_df, x = ~index(log_ret_df)) %>%
  add_lines(y = ~NKE, name = "Nike") %>%
  add_lines(y = ~WMT, name = "Walmart") %>%
  add_lines(y = ~HD, name = "Home Depot") %>%
  layout(title = "Series de Tiempo de Rendimientos Logarítmicos",
         xaxis = list(title = "Fecha"),
         yaxis = list(title = "Rendimiento Logarítmico"))

Se observa el promedio de los rendimientos de los activos.

prom_ret <- colMeans(log_ret_xts)
print(round(prom_ret, 6))
##       HD      NKE      WMT 
## 0.000427 0.000213 0.000403

El promedio de Home Depot es de 0.000427, el de Nike 0.000213 y el de Walmart es de 0.000403, dado que el valor promedio de las acciones son valores positivos las acciones han dado más rendimientos positivos que negativos, sin embargo, hay que tener presente que el valor al ser cercano a cero, quiere decir que los valores han fluctuado entre valore positivos y negativos, de manera previa se puede decir que la volatilidad es considerable, y los valores de rendimiento obtenido no son tan altos. Home Depot es la acción que ligeramente tiene mejor promedio del rendimiento, mientas que Nike es la acción que menor promedio de retornos ofrece.

Ahora hallamos la matriz de covarianza

cov_mat <- cov(log_ret_xts) * 252

print(round(cov_mat,4))
##         HD    NKE    WMT
## HD  0.0941 0.0614 0.0313
## NKE 0.0614 0.1169 0.0247
## WMT 0.0313 0.0247 0.0538

La covarianza de las acciones en este caso son todas positivas, lo que implica que las acciones del portafolio vayan en la misma dirección, es decir, que el portafolio no cuenta con gran diversificación, lo que lo hace más susceptible al riesgo. Analizando los valores de la diagonal, los cuales son las varianzas de los rendimientos de las acciones o en su defecto, el riesgo que estás; se puede encontrar que la acción, que presenta mayor fluctuación es la de Nike, por tanto, tiene mayor riesgo, la de menor riesgo sería la de Walmart con un valor de 0.0538

calculamos los porcentajes o pesos de inversión aleatorios.

pesos <- runif(n = length(tick))
print(pesos)
## [1] 0.4403207 0.2584034 0.7127726
print(sum(pesos))
## [1] 1.411497
# hacer que los pesos sumen el 100%
pesos <- pesos/sum(pesos)
print(pesos)
## [1] 0.3119530 0.1830705 0.5049765
sum(pesos)
## [1] 1

Calculamos el indice de Sharpe, riesgo y rendimientos

## se calculan los rendimientos del portafolio

retorno_portafolio <- ((sum(pesos*prom_ret)+1)^252) - 1
retorno_portafolio
## [1] 0.0993682
## desviación estandar (anual) o riesgo del portafolio.

riesgo_port <- sqrt(t(pesos) %*% (cov_mat %*% pesos))
print(riesgo_port)
##           [,1]
## [1,] 0.2196376
## considerando una tasa libre de riesgo nula o de cero calculamos el 
##indice de sharpe 

ind_sharpe <- retorno_portafolio/riesgo_port
print(ind_sharpe)
##           [,1]
## [1,] 0.4524189

El índice de Sharp es bajo y está relacionada con la alta volatilidad y riesgo del portafolio, es decir que el rendimiento no es suficiente para el nivel de riesgo que hay que asumir

Realizamos una simulación de 5.000 portafolios, para lo cual debemos prepara las variables para la simulación

## Simular 5.000 portafolios

simulacion <- 5000

## se crea matriz para almacenar los porcentajes de inversión

pesos_porta <- matrix(nrow=simulacion, ncol= length(tick))

## vector vacío para almacenar los retornos del portafolio

retorno_porta <- vector('numeric', length = simulacion)

## vector vacío para almacenar la desviación estandar del portafolio

riesgo_porta <- vector('numeric', length = simulacion)

## vector vacio para almacenar el indice de sharpe del portafolio

indice_sharpe <- vector('numeric', length = simulacion)

Con lo anteior, se realiza la simulación.

## simulacion de los 5.000 portafolios
for (i in seq_along(retorno_porta)) {
  
  pesos <- runif(length(tick))
  pesos <- pesos/sum(pesos)
  
  # Guardar los pesos del portafolio
  pesos_porta[i,] <- pesos
  
  # Calculamos los retornos del portafolio 
  retorno_portafolio <- sum(pesos * prom_ret)
  retorno_portafolio <- ((retorno_portafolio + 1)^252) - 1
  
  # Guardar los retornos del portafolio
  retorno_porta[i] <- retorno_portafolio
  
  # Calculamos el riesgo del portafolio
  riesgo_portafolio <- sqrt(t(pesos) %*% (cov_mat  %*% pesos))
  
  # Guardar el riesgo del portafolio
  riesgo_porta[i] <- riesgo_portafolio
  
  # Creamos y guardamos el índice de Sharpe teniendo presente una tasa
  # libre de riesgo del 0%
  sharpe <- retorno_portafolio/riesgo_portafolio
  indice_sharpe[i] <- sharpe
} 


# valores en una tabla
Valores_porta <- tibble(Retorno = retorno_porta,
                           Riesgo = riesgo_porta,
                           Indice_de_Sharpe = indice_sharpe)

pesos_porta <- tk_tbl(pesos_porta)

colnames(pesos_porta) <- colnames(log_ret_xts)

Colocamos ahora todo Junto

# todo junto
Valores_porta <- tk_tbl(cbind(pesos_porta, Valores_porta))

head(Valores_porta)
## # A tibble: 6 × 6
##      HD   NKE   WMT Retorno Riesgo Indice_de_Sharpe
##   <dbl> <dbl> <dbl>   <dbl>  <dbl>            <dbl>
## 1 0.321 0.360 0.319  0.0902  0.238            0.379
## 2 0.569 0.159 0.272  0.102   0.246            0.417
## 3 0.241 0.346 0.413  0.0904  0.228            0.396
## 4 0.295 0.304 0.400  0.0929  0.228            0.407
## 5 0.437 0.382 0.181  0.0898  0.256            0.350
## 6 0.133 0.369 0.498  0.0885  0.224            0.395

Colocamos ahora el Portafolio que se destaca tener el menor riesgo.

## el de menor riesgo 
menor_riesgo <- Valores_porta[which.min(Valores_porta$Riesgo),]

## Gráfica del portafolio con Menor Riesgo.

MR <- menor_riesgo %>%
  gather(HD:WMT, key = Asset, value = Weights) %>%
  mutate(Asset = factor(Asset, levels = c('HD', 'NKE', 'WMT'))) %>%
  ggplot(aes(x = fct_reorder(Asset, Weights), y = Weights, fill = Asset)) +
  geom_bar(stat = 'identity') +
  theme_minimal() +
  labs(x = 'Acción', y = 'Porcentaje de inversión', title = "Portafolio de Menor Riesgo") +
  scale_y_continuous(labels = scales::percent) 

ggplotly(MR)

Portafolio Optimo, o con mayor indice de Sharpe

## Observamos el portafolio con mayor indice de sharpe
max_ind_Sharpe <- Valores_porta[which.max(Valores_porta$Indice_de_Sharpe),]

## Gráfica del portafolio con Mayor Indice de Sharpe

MIS <- max_ind_Sharpe %>%
  gather(HD:WMT, 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 = 'Acción', y = 'Porcentaje', title = "Portafolio con Indice de Sharpe Maximizado") +
  scale_y_continuous(labels = scales::percent) 

ggplotly(MIS)

El tercer gráfico valora el proceso y fabríca la forma gráfica de la frontera eficiente donde el indice de Sharp está siendo máximizado

# Frontera eficiente de portafolios.
FE <- Valores_porta %>%
  ggplot(aes(x = Riesgo, y = Retorno, color = Indice_de_Sharpe)) +
  geom_point() +
  theme_classic() +
  scale_y_continuous(labels = scales::percent) +
  scale_x_continuous(labels = scales::percent) +
  labs(x = 'Riesgo',
       y = 'Rendimientos',
       title = "Optimización del Portafolio & Frontera Eficiente") +
  geom_point(data = menor_riesgo, aes(x = Riesgo, y = Retorno), color = 'red', size = 4) +
  geom_point(data = max_ind_Sharpe, aes(x = Riesgo, y = Retorno), color = 'blue', size = 4) +
  annotate('text', x = 0.20, y = 0.42, label = "Máximo Indice de Sharpe", color = 'blue') +
  annotate('text', x = 0.18, y = 0.01, label = "Portafolio de Mínimo Riesgo", color = 'red') +
  annotate(geom = 'segment', x = 0.14, xend = 0.135,  y = 0.01, 
           yend = 0.06, color = 'red', arrow = arrow(type = "open")) +
  annotate(geom = 'segment', x = 0.22, xend = 0.2275,  y = 0.405, 
           yend = 0.365, color = 'blue', arrow = arrow(type = "open"))

ggplotly(FE)

Tras la simulación del portafolio se obtiene que el mayor porcentaje de inversión debe ser para Walmart, quien es la acción que representa menor riesgo y un buen valor promedio de los rendimientos, ya sea para minimizar el riesgo, o por lo contrario maximizar el índice de Sharp obteniendo un portafolio optimo. Por su parte la acción que debe tener la participación más baja o nula directamente debe ser la Nike, debido a su alto riesgo. El riesgo es un valor muy alto, que se hace cercano o supera los valores esperados de rendimiento, Razón por la cual el índice de Sharpe es muy bajo, mostrando que lo obtenido en los retornos no va acorde con el riesgo asumido.

PARTE 2

1. VOLATILIDADES PARA UNA ACCIÓN

Usaremos la opción de nike para realizar esta parte, primero hallamos las tres volatilidades para realizar el ejercicio.

#FORMA 1: VOLATILIDAD IMPLICITA

Usamos la volatilidad que aparece en la página de Yahoo Finance y su precio strike.

p_strike = 96
vol_imp = 0.2236

#FORMA 2: VOLATILIDAD DE LA ACCIÓN

Usamos la volatilidad histórica de la acción desde el 01/06/2024 hasta el 19/04/2024

op = c("NKE")
data_op = lapply(op, FUN = function(x) {
  ROC(Ad(getSymbols(x, from = "2023-06-01", to = "2024-04-19", auto.assign = FALSE)),
      type = "continuous")
})  #%returns
ret_op = as.data.frame(do.call(merge, data_op))
colnames(ret_op) = gsub(".Adjusted", "", colnames(ret_op))
ret_op = ret_op[-1, ]

#Volatilidad del activo original
var_op = var(ret_op)
desves_op = sqrt(var_op)
print(desves_op)
## [1] 0.01781107

#FORMA 3: VOLATICIDAD DEL PORTAFOLIO

Usaremos la desviación estándar del portafolio ya calculada en la parte uno. “riesgo_portafolio”.

Después de tener las tres volatilidades establecemos las funciones para calcular los resultados.

#OPCION NKE
S1 <- 96
sigma1 <- 0.2236
delta_t <- 0.25
N <- 4

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)
}

First_tree <- build_stock_tree(S1, sigma1, delta_t, N)

K <- 94.53

IntrinsecValue <- First_tree[5,]-K
IntrinsecValue[IntrinsecValue<0] <- 0
print(IntrinsecValue)
## [1]  0.00000  0.00000  1.47000 25.52479 55.60700
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) {
      # Calculamos los pesos dentro del ciclo
      peso_abajo = (1 - q) * exp(-r * delta_t)
      peso_arriba = q * exp(-r * delta_t)
      option_tree[i,j] = (peso_abajo * option_tree[i+1,j] + peso_arriba * option_tree[i+1,j+1])
    }
  }
  return(option_tree)
}

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]))
}

Usaremos la tasa libre de riesgo trimestral de 5.50% y hallamos nuestro arbol binomial con nuestras tres volatilidades.

#FORMA 1:

results1 <- binomial_option(type='call', sigma=0.2236, T=1, r=0.055, X=94.53, S=96, N=4)

#Arbol binomial
results1$stock
##          [,1]      [,2]     [,3]     [,4]    [,5]
## [1,] 96.00000   0.00000   0.0000   0.0000   0.000
## [2,] 85.84542 107.35576   0.0000   0.0000   0.000
## [3,] 76.76495  96.00000 120.0548   0.0000   0.000
## [4,] 68.64499  85.84542 107.3558 134.2560   0.000
## [5,] 61.38394  76.76495  96.0000 120.0548 150.137

#FORMA 2:

results2 <- binomial_option(type='call', sigma=desves_op, T=1, r=0.055, X=94.53, S=96, N=4)

#Arbol binomial
results2$stock
##          [,1]     [,2]     [,3]     [,4]     [,5]
## [1,] 96.00000  0.00000  0.00000  0.00000  0.00000
## [2,] 95.14886 96.85875  0.00000  0.00000  0.00000
## [3,] 94.30527 96.00000 97.72518  0.00000  0.00000
## [4,] 93.46916 95.14886 96.85875 98.59936  0.00000
## [5,] 92.64047 94.30527 96.00000 97.72518 99.48136

#FORMA 3:

results3 <- binomial_option(type='call', sigma=riesgo_portafolio, T=1, r=0.055, X=94.53, S=96, N=4)

#Arbol binomial
results3$stock
##          [,1]      [,2]     [,3]     [,4]     [,5]
## [1,] 96.00000   0.00000   0.0000   0.0000   0.0000
## [2,] 83.85904 109.89871   0.0000   0.0000   0.0000
## [3,] 73.25353  96.00000 125.8096   0.0000   0.0000
## [4,] 63.98928  83.85904 109.8987 144.0241   0.0000
## [5,] 55.89666  73.25353  96.0000 125.8096 164.8757

Después de realizar los tres árboles binomiales nos damos cuenta qe tanto con la volatilidad implicita como con la volatilidad del portafolio el precio de la acción de nike tiene la misma tendencia, cosa que no ocurre si usamos la volatilidad histórica de la propia acción, esto se debe a los tiempos que se usaron para calcular esta última, que es mucho más corto que las otras dos, por lo que los cambios de precio no arrastran tanta información como lo hacen datos de más de 5 años y que a su vez tienen una volatilidad más elevada.

##2. PRECIOS SPOT EXTREMOS

Usaremos los precios spot extremos y sus volatilidades implicitas y hallaremos el arbol binomial.

#Resultados con valores extremos (PRECIO MAS BAJO)
precio_bajo <- binomial_option(type='put', sigma=0.8281, T=1, r=0.055, X=94.53, S=70, N=4)
#Arbol binomial
precio_bajo$stock
##          [,1]      [,2]     [,3]     [,4]     [,5]
## [1,] 70.00000   0.00000   0.0000   0.0000   0.0000
## [2,] 46.26775 105.90529   0.0000   0.0000   0.0000
## [3,] 30.58150  70.00000 160.2276   0.0000   0.0000
## [4,] 20.21339  46.26775 105.9053 242.4136   0.0000
## [5,] 13.36040  30.58150  70.0000 160.2276 366.7554
#Resultados con valores extremos (PRECIO MAS ALTO)
precio_alto <- binomial_option(type='call', sigma=0.8945, T=1, r=0.055, X=94.53, S=125, N=4)
#Arbol binomial
precio_alto$stock
##           [,1]      [,2]     [,3]     [,4]     [,5]
## [1,] 125.00000   0.00000   0.0000   0.0000   0.0000
## [2,]  79.92301 195.50066   0.0000   0.0000   0.0000
## [3,]  51.10149 125.00000 305.7641   0.0000   0.0000
## [4,]  32.67348  79.92301 195.5007 478.2166   0.0000
## [5,]  20.89090  51.10149 125.0000 305.7641 747.9333

Como observamos con estos, dan valores super altos y super bajos, esto debido a la volatilidad implicita que es la más alta, lo que significa que estos precios son los que la acción esmuy poco probable que se ubique, por eso es la diferencia tan grande que tiene con respecto a los anteriores casos que vimos.

PARTE 3

"Paso 1: Calcular Rcc Serie desde 01/06/2023 hasta hoy"
## [1] "Paso 1: Calcular Rcc Serie desde 01/06/2023 hasta hoy"
tick <- c('NKE', 'WMT', 'HD')

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

## se calculan los rendimientos logarítmicos

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

head(log_ret_tidy)
## # A tibble: 6 × 3
## # Groups:   symbol [1]
##   symbol date            ret
##   <chr>  <date>        <dbl>
## 1 NKE    2023-06-01  0      
## 2 NKE    2023-06-02  0.0426 
## 3 NKE    2023-06-05 -0.0242 
## 4 NKE    2023-06-06  0.00937
## 5 NKE    2023-06-07  0.00844
## 6 NKE    2023-06-08 -0.00835
## se ordenan los datos, para la vizualización en columnas.
log_ret_xts_rcc <- log_ret_tidy %>%
  spread(symbol, value = ret) %>%
  tk_tbl()

head(log_ret_xts_rcc)
## # A tibble: 6 × 4
##   date             HD      NKE       WMT
##   <date>        <dbl>    <dbl>     <dbl>
## 1 2023-06-01  0        0        0       
## 2 2023-06-02  0.0258   0.0426   0.00952 
## 3 2023-06-05 -0.00964 -0.0242   0.00656 
## 4 2023-06-06  0.00985  0.00937 -0.000133
## 5 2023-06-07  0.0191   0.00844  0.00147 
## 6 2023-06-08 -0.00202 -0.00835  0.0144
library(dplyr)
## 
## ######################### Warning from 'xts' package ##########################
## #                                                                             #
## # The dplyr lag() function breaks how base R's lag() function is supposed to  #
## # work, which breaks lag(my_xts). Calls to lag(my_xts) that you type or       #
## # source() into this session won't work correctly.                            #
## #                                                                             #
## # Use stats::lag() to make sure you're not using dplyr::lag(), or you can add #
## # conflictRules('dplyr', exclude = 'lag') to your .Rprofile to stop           #
## # dplyr from breaking base R's lag() function.                                #
## #                                                                             #
## # Code in packages is not affected. It's protected by R's namespace mechanism #
## # Set `options(xts.warn_dplyr_breaks_lag = FALSE)` to suppress this warning.  #
## #                                                                             #
## ###############################################################################
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:xts':
## 
##     first, last
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
log_ret_xts_rcc <- log_ret_xts_rcc %>%
  rename(Fecha = date)

"Paso 2: Sumatoria del Rcc"
## [1] "Paso 2: Sumatoria del Rcc"
# Datos iniciales

trimestres <- c("Trimestre 1", "Trimestre 2", "Trimestre 3", "Trimestre 4")
fechas_inicio <- as.Date(c("2023-06-01", "2023-09-01", "2023-12-01", "2024-03-01"))
fechas_fin <- as.Date(c("2023-08-30", "2023-11-30", "2024-02-28", "2024-04-22"))
resultados <- data.frame(Trimestre = trimestres, HD = numeric(length(trimestres)), NKE = numeric(length(trimestres)), WMT = numeric(length(trimestres)))

# Calcular la suma de cada columna para cada trimestre
for (i in 1:length(trimestres)) {
  resultados[i, "HD"] <- sum(log_ret_xts_rcc$HD[log_ret_xts_rcc$Fecha >= fechas_inicio[i] & log_ret_xts_rcc$Fecha <= fechas_fin[i]])
  resultados[i, "NKE"] <- sum(log_ret_xts_rcc$NKE[log_ret_xts_rcc$Fecha >= fechas_inicio[i] & log_ret_xts_rcc$Fecha <= fechas_fin[i]])
  resultados[i, "WMT"] <- sum(log_ret_xts_rcc$WMT[log_ret_xts_rcc$Fecha >= fechas_inicio[i] & log_ret_xts_rcc$Fecha <= fechas_fin[i]])
}

menor_riesgo_mat <- as.matrix(menor_riesgo[, 1:3])
menor_riesgo_mat <- menor_riesgo_mat * 10000
resultados_mat <- as.matrix(resultados[, 2:4])

# Inicializar un nuevo dataframe para almacenar los resultados
resultados_multiplicados <- matrix(NA, nrow = nrow(resultados_mat), ncol = ncol(resultados_mat))

# Realizar la multiplicación por columna y guardar los resultados en el nuevo dataframe
for (i in 1:ncol(resultados_mat)) {
  resultados_multiplicados[, i] <- menor_riesgo_mat[, i] * resultados_mat[, i]
}

# Convertir la matriz en un dataframe
resultados_multiplicados <- as.data.frame(resultados_multiplicados)

# Imprimir el resultado
print(resultados_multiplicados)
##           V1         V2        V3
## 1  214.05278  -19.56616  633.6521
## 2  -68.14505  142.09508 -296.3774
## 3  278.45891  -87.49835  970.7782
## 4 -180.46891 -154.04834  129.3181
# Calcular la suma por fila
resultados_suma <- rowSums(resultados_multiplicados)

# Imprimir el resultado
print(resultados_suma)
## [1]  828.1388 -222.4273 1161.7388 -205.1991
# Crear el gráfico de barras
barplot(resultados_suma, 
        main = "Resultados por Trimestre", 
        xlab = "Trimestre", 
        ylab = "Suma", 
        col = "#7AC5CD", 
        border = "black",
        col.axis = "black",
        horiz = FALSE)

"Paso 3: Crear estrategia de cobertura"
## [1] "Paso 3: Crear estrategia de cobertura"
"Long Straddle"
## [1] "Long Straddle"
prices <- seq(80,120,1) # Vector of prices
strike <- 103 # strike price for both put and call 
premium_call <- 0.2 # option price call
premium_put <- 0.5  # 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("#C3ACCE", "#5EB1BF", "#6320EE")) + ylab("Payoff")+
  ggtitle("Long Straddle Payoff")  

"1. Cual estrategia es prudente aplicar en cada opción para sacar provecho en cada pago? Analice"
## [1] "1. Cual estrategia es prudente aplicar en cada opción para sacar provecho en cada pago? Analice"
"Dado que según los rendimientos reportados del portafolio en cada uno de los trimestres,
se observa que tiene un comportamiento muy inestable, dandose rendimientos positivos en
los trimestres 1 y 3 y negativos en los trimestres 2 y 4. Por lo tanto se decidió aplicar la 
estrategia de Long Straddle con dos opciones del subyacente NKE, con valores de strike y
plazo al vencimiento iguales. Ejecutándose así la compra de una Call y una Put.

Adicionalmente, la teoría sugiere que es apropiado aplicar esta estrategia de cobertura
cuando se espera un movimiento fuerte en el precio de la acción y no se tiene certeza
sobre la dirección de ese movimiento."
## [1] "Dado que según los rendimientos reportados del portafolio en cada uno de los trimestres,\nse observa que tiene un comportamiento muy inestable, dandose rendimientos positivos en\nlos trimestres 1 y 3 y negativos en los trimestres 2 y 4. Por lo tanto se decidió aplicar la \nestrategia de Long Straddle con dos opciones del subyacente NKE, con valores de strike y\nplazo al vencimiento iguales. Ejecutándose así la compra de una Call y una Put.\n\nAdicionalmente, la teoría sugiere que es apropiado aplicar esta estrategia de cobertura\ncuando se espera un movimiento fuerte en el precio de la acción y no se tiene certeza\nsobre la dirección de ese movimiento."
"2. ¿Con la información de los últimos tres trimestres, cuales serían los limites mínimos 
y máximos? que tanto varían cada trimestre? hay oportunidad de arbitraje según
la posición? analice."
## [1] "2. ¿Con la información de los últimos tres trimestres, cuales serían los limites mínimos \ny máximos? que tanto varían cada trimestre? hay oportunidad de arbitraje según\nla posición? analice."
"Teniendo como base el subyacente de NKE, se tiene que por trimestre"
## [1] "Teniendo como base el subyacente de NKE, se tiene que por trimestre"
# Definir las fechas deseadas
fechas_deseadas <- as.Date(c("2023-06-01", "2023-09-01", "2023-12-01", "2024-03-01"))

# Filtrar el dataframe price_data_rcc
nke_data <- price_data_rcc %>%
  filter(symbol == "NKE" & date %in% fechas_deseadas) %>%
  select(date, adjusted)

# Ver el nuevo dataframe
print(nke_data)
## # A tibble: 4 × 2
##   date       adjusted
##   <date>        <dbl>
## 1 2023-06-01     102.
## 2 2023-09-01     102.
## 3 2023-12-01     113.
## 4 2024-03-01     102.
# Definir las constantes
K <- 103
r <- 0.055
T <- 4/12

# Agregar las columnas K, r y T
nke_data <- nke_data %>%
  mutate(K = K,
         r = r,
         T = T)

# Calcular las columnas adicionales
nke_data <- nke_data %>%
  mutate(`Límite Inferior CALL` = adjusted - K * exp(-r * T),
         `Límite Superior CALL` = adjusted,
         `Arbitraje CALL` = ifelse(0.2 > `Límite Inferior CALL`, TRUE, FALSE),
         `Límite Inferior PUT` = K * exp(-r * T) - adjusted,
         `Límite Superior PUT` = K * exp(-r * T),
         `Arbitraje PUT` = ifelse(0.5 > `Límite Inferior PUT`, TRUE, FALSE))

# Ver el dataframe resultante
print(nke_data)
## # A tibble: 4 × 11
##   date       adjusted     K     r     T `Límite Inferior CALL`
##   <date>        <dbl> <dbl> <dbl> <dbl>                  <dbl>
## 1 2023-06-01     102.   103 0.055 0.333                  1.11 
## 2 2023-09-01     102.   103 0.055 0.333                  0.524
## 3 2023-12-01     113.   103 0.055 0.333                 11.9  
## 4 2024-03-01     102.   103 0.055 0.333                  0.751
## # ℹ 5 more variables: `Límite Superior CALL` <dbl>, `Arbitraje CALL` <lgl>,
## #   `Límite Inferior PUT` <dbl>, `Límite Superior PUT` <dbl>,
## #   `Arbitraje PUT` <lgl>
"Dado el calculo anteriormente llevado a cabo, se puede observar que en la opción
PUT siempre se presenta una oportunidad de arbitraje, dado que el valor del subyacente
siempre se encuentra por encima del strike a valor presente, mientras que en la opción 
CALL se da la situación contraria. Esto reafirma la oportunidad de aplicar la estrategia de
Straddle, en donde ambas opciones contrarrestan el payoff, dando como resultado una cobertura
en donde se obtiene un mayor payoff y se minimiza la pérdida, como se puede observar en el gráfico
de Long Straddle Payoff"
## [1] "Dado el calculo anteriormente llevado a cabo, se puede observar que en la opción\nPUT siempre se presenta una oportunidad de arbitraje, dado que el valor del subyacente\nsiempre se encuentra por encima del strike a valor presente, mientras que en la opción \nCALL se da la situación contraria. Esto reafirma la oportunidad de aplicar la estrategia de\nStraddle, en donde ambas opciones contrarrestan el payoff, dando como resultado una cobertura\nen donde se obtiene un mayor payoff y se minimiza la pérdida, como se puede observar en el gráfico\nde Long Straddle Payoff"