Cargando librerias
source(file = "R Projects/Library.R")
Importando bases de datos
DataSet <- read_delim(file = "R Projects/BTC-USD (2).csv",
                      delim = ",", escape_double = F,
                      trim_ws = T, locale = locale(),
                      col_names = T)
DataSet2 <- read_delim(file = "R Projects/ETH-USD.csv",
                       delim = ",", escape_double = F,
                       trim_ws = T, locale = locale(),
                       col_names = T)
Creando DataFrames
BTC DataFrame
BTC_Price <- data.frame(DataSet$Date, DataSet$`Adj Close`)
colnames(BTC_Price)<- c("Date", "BTC")
ETH DataFrame
ETH_Price <- data.frame(DataSet2$Date, DataSet2$`Adj Close`)
colnames(ETH_Price)<- c("Date", "ETH")
Uniendo DataFrema
Crypto_prices <- merge(x = BTC_Price, y = ETH_Price, 
                       by = "Date", all.x = T)
Crypto_prices
Creando series de tiempo
BTC_TS <- ts(Crypto_prices[,2], frequency = 12, 
             start = c(2016,1), end = 2021,10)
ETH_TS <- ts (Crypto_prices[,3], frequency = 12, 
              start = c(2016,1), end = 2021, 10)
Aplicando Logaritmo para normalizar la varianza
BTC_Log <- log(BTC_TS)
ETH_Log <- log(ETH_TS)
Graficando las variables
layout(matrix(1:2, ncol = 2))
ts.plot(BTC_Log, main = "BTC PRICE", xlab = "Time", 
        ylab = "BTC", Type = "l", col=c("blue"))
ts.plot(ETH_Log, main = "ETH PRICE", xlab = "Time",
        ylab = "ETH", Type = "o", col=c("red"))

En esta gráfica podemos ver que el comportamiento de las variables del BTC y ETH no son estacionarias y se procederá a aplicar la prueba de Dicky Fuller para comprobarlo.

Aplicando las pruebas de estacionariedad de Dicky Fuller a las variables del modelo
adf.test(BTC_Log)
## 
##  Augmented Dickey-Fuller Test
## 
## data:  BTC_Log
## Dickey-Fuller = -2.2432, Lag order = 3, p-value = 0.4764
## alternative hypothesis: stationary
adf.test(ETH_Log)
## 
##  Augmented Dickey-Fuller Test
## 
## data:  ETH_Log
## Dickey-Fuller = -2.0968, Lag order = 3, p-value = 0.5357
## alternative hypothesis: stationary

Luego de aplicar las pruebas de Dicky Fuller (DF) en su forma Logarítmica a los precios del BTC y el ETH se obtuvieron p-values mayores a 0.05, debido a estos resultados no se debe rechazar la Ho, porque las variables tienen raíz unitaria, por lo tanto, debemos aplicar la segunda diferencia a cada variable para volverlas estacionarias.

Aplicando la segunda diferencia a las variables
Primera diferencia
BTC_Dif <- diff(BTC_Log)
ETH_Dif <- diff(ETH_Log)
Segunda diferencia
BTC_Dif2 <- diff(BTC_Dif)
ETH_Dif2 <- diff(ETH_Dif)
Aplicando las pruebas de estacionariedad de Dicky Fuller a las variables del modelo
adf.test(BTC_Dif2)
## 
##  Augmented Dickey-Fuller Test
## 
## data:  BTC_Dif2
## Dickey-Fuller = -5.0717, Lag order = 3, p-value = 0.01
## alternative hypothesis: stationary
adf.test(ETH_Dif2)
## 
##  Augmented Dickey-Fuller Test
## 
## data:  ETH_Dif2
## Dickey-Fuller = -5.2851, Lag order = 3, p-value = 0.01
## alternative hypothesis: stationary

Se rechazan la hipótesis nula debido a que el p-value es menor que 0.05 en cada una de las variables del modelo, lo que indica que no hay raíz unitaria y se cumple la condición de estacionariedad.

Graficando las series
ts.plot(BTC_Dif2, ETH_Dif2, main = ("Crypto Currency"), 
        col=c("red", "blue"))

En la siguiente gráfica (Crypto Currency) podemos presenciar que en ninguna de las variables hay raíz unitaria y que son estacionarias, porque su varianza y su media son constantes.

Pruebaa para determinar el orden causal (Causalidad)
grangertest(BTC_Dif2~ETH_Dif2, order = 2)
## Granger causality test
## 
## Model 1: BTC_Dif2 ~ Lags(BTC_Dif2, 1:2) + Lags(ETH_Dif2, 1:2)
## Model 2: BTC_Dif2 ~ Lags(BTC_Dif2, 1:2)
##   Res.Df Df      F Pr(>F)  
## 1     52                   
## 2     54 -2 2.5858  0.085 .
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
grangertest(ETH_Dif2~BTC_Dif2, order = 1)
## Granger causality test
## 
## Model 1: ETH_Dif2 ~ Lags(ETH_Dif2, 1:1) + Lags(BTC_Dif2, 1:1)
## Model 2: ETH_Dif2 ~ Lags(ETH_Dif2, 1:1)
##   Res.Df Df      F  Pr(>F)  
## 1     55                    
## 2     56 -1 2.8978 0.09434 .
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

BTC si causa a ETH a partir del primer rezago por lo que se rechaza la hipótesis nula ya que el p-value es menor a 0.05.

ETH también causa a BTC, en este caso es a partir del segundo rezado y se rechaza la hipótesis nula, porque el p-value es menor a 0.05.

Creando objeto para Var con las variables estacionarias
Var_BTC <- ts(BTC_Dif2, frequency = 12, start = c(2016,1), 
              end = c(2021, 10))
Var_ETH <- ts(ETH_Dif2, frequency = 12, start = c(2016,1),
              end = c(2021,10))

Var_Crypto <- cbind(Var_BTC, Var_ETH)

print(Var_Crypto)
Identificando el orden del modelo
VARselect(Var_Crypto, lag.max = 8, type = "both")
## $selection
## AIC(n)  HQ(n)  SC(n) FPE(n) 
##      2      2      1      2 
## 
## $criteria
##                   1            2            3            4            5
## AIC(n) -4.685120999 -4.792112891 -4.699528656 -4.718874674 -4.671828491
## HQ(n)  -4.577357563 -4.630467738 -4.484001785 -4.449466085 -4.348538185
## SC(n)  -4.410652046 -4.380409462 -4.150590750 -4.032702292 -3.848421633
## FPE(n)  0.009234932  0.008304999  0.009125932  0.008976088  0.009448135
##                  6           7           8
## AIC(n) -4.57409186 -4.54499131 -4.44273889
## HQ(n)  -4.19691984 -4.11393756 -3.95780343
## SC(n)  -3.61345053 -3.44711549 -3.20762860
## FPE(n)  0.01048035  0.01087689  0.01217519

De acuerdo con Aic(n), HQ(n) y FPE(n) el numero óptimo de rezagos es p = 2, mientras que el criterio de SC(n) indica que el rezago óptimo de longitud p = 2.

Crypto_Var <- VAR(Var_Crypto, p = 2, type = "both")
Crypto_Var
summary(Crypto_Var)

Si las raíces de los polinomios son mayores a 1 no se satisface la condición de estabilidad, pero en este resultado se puede observar que las raíces de los polinomios son menores a 1, por tanto, se cumple la condición de estabilidad lo que también indica que se ha utilizado el numero correcto de rezagos (1).

Nota: Para probar la condición de estabilidad hacemos un resumen del modelo Var, en el cual se comprueba que el modelo cumple con la condición de estabilidad.

plot(Crypto_Var)

summary(Crypto_Var, equation = "ETH_Dif2")
summary(Crypto_Var, equation = "BTC_Dif2")
Correlogramas de las variables
x11()
matrix(c(2,3), nrow = 2, byrow = "FALSE")
##      [,1]
## [1,]    2
## [2,]    3
acf(Var_BTC, lag.max = 2)

acf(Var_ETH, lag.max = 2)

Al observar los correlogramas de las variables del modelo en el gráfico, se puede apreciar que las variables se relacionan entre sí o están autocorelacionadas, es decir, el cambio en una de las variables afecta el comportamiento de la otra variables, esto es evidente, porque a partir del primer rezago en ambas variables se puede ver que por lo menos uno de ellos sobrepasa los márgenes que trazan las líneas azules del correlograma.

Al estimar un modelo VAR es necesario que las variables se relacionen entre ellas o estén autocorrelacionadas, por lo que se cumple esta condición en el modelo estimado según lo que se puede observar en los correlogramas del grafico de las variables de dicho modelo.

coef(Crypto_Var)
## $Var_BTC
##                 Estimate  Std. Error    t value     Pr(>|t|)
## Var_BTC.l1 -5.185844e-01 0.134714515 -3.8495065 0.0002825542
## Var_ETH.l1 -1.559504e-01 0.077741851 -2.0060030 0.0492239639
## Var_BTC.l2 -1.651503e-01 0.136013752 -1.2142178 0.2292693020
## Var_ETH.l2 -1.787664e-01 0.077149243 -2.3171499 0.0238125361
## const      -5.934148e-03 0.058307429 -0.1017734 0.9192649378
## trend      -2.443559e-05 0.001404619 -0.0173966 0.9861760864
## 
## $Var_ETH
##                 Estimate  Std. Error     t value     Pr(>|t|)
## Var_BTC.l1  0.2794378640 0.232194613  1.20346403 2.333719e-01
## Var_ETH.l1 -0.7174307319 0.133996244 -5.35411077 1.329485e-06
## Var_BTC.l2 -0.0053114734 0.234433984 -0.02265658 9.819970e-01
## Var_ETH.l2 -0.3289769398 0.132974822 -2.47397917 1.611327e-02
## const      -0.0045074593 0.100498977 -0.04485080 9.643704e-01
## trend      -0.0003985217 0.002421008 -0.16460982 8.697866e-01
Crypto_Var$varresult$Var_BTC
## 
## Call:
## lm(formula = y ~ -1 + ., data = datamat)
## 
## Coefficients:
## Var_BTC.l1  Var_ETH.l1  Var_BTC.l2  Var_ETH.l2       const       trend  
## -5.186e-01  -1.560e-01  -1.652e-01  -1.788e-01  -5.934e-03  -2.444e-05
Crypto_Var$varresult$Var_ETH
## 
## Call:
## lm(formula = y ~ -1 + ., data = datamat)
## 
## Coefficients:
## Var_BTC.l1  Var_ETH.l1  Var_BTC.l2  Var_ETH.l2       const       trend  
##  0.2794379  -0.7174307  -0.0053115  -0.3289769  -0.0045075  -0.0003985
Prueba de autocorrelación serial en los residuos
Serial_Crypt <- serial.test(Crypto_Var, lags.pt = 2, 
                            type = "PT.asymptotic")

serial.test(Crypto_Var, type = ("BG"), lags.bg = 2)
## 
##  Breusch-Godfrey LM test
## 
## data:  Residuals of VAR object Crypto_Var
## Chi-squared = 9.7778, df = 8, p-value = 0.281
Serial_Crypt$serial
## 
##  Portmanteau Test (asymptotic)
## 
## data:  Residuals of VAR object Crypto_Var
## Chi-squared = 2.5579, df = 0, p-value < 2.2e-16

Planteamiento de hipótesis Ho: Los residuales no están correlacionados > .05 No rechazar Ho – Rechazar H1 H1: Los residuales Si están correlacionados < .05 No rechazar H1 – Rechazar Ho

La primera prueba da como resultado que no hay correlación en los residuos debido a que el p-value es mayor a 0.05, sin embargo, la segunda prueba muestra lo contrario.

Residuos
Residuos <- residuals(Crypto_Var)
resix <- data.frame(Residuos)
Residuos
Histograma de los residuos
Crypto_Histogram <- hist(Residuos, col = "darkgrey")
Xfitted <-seq(min(Residuos), max(Residuos), length = 41)
Yfitted <- dnorm(Xfitted, mean = mean(Residuos), 
                 sd = sd(Residuos))
Yfitted <- Yfitted*diff(Crypto_Histogram$mids[1:2])*length(Residuos)
lines(Xfitted, Yfitted, col = "black", lwd = 2)

Prueba de normalidad de los residuos
Normalidad <- normality.test(Crypto_Var)
Normalidad$jb.mul
## $JB
## 
##  JB-Test (multivariate)
## 
## data:  Residuals of VAR object Crypto_Var
## Chi-squared = 3.8209, df = 4, p-value = 0.4308
## 
## 
## $Skewness
## 
##  Skewness only (multivariate)
## 
## data:  Residuals of VAR object Crypto_Var
## Chi-squared = 1.1494, df = 2, p-value = 0.5629
## 
## 
## $Kurtosis
## 
##  Kurtosis only (multivariate)
## 
## data:  Residuals of VAR object Crypto_Var
## Chi-squared = 2.6715, df = 2, p-value = 0.263

Ho: Los residuales se distribuyen normal > .05 No Rechazar Ho – Rechazar H1 H1: Los residuales No se distribuyen normal < .05 No rechazar H1 – Rechazar Ho

Se concluye que hay normalidad en los residuos porque los p-values de la kurtosis y el sesgo son mayores a 0.05.

Prueba de homocedasticidad de la varianza de los residuales
Arch1 <- arch.test(Crypto_Var, lags.multi = 1)
Arch1$arch.mul
## 
##  ARCH (multivariate)
## 
## data:  Residuals of VAR object Crypto_Var
## Chi-squared = 8.4425, df = 9, p-value = 0.4902
plot(Arch1, names = "Var_ETH")

plot(stability(Crypto_Var), nc = 2)

Para ver si la varianza de los residuos es constante a través del tiempo se testeó la homocedasticidad en el modelo, este testeo se realizó con el test ARCH-LM multivariado, el cual dio como resultado un p-value mayor a 0.05, por lo que no se rechaza la hipótesis nula de que la varianza de los residuos es constante, indicando esto que hay homocedasticidad en los residuos.

Correlograma de los residuos
x11()
matrix(c(2,3), nrow = 2, byrow = "FALSE")
##      [,1]
## [1,]    2
## [2,]    3
acf(resix$Var_BTC, lag.max = 2)

acf(resix$Var_ETH, lag.max = 2)

En estos correlogramas se observa que a partir del primer rezago ninguno de los retardos sobresale los márgenes que trazan las líneas azules del correlograma.

Esto nos dice que los residuos de las variables son de ruido blanco, es decir, no afectan las variables del modelo estimado, porque no están autocorrelacionados.

Predicción del modelo
PredCrypto <- predict(Crypto_Var)
PredCrypto
## $Var_BTC
##                fcst      lower     upper        CI
##  [1,]  7.540417e-04 -0.4447647 0.4462728 0.4455188
##  [2,]  3.327659e-02 -0.5062388 0.5727920 0.5395154
##  [3,]  2.749986e-02 -0.5130283 0.5680280 0.5405281
##  [4,] -5.582881e-02 -0.6074486 0.4957909 0.5516197
##  [5,]  2.814036e-02 -0.5305697 0.5868504 0.5587100
##  [6,]  4.628489e-04 -0.5586955 0.5596212 0.5591584
##  [7,] -1.314411e-02 -0.5729196 0.5466314 0.5597755
##  [8,]  4.986215e-03 -0.5551171 0.5650895 0.5601033
##  [9,] -8.227101e-05 -0.5602029 0.5600384 0.5601206
## [10,] -4.148804e-03 -0.5643146 0.5560170 0.5601658
## 
## $Var_ETH
##               fcst      lower     upper        CI
##  [1,] -0.427268545 -1.1951669 0.3406298 0.7678984
##  [2,]  0.152498401 -0.7678402 1.0728370 0.9203386
##  [3,]  0.006849648 -0.9248264 0.9385257 0.9316760
##  [4,] -0.081572918 -1.0267729 0.8636271 0.9452000
##  [5,]  0.006126206 -0.9428967 0.9551491 0.9490229
##  [6,] -0.004194613 -0.9536152 0.9452260 0.9494206
##  [7,] -0.034219797 -0.9846163 0.9161767 0.9503965
##  [8,] -0.013337310 -0.9639322 0.9372576 0.9505949
##  [9,] -0.013701404 -0.9643315 0.9369287 0.9506301
## [10,] -0.022221196 -0.9729143 0.9284719 0.9506931
plot(PredCrypto)

En estas gráficas podemos ver las posibles tendencias que podrían adoptar las variables del BTC y ETH.

Análisis del impulso respuesta de las variables estudiadas y la observación de su trayectoria.
Impulso respuesta del BTC
Var1_irflp <- irf(Crypto_Var, response = "Var_BTC", 
                  n.ahead = 2, boot = T)
Var1_irflp
## 
## Impulse response coefficients
## $Var_BTC
##          Var_BTC
## [1,]  0.22730967
## [2,] -0.14533980
## [3,]  0.01614782
## 
## $Var_ETH
##          Var_BTC
## [1,]  0.00000000
## [2,] -0.05458153
## [3,]  0.00489664
## 
## 
## Lower Band, CI= 0.95 
## $Var_BTC
##          Var_BTC
## [1,]  0.17996915
## [2,] -0.18942474
## [3,] -0.04323457
## 
## $Var_ETH
##          Var_BTC
## [1,]  0.00000000
## [2,] -0.10970104
## [3,] -0.05577392
## 
## 
## Upper Band, CI= 0.95 
## $Var_BTC
##          Var_BTC
## [1,]  0.24948267
## [2,] -0.08175461
## [3,]  0.06416258
## 
## $Var_ETH
##           Var_BTC
## [1,]  0.000000000
## [2,] -0.003655527
## [3,]  0.069036445
Impulso respuesta del ETH
Var2_irflp <- irf(Crypto_Var, response = "Var_ETH",
                  n.ahead = 2, boot = T)
Var2_irflp
## 
## Impulse response coefficients
## $Var_BTC
##          Var_ETH
## [1,]  0.17608516
## [2,] -0.06280997
## [3,] -0.05468694
## 
## $Var_ETH
##          Var_ETH
## [1,]  0.34999294
## [2,] -0.25109569
## [3,]  0.04975201
## 
## 
## Lower Band, CI= 0.95 
## $Var_BTC
##         Var_ETH
## [1,]  0.1079950
## [2,] -0.1783953
## [3,] -0.1334136
## 
## $Var_ETH
##          Var_ETH
## [1,]  0.25934991
## [2,] -0.33902513
## [3,] -0.04506109
## 
## 
## Upper Band, CI= 0.95 
## $Var_BTC
##         Var_ETH
## [1,] 0.25136366
## [2,] 0.04098001
## [3,] 0.05327589
## 
## $Var_ETH
##         Var_ETH
## [1,]  0.3979926
## [2,] -0.1376475
## [3,]  0.1295878

En los impulsos-respuestas muestran los efectos de los shocks en la trayectoria de ajuste de las variables. Todos los impulsos-respuestas muestran un intervalo de confianza de un 95 por ciento tanto en la parte alta como en la baja.

Este nos dice cómo responde el BTC a un impulso del ETH y viceverza

Como responde el BTC ante una variación en el ETH
Para graficar el impulso respuesta al BTC
plot(Var1_irflp)

Para graficar el impulso respuesta al ETH
plot(Var2_irflp)

Análisis de la descomposición de la varianza de cada variable
Descomposición de la varianza del BTC
Var_DESCM_BTC <- fevd(Crypto_Var, n.ahead = 50)$Var_BTC
Var_DESCM_BTC
Descomposición de la varianza del ETH
Var_DESCM_ETH <- fevd(Crypto_Var, n.ahead = 50)$Var_ETH
Var_DESCM_ETH