scripts/tsmomFirst.R
In 3schwartz/SpecialeScrAndFun: Script and functions used for master thesis.
# getCumReturn <- function(x) {
# getRe <- lapply(x, function(x) {
# foo <- x[, "re.proc"]})
# bindRe <- do.call(cbind, getRe)
# bindCum <- cbind(bindRe, xts::xts(apply(bindRe, 1, sum), order.by = zoo::index(bindRe)))
# colnames(bindCum) <- c(sapply(names(x), function(x) {
# return(stringr::str_match(x, "^.+(?=Yahoo)"))
# }), "Cum. Return")
# return(bindCum)
# }
library(Data)
library(xts)
library(lubridate)
library(xtable)
library(tseries)
library(quantmod)
library(dplyr)
library(ggplot2)
outputFig <- c("C:/Users/Soren Schwartz/Dropbox/Egne dokumenter/Skole/master/opgave/Figures/")
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])
)
coinList.xts <- sapply(coinList.xts, function(x) {
Ad <- quantmod::Ad(x)
x$re.proc <- (Ad[-1] - lag(Ad)[-1]) / lag(Ad)[-1]
x$re.log <-diff(log(Ad))
x
})
#### 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(x$re.log, na.rm = TRUE) * 100
}), digits = 2), "%"),
"Daily SD" = paste0(round(sapply(coinList.xts, function(x) {
sd(x$re.log, 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 ####
getCumReturn <- function(x, period = "months") {
getRe <- sapply(x, function(x) {
quantmod::Cl(xts::to.period(quantmod::Ad(x), period = period))
})
bindRe <- do.call(cbind, getRe)
bindRe <- cbind(rowSums(bindRe), bindRe)
# bindCum <- cbind(xts::xts(apply(bindRe, 1, sum), order.by = zoo::index(bindRe)), bindRe)
colnames(bindRe) <- c("Cum. Return", sapply(names(x), function(x) {
return(stringr::str_match(x, "^.+(?=Yahoo)"))
}))
bindRe <- diff(log(bindRe))
return(bindRe)
}
CumReturn.Month <- getCumReturn(coinList.xts, period = "months")
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, "ReAcfPacf.pdf"))
# for (i in 1:ncol(CumReturn.Month)) {
# par(mfrow = c(1, 2))
# forecast::Acf(CumReturn.Month[,i], main = colnames(CumReturn.Month)[i])
# forecast::Pacf(CumReturn.Month[,i], main = colnames(CumReturn.Month)[i])
# }
# dev.off()
CumReturn.Week <- getCumReturn(coinList.xts, period = "weeks")
pdf(file = paste0(outputFig, "ReAcfPacfWeek.pdf"))
par(mfrow = c(5, 2))
for (i in 1:ncol(CumReturn.Week)) {
forecast::Acf(CumReturn.Week[,i], main = colnames(CumReturn.Week)[i])
forecast::Pacf(CumReturn.Week[,i], main = colnames(CumReturn.Week)[i])
}
dev.off()
CumReturn.Days <- getCumReturn(coinList.xts, period = "days")
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 ####
BTC.daily <- fun_dailyDf(xtsObj = coinList.xts$BitCoinYahoo.xts,
dateFrom = "2013/",
delta = 60/61, annu = 261)
BTC.month.df <- fun_toPeriodCl(df = BTC.daily.df, period = "months")
BTC.month.dfLag12 <- fun_GetVolAdReturn(BTC.month.df, lag = 12)
modelBTC_lag12 <- fun_lm(dependent = "reVol", regressors = c("reVolLag12"),
data = BTC.month.dfLag12)
par(mfrow = c(1,1))
plot(BTC.month.dfLag12[,4], BTC.month.dfLag12[,5],
xlab = expression("r"[t]), ylab = expression("r"[t-1]))
abline(modelBTC_lag12$model, lwd = 2, col = "red")
summary(modelBTC_lag12$model)
cor(BTC.month.dfLag12[which(names(BTC.month.dfLag12[,4]) == names(fitted(modelBTC_lag12$model))[1]):length(BTC.month.dfLag12[,4]),4],
fitted(modelBTC_lag12$model))^2
#### Investigte residuals graphically ####
par(mfrow = c(2,2))
plot(modelBTC_lag12$model)
par(mfrow = c(1,1))
plot(BTC.month.dfLag12[!is.na(BTC.month.dfLag12[,5]),5], modelBTC_lag12$model$residuals,
ylab = "Residuals", xlab = expression(paste("r"[t-12],"/", sigma[t-13])), pch = 16)
mean(modelBTC_lag12$model$residuals)
#### Test for heteroscedasticity ####
### Breusch-Pagan test - For heteroscedasticity
library(lmtest)
resModel <- lm(modelBTC_lag12$model$residuals^2 ~
BTC.month.dfLag12[which(!is.na(BTC.month.dfLag12[,5])),5])
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(BTC.month.dfLag12[which(!is.na(BTC.month.dfLag12[,5])),5]^2)
+ BTC.month.dfLag12[which(!is.na(BTC.month.dfLag12[,5])),5])
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 ####
CumPrice <- xts::xts(x = rowSums(do.call(cbind, lapply(coinList.xts, function(x) {
quantmod::Cl(x)
}))), order.by = zoo::index(coinList.xts$BitCoinYahoo.xts))
Cum.daily <- fun_dailyDf(xtsObj = CumPrice,
dateFrom = "2017-08-01/",
delta = 60/61, annu = 261)
ETH.daily <- fun_dailyDf(xtsObj = coinList.xts$EthereumYahoo.xts,
dateFrom = "2016-02-01/",
delta = 60/61, annu = 261)
XRP.daily <- fun_dailyDf(xtsObj = coinList.xts$RippleYahoo.xts,
dateFrom = "2014-01-01/",
delta = 60/61, annu = 261)
BCH.daily <- fun_dailyDf(xtsObj = coinList.xts$BitCashYahoo.xts,
dateFrom = "2017-08-01/",
delta = 60/61, annu = 261)
DayList <- fun_PlotsAndAlphaTable(period = c("days"),
tablePeriods = c(1, 2, 3, 7, 9, 12, 15, 20, 30),
savePlot = TRUE)
weekList <- fun_PlotsAndAlphaTable(period = c("weeks"),
tablePeriods = c(1, 3, 6, 9, 12, 15, 18, 24),
savePlot = TRUE)
#### TSMOM strategy ####
fun_SharpeCompare(listData = list(BTC= BTC.daily, ETH = ETH.daily, XRP = XRP.daily, BCH = BCH.daily),
lag = c(1, 3, 6, 12),
proAnnuVol = 0.4,
savePlot = TRUE, name = "Crypto",
outputFig = c("C:/Users/Soren Schwartz/Dropbox/Egne dokumenter/Skole/master/opgave/Figures/"),
width = 8, height = 6)
#### Cross correlation between assets ####
# Lag 12
# Days
CCdays <- fun_tstats_allModels(list = list(BTC= BTC.daily, ETH = ETH.daily, XRP = XRP.daily, BCH = BCH.daily),
period = c("days"), lag = 6)
# Weeks
CCweeks <- fun_tstats_allModels(list = list(BTC= BTC.daily, ETH = ETH.daily, XRP = XRP.daily, BCH = BCH.daily),
period = c("weeks"), lag = 6)
# Months
CCmonths <- fun_tstats_allModels(list = list(BTC= BTC.daily, ETH = ETH.daily, XRP = XRP.daily, BCH = BCH.daily),
period = c("months"), lag = 6)
xtable::xtable(CCdays$tstats)
xtable::xtable(CCweeks$tstats)
xtable::xtable(CCmonths$tstats)
#### Moving correlation ####
RollingCorBTC <- fun_RollingCorrelation(list = list(BTC= BTC.daily, ETH = ETH.daily,
XRP = XRP.daily, BCH = BCH.daily),
dep = "BTC", period = c("days"),
savePlot = TRUE,
margin = 10,
outputFig = c("C:/Users/Soren Schwartz/Dropbox/Egne dokumenter/Skole/master/opgave/Figures/"),
width = 8, height = 6)
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.
# getCumReturn <- function(x) {
# getRe <- lapply(x, function(x) {
# foo <- x[, "re.proc"]})
# bindRe <- do.call(cbind, getRe)
# bindCum <- cbind(bindRe, xts::xts(apply(bindRe, 1, sum), order.by = zoo::index(bindRe)))
# colnames(bindCum) <- c(sapply(names(x), function(x) {
# return(stringr::str_match(x, "^.+(?=Yahoo)"))
# }), "Cum. Return")
# return(bindCum)
# }
library(Data)
library(xts)
library(lubridate)
library(xtable)
library(tseries)
library(quantmod)
library(dplyr)
library(ggplot2)
outputFig <- c("C:/Users/Soren Schwartz/Dropbox/Egne dokumenter/Skole/master/opgave/Figures/")
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])
)
coinList.xts <- sapply(coinList.xts, function(x) {
Ad <- quantmod::Ad(x)
x$re.proc <- (Ad[-1] - lag(Ad)[-1]) / lag(Ad)[-1]
x$re.log <-diff(log(Ad))
x
})
#### 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(x$re.log, na.rm = TRUE) * 100
}), digits = 2), "%"),
"Daily SD" = paste0(round(sapply(coinList.xts, function(x) {
sd(x$re.log, 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 ####
getCumReturn <- function(x, period = "months") {
getRe <- sapply(x, function(x) {
quantmod::Cl(xts::to.period(quantmod::Ad(x), period = period))
})
bindRe <- do.call(cbind, getRe)
bindRe <- cbind(rowSums(bindRe), bindRe)
# bindCum <- cbind(xts::xts(apply(bindRe, 1, sum), order.by = zoo::index(bindRe)), bindRe)
colnames(bindRe) <- c("Cum. Return", sapply(names(x), function(x) {
return(stringr::str_match(x, "^.+(?=Yahoo)"))
}))
bindRe <- diff(log(bindRe))
return(bindRe)
}
CumReturn.Month <- getCumReturn(coinList.xts, period = "months")
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, "ReAcfPacf.pdf"))
# for (i in 1:ncol(CumReturn.Month)) {
# par(mfrow = c(1, 2))
# forecast::Acf(CumReturn.Month[,i], main = colnames(CumReturn.Month)[i])
# forecast::Pacf(CumReturn.Month[,i], main = colnames(CumReturn.Month)[i])
# }
# dev.off()
CumReturn.Week <- getCumReturn(coinList.xts, period = "weeks")
pdf(file = paste0(outputFig, "ReAcfPacfWeek.pdf"))
par(mfrow = c(5, 2))
for (i in 1:ncol(CumReturn.Week)) {
forecast::Acf(CumReturn.Week[,i], main = colnames(CumReturn.Week)[i])
forecast::Pacf(CumReturn.Week[,i], main = colnames(CumReturn.Week)[i])
}
dev.off()
CumReturn.Days <- getCumReturn(coinList.xts, period = "days")
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 ####
BTC.daily <- fun_dailyDf(xtsObj = coinList.xts$BitCoinYahoo.xts,
dateFrom = "2013/",
delta = 60/61, annu = 261)
BTC.month.df <- fun_toPeriodCl(df = BTC.daily.df, period = "months")
BTC.month.dfLag12 <- fun_GetVolAdReturn(BTC.month.df, lag = 12)
modelBTC_lag12 <- fun_lm(dependent = "reVol", regressors = c("reVolLag12"),
data = BTC.month.dfLag12)
par(mfrow = c(1,1))
plot(BTC.month.dfLag12[,4], BTC.month.dfLag12[,5],
xlab = expression("r"[t]), ylab = expression("r"[t-1]))
abline(modelBTC_lag12$model, lwd = 2, col = "red")
summary(modelBTC_lag12$model)
cor(BTC.month.dfLag12[which(names(BTC.month.dfLag12[,4]) == names(fitted(modelBTC_lag12$model))[1]):length(BTC.month.dfLag12[,4]),4],
fitted(modelBTC_lag12$model))^2
#### Investigte residuals graphically ####
par(mfrow = c(2,2))
plot(modelBTC_lag12$model)
par(mfrow = c(1,1))
plot(BTC.month.dfLag12[!is.na(BTC.month.dfLag12[,5]),5], modelBTC_lag12$model$residuals,
ylab = "Residuals", xlab = expression(paste("r"[t-12],"/", sigma[t-13])), pch = 16)
mean(modelBTC_lag12$model$residuals)
#### Test for heteroscedasticity ####
### Breusch-Pagan test - For heteroscedasticity
library(lmtest)
resModel <- lm(modelBTC_lag12$model$residuals^2 ~
BTC.month.dfLag12[which(!is.na(BTC.month.dfLag12[,5])),5])
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(BTC.month.dfLag12[which(!is.na(BTC.month.dfLag12[,5])),5]^2)
+ BTC.month.dfLag12[which(!is.na(BTC.month.dfLag12[,5])),5])
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 ####
CumPrice <- xts::xts(x = rowSums(do.call(cbind, lapply(coinList.xts, function(x) {
quantmod::Cl(x)
}))), order.by = zoo::index(coinList.xts$BitCoinYahoo.xts))
Cum.daily <- fun_dailyDf(xtsObj = CumPrice,
dateFrom = "2017-08-01/",
delta = 60/61, annu = 261)
ETH.daily <- fun_dailyDf(xtsObj = coinList.xts$EthereumYahoo.xts,
dateFrom = "2016-02-01/",
delta = 60/61, annu = 261)
XRP.daily <- fun_dailyDf(xtsObj = coinList.xts$RippleYahoo.xts,
dateFrom = "2014-01-01/",
delta = 60/61, annu = 261)
BCH.daily <- fun_dailyDf(xtsObj = coinList.xts$BitCashYahoo.xts,
dateFrom = "2017-08-01/",
delta = 60/61, annu = 261)
DayList <- fun_PlotsAndAlphaTable(period = c("days"),
tablePeriods = c(1, 2, 3, 7, 9, 12, 15, 20, 30),
savePlot = TRUE)
weekList <- fun_PlotsAndAlphaTable(period = c("weeks"),
tablePeriods = c(1, 3, 6, 9, 12, 15, 18, 24),
savePlot = TRUE)
#### TSMOM strategy ####
fun_SharpeCompare(listData = list(BTC= BTC.daily, ETH = ETH.daily, XRP = XRP.daily, BCH = BCH.daily),
lag = c(1, 3, 6, 12),
proAnnuVol = 0.4,
savePlot = TRUE, name = "Crypto",
outputFig = c("C:/Users/Soren Schwartz/Dropbox/Egne dokumenter/Skole/master/opgave/Figures/"),
width = 8, height = 6)
#### Cross correlation between assets ####
# Lag 12
# Days
CCdays <- fun_tstats_allModels(list = list(BTC= BTC.daily, ETH = ETH.daily, XRP = XRP.daily, BCH = BCH.daily),
period = c("days"), lag = 6)
# Weeks
CCweeks <- fun_tstats_allModels(list = list(BTC= BTC.daily, ETH = ETH.daily, XRP = XRP.daily, BCH = BCH.daily),
period = c("weeks"), lag = 6)
# Months
CCmonths <- fun_tstats_allModels(list = list(BTC= BTC.daily, ETH = ETH.daily, XRP = XRP.daily, BCH = BCH.daily),
period = c("months"), lag = 6)
xtable::xtable(CCdays$tstats)
xtable::xtable(CCweeks$tstats)
xtable::xtable(CCmonths$tstats)
#### Moving correlation ####
RollingCorBTC <- fun_RollingCorrelation(list = list(BTC= BTC.daily, ETH = ETH.daily,
XRP = XRP.daily, BCH = BCH.daily),
dep = "BTC", period = c("days"),
savePlot = TRUE,
margin = 10,
outputFig = c("C:/Users/Soren Schwartz/Dropbox/Egne dokumenter/Skole/master/opgave/Figures/"),
width = 8, height = 6)
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.