Hw4
Purevdorj Munkhbayar
2024-05-12
R Markdown
This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see http://rmarkdown.rstudio.com.
When you click the Knit button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:
rm(list = ls())
library(devtools)## Loading required package: usethisetf6 <- read.table('C:/Users/Administrator/Downloads/ETF6_20080101-20200430.csv', sep = ',', header = T)
#
head(etf6)## 證券代碼 簡稱 年月日 收盤價.元.
## 1 50 元大台灣50 20080102 39.6472
## 2 52 富邦科技 20080102 27.0983
## 3 56 元大高股息 20080102 14.5739
## 4 50 元大台灣50 20080103 38.9876
## 5 52 富邦科技 20080103 26.0676
## 6 56 元大高股息 20080103 14.3758etf6 <- etf6[, -2]
colnames(etf6) <- c('id', 'date', 'price')
head(etf6)## id date price
## 1 50 20080102 39.6472
## 2 52 20080102 27.0983
## 3 56 20080102 14.5739
## 4 50 20080103 38.9876
## 5 52 20080103 26.0676
## 6 56 20080103 14.3758library(pacman)
p_load(reshape2, xts, quantmod)
etf6.l <- dcast(etf6, date~id)## Using price as value column: use value.var to override.head(etf6.l)## date 00638R 50 52 56 61 6206
## 1 20080102 NA 39.6472 27.0983 14.5739 NA NA
## 2 20080103 NA 38.9876 26.0676 14.3758 NA NA
## 3 20080104 NA 38.9876 25.9346 14.4041 NA NA
## 4 20080107 NA 37.2064 24.1391 14.1777 NA NA
## 5 20080108 NA 37.5692 24.1391 14.3531 NA NA
## 6 20080109 NA 38.2619 24.2721 14.4663 NA NA# etf6.l <- na.omit(etf6.l)
# head(etf6.l)
str(etf6.l)## 'data.frame': 3041 obs. of 7 variables:
## $ date : int 20080102 20080103 20080104 20080107 20080108 20080109 20080110 20080111 20080114 20080115 ...
## $ 00638R : num NA NA NA NA NA NA NA NA NA NA ...
## $ 50 : num 39.6 39 39 37.2 37.6 ...
## $ 52 : num 27.1 26.1 25.9 24.1 24.1 ...
## $ 56 : num 14.6 14.4 14.4 14.2 14.4 ...
## $ 61 : num NA NA NA NA NA NA NA NA NA NA ...
## $ 6206 : num NA NA NA NA NA NA NA NA NA NA ...# convert into xts
etf6.xts <- xts(etf6.l[, -1], order.by = as.Date(as.character(etf6.l$date), format = '%Y%m%d'))
class(etf6.xts)## [1] "xts" "zoo"head(etf6.xts)## 00638R 50 52 56 61 6206
## 2008-01-02 NA 39.6472 27.0983 14.5739 NA NA
## 2008-01-03 NA 38.9876 26.0676 14.3758 NA NA
## 2008-01-04 NA 38.9876 25.9346 14.4041 NA NA
## 2008-01-07 NA 37.2064 24.1391 14.1777 NA NA
## 2008-01-08 NA 37.5692 24.1391 14.3531 NA NA
## 2008-01-09 NA 38.2619 24.2721 14.4663 NA NA# SIT
# con = gzcon(url('http://www.systematicportfolio.com/sit.gz', 'rb'))
# source(con)
# close(con)
#
# devtools::install_github('systematicinvestor/SIT.date', force = T)
# curl::curl_download('https://github.com/systematicinvestor/SIT/raw/master/SIT.tar.gz', 'SIT.tar.gz',mode = 'wb',quiet=T)
# install.packages('SIT.tar.gz', repos = NULL, type='source')
library(SIT) ## Loading required package: SIT.date##
## Attaching package: 'SIT'## The following object is masked from 'package:TTR':
##
## DVI## The following object is masked from 'package:base':
##
## closelibrary(quantmod)
#
# library(SIT)
#
data <- new.env()
# 1. prices; 2. weight; 3. execution.price
# buy and hold
# etf56 <- etf6.xts$`0056`
# head(etf56)
# data$prices = data$weight = data$execution.price = etf56
# data$weight[] <- 1
# data$execution.price[] <- NA
# names(data)
#
# etf52 <- etf6.xts$`0052`
# head(etf52)
# data$prices = data$weight = data$execution.price = etf52
# data$weight[] <- 1
# data$execution.price[] <- NA
# names(data)
#
model <- list()
#
etf3 <- etf6.xts[, 1:3]
head(etf3)## 00638R 50 52
## 2008-01-02 NA 39.6472 27.0983
## 2008-01-03 NA 38.9876 26.0676
## 2008-01-04 NA 38.9876 25.9346
## 2008-01-07 NA 37.2064 24.1391
## 2008-01-08 NA 37.5692 24.1391
## 2008-01-09 NA 38.2619 24.2721names(etf3)## [1] "00638R " "50" "52"colnames(etf3) <- c('e50', 'e52', 'e56')
names(etf3)## [1] "e50" "e52" "e56"md = 50
i = 'e50'
for (i in names(etf3)) {
data$prices = data$weight = data$execution.price = etf3[, i]
data$weight[] <- 1
data$execution.price[] <- NA
model[[i]] <- bt.run(data)
sma <- SMA(data$prices, md)
data$weight[] <- iif(data$prices >= sma, 1, 0)
i <- paste(i, '.sma.cross', sep = '')
model[[i]] <- bt.run(data)
}## Latest weights :
## e50
## 2020-04-30 100
##
## Performance summary :
## CAGR Best Worst
## -4.4 17.4 -8.5
##
## Latest weights :
## e50
## 2020-04-30 0
##
## Performance summary :
## CAGR Best Worst
## -4.3 11.2 -7.9
##
## Latest weights :
## e52
## 2020-04-30 100
##
## Performance summary :
## CAGR Best Worst
## 6.4 8 -7
##
## Latest weights :
## e52
## 2020-04-30 100
##
## Performance summary :
## CAGR Best Worst
## 5.3 7 -6.4
##
## Latest weights :
## e56
## 2020-04-30 100
##
## Performance summary :
## CAGR Best Worst
## 7.3 10 -9.2
##
## Latest weights :
## e56
## 2020-04-30 100
##
## Performance summary :
## CAGR Best Worst
## 0.9 10 -9.2 #-------------------------------------------------
strategy.performance.snapshoot(model, T)
## NULLplotbt(model, plotX = T, log = 'y', LeftMargin = 3)
mtext('Cumulative Performance', side = 2, line = 1)
plotbt.strategy.sidebyside(model, return.table=T, make.plot = T)
## e50 e50.sma.cross e52
## Period "Jan2008 - Apr2020" "Jan2008 - Apr2020" "Jan2008 - Apr2020"
## Cagr "-4.37" "-4.33" "6.43"
## Sharpe "-0.22" "-0.4" "0.42"
## DVR "-0.13" "-0.19" "0.37"
## Volatility "15.57" "10.09" "20.06"
## MaxDD "-54.65" "-50.87" "-52.38"
## AvgDD "-27.49" "-20.44" "-3.57"
## VaR "-1.34" "-0.53" "-1.93"
## CVaR "-2.45" "-1.64" "-3.07"
## Exposure "99.97" "15.29" "99.97"
## e52.sma.cross e56 e56.sma.cross
## Period "Jan2008 - Apr2020" "Jan2008 - Apr2020" "Jan2008 - Apr2020"
## Cagr "5.3" "7.32" "0.93"
## Sharpe "0.49" "0.41" "0.14"
## DVR "0.39" "0.33" "0.03"
## Volatility "12.22" "26.2" "17.63"
## MaxDD "-23.13" "-59.41" "-56.14"
## AvgDD "-3.08" "-5.19" "-7.84"
## VaR "-1.17" "-2.64" "-1.74"
## CVaR "-1.94" "-3.94" "-2.93"
## Exposure "62.08" "99.97" "60.77"# --------------------------------------------------
# Add equal-weighted portfolio for 3 ETFs
# --------------------------------------------------
data$prices = data$weight = data$execution.price = etf3
data$execution.price[] <- NA
prices <- data$prices
n <- ncol(prices)
data$weight <- ntop(prices, n)
model$etf3.EqWeight.bh <- bt.run(data)## Latest weights :
## e50 e52 e56
## 2020-04-30 33.33 33.33 33.33
##
## Performance summary :
## CAGR Best Worst
## 4.9 7 -7 #
strategy.performance.snapshoot(model, T)
## NULLplotbt(model, plotX = T, log = 'y', LeftMargin = 3)
mtext('Cumulative Performance', side = 2, line = 1)
plotbt.strategy.sidebyside(model, return.table=T, make.plot = F)## e50 e50.sma.cross e52
## Period "Jan2008 - Apr2020" "Jan2008 - Apr2020" "Jan2008 - Apr2020"
## Cagr "-4.37" "-4.33" "6.43"
## Sharpe "-0.22" "-0.4" "0.42"
## DVR "-0.13" "-0.19" "0.37"
## Volatility "15.57" "10.09" "20.06"
## MaxDD "-54.65" "-50.87" "-52.38"
## AvgDD "-27.49" "-20.44" "-3.57"
## VaR "-1.34" "-0.53" "-1.93"
## CVaR "-2.45" "-1.64" "-3.07"
## Exposure "99.97" "15.29" "99.97"
## e52.sma.cross e56 e56.sma.cross
## Period "Jan2008 - Apr2020" "Jan2008 - Apr2020" "Jan2008 - Apr2020"
## Cagr "5.3" "7.32" "0.93"
## Sharpe "0.49" "0.41" "0.14"
## DVR "0.39" "0.33" "0.03"
## Volatility "12.22" "26.2" "17.63"
## MaxDD "-23.13" "-59.41" "-56.14"
## AvgDD "-3.08" "-5.19" "-7.84"
## VaR "-1.17" "-2.64" "-1.74"
## CVaR "-1.94" "-3.94" "-2.93"
## Exposure "62.08" "99.97" "60.77"
## etf3.EqWeight.bh
## Period "Jan2008 - Apr2020"
## Cagr "4.91"
## Sharpe "0.35"
## DVR "0.32"
## Volatility "19.35"
## MaxDD "-55.84"
## AvgDD "-3.13"
## VaR "-1.94"
## CVaR "-3.02"
## Exposure "99.97"#=============================================================
# MVP investment strategy
#=============================================================
# monthly rebalance
# covariance matrix
# use monthly returns to compute monthly covariance matrix
etf3.m <- to.monthly(etf3, indexAt = 'lastof', OHLC = FALSE)## Warning in to.period(x, "months", indexAt = indexAt, name = name, ...): missing
## values removed from datahead(etf3.m)## e50 e52 e56
## 2015-05-31 19.14 59.3943 35.3361
## 2015-06-30 20.20 57.9742 33.8397
## 2015-07-31 20.71 55.2593 31.4489
## 2015-08-31 22.77 52.0431 28.6985
## 2015-09-30 22.38 52.1267 29.5512
## 2015-10-31 20.27 54.4474 31.1813#etf3.w <- to.weekly(etf3, indexAt = 'lastof', OHLC = FALSE)
#head(etf3.w)
#
#=================================================================
# MVP portfolio
#=================================================================
# Reset inputs to SIT bt function
data$prices = data$weight = data$execution.price = etf3.m
#data$prices <- industry.price.sample
#data$weight <- industry.price.sample
#data$execution.price <- industry.price.sample
data$execution.price[] <- NA
prices <- data$prices
n <- ncol(prices)
#*****************************************************************
# Create Constraints
#*****************************************************************
constraints = new.constraints(n, lb = 0, ub = +Inf)
# SUM x.i = 1
constraints = add.constraints(rep(1, n), 1, type = '=', constraints)
#
ret = prices / mlag(prices) - 1
weight = coredata(prices)
weight[] = NA
i = 36
for (i in 36:dim(weight)[1]) {
# using 36 historical monthly returns
hist = ret[ (i- 36 +1):i, ]
hist = na.omit(hist)
# create historical input assumptions
ia = create.historical.ia(hist, 12)
# s0 = apply(coredata(hist),2, sd)
ia$cov = cov(coredata(hist))
#ia$cov = cor(coredata(hist), use='complete.obs',method='kendall') * (s0 %*% t(s0))
# use min.risk.portfolio() to compute MVP weights
weight[i,] = min.risk.portfolio(ia, constraints)
}## Loading required package: kernlab##
## Attaching package: 'kernlab'## The following object is masked from 'package:SIT':
##
## cross#
weight## e50 e52 e56
## [1,] NA NA NA
## [2,] NA NA NA
## [3,] NA NA NA
## [4,] NA NA NA
## [5,] NA NA NA
## [6,] NA NA NA
## [7,] NA NA NA
## [8,] NA NA NA
## [9,] NA NA NA
## [10,] NA NA NA
## [11,] NA NA NA
## [12,] NA NA NA
## [13,] NA NA NA
## [14,] NA NA NA
## [15,] NA NA NA
## [16,] NA NA NA
## [17,] NA NA NA
## [18,] NA NA NA
## [19,] NA NA NA
## [20,] NA NA NA
## [21,] NA NA NA
## [22,] NA NA NA
## [23,] NA NA NA
## [24,] NA NA NA
## [25,] NA NA NA
## [26,] NA NA NA
## [27,] NA NA NA
## [28,] NA NA NA
## [29,] NA NA NA
## [30,] NA NA NA
## [31,] NA NA NA
## [32,] NA NA NA
## [33,] NA NA NA
## [34,] NA NA NA
## [35,] NA NA NA
## [36,] 0.3460104 0.6517386 0.0022510386
## [37,] 0.3460599 0.6511324 0.0028077800
## [38,] 0.3382620 0.6480977 0.0136403198
## [39,] 0.3354779 0.6537127 0.0108093366
## [40,] 0.3220504 0.6636354 0.0143142326
## [41,] 0.3185827 0.6733775 0.0080397742
## [42,] 0.3776051 0.6208018 0.0015931788
## [43,] 0.3732760 0.6253564 0.0013675968
## [44,] 0.3793043 0.6203315 0.0003641937
## [45,] 0.4067544 0.5919195 0.0013261211
## [46,] 0.3887465 0.6098594 0.0013940660
## [47,] 0.4078722 0.5915848 0.0005430235
## [48,] 0.3974773 0.6018368 0.0006859361
## [49,] 0.4018755 0.5969384 0.0011861710
## [50,] 0.3944494 0.6032126 0.0023379616
## [51,] 0.3879108 0.6075782 0.0045109711
## [52,] 0.3901861 0.6087191 0.0010948018
## [53,] 0.3952223 0.6005548 0.0042229552
## [54,] 0.4042213 0.5951755 0.0006031345
## [55,] 0.4072271 0.5712051 0.0215677534
## [56,] 0.4215145 0.5633966 0.0150889653
## [57,] 0.3869515 0.6096048 0.0034436831
## [58,] 0.3723003 0.6273666 0.0003331131
## [59,] 0.4237882 0.5751087 0.0011030823
## [60,] 0.4467246 0.5523705 0.0009049023weight <- round(weight, digits = 2)
#format(round(weight, 2), nsmall = 2)
#apply(weight, 1, sum)
data$weight[] = weight
#capital = 100000
#data$weight[] = (capital / prices) * data$weight
model$mvp.month = bt.run(data, type = "weight")## Latest weights :
## e50 e52 e56
## 2020-04-30 42 58 0
##
## Performance summary :
## CAGR Best Worst
## 0.1 4 -6.9 #
plotbt.strategy.sidebyside(model, return.table=T, make.plot = T)
## e50 e50.sma.cross e52
## Period "Jan2008 - Apr2020" "Jan2008 - Apr2020" "Jan2008 - Apr2020"
## Cagr "-4.37" "-4.33" "6.43"
## Sharpe "-0.22" "-0.4" "0.42"
## DVR "-0.13" "-0.19" "0.37"
## Volatility "15.57" "10.09" "20.06"
## MaxDD "-54.65" "-50.87" "-52.38"
## AvgDD "-27.49" "-20.44" "-3.57"
## VaR "-1.34" "-0.53" "-1.93"
## CVaR "-2.45" "-1.64" "-3.07"
## Exposure "99.97" "15.29" "99.97"
## e52.sma.cross e56 e56.sma.cross
## Period "Jan2008 - Apr2020" "Jan2008 - Apr2020" "Jan2008 - Apr2020"
## Cagr "5.3" "7.32" "0.93"
## Sharpe "0.49" "0.41" "0.14"
## DVR "0.39" "0.33" "0.03"
## Volatility "12.22" "26.2" "17.63"
## MaxDD "-23.13" "-59.41" "-56.14"
## AvgDD "-3.08" "-5.19" "-7.84"
## VaR "-1.17" "-2.64" "-1.74"
## CVaR "-1.94" "-3.94" "-2.93"
## Exposure "62.08" "99.97" "60.77"
## etf3.EqWeight.bh mvp.month
## Period "Jan2008 - Apr2020" "May2015 - Apr2020"
## Cagr "4.91" "0.13"
## Sharpe "0.35" "0.05"
## DVR "0.32" "0"
## Volatility "19.35" "6.12"
## MaxDD "-55.84" "-11.37"
## AvgDD "-3.13" "-11.28"
## VaR "-1.94" "-2.39"
## CVaR "-3.02" "-5.67"
## Exposure "99.97" "40"plotbt(model)
#====================
# multiple models
#====================
#*****************************************************************
# Create Constraints
#*****************************************************************
constraints = new.constraints(n, lb = 0, ub = 1)
# SUM x.i = 1
constraints = add.constraints(rep(1, n), 1, type = '=', constraints)
#*****************************************************************
# Create Portfolios
#*****************************************************************
ret = prices / mlag(prices) - 1
weight = coredata(prices)
weight[] = NA
#
weights = list()
# Equal Weight 1/N Benchmark
weights$equal.weight = weight
weights$equal.weight[] = ntop(prices, n)
start.i = 35
weights$equal.weight[1:start.i,] = NA
#
weights$min.var = weight
weights$min.maxloss = weight
weights$min.mad = weight
weights$min.cvar = weight
weights$min.cdar = weight
weights$min.cor.insteadof.cov = weight
weights$min.mad.downside = weight
weights$min.risk.downside = weight
#
#
models = list()
# i = "equal.weight"
for(i in names(weights)) {
data$weight[] = NA
data$weight[] = weights[[i]]
models[[i]] = bt.run.share(data, clean.signal = F)
}## Latest weights :
## e50 e52 e56
## 2020-04-30 33.33 33.33 33.33
##
## Performance summary :
## CAGR Best Worst
## 1.9 6.3 -7.6
##
## Latest weights :
## e50 e52 e56
## 2020-04-30 0 0 0
##
## Performance summary :
## CAGR Best Worst
## 0 0 0
##
## Latest weights :
## e50 e52 e56
## 2020-04-30 0 0 0
##
## Performance summary :
## CAGR Best Worst
## 0 0 0
##
## Latest weights :
## e50 e52 e56
## 2020-04-30 0 0 0
##
## Performance summary :
## CAGR Best Worst
## 0 0 0
##
## Latest weights :
## e50 e52 e56
## 2020-04-30 0 0 0
##
## Performance summary :
## CAGR Best Worst
## 0 0 0
##
## Latest weights :
## e50 e52 e56
## 2020-04-30 0 0 0
##
## Performance summary :
## CAGR Best Worst
## 0 0 0
##
## Latest weights :
## e50 e52 e56
## 2020-04-30 0 0 0
##
## Performance summary :
## CAGR Best Worst
## 0 0 0
##
## Latest weights :
## e50 e52 e56
## 2020-04-30 0 0 0
##
## Performance summary :
## CAGR Best Worst
## 0 0 0
##
## Latest weights :
## e50 e52 e56
## 2020-04-30 0 0 0
##
## Performance summary :
## CAGR Best Worst
## 0 0 0 # Plot perfromance
plotbt(models, plotX = T, log = 'y', LeftMargin = 3)
mtext('Cumulative Performance', side = 2, line = 1)
# Plot Strategy Statistics Side by Side
plotbt.strategy.sidebyside(models)## Warning in cor(y, x): the standard deviation is zero## Warning in min(drawdown[x[1]:x[2]], na.rm = T): no non-missing arguments to
## min; returning Inf## Warning in cor(y, x): the standard deviation is zero## Warning in min(drawdown[x[1]:x[2]], na.rm = T): no non-missing arguments to
## min; returning Inf## Warning in cor(y, x): the standard deviation is zero## Warning in min(drawdown[x[1]:x[2]], na.rm = T): no non-missing arguments to
## min; returning Inf## Warning in cor(y, x): the standard deviation is zero## Warning in min(drawdown[x[1]:x[2]], na.rm = T): no non-missing arguments to
## min; returning Inf## Warning in cor(y, x): the standard deviation is zero## Warning in min(drawdown[x[1]:x[2]], na.rm = T): no non-missing arguments to
## min; returning Inf## Warning in cor(y, x): the standard deviation is zero## Warning in min(drawdown[x[1]:x[2]], na.rm = T): no non-missing arguments to
## min; returning Inf## Warning in cor(y, x): the standard deviation is zero## Warning in min(drawdown[x[1]:x[2]], na.rm = T): no non-missing arguments to
## min; returning Inf## Warning in cor(y, x): the standard deviation is zero## Warning in min(drawdown[x[1]:x[2]], na.rm = T): no non-missing arguments to
## min; returning Inf
Including Plots
You can also embed plots, for example:
Note that the echo = FALSE parameter was added to the
code chunk to prevent printing of the R code that generated the
plot.