scripts/fooCopula_thesis.R
In 3schwartz/SpecialeScrAndFun: Script and functions used for master thesis.
library(rugarch)
library(xts)
library(ADGofTest)
library(qqtest)
library(copula)
library(qrmtools)
library(scrAndFun)
library(Data)
library(dplyr)
library(ggplot2)
outdir = "XXXX"
coinList.xts <- list(
BitCoinYahoo.xts = xts::xts(BitCoinYahoo[,2:7], order.by = BitCoinYahoo[,1]),
BitCashYahoo.xts = xts::xts(BitCashYahoo[,2:7], order.by = BitCashYahoo[,1]),
EthereumYahoo.xts = xts::xts(EthereumYahoo[,2:7], order.by = EthereumYahoo[,1]),
RippleYahoo.xts = xts::xts(RippleYahoo[,2:7], order.by = RippleYahoo[,1])
)
MSCI.xts <- list(
days = xts::xts(MSCI_DP[,2], order.by = MSCI_DP[,1]),
weeks = xts::xts(MSCI_WP[,2], order.by = MSCI_WP[,1]),
months = xts::xts(MSCI_MP[,2], order.by = MSCI_MP[,1])
)
dailyExcess <- Log_Period_Vol(listCoins = coinList.xts, listIndex = MSCI.xts,
period = "days",
delta = 60/61, annu = 365.25,
dateRange = list(
BitCoin = "2013/",
BitCash = "2017-08-01/",
Ethereum = "2016-02-01/",
Ripple = "2014-01-01/",
Cum = "2013/"
))
crypto <- do.call(cbind, lapply(dailyExcess, function(x) {x$excessReturn}))[,1:4]
colnames(crypto) <- names(dailyExcess)[1:4]
crypto <- crypto[, c("BitCoin", "Ethereum", "Ripple")]
# Index portfolios without NA's
ind_BTC_ETH <- unique(which(is.na(crypto[,c("BitCoin","Ethereum")]), arr.ind = TRUE)[,1])
ind_BTC_XRP <- unique(which(is.na(crypto[,c("BitCoin","Ripple")]), arr.ind = TRUE)[,1])
ind_ETH_XRP <- unique(which(is.na(crypto[,c("Ethereum","Ripple")]), arr.ind = TRUE)[,1])
# Portfolio selection
crypto_BTC_ETH <- crypto[-ind_BTC_ETH,c("BitCoin","Ethereum")]
crypto_BTC_XRP <- crypto[-ind_BTC_XRP,c("BitCoin","Ripple")]
crypto_ETH_XRP <- crypto[-ind_ETH_XRP,c("Ethereum","Ripple")]
backtest_period <- 250
BTC_ETH_train <- crypto_BTC_ETH[1:(nrow(crypto_BTC_ETH)-backtest_period),]
BTC_XRP_train <- crypto_BTC_XRP[1:(nrow(crypto_BTC_XRP)-backtest_period),]
ETH_XRP_train <- crypto_ETH_XRP[1:(nrow(crypto_ETH_XRP)-backtest_period),]
## Fit ARMA
spec <- ugarchspec(variance.model = list(garchOrder = c(1, 1)),
mean.model = list(armaOrder = c(1, 1)),
distribution.model = "sstd")
# BTC_ETH
fitted_BTC_ETH <- fit_ARMA_GARCH(BTC_ETH_train, ugarchspec.list = rep(list(spec), 2))
Z_BTC_ETH <- as.matrix(do.call(merge, lapply(fitted_BTC_ETH$fit,
rugarch::residuals, standardize = TRUE)))
colnames(Z_BTC_ETH) <- colnames(BTC_ETH_train)
U_BTC_ETH <- pobs(Z_BTC_ETH)
# BTC_XRP
fitted_BTC_XRP <- fit_ARMA_GARCH(BTC_XRP_train, ugarchspec.list = rep(list(spec), 2))
Z_BTC_XRP <- as.matrix(do.call(merge, lapply(fitted_BTC_XRP$fit,
rugarch::residuals, standardize = TRUE)))
colnames(Z_BTC_XRP) <- colnames(BTC_XRP_train)
U_BTC_XRP <- pobs(Z_BTC_XRP)
# BTC_ETH
fitted_ETH_XRP <- fit_ARMA_GARCH(ETH_XRP_train, ugarchspec.list = rep(list(spec), 2))
Z_ETH_XRP <- as.matrix(do.call(merge, lapply(fitted_ETH_XRP$fit,
rugarch::residuals, standardize = TRUE)))
colnames(Z_ETH_XRP) <- colnames(ETH_XRP_train)
U_ETH_XRP <- pobs(Z_ETH_XRP)
coef_arma_garch <- cbind(
sapply(1:2, function(j) fitted_BTC_ETH$fit[[j]]@fit$coef),
sapply(1:2, function(j) fitted_BTC_XRP$fit[[j]]@fit$coef),
sapply(1:2, function(j) fitted_ETH_XRP$fit[[j]]@fit$coef)) %>%
round(digits = 4)
colnames(coef_arma_garch) <- c("BTC_eth", "btc_ETH", "BTC_xrp",
"btc_XRP", "ETH_xrp", "eth_XRP")
coef_arma_garch
xtable::xtable(coef_arma_garch, digits = 4)
# Test if uniform margins
pdf(file = paste0(outdir, "pit_cop_models.pdf"))
par(mfrow= c(3,2))
PIT_1_ETH_XRP <- GAS::PIT_test(U_ETH_XRP[,1], G = 20, alpha = 0.05, plot = TRUE)
PIT_2_ETH_XRP <- GAS::PIT_test(U_ETH_XRP[,2], G = 20, alpha = 0.05, plot = TRUE)
#
PIT_1_BTC_XRP <- GAS::PIT_test(U_BTC_XRP[,1], G = 20, alpha = 0.05, plot = TRUE)
PIT_2_BTC_XRP <- GAS::PIT_test(U_BTC_XRP[,2], G = 20, alpha = 0.05, plot = TRUE)
#
PIT_1_BTC_ETH <- GAS::PIT_test(U_BTC_ETH[,1], G = 20, alpha = 0.05, plot = TRUE)
PIT_2_BTC_ETH <- GAS::PIT_test(U_BTC_ETH[,2], G = 20, alpha = 0.05, plot = TRUE)
par(mfrow = c(1,1))
dev.off()
hist_p_values <- cbind(PIT_1_ETH_XRP$Hist$pvalue,
PIT_2_ETH_XRP$Hist$pvalue,
PIT_1_BTC_XRP$Hist$pvalue,
PIT_2_BTC_XRP$Hist$pvalue,
PIT_1_BTC_ETH$Hist$pvalue,
PIT_2_BTC_ETH$Hist$pvalue)
colnames(hist_p_values) <- c("BTC_eth", "btc_ETH", "BTC_xrp",
"btc_XRP", "ETH_xrp", "eth_XRP")
rownames(hist_p_values) <- c("p-value")
xtable::xtable(hist_p_values)
idd_p_values <- cbind(PIT_1_ETH_XRP$IID$pvalue,
PIT_2_ETH_XRP$IID$pvalue,
PIT_1_BTC_XRP$IID$pvalue,
PIT_2_BTC_XRP$IID$pvalue,
PIT_1_BTC_ETH$IID$pvalue,
PIT_2_BTC_ETH$IID$pvalue)
colnames(idd_p_values) <- c("$BTC_{ETH}$", "$ETH_{BTC}$", "$BTC_{XRP}$",
"$XRP_{BTC}$", "$ETH_{XRP}$", "$XRP_{ETH}$")
rownames(idd_p_values) <- c("$E[X]$", "$E[X^2]$", "$E[X^3]$", "$E[X^4]$")
xtable::xtable(idd_p_values)
# Fit copula
(LL_c_BTC_ETH <- stats::nlminb(start = c(w = 0.5, alpha = 0.5, beta =0.5),
function(par) {
U_foo = U_BTC_ETH
LL_clayton_cpp(par, U_foo)},
lower = c(rep(-Inf,3)),
upper = c(rep(Inf, 3)),control = list(rel.tol = 1e-14,
xf.tol = 2.2e-40)))
(LL_c_BTC_XRP <- stats::nlminb(start = c(w = 0.5, alpha = 0.5, beta =0.5),
function(par) {
U_foo = U_BTC_XRP
LL_clayton_cpp(par, U_foo)},
lower = c(rep(-Inf,3)), upper = c(rep(Inf, 3))))
(LL_c_ETH_XRP <- stats::nlminb(start = c(w = 0.5, alpha = 0.5, beta =0.5),
function(par) {
U_foo = U_ETH_XRP
LL_clayton_cpp(par, U_foo)},
lower = c(rep(-Inf,3)), upper = c(rep(Inf, 3))))
# Parameter estimates
(parameter <- cbind(BTC_ETH = LL_c_BTC_ETH$par,
BTC_XRP = LL_c_BTC_XRP$par,
ETH_XRP = LL_c_ETH_XRP$par))
xtable::xtable(parameter, digits = 3)
# Simulate
# Back test using Claytong copula
set.seed(123)
back_BTC_ETH <- backtest_cop_c(crypto_BTC_ETH, backtest_period = backtest_period,
alpha = 0.99, m = 10000, par = LL_c_BTC_ETH$par)
back_BTC_XRP <- backtest_cop_c(crypto_BTC_XRP, backtest_period = backtest_period,
alpha = 0.99, m = 10000, par = LL_c_BTC_XRP$par)
back_ETH_XRP <- backtest_cop_c(crypto_ETH_XRP, backtest_period = backtest_period,
alpha = 0.99, m = 10000, par = LL_c_ETH_XRP$par)
# Future index
test_idx <- zoo::index(crypto_BTC_ETH[((nrow(crypto_BTC_ETH) -
backtest_period)+1):nrow(crypto_BTC_ETH), ])
cbind(back_BTC_ETH$depen, back_BTC_XRP$depen, back_ETH_XRP$depen) %>%
tibble::as.tibble() %>%
transmute(BTC_ETH = V1, BTC_XRP = V2, ETH_XRP = V3, Date = test_idx) %>%
tidyr::gather(key = "Portfolio", value = "theta", -Date) %>%
ggplot(aes(x = Date, y = theta, col = Portfolio)) +
geom_line()
back_test_results <- lapply(1:backtest_period, function(i){
sims <- cbind(
(back_BTC_ETH$sim_list[[i]][,c("BitCoin")] +
back_BTC_XRP$sim_list[[i]][,c("BitCoin")]) / 2,
(back_BTC_ETH$sim_list[[i]][,c("Ethereum")] +
back_ETH_XRP$sim_list[[i]][,c("Ethereum")]) / 2,
(back_BTC_XRP$sim_list[[i]][,c("Ripple")] +
back_ETH_XRP$sim_list[[i]][,c("Ripple")]) / 2)
colnames(sims) <- c("BTC", "ETH", "XRP")
Xs. <- rowSums(sims)
Xs.mean <- mean(Xs.)
Xs.CI <- quantile(Xs., probs = c(0.025, 0.975))
alpha <- 0.99
VaR <- quantile(Xs., probs = c(1-alpha,alpha))
X_col = colSums(sims)
return(list(sims = sims,
forecast = Xs.mean,
future = X_col,
CI = Xs.CI,
VaR = VaR))
})
future_mean <- do.call(rbind, lapply(back_test_results, function(x){x$future}))
forecast <- do.call(rbind, lapply(back_test_results, function(x){x$forecast}))
CI = t(do.call(rbind, lapply(back_test_results, function(x){x$CI})))
VaR = t(do.call(rbind, lapply(back_test_results, function(x){x$VaR})))
X <- crypto[(1:(nrow(crypto) - backtest_period))[!(1:(nrow(crypto) - backtest_period) %in% unique(which(is.na(crypto), arr.ind = TRUE)[,1]))], ]
X <- X[(nrow(X)-20):nrow(X), ]
X_future <- crypto[((nrow(crypto) - backtest_period)+1):nrow(crypto), ]
past <- zoo::index(X)
future <- zoo::index(X_future)
pdf(file = paste0(outdir, "copula_GARCH_sim.pdf"),
width = 8, height = 6)
plot(past, rowSums(X), type = "l", xlim = range(c(past, future)),
xlab = "Time", ylab = expression(r[t]),
main = c("copula-GARCH simulations"),
ylim = c(-(max(range(VaR))+0.1), (max(range(VaR))+0.1)))
polygon(c(future, rev(future)), c(CI[1,], rev(CI[2,])),
border = NA, col = "grey80") # CI region
lines(future, rowSums(X_future), col = "orange")
lines(future, forecast, col = "royalblue3") # predicted aggregated return
lines(future, CI[1,], col = "grey50") # lower CI
lines(future, CI[2,], col = "grey50") # upper CI
lines(future, VaR[1,], col = "maroon3") # lower VaR_alpha
lines(future, VaR[2,], col = "maroon3") # upper VaR_alpha
legend("bottomright", bty = "n", lty = rep(1, 4),
col = c("black", "orange", "royalblue3", "grey50", "maroon3"),
legend = c("(Aggregated) returns", "True returns",
"(Simulated) predicted return",
"95% CIs",
as.expression(substitute("Simulated"~VaR[a], list(a = alpha)))))
dev.off()
mse = mean((rowSums(X_future) - forecast)^2)
## TSMOM extended
sigma_TS <- do.call(cbind, lapply(dailyExcess, function(x) {x$sigma}))[,1:4]
colnames(sigma_TS) <- names(dailyExcess)[1:4]
sigma_TS <- sigma_TS[, c("BitCoin", "Ethereum", "Ripple")]
sig_BTC_ETH <- sigma_TS[-ind_BTC_ETH, c("BitCoin", "Ethereum")]
sig_BTC_XRP <- sigma_TS[-ind_BTC_XRP, c("BitCoin", "Ripple")]
sig_ETH_XRP <- sigma_TS[-ind_ETH_XRP, c("Ethereum", "Ripple")]
BTC_XRP_train_TS <- as.matrix(crypto_BTC_XRP[5:(nrow(crypto_BTC_XRP)-backtest_period),])
# BTC_XRP_train_TS_lag <- as.matrix(crypto_BTC_XRP[2:(nrow(crypto_BTC_XRP)-backtest_period-12),])
sigma_BTC_XRP_1 <- as.matrix(sig_BTC_XRP[4:(nrow(sig_BTC_XRP)-backtest_period-1),])
# sigma_BTC_XRP_13 <- as.matrix(sig_BTC_XRP[1:(nrow(sig_BTC_XRP)-backtest_period-13),])
BTC_XRP_train_TS_lag <- as.matrix(crypto_BTC_XRP[2:(nrow(crypto_BTC_XRP)-backtest_period-3),])
sigma_BTC_XRP_lag <- as.matrix(sig_BTC_XRP[1:(nrow(sig_BTC_XRP)-backtest_period-4),])
ETH_XRP_train_TS <- as.matrix(crypto_ETH_XRP[5:(nrow(crypto_ETH_XRP)-backtest_period),])
ETH_XRP_train_TS_lag <- as.matrix(crypto_ETH_XRP[2:(nrow(crypto_ETH_XRP)-backtest_period-3),])
sigma_ETH_XRP_1 <- as.matrix(sig_ETH_XRP[4:(nrow(sig_ETH_XRP)-backtest_period-1),])
sigma_ETH_XRP_lag <- as.matrix(sig_ETH_XRP[1:(nrow(sig_ETH_XRP)-backtest_period-4),])
BTC_ETH_train_TS <- as.matrix(crypto_BTC_ETH[5:(nrow(crypto_BTC_ETH)-backtest_period),])
BTC_ETH_train_TS_lag <- as.matrix(crypto_BTC_ETH[2:(nrow(crypto_BTC_ETH)-backtest_period-3),])
sigma_BTC_ETH_1 <- as.matrix(sig_BTC_ETH[4:(nrow(sig_BTC_ETH)-backtest_period-1),])
sigma_BTC_ETH_lag <- as.matrix(sig_BTC_ETH[1:(nrow(sig_BTC_ETH)-backtest_period-4),])
BTC_XRP_1 <- lm((BTC_XRP_train_TS/sigma_BTC_XRP_1)[,1] ~ (BTC_XRP_train_TS_lag/sigma_BTC_XRP_lag)[,1])
BTC_XRP_2 <- lm((BTC_XRP_train_TS/sigma_BTC_XRP_1)[,2] ~ (BTC_XRP_train_TS_lag/sigma_BTC_XRP_lag)[,2])
ETH_XRP_1 <- lm((ETH_XRP_train_TS/sigma_ETH_XRP_1)[,1] ~ (ETH_XRP_train_TS_lag/sigma_ETH_XRP_lag)[,1])
ETH_XRP_2 <- lm((ETH_XRP_train_TS/sigma_ETH_XRP_1)[,2] ~ (ETH_XRP_train_TS_lag/sigma_ETH_XRP_lag)[,2])
BTC_ETH_1 <- lm((BTC_ETH_train_TS/sigma_BTC_ETH_1)[,1] ~ (BTC_ETH_train_TS_lag/sigma_BTC_ETH_lag)[,1])
BTC_ETH_2 <- lm((BTC_ETH_train_TS/sigma_BTC_ETH_1)[,2] ~ (BTC_ETH_train_TS_lag/sigma_BTC_ETH_lag)[,2])
lm_param <- cbind(BTC_ETH_1$coefficients,
BTC_ETH_2$coefficients,
BTC_XRP_1$coefficients,
BTC_XRP_2$coefficients,
ETH_XRP_1$coefficients,
ETH_XRP_2$coefficients)
colnames(lm_param) <- c("BTC_eth", "btc_ETH", "BTC_xrp",
"btc_XRP", "ETH_xrp", "eth_XRP")
rownames(lm_param) <- c("alpha_OLS", "beta_OLS")
xtable::xtable(lm_param, digits = 4)
res_BTC_XRP <- cbind(resid(BTC_XRP_1), resid(BTC_XRP_2))
res_ETH_XRP <- cbind(resid(ETH_XRP_1), resid(ETH_XRP_2))
res_BTC_ETH <- cbind(resid(BTC_ETH_1), resid(BTC_ETH_2))
# fit skew-t distributions
st_fit_BTC_XRP_1 = sn::st.mple(y=res_BTC_XRP[,1])
st_fit_BTC_XRP_2 = sn::st.mple(y=res_BTC_XRP[,2])
st_fit_ETH_XRP_1 = sn::st.mple(y=res_ETH_XRP[,1])
st_fit_ETH_XRP_2 = sn::st.mple(y=res_ETH_XRP[,2])
st_fit_BTC_ETH_1 = sn::st.mple(y=res_BTC_ETH[,1])
st_fit_BTC_ETH_2 = sn::st.mple(y=res_BTC_ETH[,2])
skewed_t_param <- cbind(st_fit_BTC_ETH_1$dp,
st_fit_BTC_ETH_2$dp,
st_fit_BTC_XRP_1$dp,
st_fit_BTC_XRP_2$dp,
st_fit_ETH_XRP_1$dp,
st_fit_ETH_XRP_2$dp)
colnames(skewed_t_param) <- c("BTC_eth", "btc_ETH", "BTC_xrp",
"btc_XRP", "ETH_xrp", "eth_XRP")
xtable::xtable(skewed_t_param, digits = 3)
U_BTC_XRP_TS <- cbind(sn::pst(res_BTC_XRP[,1], dp = st_fit_BTC_XRP_1$dp),
sn::pst(res_BTC_XRP[,2], dp = st_fit_BTC_XRP_2$dp))
colnames(U_BTC_XRP_TS) <- colnames(BTC_XRP_train_TS)
U_ETH_XRP_TS <- cbind(sn::pst(res_ETH_XRP[,1], dp = st_fit_ETH_XRP_1$dp),
sn::pst(res_ETH_XRP[,2], dp = st_fit_ETH_XRP_2$dp))
colnames(U_ETH_XRP_TS) <- colnames(ETH_XRP_train_TS)
U_BTC_ETH_TS <- cbind(sn::pst(res_BTC_ETH[,1], dp = st_fit_BTC_ETH_1$dp),
sn::pst(res_BTC_ETH[,2], dp = st_fit_BTC_ETH_2$dp))
colnames(U_BTC_ETH_TS) <- colnames(BTC_ETH_train_TS)
# Check if uniform and independent
pdf(file = paste0(outdir, "pit_cop_models_TS.pdf"))
par(mfrow= c(3,2))
PIT_1_ETH_XRP_TS <- GAS::PIT_test(U_ETH_XRP_TS[,1], G = 20, alpha = 0.05, plot = TRUE)
PIT_2_ETH_XRP_TS <- GAS::PIT_test(U_ETH_XRP_TS[,2], G = 20, alpha = 0.05, plot = TRUE)
#
PIT_1_BTC_XRP_TS <- GAS::PIT_test(U_BTC_XRP_TS[,1], G = 20, alpha = 0.05, plot = TRUE)
PIT_2_BTC_XRP_TS <- GAS::PIT_test(U_BTC_XRP_TS[,2], G = 20, alpha = 0.05, plot = TRUE)
#
PIT_1_BTC_ETH_TS <- GAS::PIT_test(U_BTC_ETH_TS[,1], G = 20, alpha = 0.05, plot = TRUE)
PIT_2_BTC_ETH_TS <- GAS::PIT_test(U_BTC_ETH_TS[,2], G = 20, alpha = 0.05, plot = TRUE)
par(mfrow = c(1,1))
dev.off()
hist_p_values_TS <- cbind(PIT_1_ETH_XRP_TS$Hist$pvalue,
PIT_2_ETH_XRP_TS$Hist$pvalue,
PIT_1_BTC_XRP_TS$Hist$pvalue,
PIT_2_BTC_XRP_TS$Hist$pvalue,
PIT_1_BTC_ETH_TS$Hist$pvalue,
PIT_2_BTC_ETH_TS$Hist$pvalue)
colnames(hist_p_values_TS) <- c("BTC_eth_TS", "btc_ETH_TS", "BTC_xrp_TS",
"btc_XRP_TS", "ETH_xrp_TS", "eth_XRP_TS")
rownames(hist_p_values_TS) <- c("p-value")
xtable::xtable(hist_p_values_TS)
idd_p_values_TS <- cbind(PIT_1_ETH_XRP_TS$IID$pvalue,
PIT_2_ETH_XRP_TS$IID$pvalue,
PIT_1_BTC_XRP_TS$IID$pvalue,
PIT_2_BTC_XRP_TS$IID$pvalue,
PIT_1_BTC_ETH_TS$IID$pvalue,
PIT_2_BTC_ETH_TS$IID$pvalue)
colnames(idd_p_values_TS) <- c("BTC_eth_TS", "btc_ETH_TS", "BTC_xrp_TS",
"btc_XRP_TS", "ETH_xrp_TS", "eth_XRP_TS")
rownames(idd_p_values_TS) <- c("$E[X]$", "$E[X^2]$", "$E[X^3]$", "$E[X^4]$")
xtable::xtable(idd_p_values_TS)
# Fit copula
(LL_BTC_XRP_TS <- stats::nlminb(start = c(w = 0.5, alpha = 1, beta =0.5),
function(par) {
U_foo = U_BTC_XRP_TS
LL_clayton_cpp(par, U_foo)},
lower = c(-Inf, 0, 0),
upper = c(rep(Inf, 3))))
(LL_ETH_XRP_TS <- stats::nlminb(start = c(w = 0.5, alpha = 0.5, beta =0.5),
function(par) {
U_foo = U_ETH_XRP_TS
LL_clayton_cpp(par, U_foo)},
lower = c(rep(-Inf,3)), upper = c(rep(Inf, 3))))
(LL_BTC_ETH_TS <- stats::nlminb(start = c(w = 0.5, alpha = 0.5, beta =0.5),
function(par) {
U_foo = U_BTC_ETH_TS
LL_clayton_cpp(par, U_foo)},
lower = c(rep(-Inf,3)), upper = c(rep(Inf, 3))))
# Parameter estimates
(parameter_TS <- cbind(BTC_XRP = LL_BTC_XRP_TS$par,
ETH_XRP = LL_ETH_XRP_TS$par,
BTC_ETH = LL_BTC_ETH_TS$par))
xtable::xtable(parameter_TS)
# Simulate
set.seed(123)
system.time(
back_TS_BTC_XRP <- backtest_TSMOM_cop(return = crypto_BTC_XRP, backtest_period = backtest_period,
alpha = 0.99, m = 5000, par_cop = LL_BTC_XRP_TS$par,
par_dp = cbind(st_fit_BTC_XRP_1$dp, st_fit_BTC_XRP_2$dp),
sigma = sig_BTC_XRP,
par_coef = cbind(coef(BTC_XRP_1),
coef(BTC_XRP_2)), lag = 3)
)
system.time(
back_TS_BTC_ETH <- backtest_TSMOM_cop(return = crypto_BTC_ETH, backtest_period = backtest_period,
alpha = 0.99, m = 5000, par_cop = LL_BTC_ETH_TS$par,
par_dp = cbind(st_fit_BTC_ETH_1$dp, st_fit_BTC_ETH_2$dp),
sigma = sig_BTC_ETH,
par_coef = cbind(coef(BTC_ETH_1),
coef(BTC_ETH_2)), lag = 3)
)
system.time(
back_TS_ETH_XRP <- backtest_TSMOM_cop(return = crypto_ETH_XRP, backtest_period = backtest_period,
alpha = 0.99, m = 5000, par_cop = LL_ETH_XRP_TS$par,
par_dp = cbind(st_fit_ETH_XRP_1$dp, st_fit_ETH_XRP_2$dp),
sigma = sig_ETH_XRP,
par_coef = cbind(coef(ETH_XRP_1),
coef(ETH_XRP_2)), lag = 3)
)
# Future index
test_idx <- zoo::index(crypto_BTC_ETH[((nrow(crypto_BTC_ETH) -
backtest_period)+1):nrow(crypto_BTC_ETH), ])
back_test_TS_results <- lapply(1:backtest_period, function(i){
sims <- cbind(
(back_TS_BTC_XRP$sim_list[[i]][,c("BitCoin")] +
back_TS_BTC_ETH$sim_list[[i]][,c("BitCoin")]) / 2,
(back_TS_BTC_ETH$sim_list[[i]][,c("Ethereum")] +
back_TS_ETH_XRP$sim_list[[i]][,c("Ethereum")]) / 2,
(back_TS_BTC_XRP$sim_list[[i]][,c("Ripple")] +
back_TS_ETH_XRP$sim_list[[i]][,c("Ripple")]) / 2)
colnames(sims) <- c("BTC", "ETH", "XRP")
Xs. <- rowSums(sims)
Xs.mean <- mean(Xs.)
Xs.CI <- quantile(Xs., probs = c(0.025, 0.975))
alpha <- 0.99
VaR <- quantile(Xs., probs = c(1 - alpha, alpha))
X_col = colSums(sims)
return(list(sims = sims,
forecast = Xs.mean,
future = X_col,
CI = Xs.CI,
VaR = VaR))
})
future_mean_TS <- do.call(rbind, lapply(back_test_TS_results, function(x){x$future}))
forecast_TS <- do.call(rbind, lapply(back_test_TS_results, function(x){x$forecast}))
CI_TS = t(do.call(rbind, lapply(back_test_TS_results, function(x){x$CI})))
VaR_TS = t(do.call(rbind, lapply(back_test_TS_results, function(x){x$VaR})))
X_TS <- crypto[(1:(nrow(crypto) - backtest_period))[!(1:(nrow(crypto) - backtest_period) %in% unique(which(is.na(crypto), arr.ind = TRUE)[,1]))], ]
X_TS <- X_TS[(nrow(X_TS)-20):nrow(X_TS), ]
X_future_TS <- crypto[((nrow(crypto) - backtest_period)+1):nrow(crypto), ]
past_TS <- zoo::index(X_TS)
future_TS <- zoo::index(X_future_TS)
pdf(file = paste0(outdir, "TSMOM_extended_sim.pdf"),
width = 8, height = 6)
plot(past_TS, rowSums(X_TS), type = "l", xlim = range(c(past_TS, future_TS)),
xlab = "Time", ylab = expression(r[t]),
main = c("TSMOM extended simulations"),
ylim = c(-(max(range(VaR_TS))+0.1), (max(range(VaR_TS))+0.1)))
polygon(c(future_TS, rev(future_TS)), c(CI_TS[1,], rev(CI_TS[2,])),
border = NA, col = "grey80") # CI region
lines(future_TS, rowSums(X_future_TS), col = "orange")
lines(future_TS, forecast_TS, col = "royalblue3") # predicted aggregated return
lines(future_TS, CI_TS[1,], col = "grey50") # lower CI
lines(future_TS, CI_TS[2,], col = "grey50") # upper CI
lines(future_TS, VaR_TS[1,], col = "maroon3") # lower VaR_alpha
lines(future_TS, VaR_TS[2,], col = "maroon3") # upper VaR_alpha
legend("bottomright", bty = "n", lty = rep(1, 4),
col = c("black", "orange", "royalblue3", "grey50", "maroon3"),
legend = c("(Aggregated) returns", "True returns",
"(Simulated) predicted return",
"95% CIs",
as.expression(substitute("Simulated"~VaR[a], list(a = alpha)))))
dev.off()
# TSMOM
X_sign_lag <- sign(as.matrix(crypto[(((nrow(crypto) - backtest_period)+1)-1):(nrow(crypto)-1), ]))
sigma <- do.call(cbind, lapply(dailyExcess, function(x) {x$sigma}))[,1:4]
colnames(sigma) <- names(dailyExcess)[1:4]
sigma <- sigma[, c("BitCoin", "Ethereum", "Ripple")]
sigma_t_1 <- as.matrix(sigma[(((nrow(sigma) - backtest_period)+1)-1):(nrow(sigma)-1), ])
stra_TSMOM <- (1/3) * rowSums((0.4 / sigma_t_1) * X_sign_lag * as.matrix(X_future))
names(stra_TSMOM) <- NULL
cum_TSMOM <- c(0, cumsum(as.numeric(stra_TSMOM)))
# TSMOM with copula
stra_TSMOM_cop <- (1/3) * rowSums((0.4 / sigma_t_1) * sign(future_mean_TS) * as.matrix(X_future))
cum_TSMOM_cop <- c(0, cumsum(as.numeric(stra_TSMOM_cop)))
# copula-GARCH strategy
stra_cop_GARCH <- (1/3) * rowSums(sign(future_mean) * X_future * (0.4 / sigma_t_1))
cum_cop_GARCH <- c(0, cumsum(as.numeric(stra_cop_GARCH)))
# Buy and hold
stra_Buy_Hold <- (1/3) * rowSums((0.4 / sigma_t_1) * X_future)
cum_Buy_Hold <- c( 0, cumsum(as.numeric(stra_Buy_Hold)))
Date <- lubridate::as_date(zoo::index(crypto[(nrow(crypto) - backtest_period):nrow(crypto), ]))
stra_wide <- matrix(ncol = 5, nrow = (backtest_period + 1)) %>%
as_tibble() %>%
transmute(`Buy and Hold` = cum_Buy_Hold,
TSMOM = cum_TSMOM,
`cop-GARCH` = cum_cop_GARCH,
`TSMOM extended` = cum_TSMOM_cop,
Date = Date)
stra_tidy <- stra_wide %>%
tidyr::gather(key = "Strategy", value = "Cumulative return", -Date)
#
pdf(file = paste0(outdir, "cumulate_strategy_comparison.pdf"),
height = 6, width = 8)
ggplot(stra_tidy, aes(x = Date, y = `Cumulative return`, col = Strategy)) +
geom_line(size = 0.7, alpha = 0.7) +
theme_classic() +
labs(title = "Cumulative return over time of different strategies",
caption = "2017-10-12 until 2018-09-26 (250 days)") +
ggplot2::scale_color_manual(values = c(RColorBrewer::brewer.pal(4,"Set1"))) +
theme(plot.title = element_text(hjust = 0.5))
dev.off()
sum_stats <- matrix(c(tseries::sharpe(cum_Buy_Hold, scale = sqrt(350)),
tseries::sharpe(cum_TSMOM, scale = sqrt(350)),
tseries::sharpe(cum_cop_GARCH, scale = sqrt(350)),
tseries::sharpe(cum_TSMOM_cop, scale = sqrt(350)),
tail(cum_Buy_Hold, 1),
tail(cum_TSMOM, 1),
tail(cum_cop_GARCH, 1),
tail(cum_TSMOM_cop, 1)), nrow = 2, byrow = TRUE)
colnames(sum_stats) <- c("Buy and Hold", "TSMOM", "cop-GARCH", "TSMOM extended")
rownames(sum_stats) <- c("Sharpe Ratio", "Cumulative return")
xtable::xtable(sum_stats)
3schwartz/SpecialeScrAndFun documentation built on May 4, 2019, 6:29 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
library(rugarch)
library(xts)
library(ADGofTest)
library(qqtest)
library(copula)
library(qrmtools)
library(scrAndFun)
library(Data)
library(dplyr)
library(ggplot2)
outdir = "XXXX"
coinList.xts <- list(
BitCoinYahoo.xts = xts::xts(BitCoinYahoo[,2:7], order.by = BitCoinYahoo[,1]),
BitCashYahoo.xts = xts::xts(BitCashYahoo[,2:7], order.by = BitCashYahoo[,1]),
EthereumYahoo.xts = xts::xts(EthereumYahoo[,2:7], order.by = EthereumYahoo[,1]),
RippleYahoo.xts = xts::xts(RippleYahoo[,2:7], order.by = RippleYahoo[,1])
)
MSCI.xts <- list(
days = xts::xts(MSCI_DP[,2], order.by = MSCI_DP[,1]),
weeks = xts::xts(MSCI_WP[,2], order.by = MSCI_WP[,1]),
months = xts::xts(MSCI_MP[,2], order.by = MSCI_MP[,1])
)
dailyExcess <- Log_Period_Vol(listCoins = coinList.xts, listIndex = MSCI.xts,
period = "days",
delta = 60/61, annu = 365.25,
dateRange = list(
BitCoin = "2013/",
BitCash = "2017-08-01/",
Ethereum = "2016-02-01/",
Ripple = "2014-01-01/",
Cum = "2013/"
))
crypto <- do.call(cbind, lapply(dailyExcess, function(x) {x$excessReturn}))[,1:4]
colnames(crypto) <- names(dailyExcess)[1:4]
crypto <- crypto[, c("BitCoin", "Ethereum", "Ripple")]
# Index portfolios without NA's
ind_BTC_ETH <- unique(which(is.na(crypto[,c("BitCoin","Ethereum")]), arr.ind = TRUE)[,1])
ind_BTC_XRP <- unique(which(is.na(crypto[,c("BitCoin","Ripple")]), arr.ind = TRUE)[,1])
ind_ETH_XRP <- unique(which(is.na(crypto[,c("Ethereum","Ripple")]), arr.ind = TRUE)[,1])
# Portfolio selection
crypto_BTC_ETH <- crypto[-ind_BTC_ETH,c("BitCoin","Ethereum")]
crypto_BTC_XRP <- crypto[-ind_BTC_XRP,c("BitCoin","Ripple")]
crypto_ETH_XRP <- crypto[-ind_ETH_XRP,c("Ethereum","Ripple")]
backtest_period <- 250
BTC_ETH_train <- crypto_BTC_ETH[1:(nrow(crypto_BTC_ETH)-backtest_period),]
BTC_XRP_train <- crypto_BTC_XRP[1:(nrow(crypto_BTC_XRP)-backtest_period),]
ETH_XRP_train <- crypto_ETH_XRP[1:(nrow(crypto_ETH_XRP)-backtest_period),]
## Fit ARMA
spec <- ugarchspec(variance.model = list(garchOrder = c(1, 1)),
mean.model = list(armaOrder = c(1, 1)),
distribution.model = "sstd")
# BTC_ETH
fitted_BTC_ETH <- fit_ARMA_GARCH(BTC_ETH_train, ugarchspec.list = rep(list(spec), 2))
Z_BTC_ETH <- as.matrix(do.call(merge, lapply(fitted_BTC_ETH$fit,
rugarch::residuals, standardize = TRUE)))
colnames(Z_BTC_ETH) <- colnames(BTC_ETH_train)
U_BTC_ETH <- pobs(Z_BTC_ETH)
# BTC_XRP
fitted_BTC_XRP <- fit_ARMA_GARCH(BTC_XRP_train, ugarchspec.list = rep(list(spec), 2))
Z_BTC_XRP <- as.matrix(do.call(merge, lapply(fitted_BTC_XRP$fit,
rugarch::residuals, standardize = TRUE)))
colnames(Z_BTC_XRP) <- colnames(BTC_XRP_train)
U_BTC_XRP <- pobs(Z_BTC_XRP)
# BTC_ETH
fitted_ETH_XRP <- fit_ARMA_GARCH(ETH_XRP_train, ugarchspec.list = rep(list(spec), 2))
Z_ETH_XRP <- as.matrix(do.call(merge, lapply(fitted_ETH_XRP$fit,
rugarch::residuals, standardize = TRUE)))
colnames(Z_ETH_XRP) <- colnames(ETH_XRP_train)
U_ETH_XRP <- pobs(Z_ETH_XRP)
coef_arma_garch <- cbind(
sapply(1:2, function(j) fitted_BTC_ETH$fit[[j]]@fit$coef),
sapply(1:2, function(j) fitted_BTC_XRP$fit[[j]]@fit$coef),
sapply(1:2, function(j) fitted_ETH_XRP$fit[[j]]@fit$coef)) %>%
round(digits = 4)
colnames(coef_arma_garch) <- c("BTC_eth", "btc_ETH", "BTC_xrp",
"btc_XRP", "ETH_xrp", "eth_XRP")
coef_arma_garch
xtable::xtable(coef_arma_garch, digits = 4)
# Test if uniform margins
pdf(file = paste0(outdir, "pit_cop_models.pdf"))
par(mfrow= c(3,2))
PIT_1_ETH_XRP <- GAS::PIT_test(U_ETH_XRP[,1], G = 20, alpha = 0.05, plot = TRUE)
PIT_2_ETH_XRP <- GAS::PIT_test(U_ETH_XRP[,2], G = 20, alpha = 0.05, plot = TRUE)
#
PIT_1_BTC_XRP <- GAS::PIT_test(U_BTC_XRP[,1], G = 20, alpha = 0.05, plot = TRUE)
PIT_2_BTC_XRP <- GAS::PIT_test(U_BTC_XRP[,2], G = 20, alpha = 0.05, plot = TRUE)
#
PIT_1_BTC_ETH <- GAS::PIT_test(U_BTC_ETH[,1], G = 20, alpha = 0.05, plot = TRUE)
PIT_2_BTC_ETH <- GAS::PIT_test(U_BTC_ETH[,2], G = 20, alpha = 0.05, plot = TRUE)
par(mfrow = c(1,1))
dev.off()
hist_p_values <- cbind(PIT_1_ETH_XRP$Hist$pvalue,
PIT_2_ETH_XRP$Hist$pvalue,
PIT_1_BTC_XRP$Hist$pvalue,
PIT_2_BTC_XRP$Hist$pvalue,
PIT_1_BTC_ETH$Hist$pvalue,
PIT_2_BTC_ETH$Hist$pvalue)
colnames(hist_p_values) <- c("BTC_eth", "btc_ETH", "BTC_xrp",
"btc_XRP", "ETH_xrp", "eth_XRP")
rownames(hist_p_values) <- c("p-value")
xtable::xtable(hist_p_values)
idd_p_values <- cbind(PIT_1_ETH_XRP$IID$pvalue,
PIT_2_ETH_XRP$IID$pvalue,
PIT_1_BTC_XRP$IID$pvalue,
PIT_2_BTC_XRP$IID$pvalue,
PIT_1_BTC_ETH$IID$pvalue,
PIT_2_BTC_ETH$IID$pvalue)
colnames(idd_p_values) <- c("$BTC_{ETH}$", "$ETH_{BTC}$", "$BTC_{XRP}$",
"$XRP_{BTC}$", "$ETH_{XRP}$", "$XRP_{ETH}$")
rownames(idd_p_values) <- c("$E[X]$", "$E[X^2]$", "$E[X^3]$", "$E[X^4]$")
xtable::xtable(idd_p_values)
# Fit copula
(LL_c_BTC_ETH <- stats::nlminb(start = c(w = 0.5, alpha = 0.5, beta =0.5),
function(par) {
U_foo = U_BTC_ETH
LL_clayton_cpp(par, U_foo)},
lower = c(rep(-Inf,3)),
upper = c(rep(Inf, 3)),control = list(rel.tol = 1e-14,
xf.tol = 2.2e-40)))
(LL_c_BTC_XRP <- stats::nlminb(start = c(w = 0.5, alpha = 0.5, beta =0.5),
function(par) {
U_foo = U_BTC_XRP
LL_clayton_cpp(par, U_foo)},
lower = c(rep(-Inf,3)), upper = c(rep(Inf, 3))))
(LL_c_ETH_XRP <- stats::nlminb(start = c(w = 0.5, alpha = 0.5, beta =0.5),
function(par) {
U_foo = U_ETH_XRP
LL_clayton_cpp(par, U_foo)},
lower = c(rep(-Inf,3)), upper = c(rep(Inf, 3))))
# Parameter estimates
(parameter <- cbind(BTC_ETH = LL_c_BTC_ETH$par,
BTC_XRP = LL_c_BTC_XRP$par,
ETH_XRP = LL_c_ETH_XRP$par))
xtable::xtable(parameter, digits = 3)
# Simulate
# Back test using Claytong copula
set.seed(123)
back_BTC_ETH <- backtest_cop_c(crypto_BTC_ETH, backtest_period = backtest_period,
alpha = 0.99, m = 10000, par = LL_c_BTC_ETH$par)
back_BTC_XRP <- backtest_cop_c(crypto_BTC_XRP, backtest_period = backtest_period,
alpha = 0.99, m = 10000, par = LL_c_BTC_XRP$par)
back_ETH_XRP <- backtest_cop_c(crypto_ETH_XRP, backtest_period = backtest_period,
alpha = 0.99, m = 10000, par = LL_c_ETH_XRP$par)
# Future index
test_idx <- zoo::index(crypto_BTC_ETH[((nrow(crypto_BTC_ETH) -
backtest_period)+1):nrow(crypto_BTC_ETH), ])
cbind(back_BTC_ETH$depen, back_BTC_XRP$depen, back_ETH_XRP$depen) %>%
tibble::as.tibble() %>%
transmute(BTC_ETH = V1, BTC_XRP = V2, ETH_XRP = V3, Date = test_idx) %>%
tidyr::gather(key = "Portfolio", value = "theta", -Date) %>%
ggplot(aes(x = Date, y = theta, col = Portfolio)) +
geom_line()
back_test_results <- lapply(1:backtest_period, function(i){
sims <- cbind(
(back_BTC_ETH$sim_list[[i]][,c("BitCoin")] +
back_BTC_XRP$sim_list[[i]][,c("BitCoin")]) / 2,
(back_BTC_ETH$sim_list[[i]][,c("Ethereum")] +
back_ETH_XRP$sim_list[[i]][,c("Ethereum")]) / 2,
(back_BTC_XRP$sim_list[[i]][,c("Ripple")] +
back_ETH_XRP$sim_list[[i]][,c("Ripple")]) / 2)
colnames(sims) <- c("BTC", "ETH", "XRP")
Xs. <- rowSums(sims)
Xs.mean <- mean(Xs.)
Xs.CI <- quantile(Xs., probs = c(0.025, 0.975))
alpha <- 0.99
VaR <- quantile(Xs., probs = c(1-alpha,alpha))
X_col = colSums(sims)
return(list(sims = sims,
forecast = Xs.mean,
future = X_col,
CI = Xs.CI,
VaR = VaR))
})
future_mean <- do.call(rbind, lapply(back_test_results, function(x){x$future}))
forecast <- do.call(rbind, lapply(back_test_results, function(x){x$forecast}))
CI = t(do.call(rbind, lapply(back_test_results, function(x){x$CI})))
VaR = t(do.call(rbind, lapply(back_test_results, function(x){x$VaR})))
X <- crypto[(1:(nrow(crypto) - backtest_period))[!(1:(nrow(crypto) - backtest_period) %in% unique(which(is.na(crypto), arr.ind = TRUE)[,1]))], ]
X <- X[(nrow(X)-20):nrow(X), ]
X_future <- crypto[((nrow(crypto) - backtest_period)+1):nrow(crypto), ]
past <- zoo::index(X)
future <- zoo::index(X_future)
pdf(file = paste0(outdir, "copula_GARCH_sim.pdf"),
width = 8, height = 6)
plot(past, rowSums(X), type = "l", xlim = range(c(past, future)),
xlab = "Time", ylab = expression(r[t]),
main = c("copula-GARCH simulations"),
ylim = c(-(max(range(VaR))+0.1), (max(range(VaR))+0.1)))
polygon(c(future, rev(future)), c(CI[1,], rev(CI[2,])),
border = NA, col = "grey80") # CI region
lines(future, rowSums(X_future), col = "orange")
lines(future, forecast, col = "royalblue3") # predicted aggregated return
lines(future, CI[1,], col = "grey50") # lower CI
lines(future, CI[2,], col = "grey50") # upper CI
lines(future, VaR[1,], col = "maroon3") # lower VaR_alpha
lines(future, VaR[2,], col = "maroon3") # upper VaR_alpha
legend("bottomright", bty = "n", lty = rep(1, 4),
col = c("black", "orange", "royalblue3", "grey50", "maroon3"),
legend = c("(Aggregated) returns", "True returns",
"(Simulated) predicted return",
"95% CIs",
as.expression(substitute("Simulated"~VaR[a], list(a = alpha)))))
dev.off()
mse = mean((rowSums(X_future) - forecast)^2)
## TSMOM extended
sigma_TS <- do.call(cbind, lapply(dailyExcess, function(x) {x$sigma}))[,1:4]
colnames(sigma_TS) <- names(dailyExcess)[1:4]
sigma_TS <- sigma_TS[, c("BitCoin", "Ethereum", "Ripple")]
sig_BTC_ETH <- sigma_TS[-ind_BTC_ETH, c("BitCoin", "Ethereum")]
sig_BTC_XRP <- sigma_TS[-ind_BTC_XRP, c("BitCoin", "Ripple")]
sig_ETH_XRP <- sigma_TS[-ind_ETH_XRP, c("Ethereum", "Ripple")]
BTC_XRP_train_TS <- as.matrix(crypto_BTC_XRP[5:(nrow(crypto_BTC_XRP)-backtest_period),])
# BTC_XRP_train_TS_lag <- as.matrix(crypto_BTC_XRP[2:(nrow(crypto_BTC_XRP)-backtest_period-12),])
sigma_BTC_XRP_1 <- as.matrix(sig_BTC_XRP[4:(nrow(sig_BTC_XRP)-backtest_period-1),])
# sigma_BTC_XRP_13 <- as.matrix(sig_BTC_XRP[1:(nrow(sig_BTC_XRP)-backtest_period-13),])
BTC_XRP_train_TS_lag <- as.matrix(crypto_BTC_XRP[2:(nrow(crypto_BTC_XRP)-backtest_period-3),])
sigma_BTC_XRP_lag <- as.matrix(sig_BTC_XRP[1:(nrow(sig_BTC_XRP)-backtest_period-4),])
ETH_XRP_train_TS <- as.matrix(crypto_ETH_XRP[5:(nrow(crypto_ETH_XRP)-backtest_period),])
ETH_XRP_train_TS_lag <- as.matrix(crypto_ETH_XRP[2:(nrow(crypto_ETH_XRP)-backtest_period-3),])
sigma_ETH_XRP_1 <- as.matrix(sig_ETH_XRP[4:(nrow(sig_ETH_XRP)-backtest_period-1),])
sigma_ETH_XRP_lag <- as.matrix(sig_ETH_XRP[1:(nrow(sig_ETH_XRP)-backtest_period-4),])
BTC_ETH_train_TS <- as.matrix(crypto_BTC_ETH[5:(nrow(crypto_BTC_ETH)-backtest_period),])
BTC_ETH_train_TS_lag <- as.matrix(crypto_BTC_ETH[2:(nrow(crypto_BTC_ETH)-backtest_period-3),])
sigma_BTC_ETH_1 <- as.matrix(sig_BTC_ETH[4:(nrow(sig_BTC_ETH)-backtest_period-1),])
sigma_BTC_ETH_lag <- as.matrix(sig_BTC_ETH[1:(nrow(sig_BTC_ETH)-backtest_period-4),])
BTC_XRP_1 <- lm((BTC_XRP_train_TS/sigma_BTC_XRP_1)[,1] ~ (BTC_XRP_train_TS_lag/sigma_BTC_XRP_lag)[,1])
BTC_XRP_2 <- lm((BTC_XRP_train_TS/sigma_BTC_XRP_1)[,2] ~ (BTC_XRP_train_TS_lag/sigma_BTC_XRP_lag)[,2])
ETH_XRP_1 <- lm((ETH_XRP_train_TS/sigma_ETH_XRP_1)[,1] ~ (ETH_XRP_train_TS_lag/sigma_ETH_XRP_lag)[,1])
ETH_XRP_2 <- lm((ETH_XRP_train_TS/sigma_ETH_XRP_1)[,2] ~ (ETH_XRP_train_TS_lag/sigma_ETH_XRP_lag)[,2])
BTC_ETH_1 <- lm((BTC_ETH_train_TS/sigma_BTC_ETH_1)[,1] ~ (BTC_ETH_train_TS_lag/sigma_BTC_ETH_lag)[,1])
BTC_ETH_2 <- lm((BTC_ETH_train_TS/sigma_BTC_ETH_1)[,2] ~ (BTC_ETH_train_TS_lag/sigma_BTC_ETH_lag)[,2])
lm_param <- cbind(BTC_ETH_1$coefficients,
BTC_ETH_2$coefficients,
BTC_XRP_1$coefficients,
BTC_XRP_2$coefficients,
ETH_XRP_1$coefficients,
ETH_XRP_2$coefficients)
colnames(lm_param) <- c("BTC_eth", "btc_ETH", "BTC_xrp",
"btc_XRP", "ETH_xrp", "eth_XRP")
rownames(lm_param) <- c("alpha_OLS", "beta_OLS")
xtable::xtable(lm_param, digits = 4)
res_BTC_XRP <- cbind(resid(BTC_XRP_1), resid(BTC_XRP_2))
res_ETH_XRP <- cbind(resid(ETH_XRP_1), resid(ETH_XRP_2))
res_BTC_ETH <- cbind(resid(BTC_ETH_1), resid(BTC_ETH_2))
# fit skew-t distributions
st_fit_BTC_XRP_1 = sn::st.mple(y=res_BTC_XRP[,1])
st_fit_BTC_XRP_2 = sn::st.mple(y=res_BTC_XRP[,2])
st_fit_ETH_XRP_1 = sn::st.mple(y=res_ETH_XRP[,1])
st_fit_ETH_XRP_2 = sn::st.mple(y=res_ETH_XRP[,2])
st_fit_BTC_ETH_1 = sn::st.mple(y=res_BTC_ETH[,1])
st_fit_BTC_ETH_2 = sn::st.mple(y=res_BTC_ETH[,2])
skewed_t_param <- cbind(st_fit_BTC_ETH_1$dp,
st_fit_BTC_ETH_2$dp,
st_fit_BTC_XRP_1$dp,
st_fit_BTC_XRP_2$dp,
st_fit_ETH_XRP_1$dp,
st_fit_ETH_XRP_2$dp)
colnames(skewed_t_param) <- c("BTC_eth", "btc_ETH", "BTC_xrp",
"btc_XRP", "ETH_xrp", "eth_XRP")
xtable::xtable(skewed_t_param, digits = 3)
U_BTC_XRP_TS <- cbind(sn::pst(res_BTC_XRP[,1], dp = st_fit_BTC_XRP_1$dp),
sn::pst(res_BTC_XRP[,2], dp = st_fit_BTC_XRP_2$dp))
colnames(U_BTC_XRP_TS) <- colnames(BTC_XRP_train_TS)
U_ETH_XRP_TS <- cbind(sn::pst(res_ETH_XRP[,1], dp = st_fit_ETH_XRP_1$dp),
sn::pst(res_ETH_XRP[,2], dp = st_fit_ETH_XRP_2$dp))
colnames(U_ETH_XRP_TS) <- colnames(ETH_XRP_train_TS)
U_BTC_ETH_TS <- cbind(sn::pst(res_BTC_ETH[,1], dp = st_fit_BTC_ETH_1$dp),
sn::pst(res_BTC_ETH[,2], dp = st_fit_BTC_ETH_2$dp))
colnames(U_BTC_ETH_TS) <- colnames(BTC_ETH_train_TS)
# Check if uniform and independent
pdf(file = paste0(outdir, "pit_cop_models_TS.pdf"))
par(mfrow= c(3,2))
PIT_1_ETH_XRP_TS <- GAS::PIT_test(U_ETH_XRP_TS[,1], G = 20, alpha = 0.05, plot = TRUE)
PIT_2_ETH_XRP_TS <- GAS::PIT_test(U_ETH_XRP_TS[,2], G = 20, alpha = 0.05, plot = TRUE)
#
PIT_1_BTC_XRP_TS <- GAS::PIT_test(U_BTC_XRP_TS[,1], G = 20, alpha = 0.05, plot = TRUE)
PIT_2_BTC_XRP_TS <- GAS::PIT_test(U_BTC_XRP_TS[,2], G = 20, alpha = 0.05, plot = TRUE)
#
PIT_1_BTC_ETH_TS <- GAS::PIT_test(U_BTC_ETH_TS[,1], G = 20, alpha = 0.05, plot = TRUE)
PIT_2_BTC_ETH_TS <- GAS::PIT_test(U_BTC_ETH_TS[,2], G = 20, alpha = 0.05, plot = TRUE)
par(mfrow = c(1,1))
dev.off()
hist_p_values_TS <- cbind(PIT_1_ETH_XRP_TS$Hist$pvalue,
PIT_2_ETH_XRP_TS$Hist$pvalue,
PIT_1_BTC_XRP_TS$Hist$pvalue,
PIT_2_BTC_XRP_TS$Hist$pvalue,
PIT_1_BTC_ETH_TS$Hist$pvalue,
PIT_2_BTC_ETH_TS$Hist$pvalue)
colnames(hist_p_values_TS) <- c("BTC_eth_TS", "btc_ETH_TS", "BTC_xrp_TS",
"btc_XRP_TS", "ETH_xrp_TS", "eth_XRP_TS")
rownames(hist_p_values_TS) <- c("p-value")
xtable::xtable(hist_p_values_TS)
idd_p_values_TS <- cbind(PIT_1_ETH_XRP_TS$IID$pvalue,
PIT_2_ETH_XRP_TS$IID$pvalue,
PIT_1_BTC_XRP_TS$IID$pvalue,
PIT_2_BTC_XRP_TS$IID$pvalue,
PIT_1_BTC_ETH_TS$IID$pvalue,
PIT_2_BTC_ETH_TS$IID$pvalue)
colnames(idd_p_values_TS) <- c("BTC_eth_TS", "btc_ETH_TS", "BTC_xrp_TS",
"btc_XRP_TS", "ETH_xrp_TS", "eth_XRP_TS")
rownames(idd_p_values_TS) <- c("$E[X]$", "$E[X^2]$", "$E[X^3]$", "$E[X^4]$")
xtable::xtable(idd_p_values_TS)
# Fit copula
(LL_BTC_XRP_TS <- stats::nlminb(start = c(w = 0.5, alpha = 1, beta =0.5),
function(par) {
U_foo = U_BTC_XRP_TS
LL_clayton_cpp(par, U_foo)},
lower = c(-Inf, 0, 0),
upper = c(rep(Inf, 3))))
(LL_ETH_XRP_TS <- stats::nlminb(start = c(w = 0.5, alpha = 0.5, beta =0.5),
function(par) {
U_foo = U_ETH_XRP_TS
LL_clayton_cpp(par, U_foo)},
lower = c(rep(-Inf,3)), upper = c(rep(Inf, 3))))
(LL_BTC_ETH_TS <- stats::nlminb(start = c(w = 0.5, alpha = 0.5, beta =0.5),
function(par) {
U_foo = U_BTC_ETH_TS
LL_clayton_cpp(par, U_foo)},
lower = c(rep(-Inf,3)), upper = c(rep(Inf, 3))))
# Parameter estimates
(parameter_TS <- cbind(BTC_XRP = LL_BTC_XRP_TS$par,
ETH_XRP = LL_ETH_XRP_TS$par,
BTC_ETH = LL_BTC_ETH_TS$par))
xtable::xtable(parameter_TS)
# Simulate
set.seed(123)
system.time(
back_TS_BTC_XRP <- backtest_TSMOM_cop(return = crypto_BTC_XRP, backtest_period = backtest_period,
alpha = 0.99, m = 5000, par_cop = LL_BTC_XRP_TS$par,
par_dp = cbind(st_fit_BTC_XRP_1$dp, st_fit_BTC_XRP_2$dp),
sigma = sig_BTC_XRP,
par_coef = cbind(coef(BTC_XRP_1),
coef(BTC_XRP_2)), lag = 3)
)
system.time(
back_TS_BTC_ETH <- backtest_TSMOM_cop(return = crypto_BTC_ETH, backtest_period = backtest_period,
alpha = 0.99, m = 5000, par_cop = LL_BTC_ETH_TS$par,
par_dp = cbind(st_fit_BTC_ETH_1$dp, st_fit_BTC_ETH_2$dp),
sigma = sig_BTC_ETH,
par_coef = cbind(coef(BTC_ETH_1),
coef(BTC_ETH_2)), lag = 3)
)
system.time(
back_TS_ETH_XRP <- backtest_TSMOM_cop(return = crypto_ETH_XRP, backtest_period = backtest_period,
alpha = 0.99, m = 5000, par_cop = LL_ETH_XRP_TS$par,
par_dp = cbind(st_fit_ETH_XRP_1$dp, st_fit_ETH_XRP_2$dp),
sigma = sig_ETH_XRP,
par_coef = cbind(coef(ETH_XRP_1),
coef(ETH_XRP_2)), lag = 3)
)
# Future index
test_idx <- zoo::index(crypto_BTC_ETH[((nrow(crypto_BTC_ETH) -
backtest_period)+1):nrow(crypto_BTC_ETH), ])
back_test_TS_results <- lapply(1:backtest_period, function(i){
sims <- cbind(
(back_TS_BTC_XRP$sim_list[[i]][,c("BitCoin")] +
back_TS_BTC_ETH$sim_list[[i]][,c("BitCoin")]) / 2,
(back_TS_BTC_ETH$sim_list[[i]][,c("Ethereum")] +
back_TS_ETH_XRP$sim_list[[i]][,c("Ethereum")]) / 2,
(back_TS_BTC_XRP$sim_list[[i]][,c("Ripple")] +
back_TS_ETH_XRP$sim_list[[i]][,c("Ripple")]) / 2)
colnames(sims) <- c("BTC", "ETH", "XRP")
Xs. <- rowSums(sims)
Xs.mean <- mean(Xs.)
Xs.CI <- quantile(Xs., probs = c(0.025, 0.975))
alpha <- 0.99
VaR <- quantile(Xs., probs = c(1 - alpha, alpha))
X_col = colSums(sims)
return(list(sims = sims,
forecast = Xs.mean,
future = X_col,
CI = Xs.CI,
VaR = VaR))
})
future_mean_TS <- do.call(rbind, lapply(back_test_TS_results, function(x){x$future}))
forecast_TS <- do.call(rbind, lapply(back_test_TS_results, function(x){x$forecast}))
CI_TS = t(do.call(rbind, lapply(back_test_TS_results, function(x){x$CI})))
VaR_TS = t(do.call(rbind, lapply(back_test_TS_results, function(x){x$VaR})))
X_TS <- crypto[(1:(nrow(crypto) - backtest_period))[!(1:(nrow(crypto) - backtest_period) %in% unique(which(is.na(crypto), arr.ind = TRUE)[,1]))], ]
X_TS <- X_TS[(nrow(X_TS)-20):nrow(X_TS), ]
X_future_TS <- crypto[((nrow(crypto) - backtest_period)+1):nrow(crypto), ]
past_TS <- zoo::index(X_TS)
future_TS <- zoo::index(X_future_TS)
pdf(file = paste0(outdir, "TSMOM_extended_sim.pdf"),
width = 8, height = 6)
plot(past_TS, rowSums(X_TS), type = "l", xlim = range(c(past_TS, future_TS)),
xlab = "Time", ylab = expression(r[t]),
main = c("TSMOM extended simulations"),
ylim = c(-(max(range(VaR_TS))+0.1), (max(range(VaR_TS))+0.1)))
polygon(c(future_TS, rev(future_TS)), c(CI_TS[1,], rev(CI_TS[2,])),
border = NA, col = "grey80") # CI region
lines(future_TS, rowSums(X_future_TS), col = "orange")
lines(future_TS, forecast_TS, col = "royalblue3") # predicted aggregated return
lines(future_TS, CI_TS[1,], col = "grey50") # lower CI
lines(future_TS, CI_TS[2,], col = "grey50") # upper CI
lines(future_TS, VaR_TS[1,], col = "maroon3") # lower VaR_alpha
lines(future_TS, VaR_TS[2,], col = "maroon3") # upper VaR_alpha
legend("bottomright", bty = "n", lty = rep(1, 4),
col = c("black", "orange", "royalblue3", "grey50", "maroon3"),
legend = c("(Aggregated) returns", "True returns",
"(Simulated) predicted return",
"95% CIs",
as.expression(substitute("Simulated"~VaR[a], list(a = alpha)))))
dev.off()
# TSMOM
X_sign_lag <- sign(as.matrix(crypto[(((nrow(crypto) - backtest_period)+1)-1):(nrow(crypto)-1), ]))
sigma <- do.call(cbind, lapply(dailyExcess, function(x) {x$sigma}))[,1:4]
colnames(sigma) <- names(dailyExcess)[1:4]
sigma <- sigma[, c("BitCoin", "Ethereum", "Ripple")]
sigma_t_1 <- as.matrix(sigma[(((nrow(sigma) - backtest_period)+1)-1):(nrow(sigma)-1), ])
stra_TSMOM <- (1/3) * rowSums((0.4 / sigma_t_1) * X_sign_lag * as.matrix(X_future))
names(stra_TSMOM) <- NULL
cum_TSMOM <- c(0, cumsum(as.numeric(stra_TSMOM)))
# TSMOM with copula
stra_TSMOM_cop <- (1/3) * rowSums((0.4 / sigma_t_1) * sign(future_mean_TS) * as.matrix(X_future))
cum_TSMOM_cop <- c(0, cumsum(as.numeric(stra_TSMOM_cop)))
# copula-GARCH strategy
stra_cop_GARCH <- (1/3) * rowSums(sign(future_mean) * X_future * (0.4 / sigma_t_1))
cum_cop_GARCH <- c(0, cumsum(as.numeric(stra_cop_GARCH)))
# Buy and hold
stra_Buy_Hold <- (1/3) * rowSums((0.4 / sigma_t_1) * X_future)
cum_Buy_Hold <- c( 0, cumsum(as.numeric(stra_Buy_Hold)))
Date <- lubridate::as_date(zoo::index(crypto[(nrow(crypto) - backtest_period):nrow(crypto), ]))
stra_wide <- matrix(ncol = 5, nrow = (backtest_period + 1)) %>%
as_tibble() %>%
transmute(`Buy and Hold` = cum_Buy_Hold,
TSMOM = cum_TSMOM,
`cop-GARCH` = cum_cop_GARCH,
`TSMOM extended` = cum_TSMOM_cop,
Date = Date)
stra_tidy <- stra_wide %>%
tidyr::gather(key = "Strategy", value = "Cumulative return", -Date)
#
pdf(file = paste0(outdir, "cumulate_strategy_comparison.pdf"),
height = 6, width = 8)
ggplot(stra_tidy, aes(x = Date, y = `Cumulative return`, col = Strategy)) +
geom_line(size = 0.7, alpha = 0.7) +
theme_classic() +
labs(title = "Cumulative return over time of different strategies",
caption = "2017-10-12 until 2018-09-26 (250 days)") +
ggplot2::scale_color_manual(values = c(RColorBrewer::brewer.pal(4,"Set1"))) +
theme(plot.title = element_text(hjust = 0.5))
dev.off()
sum_stats <- matrix(c(tseries::sharpe(cum_Buy_Hold, scale = sqrt(350)),
tseries::sharpe(cum_TSMOM, scale = sqrt(350)),
tseries::sharpe(cum_cop_GARCH, scale = sqrt(350)),
tseries::sharpe(cum_TSMOM_cop, scale = sqrt(350)),
tail(cum_Buy_Hold, 1),
tail(cum_TSMOM, 1),
tail(cum_cop_GARCH, 1),
tail(cum_TSMOM_cop, 1)), nrow = 2, byrow = TRUE)
colnames(sum_stats) <- c("Buy and Hold", "TSMOM", "cop-GARCH", "TSMOM extended")
rownames(sum_stats) <- c("Sharpe Ratio", "Cumulative return")
xtable::xtable(sum_stats)
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.