scripts/tsmomSecond_thesis.R

In 3schwartz/SpecialeScrAndFun: Script and functions used for master thesis.

library(Data)
library(scrAndFun)

outputFig <- "XXXX"
#### Data manupulation ####
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])
)

monthlyExcess <- Log_Period_Vol(listCoins = coinList.xts, listIndex = MSCI.xts,
                                period = "months",
                                delta = 60/61, annu = 365.25,
                                dateRange = list(
                                  BitCoin = "2013/",
                                  BitCash = "2017-08-01/",
                                  Ethereum = "2016-02-01/",
                                  Ripple = "2014-01-01/",
                                  Cum = "2013/"
                                ))
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/"
                              ))

#### Summary statistics for data ####
tableSumStats <- data.frame(Crypto = c("Bitcoin", "Bitcoin Cash", "Ethereum", "Ripple"),
                            "Data start date" = sapply(coinList.xts, function(x) {
                              paste0(lubridate::month(zoo::index(x)[1], label = TRUE, abbr = TRUE),
                                     "-", lubridate::epiyear(zoo::index(x)[1]))
                            }),
                            "Daily mean" = paste0(round(sapply(coinList.xts, function(x) {
                              mean(diff(log(quantmod::Ad(x))), na.rm = TRUE) * 100
                            }), digits = 2), "%"),
                            "Daily SD" = paste0(round(sapply(coinList.xts, function(x) {
                              sd(diff(log(quantmod::Ad(x))), na.rm = TRUE) * 100
                            }), digits = 2), "%"), row.names = NULL)
colnames(tableSumStats) <- c("Crypto", "Data start date", "Daily mean", "Daily SD")
xtable::xtable(tableSumStats)

#### Acf and Pacf plots ####
CumReturn.Month <- do.call(cbind, (sapply(monthlyExcess, function(x){x[,"exReVol"]})))
colnames(CumReturn.Month) <- names(monthlyExcess)
CumReturn.Days <- do.call(cbind, (sapply(dailyExcess, function(x){x[,"exReVol"]})))
colnames(CumReturn.Days) <- names(dailyExcess)

pdf(file = paste0(outputFig, "ReAcfPacfMonth.pdf"))
par(mfrow = c(5, 2))
for (i in 1:ncol(CumReturn.Month)) {
  forecast::Acf(CumReturn.Month[,i], main = colnames(CumReturn.Month)[i])
  forecast::Pacf(CumReturn.Month[,i], main = colnames(CumReturn.Month)[i])
}
dev.off()

pdf(file = paste0(outputFig, "ReAcfPacfDays.pdf"))
par(mfrow = c(5, 2))
for (i in 1:ncol(CumReturn.Days)) {
  forecast::Acf(CumReturn.Days[,i], main = colnames(CumReturn.Days)[i])
  forecast::Pacf(CumReturn.Days[,i], main = colnames(CumReturn.Days)[i])
}
dev.off()

#### Model BTC monthly 12 lag and investigate ####
Month.Lag12 <- fun_Lag_list(listData = monthlyExcess, lag = 12)

modelBTC_lag12 <- fun_lm(dependent = c("exReVol"), regressors = c("exReVol_12"),
                         data = Month.Lag12$BitCoin)
xtable::xtable(modelBTC_lag12$tableStat)

#### Investigte residuals graphically ####
pdf(file = paste0(outputFig,"tsmomBitcoin12month", ".pdf"))
par(mfrow = c(2,2))
plot(modelBTC_lag12$model)
dev.off()

mean(modelBTC_lag12$model$residuals)

### Breusch-Pagan test - For heteroscedasticity
library(lmtest)

excess12NotNA <- Month.Lag12$BitCoin$exReVol_12[which(!is.na(Month.Lag12$BitCoin$exReVol_12))]

resModel <- lm(modelBTC_lag12$model$residuals^2 ~ excess12NotNA)
summary(resModel)
R2 <- 1 - sum((resModel$residuals)^2) / sum((modelBTC_lag12$model$residuals^2-mean(modelBTC_lag12$model$residuals^2))^2); R2
n <- length(modelBTC_lag12$model$residuals); n
bp <- n*R2; bp
bpP <- 1 - pchisq(bp, df = (length(modelBTC_lag12$model$coefficients)-1)); bpP
bptest(modelBTC_lag12$model)

### White test
res <- modelBTC_lag12$model$residuals
resModel <- lm(res^2 ~ I(excess12NotNA^2)
               + excess12NotNA)
summary(resModel)
R2 <- 1 - sum((resModel$residuals)^2) / sum((res^2-mean(res^2))^2); R2
n <- length(res); n
bp <- n*R2; bp
White <- 1 - pchisq(bp, df = (length(resModel$coefficients)-1))

heteroTestStat <- data.frame(p = "P-values", Bp = bpP, White = White); heteroTestStat
colnames(heteroTestStat) = c("", "Breusch-Pagan test", "White test")
xtable::xtable(heteroTestStat)

#### Test for normality ####
### Kolmogorov-Smirnov test
f <- ecdf(res)
KS <- max(f(res) - as.numeric(pnorm(res))); KS

library(kolmim)
1 - pkolm(KS, length(res))
KStest <- ks.test(modelBTC_lag12$model$residuals,"pnorm")

### Shapiro-Wilk
SWtest <- shapiro.test(modelBTC_lag12$model$residuals)

normTestStat <- data.frame(p = "P-values", KS = round(KStest$p.value, 4),
                           SW = round(SWtest$p.value, 4));normTestStat
colnames(normTestStat) = c("", "Kolmogorov-Smirnov test", "Shapiro-Wilk test")
xtable::xtable(normTestStat)

#### Get daily and weeky alpha statistics and lagged plots ####
listExcess <- list(months = monthlyExcess,
                   # weeks = weeklyExcess,
                   days = dailyExcess)

withoutBCH <- list(
  months = listExcess[["months"]][-2])
monthList <- fun_PlotsAndAlphaTable_v2(listExcess = withoutBCH,
                                       period = c("months"),
                                       tablePeriods = c(1, 3, 6, 9, 12, 15, 18, 24),
                                       savePlot = TRUE, outdir = outputFig,
                                       namesList = c("BTC", "ETH", "XRP", "Cum"))#, "BCH"))
DayList <- fun_PlotsAndAlphaTable_v2(listExcess = listExcess,
                                     period = c("days"),
                                     tablePeriods = c(1, 3, 6, 9, 12, 15, 18, 24),
                                     savePlot = TRUE, outdir = outputFig,
                                     namesList = c("BTC", "BCH", "ETH", "XRP", "Cum"))#c("Cum", "BTC", "ETH", "XRP", "BCH"))
monthList$xtable
DayList$xtable

#### TSMOM strategy ####
TSMOMstra <- fun_SharpeCompare_v3(listData = listExcess,
                                  withoutBCH = withoutBCH,
                                  lag = c(1, 3, 6, 12),
                                  proAnnuVol = 0.4,
                                  savePlot = TRUE, name = "Crypto",
                                  outputFig = outputFig,
                                  width = 8, height = 6)

#### Cross correlation between assets ####
# Lag 12
# Days
CCdays <- fun_tstats_allModels_v2(inputList = listExcess,
                                  period = c("days"), lag = 6)
# Months
CCmonths <- fun_tstats_allModels_v2(inputList = listExcess,
                                    period = c("months"), lag = 6)
xtable::xtable(CCdays$tstats)
xtable::xtable(CCmonths$tstats)

#### Moving correlation ####
RollingCorBTC <- fun_RollingCorrelation_v2(inputList = lapply(listExcess, lapply, function(x) {
  x[,-2]}),
  dep = "BitCoin", period = c("days"),
  savePlot = TRUE,
  margin = 30,
  outputFig = outputFig,
  width = 8, height = 6)