Permalink
Cannot retrieve contributors at this time
Name already in use
A tag already exists with the provided branch name. Many Git commands accept both tag and branch names, so creating this branch may cause unexpected behavior. Are you sure you want to create this branch?
SIT/R/bt.test.r
Go to fileThis commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
10153 lines (7783 sloc)
357 KB
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
############################################################################### | |
# This software is provided 'as-is', without any express or implied | |
# warranty. In no event will the authors be held liable for any damages | |
# arising from the use of this software. | |
# | |
# Permission is granted to anyone to use this software for any purpose, | |
# including commercial applications, and to alter it and redistribute it | |
# freely, subject to the following restrictions: | |
# | |
# 1. The origin of this software must not be misrepresented; you must not | |
# claim that you wrote the original software. If you use this software | |
# in a product, an acknowledgment in the product documentation would be | |
# appreciated but is not required. | |
# 2. Altered source versions must be plainly marked as such, and must not be | |
# misrepresented as being the original software. | |
# 3. This notice may not be removed or altered from any source distribution. | |
############################################################################### | |
# Evaluating Sample Trading Strategies using Backtesting library | |
# | |
# For more information please email at TheSystematicInvestor at gmail | |
############################################################################### | |
bt.empty.test <- function() | |
{ | |
#***************************************************************** | |
# Load historical data | |
#****************************************************************** | |
load.packages('quantmod') | |
tickers = spl('SPY') | |
data <- new.env() | |
getSymbols(tickers, src = 'yahoo', from = '1970-01-01', env = data, auto.assign = T) | |
for(i in ls(data)) data[[i]] = adjustOHLC(data[[i]], use.Adjusted=T) | |
bt.prep(data, align='keep.all', dates='1970::2011') | |
#***************************************************************** | |
# Code Strategies | |
#****************************************************************** | |
prices = data$prices | |
# Buy & Hold | |
data$weight[] = 0 | |
buy.hold = bt.run(data, trade.summary=T) | |
#***************************************************************** | |
# Create Report | |
#****************************************************************** | |
plotbt.custom.report.part1( buy.hold, trade.summary =T) | |
plotbt.custom.report.part2( buy.hold, trade.summary =T) | |
plotbt.custom.report.part3( buy.hold, trade.summary =T) | |
} | |
############################################################################### | |
# How to use execution.price functionality | |
############################################################################### | |
bt.execution.price.test <- function() | |
{ | |
#***************************************************************** | |
# Load historical data | |
#****************************************************************** | |
load.packages('quantmod') | |
tickers = spl('SPY') | |
data <- new.env() | |
getSymbols(tickers, src = 'yahoo', from = '1970-01-01', env = data, auto.assign = T) | |
for(i in ls(data)) data[[i]] = adjustOHLC(data[[i]], use.Adjusted=T) | |
bt.prep(data, align='keep.all', dates='1970::') | |
#***************************************************************** | |
# Code Strategies | |
#****************************************************************** | |
prices = data$prices | |
nperiods = nrow(prices) | |
models = list() | |
#***************************************************************** | |
# Buy & Hold | |
#****************************************************************** | |
data$weight[] = 0 | |
data$execution.price[] = NA | |
data$weight[] = 1 | |
models$buy.hold = bt.run.share(data, clean.signal=T) | |
#***************************************************************** | |
# MA cross-over strategy | |
#****************************************************************** | |
sma.fast = SMA(prices, 50) | |
sma.slow = SMA(prices, 200) | |
signal = iif(sma.fast >= sma.slow, 1, -1) | |
data$weight[] = NA | |
data$execution.price[] = NA | |
data$weight[] = signal | |
models$ma.crossover = bt.run.share(data, clean.signal=T, trade.summary = TRUE) | |
#***************************************************************** | |
# MA cross-over strategy, add 10c per share commission | |
#***************************************************************** | |
data$weight[] = NA | |
data$execution.price[] = NA | |
data$weight[] = signal | |
models$ma.crossover.com = bt.run.share(data, commission = 0.1, clean.signal=T) | |
#***************************************************************** | |
# MA cross-over strategy: | |
# Exit trades at the close on the day of the signal | |
# Enter trades at the open the next day after the signal | |
#****************************************************************** | |
popen = bt.apply(data, Op) | |
signal.new = signal | |
trade.start = which(signal != mlag(signal) & signal != 0) | |
signal.new[trade.start] = 0 | |
trade.start = trade.start + 1 | |
data$weight[] = NA | |
data$execution.price[] = NA | |
data$execution.price[trade.start,] = popen[trade.start,] | |
data$weight[] = signal.new | |
models$ma.crossover.enter.next.open = bt.run.share(data, clean.signal=T, trade.summary = TRUE) | |
#***************************************************************** | |
# Create Report | |
#****************************************************************** | |
# put all reports into one pdf file | |
#pdf(file = 'report.pdf', width=8.5, height=11) | |
models = rev(models) | |
png(filename = 'plot1.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
# Plot perfromance | |
plotbt(models, plotX = T, log = 'y', LeftMargin = 3) | |
mtext('Cumulative Performance', side = 2, line = 1) | |
dev.off() | |
png(filename = 'plot2.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
# Plot trades | |
plotbt.custom.report.part3(models$ma.crossover, trade.summary = TRUE) | |
dev.off() | |
png(filename = 'plot3.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part3(models$ma.crossover.enter.next.open, trade.summary = TRUE) | |
dev.off() | |
#dev.off() | |
#***************************************************************** | |
# Simple example showing the difference in a way commission is integrated into returns | |
#****************************************************************** | |
commission = 4 | |
data$weight[] = NA | |
data$execution.price[] = NA | |
data$weight[201,] = 1 | |
data$weight[316,] = 0 | |
data$execution.price[201,] = prices[201,] + commission | |
data$execution.price[316,] = prices[316,] - commission | |
models$test.com = bt.run.share(data, clean.signal=T, trade.summary=T) | |
data$weight[] = NA | |
data$execution.price[] = NA | |
data$weight[201,] = 1 | |
data$weight[316,] = 0 | |
models$test.com.new = bt.run.share(data, commission=commission, trade.summary=T, clean.signal=T) | |
cbind(last(models$test.com$equity), last(models$test.com.new$equity), | |
as.double(prices[316] - commission)/as.double(prices[201] + commission)) | |
as.double(prices[202]) / as.double(prices[201] + commission)-1 | |
models$test.com$equity[202]-1 | |
as.double(prices[202] - commission) / as.double(prices[201])-1 | |
models$test.com.new$equity[202]-1 | |
#plotbt.custom.report.part1(models) | |
#***************************************************************** | |
# Example showing the difference in a way commission is integrated into returns | |
#****************************************************************** | |
commission = 0.1 | |
sma.fast = SMA(prices, 50) | |
sma.slow = SMA(prices, 200) | |
weight = iif(sma.fast >= sma.slow, 1, -1) | |
weight[] = bt.exrem(weight) | |
index = which(!is.na(weight)) | |
trade.start = index+1 | |
trade.end = c(index[-1],nperiods) | |
trade.direction = sign(weight[index]) | |
data$weight[] = NA | |
data$execution.price[] = NA | |
data$weight[] = weight | |
models$test.com.new = bt.run.share(data, commission=commission, trade.summary=T, clean.signal=T) | |
data$weight[] = NA | |
data$execution.price[] = NA | |
index = which(trade.direction > 0) | |
data$execution.price[trade.start[index],] = prices[trade.start[index],] + commission | |
data$execution.price[trade.end[index],] = prices[trade.end[index],] - commission | |
index = which(trade.direction < 0) | |
data$execution.price[trade.start[index],] = prices[trade.start[index],] - commission | |
data$execution.price[trade.end[index],] = prices[trade.end[index],] + commission | |
data$weight[trade.start,] = trade.direction | |
data$weight[trade.end,] = 0 | |
models$test.com = bt.run.share(data, clean.signal=T, trade.summary=T) | |
#plotbt.custom.report.part1(models) | |
} | |
############################################################################### | |
# How to use commission functionality | |
############################################################################### | |
bt.commission.test <- function() | |
{ | |
# cents / share commission | |
# trade cost = abs(share - mlag(share)) * commission$cps | |
# fixed commission per trade to more effectively to penalize for turnover | |
# trade cost = sign(abs(share - mlag(share))) * commission$fixed | |
# percentage commission | |
# trade cost = price * abs(share - mlag(share)) * commission$percentage | |
# | |
# commission = list(cps = 0.0, fixed = 0.0, percentage = 0/100) | |
# cps - cents per share i.e. cps = 1.5 is 1.5 cents per share commision | |
# fixed - fixed cost i.e. fixed = $15 is $15 per trade irrelevant of number of shares | |
# percentage - percentage cost i.e. percentage = 1/100 is 1% of trade value | |
#***************************************************************** | |
# Load historical data | |
#****************************************************************** | |
load.packages('quantmod') | |
tickers = spl('EEM') | |
data <- new.env() | |
getSymbols(tickers, src = 'yahoo', from = '1970-01-01', env = data, auto.assign = T) | |
for(i in ls(data)) data[[i]] = adjustOHLC(data[[i]], use.Adjusted=T) | |
bt.prep(data, align='keep.all', dates='2013:08::2013:09') | |
#***************************************************************** | |
# Code Strategies | |
#****************************************************************** | |
buy.date = '2013:08:14' | |
sell.date = '2013:08:15' | |
day.after.sell.date = '2013:08:16' | |
capital = 100000 | |
prices = data$prices | |
share = as.double(capital / prices[buy.date]) | |
# helper function to compute trade return | |
comp.ret <- function(sell.trade.cost, buy.trade.cost) { round(100 * (as.double(sell.trade.cost) / as.double(buy.trade.cost) - 1), 2) } | |
#***************************************************************** | |
# Zero commission | |
#****************************************************************** | |
data$weight[] = NA | |
data$weight[buy.date] = 1 | |
data$weight[sell.date] = 0 | |
commission = 0.0 | |
model = bt.run.share(data, commission = commission, capital = capital, silent = T) | |
comp.ret( share * prices[sell.date], share * prices[buy.date] ) | |
comp.ret( model$equity[day.after.sell.date], model$equity[buy.date] ) | |
#***************************************************************** | |
# 10c cps commission | |
# cents / share commission | |
# trade cost = abs(share - mlag(share)) * commission$cps | |
#****************************************************************** | |
data$weight[] = NA | |
data$weight[buy.date] = 1 | |
data$weight[sell.date] = 0 | |
commission = 0.1 | |
model = bt.run.share(data, commission = commission, capital = capital, silent = T) | |
comp.ret( share * (prices[sell.date] - commission), share * (prices[buy.date] + commission) ) | |
comp.ret( model$equity[day.after.sell.date], model$equity[buy.date] ) | |
#***************************************************************** | |
# $5 fixed commission | |
# fixed commission per trade to more effectively to penalize for turnover | |
# trade cost = sign(abs(share - mlag(share))) * commission$fixed | |
#****************************************************************** | |
data$weight[] = NA | |
data$weight[buy.date] = 1 | |
data$weight[sell.date] = 0 | |
commission = list(cps = 0.0, fixed = 5.0, percentage = 0.0) | |
model = bt.run.share(data, commission = commission, capital = capital, silent = T) | |
comp.ret( share * prices[sell.date] - commission$fixed, share * prices[buy.date] + commission$fixed ) | |
comp.ret( model$equity[day.after.sell.date], model$equity[buy.date] ) | |
#***************************************************************** | |
# % commission | |
# percentage commission | |
# trade cost = price * abs(share - mlag(share)) * commission$percentage | |
#****************************************************************** | |
data$weight[] = NA | |
data$weight[buy.date] = 1 | |
data$weight[sell.date] = 0 | |
commission = list(cps = 0.0, fixed = 0.0, percentage = 1/100) | |
model = bt.run.share(data, commission = commission, capital = capital, silent = T) | |
comp.ret( share * prices[sell.date] * (1 - commission$percentage), share * prices[buy.date] * (1 + commission$percentage) ) | |
comp.ret( model$equity[day.after.sell.date], model$equity[buy.date] ) | |
return | |
#***************************************************************** | |
# Not Used | |
#***************************************************************** | |
# comp.ret( as.double(share * prices[sell.date] - commission$fixed)*(share * prices[buy.date] -commission$fixed), share^2 * prices[buy.date]^2 ) | |
# as.double(share * prices[sell.date] - commission$fixed) / (share * prices[buy.date]) * | |
# as.double(share * prices[buy.date] -commission$fixed) / (share * prices[buy.date]) - 1 | |
# | |
# Say following is time-line 0, A, B, C, 1, 2 | |
# We open share position at 0 and close at 1 | |
# | |
# Proper Logic | |
# ret = (share * price1 - commission) / (share * price0 + commission) | |
# | |
# Current Logic | |
# trade start: cash = price0 * share | |
# retA = (share * priceA - commission) / (share * price0) | |
# retB = (share * priceB) / (share * priceA) | |
# retC = (share * priceC) / (share * priceB) | |
# ret1 = (share * price1 - commission) / (share * priceC) | |
# ret2 = (cash - commission) / (cash) | |
# ret = retA * retB * retC * ret1 * ret2 - 1 | |
#***************************************************************** | |
# Code Strategies | |
#****************************************************************** | |
obj = portfolio.allocation.helper(data$prices, | |
periodicity = 'months', lookback.len = 60, | |
min.risk.fns = list(EW=equal.weight.portfolio) | |
) | |
commission = list(cps = 0.0, fixed = 0.0, percentage = 0/100) | |
models = create.strategies(obj, data, capital = capital, commission = commission )$models | |
ret = models$EW$ret | |
commission = list(cps = 0.0, fixed = 0.0, percentage = 4/100) | |
models = create.strategies(obj, data, capital = capital, commission = commission )$models | |
ret = cbind(ret, models$EW$ret) | |
round(100 * cbind(ret, ret[,1] - ret[,2]),2) | |
write.xts(cbind(ret, ret[,1] - ret[,2]), 'diff.csv') | |
#***************************************************************** | |
# Load historical data | |
#****************************************************************** | |
tickers = spl('SPY,QQQ,EEM,IWM,EFA,TLT,IYR,GLD') | |
data <- new.env() | |
getSymbols(tickers, src = 'yahoo', from = '1980-01-01', env = data, auto.assign = T) | |
for(i in ls(data)) data[[i]] = adjustOHLC(data[[i]], use.Adjusted=T) | |
bt.prep(data, align='remove.na', dates='1990::') | |
#***************************************************************** | |
# Code Strategies | |
#****************************************************************** | |
obj = portfolio.allocation.helper(data$prices, | |
periodicity = 'months', lookback.len = 60, | |
min.risk.fns = list( | |
EW=equal.weight.portfolio | |
) | |
) | |
capital = 100000 | |
commission = list(cps = 0.0, fixed = 0.0, percentage = 0/100) | |
models = create.strategies(obj, data, capital = capital, commission = commission )$models | |
#***************************************************************** | |
# Create Report | |
#****************************************************************** | |
strategy.performance.snapshoot(models, T) | |
} | |
############################################################################### | |
# Cross Pollination from Timely Portfolio | |
# http://timelyportfolio.blogspot.ca/2011/08/drawdown-visualization.html | |
# http://timelyportfolio.blogspot.ca/2011/08/lm-system-on-nikkei-with-new-chart.html | |
############################################################################### | |
bt.timelyportfolio.visualization.test <- function() | |
{ | |
#***************************************************************** | |
# Load historical data | |
#****************************************************************** | |
load.packages('quantmod') | |
tickers = spl('SPY') | |
data <- new.env() | |
getSymbols(tickers, src = 'yahoo', from = '1970-01-01', env = data, auto.assign = T) | |
for(i in ls(data)) data[[i]] = adjustOHLC(data[[i]], use.Adjusted=T) | |
bt.prep(data, align='keep.all', dates='2000::2011') | |
#***************************************************************** | |
# Code Strategies | |
#****************************************************************** | |
prices = data$prices | |
# Buy & Hold | |
data$weight[] = 1 | |
buy.hold = bt.run(data) | |
# Strategy | |
ma10 = bt.apply.matrix(prices, EMA, 10) | |
ma50 = bt.apply.matrix(prices, EMA, 50) | |
ma200 = bt.apply.matrix(prices, EMA, 200) | |
data$weight[] = NA; | |
data$weight[] = iif(ma10 > ma50 & ma50 > ma200, 1, | |
iif(ma10 < ma50 & ma50 < ma200, -1, 0)) | |
strategy = bt.run.share(data, clean.signal=F) | |
#***************************************************************** | |
# Visualization of system Entry and Exit based on | |
# http://timelyportfolio.blogspot.ca/2011/08/lm-system-on-nikkei-with-new-chart.html | |
#****************************************************************** | |
png(filename = 'plot1.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
layout(1) | |
plota(strategy$eq, type='l', ylim=range(buy.hold$eq,strategy$eq)) | |
col = iif(strategy$weight > 0, 'green', iif(strategy$weight < 0, 'red', 'gray')) | |
plota.lines(buy.hold$eq, type='l', col=col) | |
plota.legend('strategy,Long,Short,Not Invested','black,green,red,gray') | |
dev.off() | |
#***************************************************************** | |
# Drawdown Visualization | |
# 10% drawdowns in yellow and 15% drawdowns in orange | |
# http://timelyportfolio.blogspot.ca/2011/08/drawdown-visualization.html | |
#***************************************************************** | |
png(filename = 'plot2.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
layout(1:2) | |
drawdowns = compute.drawdown(strategy$eq) | |
highlight = drawdowns < -0.1 | |
plota.control$col.x.highlight = iif(drawdowns < -0.15, 'orange', iif(drawdowns < -0.1, 'yellow', 0)) | |
plota(strategy$eq, type='l', plotX=F, x.highlight = highlight, ylim=range(buy.hold$eq,strategy$eq)) | |
plota.legend('strategy,10% Drawdown,15% Drawdown','black,yellow,orange') | |
plota(100*drawdowns, type='l', x.highlight = highlight) | |
plota.legend('drawdown', 'black', x='bottomleft') | |
dev.off() | |
#***************************************************************** | |
# Create Report | |
#****************************************************************** | |
png(filename = 'plot3.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
plota.control$col.x.highlight = iif(drawdowns < -0.15, 'orange', iif(drawdowns < -0.1, 'yellow', 0)) | |
highlight = drawdowns < -0.1 | |
plotbt.custom.report.part1(strategy, buy.hold, x.highlight = highlight) | |
dev.off() | |
} | |
############################################################################### | |
# Improving Trend-Following Strategies With Counter-Trend Entries by david varadi | |
# http://cssanalytics.wordpress.com/2011/07/29/improving-trend-following-strategies-with-counter-trend-entries/ | |
############################################################################### | |
bt.improving.trend.following.test <- function() | |
{ | |
#***************************************************************** | |
# Load historical data | |
#****************************************************************** | |
load.packages('quantmod') | |
tickers = spl('SPY') | |
data <- new.env() | |
getSymbols(tickers, src = 'yahoo', from = '1970-01-01', env = data, auto.assign = T) | |
for(i in ls(data)) data[[i]] = adjustOHLC(data[[i]], use.Adjusted=T) | |
bt.prep(data, align='keep.all', dates='1970::2011') | |
#***************************************************************** | |
# Code Strategies | |
#****************************************************************** | |
prices = data$prices | |
# Buy & Hold | |
data$weight[] = 1 | |
buy.hold = bt.run(data) | |
# Trend-Following strategy: Long[Close > SMA(10) ] | |
sma = bt.apply(data, function(x) { SMA(Cl(x), 10) } ) | |
data$weight[] = NA | |
data$weight[] = iif(prices >= sma, 1, 0) | |
trend.following = bt.run(data, trade.summary=T) | |
# Trend-Following With Counter-Trend strategy: Long[Close > SMA(10), DVB(1) CounterTrend ] | |
dv = bt.apply(data, function(x) { DV(HLC(x), 1, TRUE) } ) | |
data$weight[] = NA | |
data$weight[] = iif(prices > sma & dv < 0.25, 1, data$weight) | |
data$weight[] = iif(prices < sma & dv > 0.75, 0, data$weight) | |
trend.following.dv1 = bt.run(data, trade.summary=T) | |
#***************************************************************** | |
# Create Report | |
#****************************************************************** | |
png(filename = 'plot1.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part1(trend.following.dv1, trend.following, buy.hold) | |
dev.off() | |
png(filename = 'plot2.png', width = 1200, height = 800, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part2(trend.following.dv1, trend.following, buy.hold) | |
dev.off() | |
#***************************************************************** | |
# Sensitivity Analysis | |
#****************************************************************** | |
ma.lens = seq(10, 100, by = 10) | |
dv.lens = seq(1, 5, by = 1) | |
# precompute indicators | |
mas = matrix(double(), nrow(prices), len(ma.lens)) | |
dvs = matrix(double(), nrow(prices), len(dv.lens)) | |
for(i in 1:len(ma.lens)) { | |
ma.len = ma.lens[i] | |
mas[, i] = bt.apply(data, function(x) { SMA(Cl(x), ma.len) } ) | |
} | |
for(i in 1:len(dv.lens)) { | |
dv.len = dv.lens[i] | |
dvs[,i] = bt.apply(data, function(x) { DV(HLC(x), dv.len, TRUE) } ) | |
} | |
# allocate matrixes to store backtest results | |
dummy = matrix(double(), len(ma.lens), 1+len(dv.lens)) | |
rownames(dummy) = paste('SMA', ma.lens) | |
colnames(dummy) = c('NO', paste('DV', dv.lens)) | |
out = list() | |
out$Cagr = dummy | |
out$Sharpe = dummy | |
out$DVR = dummy | |
out$MaxDD = dummy | |
# evaluate strategies | |
for(ima in 1:len(ma.lens)) { | |
sma = mas[, ima] | |
cat('SMA =', ma.lens[ima], '\n') | |
for(idv in 0:len(dv.lens)) { | |
if( idv == 0 ) { | |
data$weight[] = NA | |
data$weight[] = iif(prices > sma, 1, 0) | |
} else { | |
dv = dvs[, idv] | |
data$weight[] = NA | |
data$weight[] = iif(prices > sma & dv < 0.25, 1, data$weight) | |
data$weight[] = iif(prices < sma & dv > 0.75, 0, data$weight) | |
} | |
strategy = bt.run(data, silent=T) | |
# add 1 to account for benchmark case, no counter-trend | |
idv = idv + 1 | |
out$Cagr[ima, idv] = compute.cagr(strategy$equity) | |
out$Sharpe[ima, idv] = compute.sharpe(strategy$ret) | |
out$DVR[ima, idv] = compute.DVR(strategy) | |
out$MaxDD[ima, idv] = compute.max.drawdown(strategy$equity) | |
} | |
} | |
#***************************************************************** | |
# Create Report | |
#****************************************************************** | |
png(filename = 'plot3.png', width = 800, height = 600, units = 'px', pointsize = 12, bg = 'white') | |
layout(matrix(1:4,nrow=2)) | |
for(i in names(out)) { | |
temp = out[[i]] | |
temp[] = plota.format( 100 * temp, 1, '', '' ) | |
plot.table(temp, smain = i, highlight = T, colorbar = F) | |
} | |
dev.off() | |
} | |
############################################################################### | |
# Simple, Long-Term Indicator Near to Giving Short Signal By Woodshedder | |
# http://ibankcoin.com/woodshedderblog/2011/08/28/simple-long-term-indicator-near-to-giving-short-signal/ | |
############################################################################### | |
bt.roc.cross.test <- function() | |
{ | |
#***************************************************************** | |
# Load historical data | |
#****************************************************************** | |
load.packages('quantmod') | |
tickers = spl('SPY') | |
data <- new.env() | |
getSymbols(tickers, src = 'yahoo', from = '1970-01-01', env = data, auto.assign = T) | |
for(i in ls(data)) data[[i]] = adjustOHLC(data[[i]], use.Adjusted=T) | |
bt.prep(data, align='keep.all', dates='1970::2011') | |
#***************************************************************** | |
# Code Strategies | |
#****************************************************************** | |
prices = data$prices | |
# Buy & Hold | |
data$weight[] = 1 | |
buy.hold = bt.run(data) | |
# Strategy: calculate the 5 day rate of change (ROC5) and the 252 day rate of change (ROC252). | |
# Buy (or cover short) at the close if yesterday the ROC252 crossed above the ROC5 and today the ROC252 is still above the ROC5. | |
# Sell (or open short) at the close if yesterday the ROC5 crossed above the ROC252 and today the ROC5 is still above the ROC252. | |
roc5 = prices / mlag(prices,5) | |
roc252 = prices / mlag(prices,252) | |
roc5.1 = mlag(roc5,1) | |
roc5.2 = mlag(roc5,2) | |
roc252.1 = mlag(roc252,1) | |
roc252.2 = mlag(roc252,2) | |
data$weight[] = NA | |
data$weight$SPY[] = iif(roc252.2 < roc5.2 & roc252.1 > roc5.1 & roc252 > roc5, 1, data$weight$SPY) | |
data$weight$SPY[] = iif(roc252.2 > roc5.2 & roc252.1 < roc5.1 & roc252 < roc5, -1, data$weight$SPY) | |
roc.cross = bt.run(data, trade.summary=T) | |
#***************************************************************** | |
# Create Report | |
#****************************************************************** | |
png(filename = 'plot1.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part1(roc.cross, buy.hold, trade.summary=T) | |
dev.off() | |
png(filename = 'plot2.png', width = 1200, height = 800, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part2(roc.cross, buy.hold, trade.summary=T) | |
dev.off() | |
png(filename = 'plot3.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part3(roc.cross, buy.hold, trade.summary=T) | |
dev.off() | |
#***************************************************************** | |
# Code Strategies | |
#****************************************************************** | |
# When shorting always use type = 'share' backtest to get realistic results | |
# The type = 'weight' backtest assumes that we are constantly adjusting our position | |
# to keep all cash = shorts | |
data$weight[] = NA | |
data$weight$SPY[] = iif(roc252.2 < roc5.2 & roc252.1 > roc5.1 & roc252 > roc5, 1, data$weight$SPY) | |
data$weight$SPY[] = iif(roc252.2 > roc5.2 & roc252.1 < roc5.1 & roc252 < roc5, -1, data$weight$SPY) | |
capital = 100000 | |
data$weight[] = (capital / prices) * bt.exrem(data$weight) | |
roc.cross.share = bt.run(data, type='share', trade.summary=T, capital=capital) | |
#***************************************************************** | |
# Create Report | |
#****************************************************************** | |
png(filename = 'plot4.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part1(roc.cross.share, roc.cross, buy.hold, trade.summary=T) | |
dev.off() | |
png(filename = 'plot5.png', width = 1200, height = 800, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part2(roc.cross.share, roc.cross, buy.hold, trade.summary=T) | |
dev.off() | |
} | |
############################################################################### | |
# Rotational Trading Strategies : ETF Sector Strategy | |
# http://www.etfscreen.com/sectorstrategy.php | |
# http://www.etfscreen.com/intlstrategy.php | |
############################################################################### | |
bt.rotational.trading.test <- function() | |
{ | |
#***************************************************************** | |
# Load historical data | |
#****************************************************************** | |
load.packages('quantmod') | |
tickers = spl('XLY,XLP,XLE,XLF,XLV,XLI,XLB,XLK,XLU,IWB,IWD,IWF,IWM,IWN,IWO,IWP,IWR,IWS,IWV,IWW,IWZ') | |
data <- new.env() | |
getSymbols(tickers, src = 'yahoo', from = '1970-01-01', env = data, auto.assign = T) | |
for(i in ls(data)) data[[i]] = adjustOHLC(data[[i]], use.Adjusted=T) | |
bt.prep(data, align='keep.all', dates='1970::') | |
#***************************************************************** | |
# Code Strategies | |
#****************************************************************** | |
prices = data$prices | |
n = len(tickers) | |
# find month ends | |
month.ends = endpoints(prices, 'months') | |
month.ends = month.ends[month.ends > 0] | |
models = list() | |
#***************************************************************** | |
# Code Strategies | |
#****************************************************************** | |
dates = '2001::' | |
# Equal Weight | |
data$weight[] = NA | |
data$weight[month.ends,] = ntop(prices, n)[month.ends,] | |
models$equal.weight = bt.run.share(data, clean.signal=F, dates=dates) | |
# Rank on 6 month return | |
position.score = prices / mlag(prices, 126) | |
# Select Top 2 funds | |
data$weight[] = NA | |
data$weight[month.ends,] = ntop(position.score[month.ends,], 2) | |
models$top2 = bt.run.share(data, trade.summary=T, dates=dates) | |
# Seletop Top 2 funds, and Keep then till they are in 1:6 rank | |
data$weight[] = NA | |
data$weight[month.ends,] = ntop.keep(position.score[month.ends,], 2, 6) | |
models$top2.keep6 = bt.run.share(data, trade.summary=T, dates=dates) | |
#***************************************************************** | |
# Create Report | |
#****************************************************************** | |
strategy.performance.snapshoot(models, T) | |
# Plot Portfolio Turnover for each strategy | |
layout(1) | |
barplot.with.labels(sapply(models, compute.turnover, data), 'Average Annual Portfolio Turnover') | |
# put all reports into one pdf file | |
pdf(file = 'report.pdf', width=8.5, height=11) | |
plotbt.custom.report(models, trade.summary=T) | |
dev.off() | |
png(filename = 'plot1.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part1(models) | |
dev.off() | |
png(filename = 'plot2.png', width = 1200, height = 800, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part2(models) | |
dev.off() | |
png(filename = 'plot3.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part3(models, trade.summary=T) | |
dev.off() | |
} | |
############################################################################### | |
# A Quantitative Approach to Tactical Asset Allocation by M. Faber (2006) | |
# http://www.mebanefaber.com/timing-model/ | |
############################################################################### | |
bt.timing.model.test <- function() | |
{ | |
#***************************************************************** | |
# Load historical data | |
#****************************************************************** | |
load.packages('quantmod') | |
tickers = spl('VTI,VEU,IEF,VNQ,DBC') | |
tickers = spl('VTI,EFA,IEF,ICF,DBC,SHY') | |
data <- new.env() | |
getSymbols(tickers, src = 'yahoo', from = '1970-01-01', env = data, auto.assign = T) | |
for(i in ls(data)) data[[i]] = adjustOHLC(data[[i]], use.Adjusted=T) | |
for(i in ls(data)) cat( i, format(index(data[[i]][1,]), '%d%b%y'), '\n') | |
# extend data for Commodities | |
CRB = get.CRB() | |
index = max(which( index(CRB) < index(data$DBC[1,]) )) | |
scale = as.vector(Cl(data$DBC[1,])) / as.vector(Cl(CRB[(index + 1),])) | |
temp = CRB[1 : (index + 1),] * repmat(scale, index + 1, 6) | |
data$DBC = rbind( temp[1:index,], data$DBC ) | |
bt.prep(data, align='remove.na', dates='1970::2011') | |
#***************************************************************** | |
# Code Strategies | |
#****************************************************************** | |
prices = data$prices | |
n = len(tickers) | |
# ignore cash when selecting funds | |
position.score = prices | |
position.score$SHY = NA | |
# find month ends | |
month.ends = date.month.ends(index(prices)) | |
# Equal Weight | |
data$weight[] = NA | |
data$weight[month.ends,] = ntop(position.score[month.ends,], n) | |
capital = 100000 | |
data$weight[] = (capital / prices) * data$weight | |
equal.weight = bt.run(data, type='share', capital=capital) | |
# BuyRule, price > 10 month SMA | |
sma = bt.apply.matrix(prices, SMA, 200) | |
buy.rule = prices > sma | |
buy.rule = ifna(buy.rule, F) | |
# Strategy | |
weight = ntop(position.score[month.ends,], n) | |
# keep in cash the rest of the funds | |
weight[!buy.rule[month.ends,]] = 0 | |
weight$SHY = 1 - rowSums(weight) | |
data$weight[] = NA | |
data$weight[month.ends,] = weight | |
capital = 100000 | |
data$weight[] = (capital / prices) * data$weight | |
timing = bt.run(data, type='share', trade.summary=T, capital=capital) | |
#***************************************************************** | |
# Code Strategies : Daily | |
#****************************************************************** | |
weight = ntop(position.score, n) | |
# keep in cash the rest of the funds | |
weight[!buy.rule] = 0 | |
weight$SHY = 1 - rowSums(weight) | |
data$weight[] = NA | |
data$weight[] = weight | |
capital = 100000 | |
data$weight[] = (capital / prices) * data$weight | |
timing.d = bt.run(data, type='share', trade.summary=T, capital=capital) | |
#***************************************************************** | |
# Create Report | |
#****************************************************************** | |
# put all reports into one pdf file | |
pdf(file = 'report.pdf', width=8.5, height=11) | |
plotbt.custom.report(timing, timing.d, equal.weight, trade.summary=T) | |
dev.off() | |
#***************************************************************** | |
# Code Strategies : Daily with Counter-Trend Entries by david varadi | |
# see bt.improving.trend.following.test | |
#****************************************************************** | |
dv = bt.apply(data, function(x) { DV(HLC(x), 1, TRUE) } ) | |
data$weight[] = NA | |
data$weight[] = iif(prices > sma & dv < 0.25, 0.2, data$weight) | |
data$weight[] = iif(prices < sma & dv > 0.75, 0, data$weight) | |
data$weight$SHY = 0 | |
data$weight = bt.apply.matrix(data$weight, ifna.prev) | |
data$weight$SHY = 1 - rowSums(data$weight) | |
data$weight = bt.exrem(data$weight) | |
capital = 100000 | |
data$weight[] = (capital / prices) * data$weight | |
timing.d1 = bt.run(data, type='share', trade.summary=T, capital=capital) | |
# compute turnover | |
models = variable.number.arguments(timing.d1, timing.d, timing, equal.weight) | |
sapply(models, compute.turnover, data) | |
#***************************************************************** | |
# Create Report | |
#****************************************************************** | |
plotbt.custom.report.part1(timing.d1, timing.d, timing, equal.weight) | |
} | |
############################################################################### | |
# Monthly End-of-the-Month (MEOM) by Quanting Dutchman | |
# http://quantingdutchman.wordpress.com/2010/06/30/strategy-2-monthly-end-of-the-month-meom/ | |
############################################################################### | |
bt.meom.test <- function() | |
{ | |
#***************************************************************** | |
# Load historical data | |
#****************************************************************** | |
load.packages('quantmod') | |
tickers = spl('DIA,EEM,EFA,EWH,EWJ,EWT,EWZ,FXI,GLD,GSG,IEF,ILF,IWM,IYR,QQQ,SPY,VNQ,XLB,XLE,XLF,XLI,XLP,XLU,XLV,XLY,XLK') | |
# Alternatively use Dow Jones Components | |
# tickers = dow.jones.components() | |
data <- new.env() | |
getSymbols(tickers, src = 'yahoo', from = '1995-01-01', env = data, auto.assign = T) | |
for(i in ls(data)) data[[i]] = adjustOHLC(data[[i]], use.Adjusted=T) | |
bt.prep(data, align='keep.all', dates='1995::') | |
#***************************************************************** | |
# Code Strategies | |
#****************************************************************** | |
prices = data$prices | |
n = ncol(prices) | |
nperiods = nrow(prices) | |
# Equal Weight | |
data$weight[] = ntop(prices, n) | |
equal.weight = bt.run(data) | |
# find month ends | |
month.ends = endpoints(prices, 'months') | |
month.ends = month.ends[month.ends > 0] | |
month.ends2 = iif(month.ends + 2 > nperiods, nperiods, month.ends + 2) | |
# Strategy MEOM - Equal Weight | |
data$weight[] = NA | |
data$weight[month.ends,] = ntop(prices, n)[month.ends,] | |
data$weight[month.ends2,] = 0 | |
capital = 100000 | |
data$weight[] = (capital / prices) * data$weight | |
meom.equal.weight = bt.run(data, type='share', capital=capital) | |
#***************************************************************** | |
# Rank1 = MA( C/Ref(C,-2), 5 ) * MA( C/Ref(C,-2), 40 ) | |
#****************************************************************** | |
# BuyRule = C > WMA(C, 89) | |
buy.rule = prices > bt.apply.matrix(prices, function(x) { WMA(x, 89) } ) | |
buy.rule = ifna(buy.rule, F) | |
# 2-day returns | |
ret2 = ifna(prices / mlag(prices, 2), 0) | |
# Rank1 = MA( C/Ref(C,-2), 5 ) * MA( C/Ref(C,-2), 40 ) | |
position.score = bt.apply.matrix(ret2, SMA, 5) * bt.apply.matrix(ret2, SMA, 40) | |
position.score[!buy.rule] = NA | |
# Strategy MEOM - top 2 | |
data$weight[] = NA; | |
data$weight[month.ends,] = ntop(position.score[month.ends,], 2) | |
data$weight[month.ends2,] = 0 | |
capital = 100000 | |
data$weight[] = (capital / prices) * data$weight | |
meom.top2.rank1 = bt.run(data, type='share', trade.summary=T, capital=capital) | |
#***************************************************************** | |
# Rank2 = MA( C/Ref(C,-2), 5 ) * Ref( MA( C/Ref(C,-2), 10 ), -5 ) | |
#****************************************************************** | |
# Rank2 = MA( C/Ref(C,-2), 5 ) * Ref( MA( C/Ref(C,-2), 10 ), -5 ) | |
position.score = bt.apply.matrix(ret2, SMA, 5) * mlag( bt.apply.matrix(ret2, SMA, 10), 5) | |
position.score[!buy.rule] = NA | |
# Strategy MEOM - top 2 | |
data$weight[] = NA | |
data$weight[month.ends,] = ntop(position.score[month.ends,], 2) | |
data$weight[month.ends2,] = 0 | |
capital = 100000 | |
data$weight[] = (capital / prices) * data$weight | |
meom.top2.rank2 = bt.run(data, type='share', trade.summary=T, capital=capital) | |
#***************************************************************** | |
# Create Report | |
#****************************************************************** | |
# put all reports into one pdf file | |
pdf(file = 'report.pdf', width=8.5, height=11) | |
plotbt.custom.report(meom.top2.rank2, meom.top2.rank1, meom.equal.weight, equal.weight, trade.summary=T) | |
dev.off() | |
png(filename = 'plot1.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part1(meom.top2.rank2, meom.top2.rank1, meom.equal.weight, equal.weight, trade.summary=T) | |
dev.off() | |
png(filename = 'plot2.png', width = 1200, height = 800, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part2(meom.top2.rank2, meom.top2.rank1, meom.equal.weight, equal.weight, trade.summary=T) | |
dev.off() | |
png(filename = 'plot3.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part3(meom.top2.rank2, meom.top2.rank1, meom.equal.weight, equal.weight, trade.summary=T) | |
dev.off() | |
#***************************************************************** | |
# Modify MEOM logic - maybe sell in 1 day | |
#****************************************************************** | |
month.ends1 = iif(month.ends + 1 > nperiods, nperiods, month.ends + 1) | |
# Strategy MEOM - top 2, maybe sell in 1 day | |
data$weight[] = NA | |
data$weight[month.ends,] = ntop(position.score[month.ends,], 2) | |
data$weight[month.ends2,] = 0 | |
# Close next day if Today's Close > Today's Open | |
popen = bt.apply(data, Op) | |
data$weight[month.ends1,] = iif((prices > popen)[month.ends1,], 0, NA) | |
capital = 100000 | |
data$weight[] = (capital / prices) * data$weight | |
meom.top2.rank2.hold12 = bt.run(data, type='share', trade.summary=T, capital=capital) | |
png(filename = 'plot4.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part1(meom.top2.rank2.hold12, meom.top2.rank2, meom.top2.rank1, meom.equal.weight, equal.weight, trade.summary=T) | |
dev.off() | |
png(filename = 'plot5.png', width = 1200, height = 800, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part2(meom.top2.rank2.hold12, meom.top2.rank2, meom.top2.rank1, meom.equal.weight, equal.weight, trade.summary=T) | |
dev.off() | |
} | |
############################################################################### | |
# Intraday Backtest | |
# The FX intraday free data was | |
# http://www.fxhistoricaldata.com/EURUSD/ | |
############################################################################### | |
bt.intraday.test <- function() | |
{ | |
#***************************************************************** | |
# Load historical data | |
#****************************************************************** | |
load.packages('quantmod') | |
EURUSD = getSymbols.fxhistoricaldata('EURUSD', 'hour', auto.assign = F, download=F) | |
SPY = getSymbols('SPY', src = 'yahoo', from = '1980-01-01', auto.assign = F) | |
#***************************************************************** | |
# Reference intraday period | |
#****************************************************************** | |
png(filename = 'plot1.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
plota(EURUSD['2012:03:06 10::2012:03:06 21'], type='candle', main='EURUSD on 2012:03:06 from 10 to 21') | |
dev.off() | |
#***************************************************************** | |
# Plot hourly and daily prices on the same chart | |
#****************************************************************** | |
png(filename = 'plot2.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
# two Y axis plot | |
dates= '2012:01:01::2012:01:11' | |
y = SPY[dates] | |
plota(y, type = 'candle', LeftMargin=3) | |
y = EURUSD[dates] | |
plota2Y(y, ylim = range(OHLC(y), na.rm=T), las=1, col='red', col.axis = 'red') | |
plota.ohlc(y, col=plota.candle.col(y)) | |
plota.legend('SPY(rhs),EURUSD(lhs)', 'black,red', list(SPY[dates],EURUSD[dates])) | |
dev.off() | |
#***************************************************************** | |
# Universe: Currency Majors | |
# http://en.wikipedia.org/wiki/Currency_pair | |
#****************************************************************** | |
tickers = spl('EURUSD,USDJPY,GBPUSD,AUDUSD,USDCHF,USDCAD') | |
#***************************************************************** | |
# Daily Backtest | |
#****************************************************************** | |
data <- new.env() | |
getSymbols.fxhistoricaldata(tickers, 'day', data, download=F) | |
bt.prep(data, align='remove.na', dates='1990::') | |
prices = data$prices | |
n = len(tickers) | |
models = list() | |
# Equal Weight | |
data$weight[] = NA | |
data$weight[] = ntop(prices, n) | |
models$equal.weight = bt.run.share(data, clean.signal=F) | |
# Timing by M. Faber | |
sma = bt.apply.matrix(prices, SMA, 200) | |
data$weight[] = NA | |
data$weight[] = ntop(prices, n) * (prices > sma) | |
models$timing = bt.run.share(data, clean.signal=F) | |
# Report | |
models = rev(models) | |
png(filename = 'plot3.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part1(models) | |
dev.off() | |
png(filename = 'plot4.png', width = 1200, height = 800, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part2(models) | |
dev.off() | |
#***************************************************************** | |
# Intraday Backtest | |
#****************************************************************** | |
data <- new.env() | |
getSymbols.fxhistoricaldata(tickers, 'hour', data, download=F) | |
bt.prep(data, align='remove.na', dates='1990::') | |
prices = data$prices | |
n = len(tickers) | |
models = list() | |
# Equal Weight | |
data$weight[] = NA | |
data$weight[] = ntop(prices, n) | |
models$equal.weight = bt.run.share(data, clean.signal=F) | |
# Timing by M. Faber | |
sma = bt.apply.matrix(prices, SMA, 200) | |
data$weight[] = NA | |
data$weight[] = ntop(prices, n) * (prices > sma) | |
models$timing = bt.run.share(data, clean.signal=F) | |
# Report | |
models = rev(models) | |
png(filename = 'plot5.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part1(models) | |
dev.off() | |
png(filename = 'plot6.png', width = 1200, height = 800, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part2(models) | |
dev.off() | |
} | |
############################################################################### | |
# Forecast-Free Algorithms: A New Benchmark For Tactical Strategies | |
# Rebalancing was done on a weekly basis and quarterly data was used to estimate correlations. | |
# http://cssanalytics.wordpress.com/2011/08/09/forecast-free-algorithms-a-new-benchmark-for-tactical-strategies/ | |
# | |
# Minimum Variance Sector Rotation | |
# http://quantivity.wordpress.com/2011/04/20/minimum-variance-sector-rotation/ | |
# | |
# The volatility mystery continues | |
# http://www.portfolioprobe.com/2011/12/05/the-volatility-mystery-continues/ | |
############################################################################### | |
bt.min.var.test <- function() | |
{ | |
#***************************************************************** | |
# Load historical data | |
#****************************************************************** | |
load.packages('quantmod,quadprog,lpSolve') | |
tickers = spl('SPY,QQQ,EEM,IWM,EFA,TLT,IYR,GLD') | |
data <- new.env() | |
getSymbols(tickers, src = 'yahoo', from = '1980-01-01', env = data, auto.assign = T) | |
for(i in ls(data)) data[[i]] = adjustOHLC(data[[i]], use.Adjusted=T) | |
data.weekly <- new.env() | |
for(i in tickers) data.weekly[[i]] = to.weekly(data[[i]], indexAt='endof') | |
bt.prep(data, align='remove.na', dates='1990::') | |
bt.prep(data.weekly, align='remove.na', dates='1990::') | |
#***************************************************************** | |
# Code Strategies | |
#****************************************************************** | |
prices = data$prices | |
n = ncol(prices) | |
# find week ends | |
week.ends = endpoints(prices, 'weeks') | |
week.ends = week.ends[week.ends > 0] | |
# Equal Weight 1/N Benchmark | |
data$weight[] = NA | |
data$weight[week.ends,] = ntop(prices[week.ends,], n) | |
capital = 100000 | |
data$weight[] = (capital / prices) * data$weight | |
equal.weight = bt.run(data, type='share', capital=capital) | |
#***************************************************************** | |
# Create Constraints | |
#***************************************************************** | |
constraints = new.constraints(n, lb = -Inf, ub = +Inf) | |
#constraints = new.constraints(n, lb = 0, ub = 1) | |
# 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 week.ends[week.ends >= (63 + 1)] ) { | |
# one quarter = 63 days | |
hist = ret[ (i- 63 +1):i, ] | |
# create historical input assumptions | |
ia = create.ia(hist) | |
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) | |
} | |
# Minimum Variance | |
data$weight[] = weight | |
capital = 100000 | |
data$weight[] = (capital / prices) * data$weight | |
min.var.daily = bt.run(data, type='share', capital=capital) | |
#***************************************************************** | |
# Code Strategies: Weekly | |
#****************************************************************** | |
retw = data.weekly$prices / mlag(data.weekly$prices) - 1 | |
weightw = coredata(prices) | |
weightw[] = NA | |
for( i in week.ends[week.ends >= (63 + 1)] ) { | |
# map | |
j = which(index(ret[i,]) == index(retw)) | |
# one quarter = 13 weeks | |
hist = retw[ (j- 13 +1):j, ] | |
# create historical input assumptions | |
ia = create.ia(hist) | |
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) | |
} | |
data$weight[] = weightw | |
capital = 100000 | |
data$weight[] = (capital / prices) * data$weight | |
min.var.weekly = bt.run(data, type='share', capital=capital, trade.summary = T) | |
#min.var.weekly$trade.summary$trades | |
#***************************************************************** | |
# Create Report | |
#****************************************************************** | |
png(filename = 'plot1.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part1(min.var.weekly, min.var.daily, equal.weight) | |
dev.off() | |
png(filename = 'plot2.png', width = 1200, height = 800, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part2(min.var.weekly, min.var.daily, equal.weight) | |
dev.off() | |
png(filename = 'plot3.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
layout(1:2) | |
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') | |
dev.off() | |
} | |
############################################################################### | |
# Backtest various asset allocation strategies based on the idea | |
# Forecast-Free Algorithms: A New Benchmark For Tactical Strategies | |
# http://cssanalytics.wordpress.com/2011/08/09/forecast-free-algorithms-a-new-benchmark-for-tactical-strategies/ | |
# | |
# Extension to http://systematicinvestor.wordpress.com/2011/12/13/backtesting-minimum-variance-portfolios/ | |
############################################################################### | |
bt.aa.test <- function() | |
{ | |
#***************************************************************** | |
# Load historical data | |
#****************************************************************** | |
load.packages('quantmod,quadprog,corpcor,lpSolve') | |
tickers = spl('SPY,QQQ,EEM,IWM,EFA,TLT,IYR,GLD') | |
#tickers = dow.jones.components() | |
data <- new.env() | |
getSymbols(tickers, src = 'yahoo', from = '1980-01-01', env = data, auto.assign = T) | |
for(i in ls(data)) data[[i]] = adjustOHLC(data[[i]], use.Adjusted=T) | |
bt.prep(data, align='remove.na', dates='1990::2011') | |
#***************************************************************** | |
# Code Strategies | |
#****************************************************************** | |
prices = data$prices | |
n = ncol(prices) | |
# find week ends | |
period.ends = endpoints(prices, 'weeks') | |
period.annual.factor = 52 | |
# period.ends = endpoints(prices, 'months') | |
# period.annual.factor = 12 | |
period.ends = period.ends[period.ends > 0] | |
#***************************************************************** | |
# Create Constraints | |
#***************************************************************** | |
constraints = new.constraints(n, lb = 0, ub = 1) | |
# SUM x.i = 1 | |
constraints = add.constraints(rep(1, n), 1, type = '=', constraints) | |
#***************************************************************** | |
# Code Strategies | |
#****************************************************************** | |
ret = prices / mlag(prices) - 1 | |
start.i = which(period.ends >= (63 + 1))[1] | |
#min.risk.fns = spl('min.risk.portfolio,min.maxloss.portfolio,min.mad.portfolio,min.cvar.portfolio,min.cdar.portfolio,min.cor.insteadof.cov.portfolio,min.mad.downside.portfolio,min.risk.downside.portfolio,min.avgcor.portfolio,find.erc.portfolio,min.gini.portfolio') | |
min.risk.fns = spl('min.risk.portfolio,min.maxloss.portfolio') | |
# Gini risk measure optimization takes a while, uncomment below to add Gini risk measure | |
# min.risk.fns = c(min.risk.fns, 'min.gini.portfolio') | |
weight = NA * prices[period.ends,] | |
weights = list() | |
# Equal Weight 1/N Benchmark | |
weights$equal.weight = weight | |
weights$equal.weight[] = ntop(prices[period.ends,], n) | |
weights$equal.weight[1:start.i,] = NA | |
for(f in min.risk.fns) weights[[ gsub('\\.portfolio', '', f) ]] = weight | |
risk.contributions = list() | |
for(f in names(weights)) risk.contributions[[ f ]] = weight | |
# construct portfolios | |
for( j in start.i:len(period.ends) ) { | |
i = period.ends[j] | |
# one quarter = 63 days | |
hist = ret[ (i- 63 +1):i, ] | |
include.index = rep(TRUE, n) | |
# new logic, require all assets to have full price history | |
#include.index = count(hist)== 63 | |
#hist = hist[ , include.index] | |
# create historical input assumptions | |
ia = create.ia(hist) | |
s0 = apply(coredata(hist),2,sd) | |
ia$correlation = cor(coredata(hist), use='complete.obs',method='pearson') | |
ia$cov = ia$correlation * (s0 %*% t(s0)) | |
# find optimal portfolios under different risk measures | |
for(f in min.risk.fns) { | |
# set up initial solution | |
constraints$x0 = weights[[ gsub('\\.portfolio', '', f) ]][(j-1), include.index] | |
weights[[ gsub('\\.portfolio', '', f) ]][j, include.index] = match.fun(f)(ia, constraints) | |
} | |
# compute risk contributions implied by portfolio weihgts | |
for(f in names(weights)) { | |
risk.contributions[[ f ]][j, include.index] = portfolio.risk.contribution(weights[[ f ]][j, include.index], ia) | |
} | |
if( j %% 10 == 0) cat(j, '\n') | |
} | |
#***************************************************************** | |
# Create strategies | |
#****************************************************************** | |
models = list() | |
for(i in names(weights)) { | |
data$weight[] = NA | |
data$weight[period.ends,] = weights[[i]] | |
models[[i]] = bt.run.share(data, clean.signal = F) | |
} | |
#***************************************************************** | |
# Create Report | |
#****************************************************************** | |
models = rev(models) | |
weights = rev(weights) | |
risk.contributions = rev(risk.contributions) | |
png(filename = 'plot1.png', width = 800, height = 600, units = 'px', pointsize = 12, bg = 'white') | |
# Plot perfromance | |
plotbt(models, plotX = T, log = 'y', LeftMargin = 3) | |
mtext('Cumulative Performance', side = 2, line = 1) | |
dev.off() | |
png(filename = 'plot2.png', width = 1200, height = 800, units = 'px', pointsize = 12, bg = 'white') | |
# Plot Strategy Statistics Side by Side | |
plotbt.strategy.sidebyside(models) | |
dev.off() | |
png(filename = 'plot3.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
# Plot Portfolio Turnover for each strategy | |
layout(1) | |
barplot.with.labels(sapply(models, compute.turnover, data), 'Average Annual Portfolio Turnover') | |
dev.off() | |
png(filename = 'plot4.png', width = 600, height = 1600, units = 'px', pointsize = 12, bg = 'white') | |
# Plot transition maps | |
layout(1:len(models)) | |
for(m in names(models)) { | |
plotbt.transition.map(models[[m]]$weight, name=m) | |
legend('topright', legend = m, bty = 'n') | |
} | |
dev.off() | |
png(filename = 'plot5.png', width = 600, height = 1600, units = 'px', pointsize = 12, bg = 'white') | |
# Plot risk contributions | |
layout(1:len(risk.contributions)) | |
for(m in names(risk.contributions)) { | |
plotbt.transition.map(risk.contributions[[m]], name=paste('Risk Contributions',m)) | |
legend('topright', legend = m, bty = 'n') | |
} | |
dev.off() | |
png(filename = 'plot6.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
# Plot portfolio concentration stats | |
layout(1:2) | |
plota.matplot(lapply(weights, portfolio.concentration.gini.coefficient), main='Gini Coefficient') | |
plota.matplot(lapply(weights, portfolio.concentration.herfindahl.index), main='Herfindahl Index') | |
#plota.matplot(lapply(weights, portfolio.turnover), main='Turnover') | |
dev.off() | |
png(filename = 'plot7.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
# Compute stats | |
out = compute.stats(weights, | |
list(Gini=function(w) mean(portfolio.concentration.gini.coefficient(w), na.rm=T), | |
Herfindahl=function(w) mean(portfolio.concentration.herfindahl.index(w), na.rm=T), | |
Turnover=function(w) period.annual.factor * mean(portfolio.turnover(w), na.rm=T) | |
) | |
) | |
out[] = plota.format(100 * out, 1, '', '%') | |
plot.table(t(out)) | |
dev.off() | |
png(filename = 'plot8.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
# Plot Portfolio Turnover for each strategy | |
layout(1) | |
barplot.with.labels(sapply(weights, function(w) period.annual.factor * mean(portfolio.turnover(w), na.rm=T)), 'Average Annual Portfolio Turnover') | |
dev.off() | |
} | |
bt.aa.test.new <- function() | |
{ | |
#***************************************************************** | |
# Load historical data | |
#****************************************************************** | |
load.packages('quantmod,quadprog,corpcor,lpSolve') | |
tickers = spl('SPY,QQQ,EEM,IWM,EFA,TLT,IYR,GLD') | |
data <- new.env() | |
getSymbols(tickers, src = 'yahoo', from = '1980-01-01', env = data, auto.assign = T) | |
for(i in ls(data)) data[[i]] = adjustOHLC(data[[i]], use.Adjusted=T) | |
bt.prep(data, align='remove.na', dates='1990::') | |
#***************************************************************** | |
# Code Strategies | |
#****************************************************************** | |
cluster.group = cluster.group.kmeans.90 | |
obj = portfolio.allocation.helper(data$prices, | |
periodicity = 'months', lookback.len = 60, | |
min.risk.fns = list( | |
EW=equal.weight.portfolio, | |
RP=risk.parity.portfolio(), | |
MD=max.div.portfolio, | |
MV=min.var.portfolio, | |
MVE=min.var.excel.portfolio, | |
MV2=min.var2.portfolio, | |
MC=min.corr.portfolio, | |
MCE=min.corr.excel.portfolio, | |
MC2=min.corr2.portfolio, | |
MS=max.sharpe.portfolio(), | |
ERC = equal.risk.contribution.portfolio, | |
# target retunr / risk | |
TRET.12 = target.return.portfolio(12/100), | |
TRISK.10 = target.risk.portfolio(10/100), | |
# cluster | |
C.EW = distribute.weights(equal.weight.portfolio, cluster.group), | |
C.RP = distribute.weights(risk.parity.portfolio(), cluster.group), | |
# rso | |
RSO.RP.5 = rso.portfolio(risk.parity.portfolio(), 5, 500), | |
# others | |
MMaxLoss = min.maxloss.portfolio, | |
MMad = min.mad.portfolio, | |
MCVaR = min.cvar.portfolio, | |
MCDaR = min.cdar.portfolio, | |
MMadDown = min.mad.downside.portfolio, | |
MRiskDown = min.risk.downside.portfolio, | |
MCorCov = min.cor.insteadof.cov.portfolio | |
) | |
) | |
models = create.strategies(obj, data)$models | |
#***************************************************************** | |
# Create Report | |
#****************************************************************** | |
# put all reports into one pdf file | |
#pdf(file = 'filename.pdf', width=8.5, height=11) | |
png(filename = 'plot1.png', width = 1800, height = 1800, units = 'px', pointsize = 12, bg = 'white') | |
strategy.performance.snapshoot(models, T, 'Backtesting Asset Allocation portfolios') | |
dev.off() | |
# close pdf file | |
#dev.off() | |
#pdf(file = 'filename.pdf', width=18.5, height=21) | |
# strategy.performance.snapshoot(models, title = 'Backtesting Asset Allocation portfolios', data = data) | |
#dev.off() | |
# to see last 5 re-balances | |
# round(100 * last(models$MCDaR$weight[obj$period.ends[-len(obj$period.ends)]+1], 5)) | |
} | |
############################################################################### | |
# Investigate Rebalancing methods: | |
# 1. Periodic Rebalancing: rebalance to the target mix every month, quarter, year. | |
# 2. Maximum Deviation Rebalancing: rebalance to the target mix when asset weights deviate more than a given percentage from the target mix. | |
# 3. Same as 2, but rebalance half-way to target | |
############################################################################### | |
bt.rebalancing.test <- function() | |
{ | |
#***************************************************************** | |
# Load historical data | |
#****************************************************************** | |
load.packages('quantmod') | |
tickers = spl('SPY,TLT') | |
data <- new.env() | |
getSymbols(tickers, src = 'yahoo', from = '1900-01-01', env = data, auto.assign = T) | |
for(i in ls(data)) data[[i]] = adjustOHLC(data[[i]], use.Adjusted=T) | |
bt.prep(data, align='remove.na', dates='1900::2011') | |
#***************************************************************** | |
# Code Strategies | |
#****************************************************************** | |
prices = data$prices | |
nperiods = nrow(prices) | |
target.allocation = matrix(c(0.5, 0.5), nrow=1) | |
# Buy & Hold | |
data$weight[] = NA | |
data$weight[1,] = target.allocation | |
capital = 100000 | |
data$weight[] = (capital / prices) * data$weight | |
buy.hold = bt.run(data, type='share', capital=capital) | |
# Rebalance periodically | |
models = list() | |
for(period in spl('months,quarters,years')) { | |
data$weight[] = NA | |
data$weight[1,] = target.allocation | |
period.ends = endpoints(prices, period) | |
period.ends = period.ends[period.ends > 0] | |
data$weight[period.ends,] = repmat(target.allocation, len(period.ends), 1) | |
capital = 100000 | |
data$weight[] = (capital / prices) * data$weight | |
models[[period]] = bt.run(data, type='share', capital=capital) | |
} | |
models$buy.hold = buy.hold | |
# Compute Portfolio Turnover | |
compute.turnover(models$years, data) | |
# Compute Portfolio Maximum Deviation | |
compute.max.deviation(models$years, target.allocation) | |
#***************************************************************** | |
# Create Report | |
#****************************************************************** | |
# put all reports into one pdf file | |
pdf(file = 'report.pdf', width=8.5, height=11) | |
plotbt.custom.report(models) | |
dev.off() | |
png(filename = 'plot1.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part1(models) | |
dev.off() | |
png(filename = 'plot2.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
# Plot BuyHold and Monthly Rebalancing Weights | |
layout(1:2) | |
plotbt.transition.map(models$buy.hold$weight, 'buy.hold', spl('red,orange')) | |
abline(h=50) | |
plotbt.transition.map(models$months$weight, 'months', spl('red,orange')) | |
abline(h=50) | |
dev.off() | |
png(filename = 'plot3.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
# Plot Portfolio Turnover for each Rebalancing method | |
layout(1) | |
barplot.with.labels(sapply(models, compute.turnover, data), 'Average Annual Portfolio Turnover') | |
dev.off() | |
#***************************************************************** | |
# Code Strategies that rebalance based on maximum deviation | |
#****************************************************************** | |
# rebalance to target.allocation when portfolio weights are 5% away from target.allocation | |
models$smart5.all = bt.max.deviation.rebalancing(data, buy.hold, target.allocation, 5/100, 0) | |
# rebalance half-way to target.allocation when portfolio weights are 5% away from target.allocation | |
models$smart5.half = bt.max.deviation.rebalancing(data, buy.hold, target.allocation, 5/100, 0.5) | |
#***************************************************************** | |
# Create Report | |
#****************************************************************** | |
png(filename = 'plot4.png', width = 600, height = 800, units = 'px', pointsize = 12, bg = 'white') | |
# Plot BuyHold, Years and Max Deviation Rebalancing Weights | |
layout(1:4) | |
plotbt.transition.map(models$buy.hold$weight, 'buy.hold', spl('red,orange')) | |
abline(h=50) | |
plotbt.transition.map(models$smart5.all$weight, 'Max Deviation 5%, All the way', spl('red,orange')) | |
abline(h=50) | |
plotbt.transition.map(models$smart5.half$weight, 'Max Deviation 5%, Half the way', spl('red,orange')) | |
abline(h=50) | |
plotbt.transition.map(models$years$weight, 'years', spl('red,orange')) | |
abline(h=50) | |
dev.off() | |
png(filename = 'plot5.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
# Plot Portfolio Turnover for each Rebalancing method | |
layout(1:2) | |
barplot.with.labels(sapply(models, compute.turnover, data), 'Average Annual Portfolio Turnover', F) | |
barplot.with.labels(sapply(models, compute.max.deviation, target.allocation), 'Maximum Deviation from Target Mix') | |
dev.off() | |
png(filename = 'plot6.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
# Plot Strategy Statistics Side by Side | |
plotbt.strategy.sidebyside(models) | |
dev.off() | |
#***************************************************************** | |
# Periodic Rebalancing Seasonality | |
#****************************************************************** | |
# maQuant annual rebalancing (september/october showed the best results) | |
months = spl('Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec') | |
period.ends = endpoints(prices, 'months') | |
period.ends = period.ends[period.ends > 0] | |
models = list() | |
for(i in 1:12) { | |
index = which( date.month(index(prices)[period.ends]) == i ) | |
data$weight[] = NA | |
data$weight[1,] = target.allocation | |
data$weight[period.ends[index],] = repmat(target.allocation, len(index), 1) | |
capital = 100000 | |
data$weight[] = (capital / prices) * data$weight | |
models[[ months[i] ]] = bt.run(data, type='share', capital=capital) | |
} | |
png(filename = 'plot7.png', width = 1200, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.strategy.sidebyside(models) | |
dev.off() | |
layout(1) | |
barplot.with.labels(sapply(models, compute.turnover, data), 'Average Annual Portfolio Turnover') | |
} | |
# Maximum Deviation Rebalancing: rebalance to the target mix when asset weights deviate more than a given percentage from the target mix. | |
# Also support rebalancing.ratio, same as above, but rebalance half-way to target | |
#' @export | |
bt.max.deviation.rebalancing <- function | |
( | |
data, | |
model, | |
target.allocation, | |
max.deviation = 3/100, | |
rebalancing.ratio = 0, # 0 means rebalance all-way to target.allocation | |
# 0.5 means rebalance half-way to target.allocation | |
start.index = 1, | |
period.ends = 1:nrow(model$weight), | |
fast = T | |
) | |
{ | |
nperiods = nrow(model$weight) | |
action.index = rep(F, nperiods) | |
start.index = period.ends[start.index] | |
start.index0 = start.index | |
while(T) { | |
# find rows that violate max.deviation | |
weight = model$weight | |
index = apply(abs(weight - rep.row(target.allocation, nperiods)), 1, max) > max.deviation | |
index = which( index[period.ends] ) | |
if( len(index) > 0 ) { | |
index = period.ends[index] | |
index = index[ index > start.index ] | |
if( len(index) > 0 ) { | |
action.index[index[1]] = T | |
data$weight[] = NA | |
data$weight[start.index0,] = target.allocation | |
temp = rep.row(target.allocation, sum(action.index)) | |
data$weight[action.index,] = temp + | |
rebalancing.ratio * (weight[action.index,] - temp) | |
# please note the bt.run.share.ex somehow gives slighly better results | |
if(fast) | |
model = bt.run.share.fast(data) | |
else | |
model = bt.run.share.ex(data, clean.signal=F, silent=T) | |
start.index = index[1] | |
} else break | |
} else break | |
} | |
model = bt.run.share.ex(data, clean.signal=F, silent=F) | |
return(model) | |
} | |
bt.rebalancing1.test <- function() | |
{ | |
#***************************************************************** | |
# Load historical data | |
#****************************************************************** | |
load.packages('quantmod') | |
# SHY - cash | |
tickers = spl('SPY,TLT,GLD,FXE,USO,SHY') | |
data <- new.env() | |
getSymbols(tickers, src = 'yahoo', from = '1900-01-01', env = data, auto.assign = T) | |
for(i in ls(data)) data[[i]] = adjustOHLC(data[[i]], use.Adjusted=T) | |
bt.prep(data, align='remove.na', dates='1900::2011') | |
#***************************************************************** | |
# Code Strategies | |
#****************************************************************** | |
prices = data$prices | |
nperiods = nrow(prices) | |
target.allocation = matrix(rep(1/6,6), nrow=1) | |
# Buy & Hold | |
data$weight[] = NA | |
data$weight[1,] = target.allocation | |
capital = 100000 | |
data$weight[] = (capital / prices) * data$weight | |
buy.hold = bt.run(data, type='share', capital=capital) | |
# Rebalance periodically | |
models = list() | |
for(period in spl('months,quarters,years')) { | |
data$weight[] = NA | |
data$weight[1,] = target.allocation | |
period.ends = endpoints(prices, period) | |
period.ends = period.ends[period.ends > 0] | |
data$weight[period.ends,] = repmat(target.allocation, len(period.ends), 1) | |
capital = 100000 | |
data$weight[] = (capital / prices) * data$weight | |
models[[period]] = bt.run(data, type='share', capital=capital) | |
} | |
models$buy.hold = buy.hold | |
#***************************************************************** | |
# Code Strategies that rebalance based on maximum deviation | |
#****************************************************************** | |
# rebalance to target.allocation when portfolio weights are 3% away from target.allocation | |
models$smart3.all = bt.max.deviation.rebalancing(data, buy.hold, target.allocation, 3/100, 0) | |
# rebalance half-way to target.allocation when portfolio weights are 3% away from target.allocation | |
models$smart3.half = bt.max.deviation.rebalancing(data, buy.hold, target.allocation, 3/100, 0.5) | |
#***************************************************************** | |
# Create Report | |
#****************************************************************** | |
png(filename = 'plot1.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
# Plot Portfolio Turnover for each Rebalancing method | |
layout(1:2) | |
barplot.with.labels(sapply(models, compute.turnover, data), 'Average Annual Portfolio Turnover', F) | |
barplot.with.labels(sapply(models, compute.max.deviation, target.allocation), 'Maximum Deviation from Target Mix') | |
dev.off() | |
png(filename = 'plot2.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
# Plot Strategy Statistics Side by Side | |
plotbt.strategy.sidebyside(models) | |
dev.off() | |
} | |
############################################################################### | |
# Rotational Trading: how to reduce trades and improve returns by Frank Hassler | |
# http://engineering-returns.com/2011/07/06/rotational-trading-how-to-reducing-trades-and-improve-returns/ | |
############################################################################### | |
bt.rotational.trading.trades.test <- function() | |
{ | |
#***************************************************************** | |
# Load historical data | |
#****************************************************************** | |
load.packages('quantmod') | |
tickers = spl('XLY,XLP,XLE,XLF,XLV,XLI,XLB,XLK,XLU,IWB,IWD,IWF,IWM,IWN,IWO,IWP,IWR,IWS,IWV,IWW,IWZ') | |
data <- new.env() | |
getSymbols(tickers, src = 'yahoo', from = '1970-01-01', env = data, auto.assign = T) | |
for(i in ls(data)) data[[i]] = adjustOHLC(data[[i]], use.Adjusted=T) | |
bt.prep(data, align='remove.na', dates='1970::2011') | |
#***************************************************************** | |
# Code Strategies : weekly rebalancing | |
#****************************************************************** | |
prices = data$prices | |
n = len(tickers) | |
# find week ends | |
week.ends = endpoints(prices, 'weeks') | |
week.ends = week.ends[week.ends > 0] | |
# Rank on ROC 200 | |
position.score = prices / mlag(prices, 200) | |
position.score.ma = position.score | |
buy.rule = T | |
# Select Top 2 funds daily | |
data$weight[] = NA | |
data$weight[] = ntop(position.score, 2) | |
capital = 100000 | |
data$weight[] = (capital / prices) * bt.exrem(data$weight) | |
top2.d = bt.run(data, type='share', trade.summary=T, capital=capital) | |
# Select Top 2 funds weekly | |
data$weight[] = NA | |
data$weight[week.ends,] = ntop(position.score[week.ends,], 2) | |
capital = 100000 | |
data$weight[] = (capital / prices) * bt.exrem(data$weight) | |
top2.w = bt.run(data, type='share', trade.summary=T, capital=capital) | |
png(filename = 'plot1.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
# Plot Strategy Metrics Side by Side | |
plotbt.strategy.sidebyside(top2.d, top2.w, perfromance.fn = 'engineering.returns.kpi') | |
dev.off() | |
#***************************************************************** | |
# Code Strategies : different entry/exit rank | |
#****************************************************************** | |
# Select Top 2 funds, Keep till they are in 4/6 rank | |
data$weight[] = NA | |
data$weight[] = ntop.keep(position.score, 2, 4) | |
capital = 100000 | |
data$weight[] = (capital / prices) * bt.exrem(data$weight) | |
top2.d.keep4 = bt.run(data, type='share', trade.summary=T, capital=capital) | |
data$weight[] = NA | |
data$weight[] = ntop.keep(position.score, 2, 6) | |
capital = 100000 | |
data$weight[] = (capital / prices) * bt.exrem(data$weight) | |
top2.d.keep6 = bt.run(data, type='share', trade.summary=T, capital=capital) | |
png(filename = 'plot2.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
# Plot Strategy Metrics Side by Side | |
plotbt.strategy.sidebyside(top2.d, top2.d.keep4, top2.d.keep6, perfromance.fn = 'engineering.returns.kpi') | |
dev.off() | |
#***************************************************************** | |
# Code Strategies : Rank smoothing | |
#****************************************************************** | |
models = list() | |
models$Bench = top2.d | |
for( avg in spl('SMA,EMA') ) { | |
for( i in c(3,5,10,20) ) { | |
position.score.smooth = bt.apply.matrix(position.score.ma, avg, i) | |
position.score.smooth[!buy.rule,] = NA | |
data$weight[] = NA | |
data$weight[] = ntop(position.score.smooth, 2) | |
capital = 100000 | |
data$weight[] = (capital / prices) * bt.exrem(data$weight) | |
models[[ paste(avg,i) ]] = bt.run(data, type='share', trade.summary=T, capital=capital) | |
} | |
} | |
png(filename = 'plot3.png', width = 1200, height = 600, units = 'px', pointsize = 12, bg = 'white') | |
# Plot Strategy Metrics Side by Side | |
plotbt.strategy.sidebyside(models, perfromance.fn = 'engineering.returns.kpi') | |
dev.off() | |
#***************************************************************** | |
# Code Strategies : Combination | |
#****************************************************************** | |
# Select Top 2 funds daily, Keep till they are 6 rank, Smooth Rank by 10 day EMA | |
position.score.smooth = bt.apply.matrix(position.score.ma, 'EMA', 10) | |
position.score.smooth[!buy.rule,] = NA | |
data$weight[] = NA | |
data$weight[] = ntop.keep(position.score.smooth, 2, 6) | |
capital = 100000 | |
data$weight[] = (capital / prices) * bt.exrem(data$weight) | |
top2.d.keep6.EMA10 = bt.run(data, type='share', trade.summary=T, capital=capital) | |
# Select Top 2 funds weekly, Keep till they are 6 rank | |
data$weight[] = NA | |
data$weight[week.ends,] = ntop.keep(position.score[week.ends,], 2, 6) | |
capital = 100000 | |
data$weight[] = (capital / prices) * bt.exrem(data$weight) | |
top2.w.keep6 = bt.run(data, type='share', trade.summary=T, capital=capital) | |
# Select Top 2 funds weekly, Keep till they are 6 rank, Smooth Rank by 10 week EMA | |
position.score.smooth[] = NA | |
position.score.smooth[week.ends,] = bt.apply.matrix(position.score.ma[week.ends,], 'EMA', 10) | |
position.score.smooth[!buy.rule,] = NA | |
data$weight[] = NA | |
data$weight[week.ends,] = ntop.keep(position.score.smooth[week.ends,], 2, 6) | |
capital = 100000 | |
data$weight[] = (capital / prices) * bt.exrem(data$weight) | |
top2.w.keep6.EMA10 = bt.run(data, type='share', trade.summary=T, capital=capital) | |
png(filename = 'plot4.png', width = 800, height = 600, units = 'px', pointsize = 12, bg = 'white') | |
# Plot Strategy Metrics Side by Side | |
plotbt.strategy.sidebyside(top2.d, top2.d.keep6, top2.d.keep6.EMA10, top2.w, top2.w.keep6, top2.w.keep6.EMA10, perfromance.fn = 'engineering.returns.kpi') | |
dev.off() | |
#***************************************************************** | |
# Possible Improvements to reduce drawdowns | |
#****************************************************************** | |
# Equal Weight | |
data$weight[] = ntop(prices, n) | |
ew = bt.run(data) | |
# Avoiding severe draw downs | |
# http://engineering-returns.com/2010/07/26/rotational-trading-system/ | |
# Only trade the system when the index is either above the 200 MA or 30 MA | |
# Usually these severe draw downs happen bellow the 200MA average and | |
# the second 30 MA average will help to get in when the recovery happens | |
buy.rule = (ew$equity > SMA(ew$equity,200)) | (ew$equity > SMA(ew$equity,30)) | |
buy.rule = (ew$equity > SMA(ew$equity,200)) | |
buy.rule = ifna(buy.rule, F) | |
# Rank using TSI by Frank Hassler, TSI is already smoothed and slow varying, | |
# so SMA will filter will not very effective | |
#http://engineering-returns.com/tsi/ | |
position.score = bt.apply(data, function(x) TSI(HLC(x)) ) | |
position.score.ma = position.score | |
position.score[!buy.rule,] = NA | |
} | |
############################################################################### | |
# Charting the Santa Claus Rally | |
# http://ibankcoin.com/woodshedderblog/2011/12/15/charting-the-santa-claus-rally/ | |
# | |
# Trading Calendar | |
# http://www.cxoadvisory.com/trading-calendar/ | |
############################################################################### | |
bt.december.trading.test <- function() | |
{ | |
#***************************************************************** | |
# Load historical data | |
#****************************************************************** | |
load.packages('quantmod') | |
tickers = spl('SPY') | |
data <- new.env() | |
getSymbols(tickers, src = 'yahoo', from = '1970-01-01', env = data, auto.assign = T) | |
for(i in ls(data)) data[[i]] = adjustOHLC(data[[i]], use.Adjusted=T) | |
bt.prep(data, align='remove.na', dates='1970::2011') | |
#***************************************************************** | |
# Code Strategies | |
#****************************************************************** | |
prices = data$prices | |
n = len(tickers) | |
ret = prices / mlag(prices) - 1 | |
# find prices in December | |
dates = index(prices) | |
years = date.year(dates) | |
index = which(date.month(dates) == 12) | |
# rearrange data in trading days | |
trading.days = sapply(tapply(ret[index,], years[index], function(x) coredata(x)), function(x) x[1:22]) | |
# average return each trading days, excluding current year | |
avg.trading.days = apply(trading.days[, -ncol(trading.days)], 1, mean, na.rm=T) | |
current.year = trading.days[, ncol(trading.days)] | |
# cumulative | |
avg.trading.days = 100 * ( cumprod(1 + avg.trading.days) - 1 ) | |
current.year = 100 * ( cumprod(1 + current.year) - 1 ) | |
#***************************************************************** | |
# Create Plot | |
#****************************************************************** | |
png(filename = 'plot1.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
# plot | |
par(mar=c(4,4,1,1)) | |
plot(avg.trading.days, type='b', col=1, | |
ylim=range(avg.trading.days,current.year,na.rm=T), | |
xlab = 'Number of Trading Days in December', | |
ylab = 'Avg % Profit/Loss' | |
) | |
lines(current.year, type='b', col=2) | |
grid() | |
plota.legend('Avg SPY,SPY Dec 2011', 1:2) | |
dev.off() | |
#***************************************************************** | |
# Code Strategies | |
#****************************************************************** | |
# Buy & Hold | |
data$weight[] = 1 | |
capital = 100000 | |
data$weight[] = (capital / prices) * data$weight | |
buy.hold = bt.run(data, type='share', capital=capital) | |
# Find Last trading days in November and December | |
index = which(date.month(dates) == 11) | |
last.day.november = match(tapply(dates[index], years[index], function(x) tail(x,1)), dates) | |
index = which(date.month(dates) == 12) | |
last.day.december = match(tapply(dates[index], years[index], function(x) tail(x,1)), dates) | |
# December | |
data$weight[] = NA | |
data$weight[last.day.november,] = 1 | |
data$weight[last.day.december,] = 0 | |
capital = 100000 | |
data$weight[] = (capital / prices) * data$weight | |
december = bt.run(data, type='share', capital=capital, trade.summary=T) | |
#***************************************************************** | |
# Create Report | |
#****************************************************************** | |
png(filename = 'plot2.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part1(december, buy.hold, trade.summary=T) | |
dev.off() | |
png(filename = 'plot3.png', width = 1200, height = 800, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part2(december, buy.hold, trade.summary=T) | |
dev.off() | |
} | |
############################################################################### | |
# Seasonality Case Study | |
# Historical Seasonality Analysis: What company in DOW is likely to do well in January? | |
############################################################################### | |
bt.seasonality.test <- function() | |
{ | |
#***************************************************************** | |
# Load historical data | |
#****************************************************************** | |
load.packages('quantmod') | |
tickers = dow.jones.components() | |
data <- new.env() | |
getSymbols(tickers, src = 'yahoo', from = '1970-01-01', env = data, auto.assign = T) | |
for(i in ls(data)) data[[i]] = adjustOHLC(data[[i]], use.Adjusted=T) | |
bt.prep(data, align='keep.all', dates='1970::2011') | |
#***************************************************************** | |
# Compute monthly returns | |
#****************************************************************** | |
prices = data$prices | |
n = ncol(prices) | |
# find month ends | |
month.ends = endpoints(prices, 'months') | |
prices = prices[month.ends,] | |
ret = prices / mlag(prices) - 1 | |
# keep only January | |
ret = ret[date.month(index(ret)) == 1, ] | |
# keep last 20 years | |
ret = last(ret,20) | |
#***************************************************************** | |
# Compute stats | |
#****************************************************************** | |
stats = matrix(rep(NA,2*n), nc=n) | |
colnames(stats) = colnames(prices) | |
rownames(stats) = spl('N,Positive') | |
for(i in 1:n) { | |
stats['N',i] = sum(!is.na(ret[,i])) | |
stats['Positive',i] = sum(ret[,i]>0, na.rm=T) | |
} | |
sort(stats['Positive',], decreasing =T) | |
png(filename = 'plot1.png', width = 600, height = 200, units = 'px', pointsize = 12, bg = 'white') | |
plot.table(stats[, order(stats['Positive',], decreasing =T)[1:10]]) | |
dev.off() | |
} | |
############################################################################### | |
# Volatility Forecasting using Garch(1,1) based | |
# | |
# Regime Switching System Using Volatility Forecast by Quantum Financier | |
# http://quantumfinancier.wordpress.com/2010/08/27/regime-switching-system-using-volatility-forecast/ | |
############################################################################### | |
# Benchmarking Garch algorithms | |
# garch from tseries package is faster than garchFit from fGarch package | |
############################################################################### | |
bt.test.garch.speed <- function() | |
{ | |
load.packages('tseries,fGarch,rbenchmark') | |
temp = garchSim(n=252) | |
test1 <- function() { | |
fit1=garch(temp, order = c(1, 1), control = garch.control(trace = F)) | |
} | |
test2 <- function() { | |
fit2=garchFit(~ garch(1,1), data = temp, include.mean=FALSE, trace=F) | |
} | |
benchmark( | |
test1(), | |
test2(), | |
columns=spl('test,replications,elapsed,relative'), | |
order='relative', | |
replications=100 | |
) | |
} | |
############################################################################### | |
# One day ahead forecast functions for garch (tseries) and garchFit(fGarch) | |
# Sigma[t]^2 = w + a* Sigma[t-1]^2 + b*r[t-1]^2 | |
# r.last - last return, h.last - last volatility | |
############################################################################### | |
garch.predict.one.day <- function(fit, r.last) | |
{ | |
h.last = tail( fitted(fit)[,1] ,1) | |
sqrt(sum( coef(fit) * c(1, r.last^2, h.last^2) )) | |
} | |
# same as predict( fit, n.ahead=1, doplot=F)[3] | |
garchFit.predict.one.day <- function(fit, r.last) | |
{ | |
h.last = tail(sqrt(fit@h.t), 1) | |
sqrt(sum( fit@fit$matcoef[,1] * c(1, r.last^2, h.last^2) )) | |
} | |
############################################################################### | |
# Forecast Volatility using Garch | |
# garch from tseries is fast, but does not consistently converge | |
# garchFit from fGarch is slower, but converges consistently | |
############################################################################### | |
bt.forecast.garch.volatility <- function(ret.log, est.period = 252) | |
{ | |
nperiods = nrow(ret.log) | |
garch.vol = NA * ret.log | |
for( i in (est.period + 1) : nperiods ) { | |
temp = as.vector(ret.log[ (i - est.period + 1) : i, ]) | |
r.last = tail( temp, 1 ) | |
fit = tryCatch( garch(temp, order = c(1, 1), control = garch.control(trace = F)), | |
error=function( err ) FALSE, warning=function( warn ) FALSE ) | |
if( !is.logical( fit ) ) { | |
if( i == est.period + 1 ) garch.vol[1:est.period] = fitted(fit)[,1] | |
garch.vol[i] = garch.predict.one.day(fit, r.last) | |
} else { | |
fit = tryCatch( garchFit(~ garch(1,1), data = temp, include.mean=FALSE, trace=F), | |
error=function( err ) FALSE, warning=function( warn ) FALSE ) | |
if( !is.logical( fit ) ) { | |
if( i == est.period + 1 ) garch.vol[1:est.period] = sqrt(fit@h.t) | |
garch.vol[i] = garchFit.predict.one.day(fit, r.last) | |
} | |
} | |
if( i %% 100 == 0) cat(i, '\n') | |
} | |
garch.vol[] = ifna.prev(coredata(garch.vol)) | |
return(garch.vol) | |
} | |
############################################################################### | |
# Volatility Forecasting using Garch(1,1) based | |
############################################################################### | |
bt.volatility.garch <- function() | |
{ | |
#***************************************************************** | |
# Load historical data | |
#****************************************************************** | |
load.packages('quantmod') | |
tickers = 'SPY' | |
data <- new.env() | |
getSymbols(tickers, src = 'yahoo', from = '1970-01-01', env = data, auto.assign = T) | |
for(i in ls(data)) data[[i]] = adjustOHLC(data[[i]], use.Adjusted=T) | |
bt.prep(data, align='remove.na', dates='2000::2012') | |
#***************************************************************** | |
# Code Strategies | |
#****************************************************************** | |
prices = data$prices | |
n = len(tickers) | |
nperiods = nrow(prices) | |
# Buy & Hold | |
data$weight[] = 1 | |
buy.hold = bt.run(data) | |
# Mean-Reversion(MR) strategy - RSI2 | |
rsi2 = bt.apply.matrix(prices, RSI, 2) | |
data$weight[] = NA | |
data$weight[] = iif(rsi2 < 50, 1, -1) | |
capital = 100000 | |
data$weight[] = (capital / prices) * bt.exrem(data$weight) | |
mr = bt.run(data, type='share', capital=capital, trade.summary=T) | |
# Trend Following(TF) strategy - MA 50/200 crossover | |
sma.short = bt.apply.matrix(prices, SMA, 50) | |
sma.long = bt.apply.matrix(prices, SMA, 200) | |
data$weight[] = NA | |
data$weight[] = iif(sma.short > sma.long, 1, -1) | |
capital = 100000 | |
data$weight[] = (capital / prices) * bt.exrem(data$weight) | |
tf = bt.run(data, type='share', capital=capital, trade.summary=T) | |
#***************************************************************** | |
# Create Report | |
#****************************************************************** | |
png(filename = 'plot1.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part1(mr, tf, buy.hold, trade.summary=T) | |
dev.off() | |
#***************************************************************** | |
# Regime Switching Historical | |
#****************************************************************** | |
#classify current volatility by percentile using a 252 day lookback period | |
#The resulting series oscillate between 0 and 1, and is smoothed using a 21 day percentrankSMA (developed by David Varadi) using a 252 day lookback period. | |
#percentrank(MA(percentrank(Stdev( diff(log(close)) ,21),252),21),250) | |
ret.log = bt.apply.matrix(prices, ROC, type='continuous') | |
hist.vol = bt.apply.matrix(ret.log, runSD, n = 21) | |
vol.rank = percent.rank(SMA(percent.rank(hist.vol, 252), 21), 250) | |
# Regime Switching Historical | |
data$weight[] = NA | |
data$weight[] = iif(vol.rank > 0.5, | |
iif(rsi2 < 50, 1, -1), | |
iif(sma.short > sma.long, 1, -1) | |
) | |
capital = 100000 | |
data$weight[] = (capital / prices) * bt.exrem(data$weight) | |
regime.switching = bt.run(data, type='share', capital=capital, trade.summary=T) | |
#***************************************************************** | |
# Create Report | |
#****************************************************************** | |
png(filename = 'plot2.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part1(regime.switching, mr, tf, buy.hold, trade.summary=T) | |
dev.off() | |
#***************************************************************** | |
# Regime Switching using Garch | |
#****************************************************************** | |
load.packages('tseries,fGarch') | |
garch.vol = bt.forecast.garch.volatility(ret.log, 252) | |
vol.rank = percent.rank(SMA(percent.rank(garch.vol, 252), 21), 250) | |
# Regime Switching Garch | |
data$weight[] = NA | |
data$weight[] = iif(vol.rank > 0.5, | |
iif(rsi2 < 50, 1, -1), | |
iif(sma.short > sma.long, 1, -1) | |
) | |
capital = 100000 | |
data$weight[] = (capital / prices) * bt.exrem(data$weight) | |
regime.switching.garch = bt.run(data, type='share', capital=capital, trade.summary=T) | |
#***************************************************************** | |
# Create Report | |
#****************************************************************** | |
png(filename = 'plot3.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part1(regime.switching.garch, regime.switching, buy.hold, trade.summary=T) | |
dev.off() | |
} | |
############################################################################### | |
# Time Series Matching | |
# | |
# Based on Jean-Robert Avettand-Fenoel - How to Accelerate Model Deployment using Rook | |
# http://www.londonr.org/Sep%2011%20LondonR_AvettandJR.pdf | |
############################################################################### | |
bt.matching.test <- function() | |
{ | |
#***************************************************************** | |
# Load historical data | |
#****************************************************************** | |
load.packages('quantmod') | |
tickers = 'SPY' | |
data = getSymbols(tickers, src = 'yahoo', from = '1950-01-01', auto.assign = F) | |
#***************************************************************** | |
# New: logic moved to functions | |
#****************************************************************** | |
png(filename = 'plot1.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
obj = bt.matching.find(Cl(data), plot=T) | |
dev.off() | |
png(filename = 'plot2.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
matches = bt.matching.overlay(obj, plot=T) | |
dev.off() | |
png(filename = 'plot3.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
bt.matching.overlay.table(obj, matches, plot=T) | |
dev.off() | |
#***************************************************************** | |
# Original logic: Setup search | |
#****************************************************************** | |
data = last(data, 252*10) | |
reference = coredata(Cl(data)) | |
n = len(reference) | |
query = reference[(n-90+1):n] | |
reference = reference[1:(n-90)] | |
n.query = len(query) | |
n.reference = len(reference) | |
#***************************************************************** | |
# Compute Distance | |
#****************************************************************** | |
dist = rep(NA, n.reference) | |
query.normalized = (query - mean(query)) / sd(query) | |
for( i in n.query : n.reference ) { | |
window = reference[ (i - n.query + 1) : i] | |
window.normalized = (window - mean(window)) / sd(window) | |
dist[i] = stats:::dist(rbind(query.normalized, window.normalized)) | |
} | |
#***************************************************************** | |
# Find Matches | |
#****************************************************************** | |
min.index = c() | |
n.match = 10 | |
# only look at the minimums | |
temp = dist | |
temp[ temp > mean(dist, na.rm=T) ] = NA | |
# remove n.query, points to the left/right of the minimums | |
for(i in 1:n.match) { | |
if(any(!is.na(temp))) { | |
index = which.min(temp) | |
min.index[i] = index | |
temp[max(0,index - 2*n.query) : min(n.reference,(index + n.query))] = NA | |
} | |
} | |
n.match = len(min.index) | |
#***************************************************************** | |
# Plot Matches | |
#****************************************************************** | |
dates = index(data)[1:len(dist)] | |
png(filename = 'plot1.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
par(mar=c(2, 4, 2, 2)) | |
plot(dates, dist, type='l',col='gray', main='Top Matches', ylab='Euclidean Distance', xlab='') | |
abline(h = mean(dist, na.rm=T), col='darkgray', lwd=2) | |
points(dates[min.index], dist[min.index], pch=22, col='red', bg='red') | |
text(dates[min.index], dist[min.index], 1:n.match, adj=c(1,1), col='black',xpd=TRUE) | |
dev.off() | |
png(filename = 'plot2.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
plota(data, type='l', col='gray', main=tickers) | |
plota.lines(last(data,90), col='blue') | |
for(i in 1:n.match) { | |
plota.lines(data[(min.index[i]-n.query + 1):min.index[i]], col='red') | |
} | |
text(index4xts(data)[min.index - n.query/2], reference[min.index - n.query/2], 1:n.match, | |
adj=c(1,-1), col='black',xpd=TRUE) | |
plota.legend('Pattern,Match Number','blue,red') | |
dev.off() | |
#***************************************************************** | |
# Overlay all Matches | |
#****************************************************************** | |
matches = matrix(NA, nr=(n.match+1), nc=3*n.query) | |
temp = c(rep(NA, n.query), reference, query) | |
for(i in 1:n.match) { | |
matches[i,] = temp[ (min.index[i] - n.query + 1):(min.index[i] + 2*n.query) ] | |
} | |
#reference[min.index] == matches[,(2*n.query)] | |
matches[(n.match+1),] = temp[ (len(temp) - 2*n.query + 1):(len(temp) + n.query) ] | |
#matches[(n.match+1), (n.query+1):(2*n.query)] == query | |
for(i in 1:(n.match+1)) { | |
matches[i,] = matches[i,] / matches[i,n.query] | |
} | |
#***************************************************************** | |
# Plot all Matches | |
#****************************************************************** | |
temp = 100 * ( t(matches[,-c(1:n.query)]) - 1) | |
png(filename = 'plot3.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
par(mar=c(2, 4, 2, 2)) | |
matplot(temp, type='l',col='gray',lwd=2, lty='dotted', xlim=c(1,2.5*n.query), | |
main = paste('Pattern Prediction with', n.match, 'neighbours'),ylab='Normalized', xlab='') | |
lines(temp[,(n.match+1)], col='black',lwd=4) | |
points(rep(2*n.query,n.match), temp[2*n.query,1:n.match], pch=21, lwd=2, col='gray', bg='gray') | |
bt.plot.dot.label <- function(x, data, xfun, col='red') { | |
for(j in 1:len(xfun)) { | |
y = match.fun(xfun[[j]])(data) | |
points(x, y, pch=21, lwd=4, col=col, bg=col) | |
text(x, y, paste(names(xfun)[j], ':', round(y,1),'%'), | |
adj=c(-0.1,0), cex = 0.8, col=col,xpd=TRUE) | |
} | |
} | |
bt.plot.dot.label(2*n.query, temp[2*n.query,1:n.match], | |
list(Min=min,Max=max,Median=median,'Bot 25%'=function(x) quantile(x,0.25),'Top 75%'=function(x) quantile(x,0.75))) | |
bt.plot.dot.label(n.query, temp[n.query,(n.match+1)], list(Current=min)) | |
dev.off() | |
#***************************************************************** | |
# Table with predictions | |
#****************************************************************** | |
temp = matrix( double(), nr=(n.match+4), 6) | |
rownames(temp) = c(1:n.match, spl('Current,Min,Average,Max')) | |
colnames(temp) = spl('Start,End,Return,Week,Month,Quarter') | |
# compute returns | |
temp[1:(n.match+1),'Return'] = matches[,2*n.query]/ matches[,n.query] | |
temp[1:(n.match+1),'Week'] = matches[,(2*n.query+5)]/ matches[,2*n.query] | |
temp[1:(n.match+1),'Month'] = matches[,(2*n.query+20)]/ matches[,2*n.query] | |
temp[1:(n.match+1),'Quarter'] = matches[,(2*n.query+60)]/ matches[,2*n.query] | |
# compute average returns | |
index = spl('Return,Week,Month,Quarter') | |
temp['Min', index] = apply(temp[1:(n.match+1),index],2,min,na.rm=T) | |
temp['Average', index] = apply(temp[1:(n.match+1),index],2,mean,na.rm=T) | |
temp['Max', index] = apply(temp[1:(n.match+1),index],2,max,na.rm=T) | |
# format | |
temp[] = plota.format(100*(temp-1),1,'','%') | |
# enter dates | |
temp['Current', 'Start'] = format(index(last(data,90)[1]), '%d %b %Y') | |
temp['Current', 'End'] = format(index(last(data,1)[1]), '%d %b %Y') | |
for(i in 1:n.match) { | |
temp[i, 'Start'] = format(index(data[min.index[i] - n.query + 1]), '%d %b %Y') | |
temp[i, 'End'] = format(index(data[min.index[i]]), '%d %b %Y') | |
} | |
# plot table | |
png(filename = 'plot4.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
plot.table(temp, smain='Match Number') | |
dev.off() | |
} | |
############################################################################### | |
# Time Series Matching Backtest | |
# | |
# New weighting scheme : seight each match by its distance | |
############################################################################### | |
bt.matching.backtest.test <- function() | |
{ | |
#***************************************************************** | |
# Load historical data | |
#****************************************************************** | |
load.packages('quantmod') | |
tickers = spl('SPY,^GSPC') | |
data <- new.env() | |
quantmod:::getSymbols(tickers, src = 'yahoo', from = '1950-01-01', env = data, auto.assign = T) | |
bt.prep(data, align='keep.all') | |
# compare common part [ SPY and ^GSPC match only if not adjusted for dividends] | |
#temp = data$prices['1993:01:29::'] | |
#plot(temp[,1]/as.double(temp[1,1]) - temp[,2]/as.double(temp[1,2]), main='Diff between SPY and ^GSPC') | |
# combine SPY and ^GSPC | |
scale = as.double( data$prices$SPY['1993:01:29'] / data$prices$GSPC['1993:01:29'] ) | |
hist = c(scale * data$prices$GSPC['::1993:01:28'], data$prices$SPY['1993:01:29::']) | |
#***************************************************************** | |
# Backtest setup: | |
# Starting January 1994, each month search for the 10 best matches | |
# similar to the last 90 days in the last 10 years of history data | |
# | |
# Invest next month if distance weighted prediction is positive | |
# otherwise stay in cash | |
#****************************************************************** | |
# find month ends | |
month.ends = endpoints(hist, 'months') | |
month.ends = month.ends[month.ends > 0] | |
start.index = which(date.year(index(hist[month.ends])) == 1994)[1] | |
weight = hist * NA | |
for( i in start.index : len(month.ends) ) { | |
#obj = bt.matching.find(hist[1:month.ends[i],], n.match=10, normalize.fn = normalize.mean, plot=T) | |
#matches = bt.matching.overlay(obj, future=hist[(month.ends[i]+1):(month.ends[i]+22),], plot=T) | |
#bt.matching.overlay.table(obj, matches, weights=NA, plot=T) | |
obj = bt.matching.find(hist[1:month.ends[i],], normalize.fn = normalize.first) | |
matches = bt.matching.overlay(obj) | |
# compute prediction for next month | |
n.match = len(obj$min.index) | |
n.query = len(obj$query) | |
month.ahead.forecast = matches[,(2*n.query+22)]/ matches[,2*n.query] - 1 | |
# Average, mean(month.ahead.forecast[1:n.match]) | |
weights = rep(1/n.match, n.match) | |
avg.direction = weighted.mean(month.ahead.forecast[1:n.match], w=weights) | |
# Distance weighted average | |
temp = round(100*(obj$dist / obj$dist[1] - 1)) | |
n.weight = max(temp) + 1 | |
weights = (n.weight - temp) / ( n.weight * (n.weight+1) / 2) | |
weights = weights / sum(weights) | |
# barplot(weights) | |
avg.direction = weighted.mean(month.ahead.forecast[1:n.match], w=weights) | |
# Logic | |
weight[month.ends[i]] = 0 | |
if( avg.direction > 0 ) weight[month.ends[i]] = 1 | |
# print progress | |
if( i %% 10 == 0) cat(i, '\n') | |
} | |
#***************************************************************** | |
# Code Strategies | |
#****************************************************************** | |
tickers = 'SPY' | |
data <- new.env() | |
getSymbols(tickers, src = 'yahoo', from = '1950-01-01', env = data, auto.assign = T) | |
bt.prep(data, align='keep.all') | |
prices = data$prices | |
# Buy & Hold | |
data$weight[] = 1 | |
buy.hold = bt.run(data) | |
# Strategy | |
data$weight[] = NA | |
data$weight[] = weight['1993:01:29::'] | |
capital = 100000 | |
data$weight[] = (capital / prices) * bt.exrem(data$weight) | |
test = bt.run(data, type='share', capital=capital, trade.summary=T) | |
#***************************************************************** | |
# Create Report | |
#****************************************************************** | |
png(filename = 'plot1.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part1(test, buy.hold, trade.summary=T) | |
dev.off() | |
} | |
############################################################################### | |
# Time Series Matching helper functions | |
############################################################################### | |
# functions to normalize data | |
############################################################################### | |
normalize.mean <- function(x) { x - mean(x) } | |
normalize.mean.sd <- function(x) { (x - mean(x)) / sd(x) } | |
normalize.first <- function(x) { x/as.double(x[1]) } | |
############################################################################### | |
# functions to compute distance | |
############################################################################### | |
dist.euclidean <- function(x) { stats:::dist(x) } | |
############################################################################### | |
# Find historical matches similar to the given query(pattern) | |
############################################################################### | |
bt.matching.find <- function | |
( | |
data, # time series | |
n.query=90, # length of pattern i.e. last 90 days | |
n.reference=252*10, # length of history to look for pattern | |
n.match=10, # number of matches to find | |
normalize.fn = normalize.mean.sd, # function to normalize data | |
dist.fn = dist.euclidean, # function to compute distance | |
plot=FALSE, # flag to create plot | |
plot.dist=FALSE, # flag to create distance plot | |
layout = NULL, # flag to idicate if layout is already set | |
main = NULL # plot title | |
) | |
{ | |
#***************************************************************** | |
# Setup search | |
#****************************************************************** | |
data = last(data, n.reference) | |
reference = coredata(data) | |
n = len(reference) | |
query = reference[(n - n.query + 1):n] | |
reference = reference[1:(n - n.query)] | |
main = paste(main, join(format(range(index(data)[(n - n.query + 1):n]), '%d%b%Y'), ' - ')) | |
n.query = len(query) | |
n.reference = len(reference) | |
dist.fn.name = '' | |
if(is.character(dist.fn)) { | |
dist.fn.name = paste('with',dist.fn) | |
dist.fn = get(dist.fn) | |
} | |
#***************************************************************** | |
# Compute Distance | |
#****************************************************************** | |
dist = rep(NA, n.reference) | |
query.normalized = match.fun(normalize.fn)(query) | |
for( i in n.query : n.reference ) { | |
window = reference[ (i - n.query + 1) : i] | |
window.normalized = match.fun(normalize.fn)(window) | |
dist[i] = match.fun(dist.fn)(rbind(query.normalized, window.normalized)) | |
# print progress | |
if( i %% 100 == 0) cat(i, '\n') | |
} | |
#***************************************************************** | |
# Find Matches | |
#****************************************************************** | |
min.index = c() | |
# only look at the minimums | |
temp = dist | |
temp[ temp > mean(dist, na.rm=T) ] = NA | |
# remove n.query, points to the left/right of the minimums | |
for(i in 1:n.match) { | |
if(any(!is.na(temp))) { | |
index = which.min(temp) | |
min.index[i] = index | |
temp[max(0,index - 2*n.query) : min(n.reference,(index + n.query))] = NA | |
} | |
} | |
n.match = len(min.index) | |
#***************************************************************** | |
# Plot Matches | |
#****************************************************************** | |
if(plot) { | |
dates = index(data)[1:len(dist)] | |
if(is.null(layout)) { | |
if(plot.dist) layout(1:2) else layout(1) | |
} | |
par(mar=c(2, 4, 2, 2)) | |
if(plot.dist) { | |
plot(dates, dist, type='l',col='gray', main=paste('Top Historical Matches for', main, dist.fn.name), ylab='Distance', xlab='') | |
abline(h = mean(dist, na.rm=T), col='darkgray', lwd=2) | |
points(dates[min.index], dist[min.index], pch=22, col='red', bg='red') | |
text(dates[min.index], dist[min.index], 1:n.match, adj=c(1,1), col='black',xpd=TRUE) | |
} | |
plota(data, type='l', col='gray', LeftMargin = 1, | |
main=iif(!plot.dist, paste('Top Historical Matches for', main), NULL) | |
) | |
plota.lines(last(data,90), col='blue') | |
for(i in 1:n.match) { | |
plota.lines(data[(min.index[i]-n.query + 1):min.index[i]], col='red') | |
} | |
text(index4xts(data)[min.index - n.query/2], reference[min.index - n.query/2], 1:n.match, | |
adj=c(1,-1), col='black',xpd=TRUE) | |
plota.legend(paste('Pattern: ', main, ',Match Number'),'blue,red') | |
} | |
return(list(min.index=min.index, dist=dist[min.index], query=query, reference=reference, dates = index(data), main = main)) | |
} | |
############################################################################### | |
# Create matrix that overlays all matches one on top of each other | |
############################################################################### | |
# helper function to plot dots and labels | |
############################################################################### | |
bt.plot.dot.label <- function(x, data, xfun, col='red') { | |
for(j in 1:len(xfun)) { | |
y = match.fun(xfun[[j]])(data) | |
points(x, y, pch=21, lwd=4, col=col, bg=col) | |
text(x, y, paste(names(xfun)[j], ':', round(y,1),'%'), | |
adj=c(-0.1,0), cex = 0.8, col=col,xpd=TRUE) | |
} | |
} | |
bt.matching.overlay <- function | |
( | |
obj, # object from bt.matching.find function | |
future=NA, # time series of future, only used for plotting | |
plot=FALSE, # flag to create plot | |
plot.index=NA, # range of data to plot | |
layout = NULL # flag to idicate if layout is already set | |
) | |
{ | |
min.index = obj$min.index | |
query = obj$query | |
reference = obj$reference | |
n.match = len(min.index) | |
n.query = len(query) | |
n.reference = len(reference) | |
#***************************************************************** | |
# Overlay all Matches | |
#****************************************************************** | |
matches = matrix(NA, nr=(n.match+1), nc=3*n.query) | |
temp = c(rep(NA, n.query), reference, query, future) | |
for(i in 1:n.match) { | |
matches[i,] = temp[ (min.index[i] - n.query + 1):(min.index[i] + 2*n.query) ] | |
} | |
#reference[min.index] == matches[,(2*n.query)] | |
matches[(n.match+1),] = temp[ (n.reference + 1):(n.reference + 3*n.query) ] | |
#matches[(n.match+1), (n.query+1):(2*n.query)] == query | |
for(i in 1:(n.match+1)) { | |
matches[i,] = matches[i,] / iif(!is.na(matches[i,n.query]), matches[i,n.query], matches[i,(n.query+1)]) | |
} | |
#***************************************************************** | |
# Plot all Matches | |
#****************************************************************** | |
if(plot) { | |
temp = 100 * ( t(matches[,-c(1:n.query)]) - 1) | |
if(!is.na(plot.index[1])) temp=temp[plot.index,] | |
n = nrow(temp) | |
if(is.null(layout)) layout(1) | |
#par(mar=c(4, 2, 2, 2), ...) | |
par(mar=c(4, 2, 2, 2)) | |
matplot(temp, type='n',col='gray',lwd=2, lty='dotted', xlim=c(1, n + 0.15*n), | |
main = paste(obj$main,'Historical Pattern Prediction with', n.match, 'neighbours'),ylab='Normalized', xlab = 'Trading Days') | |
col=adjustcolor('yellow', 0.5) | |
rect(0, par('usr')[3],n.query, par('usr')[4], col=col, border=col) | |
box() | |
matlines(temp, col='gray',lwd=2, lty='dotted') | |
lines(temp[,(n.match+1)], col='black',lwd=4) | |
points(rep(n, n.match), temp[n, 1:n.match], pch=21, lwd=2, col='gray', bg='gray') | |
bt.plot.dot.label(n, temp[n, 1:n.match], | |
list(Min=min,Max=max,Median=median,'Bot 25%'=function(x) quantile(x,0.25),'Top 75%'=function(x) quantile(x,0.75))) | |
bt.plot.dot.label(n.query, temp[n.query,(n.match+1)], list(Current=min)) | |
} | |
return(matches) | |
} | |
############################################################################### | |
# Create matches summary table | |
############################################################################### | |
bt.matching.overlay.table <- function | |
( | |
obj, # object from bt.matching.find function | |
matches, # matches from bt.matching.overlay function | |
weights=NA, # weights to compute average | |
plot=FALSE, # flag to create plot | |
layout = NULL # flag to idicate if layout is already set | |
) | |
{ | |
min.index = obj$min.index | |
query = obj$query | |
reference = obj$reference | |
dates = obj$dates | |
n.match = len(min.index) | |
n.query = len(query) | |
n.reference = len(reference) | |
if(is.na(weights)) weights = rep(1/n.match, n.match) | |
#***************************************************************** | |
# Table with predictions | |
#****************************************************************** | |
temp = matrix( double(), nr=(n.match + 4), 6) | |
rownames(temp) = c(1:n.match, spl('Current,Min,Average,Max')) | |
colnames(temp) = spl('Start,End,Return,Week,Month,Quarter') | |
# compute returns | |
temp[1:(n.match+1),'Return'] = matches[,2*n.query]/ matches[,n.query] | |
temp[1:(n.match+1),'Week'] = matches[,(2*n.query+5)]/ matches[,2*n.query] | |
temp[1:(n.match+1),'Month'] = matches[,(2*n.query+20)]/ matches[,2*n.query] | |
temp[1:(n.match+1),'Quarter'] = matches[,(2*n.query+60)]/ matches[,2*n.query] | |
# compute average returns | |
index = spl('Return,Week,Month,Quarter') | |
temp['Min', index] = apply(temp[1:(n.match+0),index],2,min,na.rm=T) | |
#temp['Average', index] = apply(temp[1:(n.match+0),index],2,mean,na.rm=T) | |
temp['Average', index] = apply(temp[1:(n.match+0),index],2,weighted.mean,w=weights,na.rm=T) | |
temp['Max', index] = apply(temp[1:(n.match+0),index],2,max,na.rm=T) | |
# format | |
temp[] = plota.format(100*(temp-1),1,'','%') | |
# enter dates | |
temp['Current', 'Start'] = format(dates[(n.reference+1)], '%d %b %Y') | |
temp['Current', 'End'] = format(dates[len(dates)], '%d %b %Y') | |
for(i in 1:n.match) { | |
temp[i, 'Start'] = format(dates[min.index[i] - n.query + 1], '%d %b %Y') | |
temp[i, 'End'] = format(dates[min.index[i]], '%d %b %Y') | |
} | |
# plot table | |
if(plot) { | |
if(is.null(layout)) layout(1) | |
plot.table(temp, smain='Match Number') | |
} | |
return(temp) | |
} | |
############################################################################### | |
# Time Series Matching with Dynamic time warping | |
# | |
# Based on Jean-Robert Avettand-Fenoel - How to Accelerate Model Deployment using Rook | |
# http://www.londonr.org/Sep%2011%20LondonR_AvettandJR.pdf | |
############################################################################### | |
# functions to compute distance | |
############################################################################### | |
#dist.euclidean <- function(x) { stats:::dist(x) } | |
dist.MOdist <- function(x) { MOdist(t(x)) } | |
dist.DTW <- function(x) { dtw(x[1,], x[2,])$distance } | |
bt.matching.dtw.test <- function() | |
{ | |
#***************************************************************** | |
# Example of Dynamic time warping from dtw help | |
#****************************************************************** | |
load.packages('dtw') | |
# A noisy sine wave as query | |
idx = seq(0,6.28,len=100) | |
query = sin(idx)+runif(100)/10 | |
# A cosine is for reference; sin and cos are offset by 25 samples | |
reference = cos(idx) | |
# map one to one, typical distance | |
alignment<-dtw(query, reference, keep=TRUE) | |
alignment$index1 = 1:100 | |
alignment$index2 = 1:100 | |
png(filename = 'plot0.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
plot(alignment,main='Example of 1 to 1 mapping', type='two',off=3) | |
dev.off() | |
# map one to many, dynamic time warping | |
alignment<-dtw(query, reference, keep=TRUE) | |
png(filename = 'plot1.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
plot(alignment,main='Example of 1 to many mapping (DTW)', type='two',off=3) | |
dev.off() | |
#***************************************************************** | |
# Load historical data | |
#****************************************************************** | |
load.packages('quantmod') | |
tickers = 'SPY' | |
data = getSymbols(tickers, src = 'yahoo', from = '1950-01-01', auto.assign = F) | |
#***************************************************************** | |
# Euclidean distance | |
#****************************************************************** | |
png(filename = 'plot2.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
obj = bt.matching.find(Cl(data), normalize.fn = normalize.mean, dist.fn = 'dist.euclidean', plot=T) | |
dev.off() | |
png(filename = 'plot3.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
matches = bt.matching.overlay(obj, plot.index=1:90, plot=T) | |
dev.off() | |
png(filename = 'plot4.png', width = 600, height = 800, units = 'px', pointsize = 12, bg = 'white') | |
layout(1:2) | |
matches = bt.matching.overlay(obj, plot=T, layout=T) | |
bt.matching.overlay.table(obj, matches, plot=T, layout=T) | |
dev.off() | |
#***************************************************************** | |
# Dynamic time warping distance | |
#****************************************************************** | |
# http://en.wikipedia.org/wiki/Dynamic_time_warping | |
# http://dtw.r-forge.r-project.org/ | |
#****************************************************************** | |
png(filename = 'plot5.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
obj = bt.matching.find(Cl(data), normalize.fn = normalize.mean, dist.fn = 'dist.DTW', plot=T) | |
dev.off() | |
png(filename = 'plot6.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
matches = bt.matching.overlay(obj, plot.index=1:90, plot=T) | |
dev.off() | |
png(filename = 'plot7.png', width = 600, height = 800, units = 'px', pointsize = 12, bg = 'white') | |
layout(1:2) | |
matches = bt.matching.overlay(obj, plot=T, layout=T) | |
bt.matching.overlay.table(obj, matches, plot=T, layout=T) | |
dev.off() | |
#***************************************************************** | |
# Dynamic time warping distance | |
#****************************************************************** | |
png(filename = 'plot8.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
obj = bt.matching.find(Cl(data), normalize.fn = normalize.mean, dist.fn = 'dist.DTW1', plot=T) | |
dev.off() | |
png(filename = 'plot9.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
matches = bt.matching.overlay(obj, plot.index=1:90, plot=T) | |
dev.off() | |
png(filename = 'plot10.png', width = 600, height = 800, units = 'px', pointsize = 12, bg = 'white') | |
layout(1:2) | |
matches = bt.matching.overlay(obj, plot=T, layout=T) | |
bt.matching.overlay.table(obj, matches, plot=T, layout=T) | |
dev.off() | |
#***************************************************************** | |
# Dynamic time warping distance | |
#****************************************************************** | |
png(filename = 'plot11.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
obj = bt.matching.find(Cl(data), normalize.fn = normalize.mean, dist.fn = 'dist.DDTW', plot=T) | |
dev.off() | |
png(filename = 'plot12.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
matches = bt.matching.overlay(obj, plot.index=1:90, plot=T) | |
dev.off() | |
png(filename = 'plot13.png', width = 600, height = 800, units = 'px', pointsize = 12, bg = 'white') | |
layout(1:2) | |
matches = bt.matching.overlay(obj, plot=T, layout=T) | |
bt.matching.overlay.table(obj, matches, plot=T, layout=T) | |
dev.off() | |
} | |
############################################################################### | |
# Derivative Dynamic Time Warping by Eamonn J. Keogh and Michael J. Pazzani | |
# http://www.cs.rutgers.edu/~mlittman/courses/statai03/DDTW-2001.pdf | |
# | |
# page 3 | |
# To align two sequences using DTW we construct an n-by-m matrix where the (ith, jth) | |
# element of the matrix contains the distance d(qi,cj) between the two points qi and cj | |
# (Typically the Euclidean distance is used, so d(qi,cj) = (qi - cj)2 ). | |
# | |
# page 6 | |
# With DDTW the distance measure d(qi,cj) is not Euclidean but rather the square of the | |
# difference of the estimated derivatives of qi and cj. | |
# This estimate is simply the average of the slope of the line through the point in | |
# question and its left neighbor, and the slope of the line through the left neighbor and the | |
# right neighbor. Empirically this estimate is more robust to outliers than any estimate | |
# considering only two datapoints. Note the estimate is not defined for the first and last | |
# elements of the sequence. Instead we use the estimates of the second and next-to-last | |
# elements respectively. | |
############################################################################### | |
derivative.est <- function(x) { | |
x = as.vector(x) | |
n = len(x) | |
d = (( x - mlag(x) ) + ( mlag(x,-1)- mlag(x) ) / 2) / 2 | |
d[1] = d[2] | |
d[n] = d[(n-1)] | |
d | |
} | |
dist.DDTW <- function(x) { | |
y = x | |
x[1,] = derivative.est(x[1,]) | |
x[2,] = derivative.est(x[2,]) | |
alignment = dtw(x[1,], x[2,]) | |
stats:::dist(rbind(y[1,alignment$index1],y[2,alignment$index2])) | |
#proxy::dist(y[1,alignment$index1],y[2,alignment$index2],method='Euclidean',by_rows=F) | |
} | |
dist.DTW1 <- function(x) { | |
alignment = dtw(x[1,], x[2,]) | |
stats:::dist(rbind(x[1,alignment$index1],x[2,alignment$index2])) | |
} | |
bt.ddtw.test <- function() | |
{ | |
#***************************************************************** | |
# Load historical data | |
#****************************************************************** | |
load.packages('quantmod') | |
tickers = 'SPY' | |
data = getSymbols(tickers, src = 'yahoo', from = '1950-01-01', auto.assign = F) | |
#***************************************************************** | |
# Setup | |
#****************************************************************** | |
load.packages('dtw') | |
query = as.vector(coredata(last(Cl(data['2011::2011']), 60))) | |
reference = as.vector(coredata(last(Cl(data['2010::2010']), 60))) | |
#***************************************************************** | |
# Dynamic Time Warping | |
#****************************************************************** | |
alignment = dtw(query, reference, keep=TRUE) | |
png(filename = 'plot1.ddtw.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
plot(alignment,main='DTW Alignment', type='two',off=20) | |
dev.off() | |
#***************************************************************** | |
# Derivative Dynamic Time Warping by Eamonn J. Keogh and Michael J. Pazzani | |
# http://www.cs.rutgers.edu/~mlittman/courses/statai03/DDTW-2001.pdf | |
#****************************************************************** | |
derivative.est <- function(x) { | |
x = as.vector(x) | |
n = len(x) | |
d = (( x - mlag(x) ) + ( mlag(x,-1)- mlag(x) ) / 2) / 2 | |
d[1] = d[2] | |
d[n] = d[(n-1)] | |
d | |
} | |
alignment0 = dtw(derivative.est(query), derivative.est(reference), keep=TRUE) | |
alignment$index1 = alignment0$index1 | |
alignment$index2 = alignment0$index2 | |
png(filename = 'plot2.ddtw.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
plot(alignment,main='Derivative DTW Alignment', type='two',off=20) | |
dev.off() | |
} | |
############################################################################### | |
# Position Sizing | |
# | |
# Money Management Position Sizing | |
# http://www.trading-plan.com/money_position_sizing.html | |
# | |
# Position Sizing is Everything | |
# http://www.leighdrogen.com/position-sizing-is-everything/ | |
############################################################################### | |
bt.position.sizing.test <- function() | |
{ | |
#***************************************************************** | |
# Load historical data | |
#****************************************************************** | |
load.packages('quantmod') | |
tickers = spl('SPY') | |
data <- new.env() | |
getSymbols(tickers, src = 'yahoo', from = '1970-01-01', env = data, auto.assign = T) | |
for(i in ls(data)) data[[i]] = adjustOHLC(data[[i]], use.Adjusted=T) | |
bt.prep(data, align='keep.all', dates='1970::') | |
#***************************************************************** | |
# Code Strategies | |
#****************************************************************** | |
prices = data$prices | |
nperiods = nrow(prices) | |
models = list() | |
#***************************************************************** | |
# Buy & Hold | |
#****************************************************************** | |
data$weight[] = 0 | |
data$weight[] = 1 | |
models$buy.hold = bt.run.share(data, clean.signal=T) | |
#***************************************************************** | |
# Volatility Position Sizing - ATR | |
#****************************************************************** | |
atr = bt.apply(data, function(x) ATR(HLC(x),20)[,'atr']) | |
# http://www.leighdrogen.com/position-sizing-is-everything/ | |
# position size in units = ((porfolio size * % of capital to risk)/(ATR*2)) | |
data$weight[] = NA | |
capital = 100000 | |
# risk 2% of capital, assuming 2 atr stop | |
data$weight[] = (capital * 2/100) / (2 * atr) | |
# make sure you are not commiting more than 100% | |
# http://www.trading-plan.com/money_position_sizing.html | |
max.allocation = capital / prices | |
data$weight[] = iif(data$weight > max.allocation, max.allocation,data$weight) | |
models$buy.hold.2atr = bt.run(data, type='share', capital=capital) | |
#***************************************************************** | |
# Create Report | |
#****************************************************************** | |
models = rev(models) | |
png(filename = 'plot1.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part1(models) | |
dev.off() | |
png(filename = 'plot2.png', width = 1200, height = 800, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part2(models) | |
dev.off() | |
} | |
############################################################################### | |
# Trading Equity Curve with Volatility Position Sizing | |
############################################################################### | |
bt.volatility.position.sizing.test <- function() | |
{ | |
#***************************************************************** | |
# Load historical data | |
#****************************************************************** | |
load.packages('quantmod') | |
tickers = 'SPY' | |
data <- new.env() | |
getSymbols(tickers, src = 'yahoo', from = '1970-01-01', env = data, auto.assign = T) | |
for(i in ls(data)) data[[i]] = adjustOHLC(data[[i]], use.Adjusted=T) | |
bt.prep(data, align='keep.all', dates='1994::') | |
#***************************************************************** | |
# Buy and Hold | |
#****************************************************************** | |
models = list() | |
prices = data$prices | |
data$weight[] = 1 | |
models$buy.hold = bt.run.share(data, clean.signal=T) | |
#***************************************************************** | |
# Buy and Hold with target 10% Volatility | |
#****************************************************************** | |
ret.log = bt.apply.matrix(prices, ROC, type='continuous') | |
hist.vol = sqrt(252) * bt.apply.matrix(ret.log, runSD, n = 60) | |
data$weight[] = 0.1 / hist.vol | |
models$buy.hold.volatility.weighted = bt.run.share(data, clean.signal=T) | |
#***************************************************************** | |
# Buy and Hold with target 10% Volatility and Max Total leverage 100% | |
#****************************************************************** | |
data$weight[] = 0.1 / hist.vol | |
rs = rowSums(data$weight) | |
data$weight[] = data$weight / iif(rs > 1, rs, 1) | |
models$buy.hold.volatility.weighted.100 = bt.run.share(data, clean.signal=T) | |
#***************************************************************** | |
# Same, rebalanced Monthly | |
#****************************************************************** | |
period.ends = endpoints(prices, 'months') | |
period.ends = period.ends[period.ends > 0] | |
data$weight[] = NA | |
data$weight[period.ends,] = 0.1 / hist.vol[period.ends,] | |
rs = rowSums(data$weight[period.ends,]) | |
data$weight[period.ends,] = data$weight[period.ends,] / iif(rs > 1, rs, 1) | |
models$buy.hold.volatility.weighted.100.monthly = bt.run.share(data, clean.signal=T) | |
#***************************************************************** | |
# Create Report | |
#****************************************************************** | |
png(filename = 'plot1.png', width = 800, height = 600, units = 'px', pointsize = 12, bg = 'white') | |
# Plot performance | |
plotbt(models, plotX = T, log = 'y', LeftMargin = 3) | |
mtext('Cumulative Performance', side = 2, line = 1) | |
dev.off() | |
png(filename = 'plot2.png', width = 1600, height = 1000, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.custom.report.part2(rev(models)) | |
dev.off() | |
png(filename = 'plot3.png', width = 600, height = 500, units = 'px', pointsize = 12, bg = 'white') | |
# Plot Portfolio Turnover for each strategy | |
layout(1) | |
barplot.with.labels(sapply(models, compute.turnover, data), 'Average Annual Portfolio Turnover', plotX = F, label='both') | |
dev.off() | |
#***************************************************************** | |
# Next let's examine other volatility measures | |
#****************************************************************** | |
models = models[c('buy.hold' ,'buy.hold.volatility.weighted.100.monthly')] | |
# TTR volatility calc types | |
calc = c("close", "garman.klass", "parkinson", "rogers.satchell", "gk.yz", "yang.zhang") | |
ohlc = OHLC(data$SPY) | |
for(icalc in calc) { | |
vol = volatility(ohlc, calc = icalc, n = 60, N = 252) | |
data$weight[] = NA | |
data$weight[period.ends,] = 0.1 / vol[period.ends,] | |
rs = rowSums(data$weight[period.ends,]) | |
data$weight[period.ends,] = data$weight[period.ends,] / iif(rs > 1, rs, 1) | |
models[[icalc]] = bt.run.share(data, clean.signal=T) | |
} | |
#***************************************************************** | |
# Create Report | |
#****************************************************************** | |
png(filename = 'plot4.png', width = 800, height = 600, units = 'px', pointsize = 12, bg = 'white') | |
# Plot performance | |
plotbt(models, plotX = T, log = 'y', LeftMargin = 3) | |
mtext('Cumulative Performance', side = 2, line = 1) | |
dev.off() | |
png(filename = 'plot5.png', width = 1600, height = 600, units = 'px', pointsize = 12, bg = 'white') | |
plotbt.strategy.sidebyside(models) | |
dev.off() | |
#***************************************************************** | |
# Volatility Position Sizing applied to MA cross-over strategy's Equity Curve | |
#****************************************************************** | |
models = list() | |
sma.fast = SMA(prices, 50) | |
sma.slow = SMA(prices, 200) | |
weight = iif(sma.fast >= sma.slow, 1, -1) | |
data$weight[] = weight | |
models$ma.crossover = bt.run.share(data, clean.signal=T) | |
#***************************************************************** | |
# Target 10% Volatility | |
#****************************************************************** | |
ret.log = bt.apply.matrix(models$ma.crossover$equity, ROC, type='continuous') | |
hist.vol = sqrt(252) * bt.apply.matrix(ret.log, runSD, n = 60) | |
data$weight[] = NA | |
data$weight[period.ends,] = (0.1 / hist.vol[period.ends,]) * weight[period.ends,] | |
# limit total leverage to 100% | |
rs = rowSums(data$weight[period.ends,]) | |
data$weight[period.ends,] = data$weight[period.ends,] / iif(abs(rs) > 1, abs(rs), 1) | |
models$ma.crossover.volatility.weighted.100.monthly = bt.run.share(data, clean.signal=T) | |
#***************************************************************** |