DESARROLLO

A continuación, realizaremos una práctica de simulaciones con MBG y precios futuros, se mostrará el código de ejecución en R-Studio y el análisis correspondiente a cada cálculo. 

library(quantmod)
library(zoo)
library(TTR)
library(xts)
library(knitr)
library(fBasics)
library(moments)
library(tidyverse)
library(dplyr)
library(ggplot2)

#Cargar datos.

datos_trm = read.table("trm_cm.txt", head = T)


head(datos_trm)
##        Fecha     TRM
## 1 01/01/2000 1873.77
## 2 02/01/2000 1873.77
## 3 03/01/2000 1873.77
## 4 04/01/2000 1874.35
## 5 05/01/2000 1895.97
## 6 06/01/2000 1912.69
tail(datos_trm)
##           Fecha     TRM
## 8291 12/09/2022 4365.32
## 8292 13/09/2022 4346.91
## 8293 14/09/2022 4413.89
## 8294 15/09/2022 4389.80
## 8295 16/09/2022 4404.64
## 8296 17/09/2022 4435.84
# Tamaño de la muestra
n <- nrow(datos_trm)

#Vector de precios
precios = datos_trm[,-1]
precios = ts(precios)

#Precio actual de la TRM
s = tail(precios,1)
s = as.numeric(s)
s
## [1] 4435.84
# Verificar que el formato de la fecha sea correcto.
datos_trm[,"Fecha"]<-as.Date(datos_trm[,"Fecha"],format = "%d/%m/%Y")
datos_trm <- datos_trm %>% arrange(Fecha)

#Media y desviación de los precios de la TRM
mean_precios <- mean(precios)
sd_precios <- sd(precios)


#Vector de rendimientos diarios
Rtos_diarios = diff(log(precios))

#Vector rendimientos anuales
Rtos_anuales = (Rtos_diarios) * 252

# MEDIA de rendimientos diaria
media_diaria = mean(Rtos_diarios)
media_diaria
## [1] 0.0001038896
#Volatilidad diaria(SIGMA/DESVIACIÓN)
volatilidad_diaria = sd(Rtos_diarios)
volatilidad_diaria
## [1] 0.005783866
#Volatilidad anual
Volatilidad_Anual = sd(Rtos_diarios) * 252


#Media de rendimientos anual
media_Anual = mean(Rtos_diarios) * 252
media_Anual
## [1] 0.02618019

Gráfica de la TRM.

plot(datos_trm[,"Fecha"],datos_trm[,"TRM"], type = "l", col = "blue", main = "Serie Historica TRM")

Primera parte

1. En una tabla, calcule e interprete la estadística descriptiva (media, desviación estándar, rendimiento anual, volatilidad anual, cuantiles, sesgo, curtosis, mínimo y máximo).

Estadística básica

Sobre Precios:

max(datos_trm[,"TRM"])
## [1] 4627.46
min(datos_trm[,"TRM"])
## [1] 1652.41
mean(datos_trm[,"TRM"])
## [1] 2553.402
sd(datos_trm[,"TRM"])
## [1] 643.277
skewness(datos_trm[,"TRM"])
## [1] 0.7478894
kurtosis(datos_trm[,"TRM"])
## [1] 2.685184
estad_precios=cbind(Estadistica=c("Max", "Min", "Mean", "Desv", "Sesgo", "Kurtosis"), Precios=c(max(datos_trm[,"TRM"]),min(datos_trm[,"TRM"]),mean(datos_trm[,"TRM"]),sd(datos_trm[,"TRM"]),skewness(datos_trm[,"TRM"]),kurtosis(datos_trm[,"TRM"])))
kable(estad_precios)
Estadistica Precios
Max 4627.46
Min 1652.41
Mean 2553.40167430087
Desv 643.276997400928
Sesgo 0.747889447812386
Kurtosis 2.68518407398657 
#Cuantiles precios
quantile(datos_trm[,"TRM"],c(0.01,0.05,0.1,0.5,0.75,0.90,0.95,0.99))
##       1%       5%      10%      50%      75%      90%      95%      99% 
## 1761.485 1789.540 1830.770 2345.470 2954.158 3580.350 3830.250 4129.870

Sobre Rendimientos:

max(Rtos_diarios)
## [1] 0.05930667
min(Rtos_diarios)
## [1] -0.05621935
mean(Rtos_diarios)
## [1] 0.0001038896
sd(Rtos_diarios)
## [1] 0.005783866
skewness(Rtos_diarios)
## [1] 0.2649411
kurtosis(Rtos_diarios)
## [1] 13.88438
estad_rendimientos=cbind(Estadistica=c("Max", "Min", "Mean", "Desv", "Sesgo", "Kurtosis"), Rendimientos=c(max(Rtos_diarios),min(Rtos_diarios),mean(Rtos_diarios),sd(Rtos_diarios),skewness(Rtos_diarios),kurtosis(Rtos_diarios)))
kable(estad_rendimientos)
Estadistica Rendimientos
Max 0.0593066743064448
Min -0.0562193503314647
Mean 0.00010388963907742
Desv 0.00578386604402905
Sesgo 0.264941128226632
Kurtosis 13.8843844743101 
#Comparación de cuantiles

qqnorm(Rtos_diarios)
qqline(Rtos_diarios)

#Cuantiles rendimientos
quantile(Rtos_diarios,c(0.01,0.05,0.1,0.5,0.75,0.90,0.95,0.99))
##           1%           5%          10%          50%          75%          90% 
## -0.016347400 -0.008534254 -0.005462864  0.000000000  0.001315725  0.005793101 
##          95%          99% 
##  0.009327293  0.018328488

2.Calcule de manera teórica un intervalo de confianza al 95% sobre los posibles precios futuros de la TRM.

#Para los precios
qnorm(c(0.05,0.95),mean = mean(precios),sd=sd(precios))
## [1] 1495.305 3611.498
#Para los rendimientos
qnorm(c(0.05,0.95),mean = mean(Rtos_diarios),sd=sd(Rtos_diarios))
## [1] -0.009409723  0.009617503

3. Realizando una simulación MBG con S=Precio de la TRM del 17 de septiembre de 2022, y t=180, volatilidad = histórica de la serie, mu = histórica de la serie, iteraciones = 10000, de los posibles precios futuros.

Simulación MBG

# Definir los parámetros
S =s  # Precio de la TRM del 17 de septiembre de 2022
t <- 180   # Tiempo en días
volatilidad <- volatilidad_diaria  # Volatilidad histórica de la serie
mu <- media_diaria  # Tasa de crecimiento/rendimiento histórica de la serie
iteraciones <- 10000  # Número de iteraciones

# Crear una función para simular el MBG
set.seed(123) #Establecer una semilla
simular_MB <- function(S, t, volatilidad, mu, iteraciones) {
  precios_futuros <- numeric(iteraciones)
  for (i in 1:iteraciones) {
    W_t <- rnorm(1, mean = 0, sd = sqrt(t))  # Generar un valor del proceso Browniano
    S_t <- S * exp((mu - 0.5 * volatilidad^2) * t + volatilidad * W_t)  # Calcular el precio futuro
    precios_futuros[i] <- S_t
  }
  return(precios_futuros)
}

precios_simulados = simular_MB(S, t, volatilidad, mu, iteraciones)

# Ver los primeros 5 precios simulados
head(precios_simulados, 5)
## [1] 4314.210 4426.215 5085.331 4530.706 4551.418

3.a. Grafique la distribución empírica

Gráfico del histograma y densidad

hist(precios_simulados, breaks = 30, prob = TRUE, col = "skyblue", main = "Distribución Empírica de Precios Futuros", xlab = "Precio Futuro", ylab = "Densidad")

# Curva de densidad
densidad <- density(precios_simulados)
lines(densidad, col = "red", lwd = 2)

La gráfica nos muestra la distribución empírica de los precios futuros simulados.Esta tiende a ser mesocúrtica. La curva de densidad (en rojo) nos da una idea de la forma de la distribución.

3.b. Calcule los cuantiles al 2.5% y 97.5% de los posibles precios.

cuantil_2_5 <- quantile(precios_simulados, 0.025)
cuantil_97_5 <- quantile(precios_simulados, 0.975)

3.c. Grafique sus resultados.

hist(precios_simulados, breaks = 30, prob = TRUE, col = "skyblue", main = "Distribución Empírica de Precios Futuros", xlab = "Precio Futuro", ylab = "Densidad")

# Curva de densidad
densidad <- density(precios_simulados)
lines(densidad, col = "red", lwd = 2)
abline(v = cuantil_2_5, col = "blue", lty = 2)
abline(v = cuantil_97_5, col = "blue", lty = 2)

# Mostrar los cuantiles en la leyenda
legend("topright", legend = c("Distribución Empírica", "Densidad", "Cuantiles al 2.5% y 97.5%"), fill = c("skyblue", "red", NA), lty = c(0, 1, 2), col = c(NA, "red", "blue"), lwd = c(0, 2, 1), bty = "n", title = "Datos")

# Imprimir los cuantiles
cat("Cuantil al 2.5%:", cuantil_2_5, "\n")
## Cuantil al 2.5%: 3865.042
cat("Cuantil al 97.5%:", cuantil_97_5, "\n")
## Cuantil al 97.5%: 5242.569

Existe una probabilidad del 95% de que el precio futuro esté dentro del rango de 3865.042 y 5242.569 pesos.

3.d. Qué puede concluir sobre los posibles precios futuros?

Cuantil al 2.5%: 3,865.042: Podemos decir que el 2.5% de los precios futuros simulados son inferiores o iguales a $3,865.042. En otras palabras, hay un 2.5% de probabilidad de que el precio futuro sea igual o inferior a este valor.

Cuantil al 97.5%: 5242.569: Esto nos indica que el 97.5% de los precios futuros simulados son inferiores o iguales a $5,242.569. Por lo tanto, hay un 97.5% de probabilidad de que el precio futuro sea igual o inferior a este valor.

Precio actual de la TRM:

s
## [1] 4435.84

Conclusiones

Dado que el último precio conocido (s) es de 4,435.84, y los cuantiles al 2.5% y 97.5% son 3,865.042 y $5,242.569 respectivamente, podemos inferir lo siguiente:

-El rango entre estos cuantiles nos proporciona una estimaciónn de la incertidumbre asociada con los posibles precios futuros. Cuanto más amplio sea este rango, mayor será la incertidumbre.

-Dado que el precio actual es $4435.84 y cae dentro de este rango, podemos concluir que, en general, es recomendable que el precio futuro esté en línea con el precio actual, pero hay una cierta variabilidad y riesgo asociados con el pronóstico debido a la volatilidad de los precios y otros factores inherentes.

-Basándonos en este análisis, concluímos que los precios futuros de la TRM están sujetos a una considerable incertidumbre y variabilidad, lo que es un reflejo de las fluctuaciones históricas y de la naturaleza impredecible de los mercados financieros. Aunque las simulaciones proporcionan una guía sobre lo que podría esperarse en términos de movimientos de precios, la realidad del mercado podría desviarse significativamente de estos rangos proyectados debido a eventos inesperados o cambios en las condiciones económicas.

Segunda Parte

Proyecte la TRM por medio de simulación MBG con 1000 iteraciones, los parámetros del ejercicio se ejecutan a través de los valores históricos de desviación estándar, promedio de los rendimientos de la serie.

S <- 4066  # Tasa de cambio actual en COP
t <- 180/252  # Proyección a futuro en términos anuales (para 180 días)
mu <- mean(Rtos_diarios, na.rm = TRUE) * 252  # Rendimiento anual estimado
sigma <- sd(Rtos_diarios, na.rm = TRUE) * sqrt(252)  # Volatilidad anual estimada

iteraciones <- 1000  # Número de iteraciones para la nueva simulación

precios_simulados_TRM <- numeric(iteraciones)

set.seed(123)  # Garantiza la reproducibilidad
for(i in 1:iteraciones) {
  Z <- rnorm(1)  # Generar un valor aleatorio de una distribución normal estándar
  
  precios_simulados_TRM[i] <- S * exp((mu - 0.5 * sigma^2) * t + sigma * sqrt(t) * Z)
  
}

CI_inferior <- quantile(precios_simulados_TRM, probs = 0.025)
CI_superior <- quantile(precios_simulados_TRM, probs = 0.975)
cat("El intervalo de confianza del 95% para el precio futuro de la TRM es de:", CI_inferior, "a", CI_superior, "\n")
## El intervalo de confianza del 95% para el precio futuro de la TRM es de: 3552.626 a 4837.928

Simule el flujo de caja total esperado para las cuotas sin cobertura de un futuro.

pagos_usd <- c(91738, 90992, 90246, 89500, 88754)
fechas <- as.Date(c("2022-10-17", "2022-11-17", "2022-12-17", "2023-01-17", "2023-02-17"))

S <- 4066  # Tasa de cambio actual en COP
mu <- 0.0001039  # Media de rendimientos
sigma <- 0.091816  # Desviación estándar de los rendimientos
dias <- as.numeric(difftime(fechas, as.Date("2022-09-17"), units = "days"))  # Días hasta cada pago

iteraciones <- 1000  # Número de iteraciones para la simulación

set.seed(123)
flujo_caja_total <- numeric(iteraciones)

for (i in 1:iteraciones) {
  flujo_caja <- 0
  for (j in 1:length(pagos_usd)) {
    t <- dias[j] / 365
    TRM_futura <- S * exp((mu - 0.5 * sigma^2) * t + sigma * sqrt(t) * rnorm(1))
    flujo_caja <- flujo_caja + pagos_usd[j] * TRM_futura
  }
  flujo_caja_total[i] <- flujo_caja
}

media_flujo_caja <- mean(flujo_caja_total)
CI_inferior <- quantile(flujo_caja_total, probs = 0.025)
CI_superior <- quantile(flujo_caja_total, probs = 0.975)

cat("El flujo de caja total esperado promedio es:", media_flujo_caja, "COP\n")
## El flujo de caja total esperado promedio es: 1834672565 COP
cat("El intervalo de confianza del 95% para el flujo de caja total esperado es de:", CI_inferior, "a", CI_superior, "COP\n")
## El intervalo de confianza del 95% para el flujo de caja total esperado es de: 1766560152 a 1903628808 COP

Simule el flujo de caja total esperado para las cuotas con cobertura de un futuro.

pagos_usd <- c(91738, 90992, 90246, 89500, 88754)
fechas <- as.Date(c("2022-10-17", "2022-11-17", "2022-12-17", "2023-01-17", "2023-02-17"))
S <- 4066
cobertura <- 0.70
exposicion <- 1 - cobertura

mu <- 0.0001039
sigma <- 0.091816
dias <- as.numeric(difftime(fechas, as.Date("2022-09-17"), units = "days"))
iteraciones <- 1000

set.seed(123)
flujo_caja_total_con_cobertura <- numeric(iteraciones)

for (i in 1:iteraciones) {
  flujo_caja_con_cobertura <- 0
  for (j in 1:length(pagos_usd)) {
    t <- dias[j] / 365
    TRM_futura <- S * exp((mu - 0.5 * sigma^2) * t + sigma * sqrt(t) * rnorm(1))
    pago_cubierto <- pagos_usd[j] * cobertura * S
    
    pago_no_cubierto <- pagos_usd[j] * exposicion * TRM_futura
    
    flujo_caja_con_cobertura <- flujo_caja_con_cobertura + pago_cubierto + pago_no_cubierto
  }
  flujo_caja_total_con_cobertura[i] <- flujo_caja_con_cobertura
}

media_flujo_caja_con_cobertura <- mean(flujo_caja_total_con_cobertura)
CI_inferior_con_cobertura <- quantile(flujo_caja_total_con_cobertura, probs = 0.025)
CI_superior_con_cobertura <- quantile(flujo_caja_total_con_cobertura, probs = 0.975)

cat("El flujo de caja total esperado promedio con cobertura es:", media_flujo_caja_con_cobertura, "COP\n")
## El flujo de caja total esperado promedio con cobertura es: 1834692595 COP
cat("El intervalo de confianza del 95% para el flujo de caja total esperado con cobertura es de:", CI_inferior_con_cobertura, "a", CI_superior_con_cobertura, "COP\n")
## El intervalo de confianza del 95% para el flujo de caja total esperado con cobertura es de: 1814258872 a 1855379468 COP

Obtenga los beneficios reales de las series de la pregunta 2 y 3.

media_flujo_caja_sin_cobertura <- mean(flujo_caja_total)
media_flujo_caja_con_cobertura <- mean(flujo_caja_total_con_cobertura)

beneficio_real <- media_flujo_caja_con_cobertura - media_flujo_caja_sin_cobertura

cat("El beneficio real obtenido de aplicar la cobertura es:", beneficio_real, "COP\n")
## El beneficio real obtenido de aplicar la cobertura es: 20030.65 COP
CI_inferior_sin_cobertura <- quantile(flujo_caja_total, probs = 0.025)
CI_superior_sin_cobertura <- quantile(flujo_caja_total, probs = 0.975)
CI_inferior_con_cobertura <- quantile(flujo_caja_total_con_cobertura, probs = 0.025)
CI_superior_con_cobertura <- quantile(flujo_caja_total_con_cobertura, probs = 0.975)

cat("El intervalo de confianza del 95% para el flujo de caja total esperado sin cobertura es de:", CI_inferior_sin_cobertura, "a", CI_superior_sin_cobertura, "COP\n")
## El intervalo de confianza del 95% para el flujo de caja total esperado sin cobertura es de: 1766560152 a 1903628808 COP
cat("El intervalo de confianza del 95% para el flujo de caja total esperado con cobertura es de:", CI_inferior_con_cobertura, "a", CI_superior_con_cobertura, "COP\n")
## El intervalo de confianza del 95% para el flujo de caja total esperado con cobertura es de: 1814258872 a 1855379468 COP

Realizar la cuenta de margen con el flujo de caja operado.

diferencia_flujo_caja <- flujo_caja_total_con_cobertura - flujo_caja_total
media_diferencia_flujo_caja <- mean(diferencia_flujo_caja)

porcentaje_margen <- 0.10
requerimiento_margen <- porcentaje_margen * media_diferencia_flujo_caja

cat("La diferencia promedio del flujo de caja debido a la cobertura es:", media_diferencia_flujo_caja, "COP\n")
## La diferencia promedio del flujo de caja debido a la cobertura es: 20030.65 COP
cat("El requerimiento de margen, asumiendo un 10% de la diferencia promedio, es:", requerimiento_margen, "COP\n")
## El requerimiento de margen, asumiendo un 10% de la diferencia promedio, es: 2003.065 COP

Cuál es la probabilidad de ser llamado al margen si solo se deposita en la cuenta el margen inicial?

margen_inicial <- 0.10 * media_flujo_caja_sin_cobertura
veces_bajo_margen <- sum(flujo_caja_total_con_cobertura < margen_inicial)

probabilidad_llamado_margen <- veces_bajo_margen / iteraciones

cat("La probabilidad de ser llamado al margen si solo se deposita el margen inicial es:", probabilidad_llamado_margen * 100, "%\n")
## La probabilidad de ser llamado al margen si solo se deposita el margen inicial es: 0 %

Cuánnto debería de haber en la cuenta de margen al inicio para que la probabilidad de ser llamado al margen antes de cubrir el primer flujo sea menor al 1%?

calcular_probabilidad_llamado_margen <- function(margen_inicial, flujo_caja_total_con_cobertura) {
  veces_bajo_margen <- sum(flujo_caja_total_con_cobertura < margen_inicial)
  probabilidad_llamado_margen <- veces_bajo_margen / length(flujo_caja_total_con_cobertura)
  return(probabilidad_llamado_margen)
}

margen_inicial <- 0
probabilidad_objetivo <- 0.01

while (TRUE) {
  probabilidad <- calcular_probabilidad_llamado_margen(margen_inicial, flujo_caja_total_con_cobertura)
  if (probabilidad < probabilidad_objetivo) {
    break
  }
  margen_inicial <- margen_inicial + 10000
}

cat("El margen inicial necesario para que la probabilidad de ser llamado al margen antes de cubrir el primer flujo sea menor al 1% es:", margen_inicial, "COP\n")
## El margen inicial necesario para que la probabilidad de ser llamado al margen antes de cubrir el primer flujo sea menor al 1% es: 0 COP

Tercera parte

1. Como resultan las tasas simuladas con 10 iteraciones, para los siguientes 10 periodos, a 252 días.

r0 <- 0.05
k <- 0.3
theta <- 0.08
sigma <- 0.03
dt <- 1/252

iteraciones <- 10
periodos <- 10
t <- seq(0, periodos*dt, by = dt)

tasas_simuladas <- matrix(NA, nrow = iteraciones, ncol = length(t))

set.seed(123)

for (i in 1:iteraciones) {
  tasas_simuladas[i, 1] <- r0
  for (j in 2:length(t)) {
    dW <- rnorm(1, mean = 0, sd = sqrt(dt))
    dR <- k * (theta - tasas_simuladas[i, j-1]) * dt + sigma * dW
    tasas_simuladas[i, j] <- tasas_simuladas[i, j-1] + dR
  }
}
print(tasas_simuladas)
##       [,1]       [,2]       [,3]       [,4]       [,5]       [,6]       [,7]
##  [1,] 0.05 0.04897651 0.04857845 0.05156154 0.05172865 0.05200663 0.05528113
##  [2,] 0.05 0.05234901 0.05306191 0.05385137 0.05409167 0.05307207 0.05648108
##  [3,] 0.05 0.04801772 0.04764386 0.04574341 0.04440672 0.04326788 0.04012405
##  [4,] 0.05 0.05084166 0.05031874 0.05204570 0.05373849 0.05532240 0.05665319
##  [5,] 0.05 0.04872284 0.04836715 0.04601343 0.05015284 0.05247120 0.05038150
##  [6,] 0.05 0.05051444 0.05049559 0.05044970 0.05307130 0.05267669 0.05557507
##  [7,] 0.05 0.05075317 0.04983868 0.04924488 0.04735657 0.04536994 0.04598478
##  [8,] 0.05 0.04910775 0.04478061 0.04672321 0.04542256 0.04416351 0.04614432
##  [9,] 0.05 0.05004661 0.05081038 0.05014465 0.05139795 0.05101531 0.05167683
## [10,] 0.05 0.05191326 0.05298307 0.05346639 0.05231135 0.05491570 0.05381118
##             [,8]       [,9]      [,10]      [,11]
##  [1,] 0.05618160 0.05381922 0.05255235 0.05174281
##  [2,] 0.05744992 0.05376021 0.05511689 0.05425302
##  [3,] 0.04175480 0.04209017 0.03998443 0.04240155
##  [4,] 0.05772779 0.05763730 0.05708571 0.05639396
##  [5,] 0.04965538 0.04880961 0.05032073 0.05019851
##  [6,] 0.05267728 0.05381463 0.05407986 0.05451881
##  [7,] 0.04687231 0.04701192 0.04879411 0.05270556
##  [8,] 0.04564645 0.04338041 0.04376663 0.04354729
##  [9,] 0.05378338 0.05463700 0.05405125 0.05625318
## [10,] 0.05797603 0.06089861 0.06047592 0.05855941

2. Cómo quedan las curvas yield de ambas tasas en los períodos descritos.

rendimientos <- apply(tasas_simuladas, 2, function(x) c(0, diff(x) / x[-length(x)]))

periodos_secuencia <- seq(0, periodos*dt, by = dt)[-1]

plot(periodos_secuencia, rendimientos[,1], type = "l", col = "blue", ylim = c(min(rendimientos), max(rendimientos)),
     xlab = "Tiempo", ylab = "Rendimiento", main = "Curvas de Rendimiento de Tasas Simuladas")
for (i in 2:iteraciones) {
  lines(periodos_secuencia, rendimientos[,i], col = "blue")
}