rm(list=ls())
#setInternet2(TRUE)
con = gzcon(url('https://github.com/systematicinvestor/SIT/raw/master/sit.gz', 'rb'))
source(con)
close(con)
#*****************************************************************
# Load historical data
#******************************************************************
load.packages('quantmod,quadprog,lpSolve')
## Warning: package 'quantmod' was built under R version 3.4.4
## Warning: package 'xts' was built under R version 3.4.4
## Warning: package 'zoo' was built under R version 3.4.4
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
## Warning: package 'TTR' was built under R version 3.4.4
##
## Attaching package: 'TTR'
## The following object is masked _by_ '.GlobalEnv':
##
## DVI
## Version 0.4-0 included new data defaults. See ?getSymbols.
## Warning: package 'quadprog' was built under R version 3.4.4
## Warning: package 'lpSolve' was built under R version 3.4.4
library(quantmod)
getSymbols("SSUN.F", auto.assign = TRUE)
## 'getSymbols' currently uses auto.assign=TRUE by default, but will
## use auto.assign=FALSE in 0.5-0. You will still be able to use
## 'loadSymbols' to automatically load data. getOption("getSymbols.env")
## and getOption("getSymbols.auto.assign") will still be checked for
## alternate defaults.
##
## This message is shown once per session and may be disabled by setting
## options("getSymbols.warning4.0"=FALSE). See ?getSymbols for details.
## Warning: SSUN.F contains missing values. Some functions will not work if
## objects contain missing values in the middle of the series. Consider using
## na.omit(), na.approx(), na.fill(), etc to remove or replace them.
## [1] "SSUN.F"
tickers = c("SSUN.F", "AAPL", "LGLG.F")
getSymbols(tickers, from = "2007-01-01", auto.assign = TRUE)
## Warning: SSUN.F contains missing values. Some functions will not work if
## objects contain missing values in the middle of the series. Consider using
## na.omit(), na.approx(), na.fill(), etc to remove or replace them.
## Warning: LGLG.F contains missing values. Some functions will not work if
## objects contain missing values in the middle of the series. Consider using
## na.omit(), na.approx(), na.fill(), etc to remove or replace them.
## [1] "SSUN.F" "AAPL" "LGLG.F"
data = new.env()
getSymbols(tickers, from = "2007-01-01", env = data , auto.assign = TRUE)
## Warning: SSUN.F contains missing values. Some functions will not work if
## objects contain missing values in the middle of the series. Consider using
## na.omit(), na.approx(), na.fill(), etc to remove or replace them.
## Warning: LGLG.F contains missing values. Some functions will not work if
## objects contain missing values in the middle of the series. Consider using
## na.omit(), na.approx(), na.fill(), etc to remove or replace them.
## [1] "SSUN.F" "AAPL" "LGLG.F"
ls(data)
## [1] "AAPL" "LGLG.F" "SSUN.F"
names(data)
## [1] "AAPL" "SSUN.F" "LGLG.F" ".getSymbols"
head(data$AAPL)
## AAPL.Open AAPL.High AAPL.Low AAPL.Close AAPL.Volume
## 2007-01-03 12.32714 12.36857 11.70000 11.97143 309579900
## 2007-01-04 12.00714 12.27857 11.97429 12.23714 211815100
## 2007-01-05 12.25286 12.31428 12.05714 12.15000 208685400
## 2007-01-08 12.28000 12.36143 12.18286 12.21000 199276700
## 2007-01-09 12.35000 13.28286 12.16429 13.22429 837324600
## 2007-01-10 13.53571 13.97143 13.35000 13.85714 738220000
## AAPL.Adjusted
## 2007-01-03 7.982585
## 2007-01-04 8.159763
## 2007-01-05 8.101658
## 2007-01-08 8.141665
## 2007-01-09 8.817995
## 2007-01-10 9.239983
for(i in ls(data)) data[[i]] = adjustOHLC(data[[i]], use.Adjusted=T)
names(data)
## [1] "AAPL" "SSUN.F" "LGLG.F" ".getSymbols"
data.weekly <- new.env()
for(i in tickers) data.weekly[[i]] = to.weekly(data[[i]], indexAt='endof')
## Warning in to.period(x, "weeks", name = name, ...): missing values removed
## from data
## Warning in to.period(x, "weeks", name = name, ...): missing values removed
## from data
data.monthly <- new.env()
for(i in tickers) data.monthly[[i]] = to.monthly(data[[i]], indexAt='endof')
## Warning in to.period(x, "months", indexAt = indexAt, name = name, ...):
## missing values removed from data
## Warning in to.period(x, "months", indexAt = indexAt, name = name, ...):
## missing values removed from data
bt.prep(data, align='remove.na', dates='2010::2018')
bt.prep(data.monthly, align='remove.na', dates='2010::2018')
names(data)
## [1] "prices" "AAPL" "SSUN.F" "dates"
## [5] "LGLG.F" "weight" ".getSymbols" "symbolnames"
## [9] "execution.price"
#*****************************************************************
# Code Strategies
#******************************************************************
prices = data$prices
n = ncol(prices)
n
## [1] 3
# find week ends
week.ends = endpoints(prices, 'weeks')
week.ends = week.ends[week.ends > 0]
month.ends = endpoints(prices, 'months')
month.ends = month.ends[month.ends > 0]
# Equal Weight 1/N Benchmark
data$weight[] = NA
data$weight[week.ends,] = ntop(prices[week.ends,], n)
data$weight[month.ends,] = ntop(prices[month.ends,], n)
#capital = 100000
#data$weight[] = (capital / prices) * data$weight
equal.weight = bt.run(data)
## Latest weights :
## AAPL LGLG.F SSUN.F
## 2018-12-28 08:00:00 33.33 33.33 33.33
##
## Performance summary :
## CAGR Best Worst
## 17 5.8 -6.3
names(equal.weight)
## [1] "weight" "type" "ret" "best" "worst"
## [6] "equity" "cagr" "dates.index"
head(equal.weight$equity)
## AAPL
## 2010-01-04 08:00:00 1.0000000
## 2010-01-05 08:00:00 1.0000000
## 2010-01-06 08:00:00 1.0000000
## 2010-01-07 08:00:00 1.0000000
## 2010-01-08 08:00:00 1.0000000
## 2010-01-11 08:00:00 0.9858913
#*****************************************************************
# Create Constraints
#*****************************************************************
constraints = new.constraints(n, lb = -Inf, 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
for( i in month.ends[month.ends >= (756 + 1)] ) {
# one quarter is 63 days
hist = ret[ (i- 756 +1):i, ]
# create historical input assumptions
ia = create.historical.ia(hist, 756)
#s0 = apply(coredata(hist),2,sd)
#ia$cov = cor(coredata(hist), use='complete.obs',method='pearson') * (s0 %*% t(s0))
weight[i,] = min.risk.portfolio(ia, constraints)
}
tail(weight,10)
## AAPL LGLG.F SSUN.F
## [2216,] NA NA NA
## [2217,] NA NA NA
## [2218,] NA NA NA
## [2219,] NA NA NA
## [2220,] NA NA NA
## [2221,] NA NA NA
## [2222,] NA NA NA
## [2223,] NA NA NA
## [2224,] NA NA NA
## [2225,] 0.5797841 0.1607614 0.2594544
# Minimum Variance
data$weight[] = weight
#capital = 100000
#data$weight[] = (capital / prices) * data$weight
min.var.daily = bt.run(data)
## Latest weights :
## AAPL LGLG.F SSUN.F
## 2018-12-28 08:00:00 58.89 16.25 24.86
##
## Performance summary :
## CAGR Best Worst
## 13.5 4.6 -5.4
names(min.var.daily)
## [1] "weight" "type" "ret" "best" "worst"
## [6] "equity" "cagr" "dates.index"
#
#*****************************************************************
# Code Strategies: Weekly
#******************************************************************
retw = data.weekly$prices / mlag(data.weekly$prices) - 1
weightw = coredata(prices)
weightw[] = NA
week.ends<-week.ends[-length(week.ends)]
for( i in month.ends[month.ends >= (756 + 1)] ) {
# map
j = which(index(ret[i,]) == index(retw))
# one quarter = 13 weeks
#hist = retw[ (j- 156 +1):j, ]
# create historical input assumptions
ia = create.historical.ia(hist, n)
s0 = apply(coredata(hist),2,sd)
ia$cov = cor(coredata(hist), use='complete.obs',method='pearson') * (s0 %*% t(s0))
weightw[i,] = min.risk.portfolio(ia, constraints)
}
## Loading required package: kernlab
## Warning: package 'kernlab' was built under R version 3.4.4
##
## Attaching package: 'kernlab'
## The following object is masked _by_ '.GlobalEnv':
##
## cross
data$weight[] = weightw
capital = 100000
data$weight[] = (capital / prices) * data$weight
min.var.weekly = bt.run(data, type='share', capital=capital)
## Latest weights :
## AAPL LGLG.F SSUN.F
## 2018-12-28 08:00:00 0 0 0
##
## Performance summary :
## CAGR Best Worst
## 0 0 0
#*****************************************************************
# Code Strategies: Monthly
#******************************************************************
retm = data.monthly$prices / mlag(data.monthly$prices) - 1
weightm = coredata(prices)
weightm[] = NA
month.ends<-month.ends[-length(month.ends)]
data$weight[] = weightm
capital = 100000
data$weight[] = (capital / prices) * data$weight
min.var.monthly = bt.run(data, type='share', capital=capital)
## Latest weights :
## AAPL LGLG.F SSUN.F
## 2018-12-28 08:00:00 0 0 0
##
## Performance summary :
## CAGR Best Worst
## 0 0 0
#*****************************************************************
# Create Report
#******************************************************************
plotbt.custom.report.part3(min.var.daily, min.var.weekly, min.var.monthly, equal.weight)
#
models<-list("Min.var.daily" = min.var.daily,
"Min.var.weekly" = min.var.weekly,
"Min.var.monthly" = min.var.monthly,
"Equal.weight" = equal.weight)
#
strategy.performance.snapshoot(models, T)
## 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
## NULL
strategy.performance.snapshoot(models, control=list(comparison=T),
sort.performance=T)
## Warning in cor(y, x): the standard deviation is zero
## Warning in cor(y, x): 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
plotbt.strategy.sidebyside(models, return.table=T)
## Warning in cor(y, x): the standard deviation is zero
## Warning in cor(y, x): 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
## Min.var.daily Min.var.weekly Min.var.monthly
## Period "Jan2010 - Dec2018" "Jan2010 - Dec2018" "Jan2010 - Dec2018"
## Cagr "13.49" "0" "0"
## Sharpe "0.89" "NaN" "NaN"
## DVR "0.75" "NaN" "NaN"
## Volatility "15.8" "0" "0"
## MaxDD "-29.51" "0" "0"
## AvgDD "-2.97" "NaN" "NaN"
## VaR "-1.61" "0" "0"
## CVaR "-2.33" "NaN" "NaN"
## Exposure "65.75" "0" "0"
## Equal.weight
## Period "Jan2010 - Dec2018"
## Cagr "16.95"
## Sharpe "0.83"
## DVR "0.74"
## Volatility "22.08"
## MaxDD "-32.66"
## AvgDD "-3.82"
## VaR "-2.12"
## CVaR "-2.98"
## Exposure "99.78"
plotbt.strategy.sidebyside(min.var.daily, return.table=T)
## min.var.daily
## Period "Jan2010 - Dec2018"
## Cagr "13.49"
## Sharpe "0.89"
## DVR "0.75"
## Volatility "15.8"
## MaxDD "-29.51"
## AvgDD "-2.97"
## VaR "-1.61"
## CVaR "-2.33"
## Exposure "65.75"
# plot Daily and Weekly transition maps
layout(1:3)
plotbt.transition.map(min.var.daily$weight)
legend('topright', legend = 'min.var.daily', bty = 'n')
plotbt.transition.map(min.var.weekly$weight)
legend('topright', legend = 'min.var.weekly', bty = 'n')
plotbt.transition.map(min.var.monthly$weight)
legend('topright', legend = 'min.var.monthy', bty = 'n')
