Archive
Modeling Couch Potato strategy
I first read about the Couch Potato strategy in the MoneySense magazine. I liked this simple strategy because it was easy to understand and easy to manage. The Couch Potato strategy is similar to the Permanent Portfolio strategy that I have analyzed previously.
The Couch Potato strategy invests money in the given proportions among different types of assets to ensure diversification and rebalances the holdings once a year. For example the Classic Couch Potato strategy is:
- 1) Canadian equity (33.3%)
- 2) U.S. equity (33.3%)
- 3) Canadian bond (33.3%)
I highly recommend reading following online resources to get more information about the Couch Potato strategy:
- MoneySense
- Canadian Couch Potato
- AssetBuilder
Today, I want to show how you can model and monitor the Couch Potato strategy with the Systematic Investor Toolbox.
###############################################################################
# Load Systematic Investor Toolbox (SIT)
# http://systematicinvestor.wordpress.com/systematic-investor-toolbox/
###############################################################################
setInternet2(TRUE)
con = gzcon(url('http://www.systematicportfolio.com/sit.gz', 'rb'))
source(con)
close(con)
# helper function to model Couch Potato strategy - a fixed allocation strategy
couch.potato.strategy <- function
(
data.all,
tickers = 'XIC.TO,XSP.TO,XBB.TO',
weights = c( 1/3, 1/3, 1/3 ),
periodicity = 'years',
dates = '1900::',
commission = 0.1
)
{
#*****************************************************************
# Load historical data
#******************************************************************
tickers = spl(tickers)
names(weights) = tickers
data <- new.env()
for(s in tickers) data[[ s ]] = data.all[[ s ]]
bt.prep(data, align='remove.na', dates=dates)
#*****************************************************************
# Code Strategies
#******************************************************************
prices = data$prices
n = ncol(prices)
nperiods = nrow(prices)
# find period ends
period.ends = endpoints(data$prices, periodicity)
period.ends = c(1, period.ends[period.ends > 0])
#*****************************************************************
# Code Strategies
#******************************************************************
data$weight[] = NA
for(s in tickers) data$weight[period.ends, s] = weights[s]
model = bt.run.share(data, clean.signal=F, commission=commission)
return(model)
}
The couch.potato.strategy() function creates a periodically rebalanced portfolio for given static allocation.
Next, let’s back-test some Canadian Couch Potato portfolios:
#*****************************************************************
# Load historical data
#******************************************************************
load.packages('quantmod')
map = list()
map$can.eq = 'XIC.TO'
map$can.div = 'XDV.TO'
map$us.eq = 'XSP.TO'
map$us.div = 'DVY'
map$int.eq = 'XIN.TO'
map$can.bond = 'XBB.TO'
map$can.real.bond = 'XRB.TO'
map$can.re = 'XRE.TO'
map$can.it = 'XTR.TO'
map$can.gold = 'XGD.TO'
data <- new.env()
for(s in names(map)) {
data[[ s ]] = getSymbols(map[[ s ]], src = 'yahoo', from = '1995-01-01', env = data, auto.assign = F)
data[[ s ]] = adjustOHLC(data[[ s ]], use.Adjusted=T)
}
#*****************************************************************
# Code Strategies
#******************************************************************
models = list()
periodicity = 'years'
dates = '2006::'
models$classic = couch.potato.strategy(data, 'can.eq,us.eq,can.bond', rep(1/3,3), periodicity, dates)
models$global = couch.potato.strategy(data, 'can.eq,us.eq,int.eq,can.bond', c(0.2, 0.2, 0.2, 0.4), periodicity, dates)
models$yield = couch.potato.strategy(data, 'can.div,can.it,us.div,can.bond', c(0.25, 0.25, 0.25, 0.25), periodicity, dates)
models$growth = couch.potato.strategy(data, 'can.eq,us.eq,int.eq,can.bond', c(0.25, 0.25, 0.25, 0.25), periodicity, dates)
models$complete = couch.potato.strategy(data, 'can.eq,us.eq,int.eq,can.re,can.real.bond,can.bond', c(0.2, 0.15, 0.15, 0.1, 0.1, 0.3), periodicity, dates)
models$permanent = couch.potato.strategy(data, 'can.eq,can.gold,can.bond', c(0.25,0.25,0.5), periodicity, dates)
#*****************************************************************
# Create Report
#******************************************************************
plotbt.custom.report.part1(models)
I have included a few classic Couch Potato portfolios and the Canadian version of the Permanent portfolio. The equity curves speak for themselves: you can call them by the fancy names, but in the end all variations of the Couch Potato portfolios performed similar and suffered a huge draw-down during 2008. The Permanent portfolio did a little better during 2008 bear market.
Next, let’s back-test some US Couch Potato portfolios:
#*****************************************************************
# Load historical data
#******************************************************************
tickers = spl('VIPSX,VTSMX,VGTSX,SPY,TLT,GLD,SHY')
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)
# extend GLD with Gold.PM - London Gold afternoon fixing prices
data$GLD = extend.GLD(data$GLD)
#*****************************************************************
# Code Strategies
#******************************************************************
models = list()
periodicity = 'years'
dates = '2003::'
models$classic = couch.potato.strategy(data, 'VIPSX,VTSMX', rep(1/2,2), periodicity, dates)
models$margarita = couch.potato.strategy(data, 'VIPSX,VTSMX,VGTSX', rep(1/3,3), periodicity, dates)
models$permanent = couch.potato.strategy(data, 'SPY,TLT,GLD,SHY', rep(1/4,4), periodicity, dates)
#*****************************************************************
# Create Report
#******************************************************************
plotbt.custom.report.part1(models)
The US Couch Potato portfolios also suffered huge draw-downs during 2008. The Permanent portfolio hold it ground much better.
It has been written quite a lot about Couch Potato strategy, but looking at different variations I cannot really see much difference in terms of perfromance or draw-downs. Probably that is why in the last few years, I have seen the creation of many new ETFs to address that in one way or another. For example, now we have tactical asset allocation ETFs, minimum volatility ETFs, income ETFs with covered calls overlays.
To view the complete source code for this example, please have a look at the bt.couch.potato.test() function in bt.test.r at github.
Some additional references from the Canadian Couch Potato blog that are worth reading:
Permanent Portfolio
First, just a quick update: I’m moving the release date of the SIT package a few months down the road, probably in November.
Now back to the post. Recently I came across a series of interesting posts about the Permanent Portfolio at the GestaltU blog. Today I want to show you how to back-test the Permanent Portfolio using the Systematic Investor Toolbox.
The simple version of the Permanent Portfolio consists of equal allocations to stocks(SPY), gold(GLD), treasuries(TLT), and cash(SHY). [25% allocation each] The portfolio is rebalanced once a year if any allocation breaks out from the 15% – 35% range.
###############################################################################
# Load Systematic Investor Toolbox (SIT)
# http://systematicinvestor.wordpress.com/systematic-investor-toolbox/
###############################################################################
setInternet2(TRUE)
con = gzcon(url('http://www.systematicportfolio.com/sit.gz', 'rb'))
source(con)
close(con)
#*****************************************************************
# Load historical data
#******************************************************************
load.packages('quantmod')
tickers = spl('SPY,TLT,GLD,SHY')
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)
# extend GLD with Gold.PM - London Gold afternoon fixing prices
data$GLD = extend.GLD(data$GLD)
bt.prep(data, align='remove.na')
#*****************************************************************
# Code Strategies
#******************************************************************
prices = data$prices
n = ncol(prices)
nperiods = nrow(prices)
# annual
period.ends = endpoints(prices, 'years')
period.ends = period.ends[period.ends > 0]
period.ends.y = c(1, period.ends)
# quarterly
period.ends = endpoints(prices, 'quarters')
period.ends = period.ends[period.ends > 0]
period.ends.q = c(1, period.ends)
models = list()
#*****************************************************************
# Code Strategies
#******************************************************************
target.allocation = matrix(rep(1/n,n), nrow=1)
# Buy & Hold
data$weight[] = NA
data$weight[period.ends.y[1],] = target.allocation
models$buy.hold = bt.run.share(data, clean.signal=F)
# Equal Weight Annual
data$weight[] = NA
data$weight[period.ends.y,] = ntop(prices[period.ends.y,], n)
models$equal.weight.y = bt.run.share(data, clean.signal=F)
# Equal Weight Quarterly
data$weight[] = NA
data$weight[period.ends.q,] = ntop(prices[period.ends.q,], n)
models$equal.weight.q = bt.run.share(data, clean.signal=F)
To rebalance base on the 10% threshold (i.e. portfolio weights breaking out from the 15% – 35% range) I will use bt.max.deviation.rebalancing() function introduced in the Backtesting Rebalancing methods post.
#***************************************************************** # Rebalance based on threshold #****************************************************************** # Rebalance only when threshold is broken models$threshold.y = bt.max.deviation.rebalancing(data, models$buy.hold, target.allocation, 10/100, 0, period.ends = period.ends.y) # Rebalance only when threshold is broken models$threshold.q = bt.max.deviation.rebalancing(data, models$buy.hold, target.allocation, 10/100, 0, period.ends = period.ends.q) #***************************************************************** # Create Report #****************************************************************** plotbt.custom.report.part1(models) plotbt.strategy.sidebyside(models) # 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')
The Quarterly rebalancing with 10% threshold produces an attractive portfolio with top performance and low turnover.
To view the complete source code for this example, please have a look at the bt.permanent.portfolio.test() function in bt.test.r at github.
Adaptive Asset Allocation – Sensitivity Analysis
Today I want to continue with Adaptive Asset Allocation theme and examine how the strategy results are sensitive to look-back parameters used for momentum and volatility computations. I will follow the sample steps that were outlined by David Varadi on the robustness of parameters of the Adaptive Asset Allocation algorithm post. Please see my prior post for more infromation.
Let’s start by loading historical prices for 10 ETFs using the Systematic Investor Toolbox:
###############################################################################
# Load Systematic Investor Toolbox (SIT)
# http://systematicinvestor.wordpress.com/systematic-investor-toolbox/
###############################################################################
setInternet2(TRUE)
con = gzcon(url('http://www.systematicportfolio.com/sit.gz', 'rb'))
source(con)
close(con)
#*****************************************************************
# Load historical data
#******************************************************************
load.packages('quantmod')
tickers = spl('SPY,EFA,EWJ,EEM,IYR,RWX,IEF,TLT,DBC,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='keep.all', dates='2004:12::')
#*****************************************************************
# Code Strategies
#******************************************************************
prices = data$prices
n = ncol(prices)
models = list()
# find period ends
period.ends = endpoints(prices, 'months')
period.ends = period.ends[period.ends > 0]
Next I wrapped the Combo (Momentum and Volatility weighted) strategy and Adaptive Asset Allocation (AAA) strategy into bt.aaa.combo and bt.aaa.minrisk functions respectively. Following is an example how you can use them:
#***************************************************************** # Test #****************************************************************** models = list() models$combo = bt.aaa.combo(data, period.ends, n.top = 5, n.mom = 180, n.vol = 20) models$aaa = bt.aaa.minrisk(data, period.ends, n.top = 5, n.mom = 180, n.vol = 20) plotbt.custom.report.part1(models)
Now let’s evaluate all possible combinations of momentum and volatility look back parameters ranging from 1 to 12 months using Combo strategy:
#*****************************************************************
# Sensitivity Analysis: bt.aaa.combo / bt.aaa.minrisk
#******************************************************************
# length of momentum look back
mom.lens = ( 1 : 12 ) * 20
# length of volatility look back
vol.lens = ( 1 : 12 ) * 20
models = list()
# evaluate strategies
for(n.mom in mom.lens) {
cat('MOM =', n.mom, '\n')
for(n.vol in vol.lens) {
cat('\tVOL =', n.vol, '\n')
models[[ paste('M', n.mom, 'V', n.vol) ]] =
bt.aaa.combo(data, period.ends, n.top = 5,
n.mom = n.mom, n.vol = n.vol)
}
}
out = plotbt.strategy.sidebyside(models, return.table=T, make.plot = F)
Finally let’s plot the Sharpe, Cagr, DVR, MaxDD statistics for the each strategy:
#*****************************************************************
# Create Report
#******************************************************************
# allocate matrix to store backtest results
dummy = matrix('', len(vol.lens), len(mom.lens))
colnames(dummy) = paste('M', mom.lens)
rownames(dummy) = paste('V', vol.lens)
names = spl('Sharpe,Cagr,DVR,MaxDD')
layout(matrix(1:4,nrow=2))
for(i in names) {
dummy[] = ''
for(n.mom in mom.lens)
for(n.vol in vol.lens)
dummy[paste('V', n.vol), paste('M', n.mom)] =
out[i, paste('M', n.mom, 'V', n.vol) ]
plot.table(dummy, smain = i, highlight = T, colorbar = F)
}
I have also repeated the last two steps for the AAA strategy (bt.aaa.minrisk function):
The results for AAA and Combo strategies are very similar. The shorter term momentum and shorter term volatility produce the best results, but likely at the cost of higher turnover.
To view the complete source code for this example, please have a look at the bt.aaa.sensitivity.test() function in bt.test.r at github.
Adaptive Asset Allocation
Today I want to highlight a whitepaper about Adaptive Asset Allocation by Butler, Philbrick and Gordillo and the discussion by David Varadi on the robustness of parameters of the Adaptive Asset Allocation algorithm.
In this post I will follow the steps of the Adaptive Asset Allocation paper, and in the next post I will show how to test the sensitivity of parameters of the of the Adaptive Asset Allocation algorithm.
I will use the 10 ETFs that invest into the same asset classes as presented in the paper:
- U.S. Stocks (SPY)
- European Stocks (EFA)
- Japanese Stocks (EWJ)
- Emerging Market Stocks (EEM)
- U.S. REITs (IYR)
- International REITs (RWX)
- U.S. Mid-term Treasuries (IEF)
- U.S. Long-term Treasuries (TLT)
- Commodities (DBC)
- Gold (GLD)
Unfortunately, most of these 10 ETFs only began trading in the end of 2004, so I will only be able to replicate the recent Adaptive Asset Allocation strategy performance.
Let’s start by loading historical prices of 10 ETFs using the Systematic Investor Toolbox:
###############################################################################
# Load Systematic Investor Toolbox (SIT)
# http://systematicinvestor.wordpress.com/systematic-investor-toolbox/
###############################################################################
setInternet2(TRUE)
con = gzcon(url('http://www.systematicportfolio.com/sit.gz', 'rb'))
source(con)
close(con)
#*****************************************************************
# Load historical data
#******************************************************************
load.packages('quantmod')
tickers = spl('SPY,EFA,EWJ,EEM,IYR,RWX,IEF,TLT,DBC,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='keep.all', dates='2004:12::')
#*****************************************************************
# Code Strategies
#******************************************************************
prices = data$prices
n = ncol(prices)
models = list()
# find period ends
period.ends = endpoints(prices, 'months')
period.ends = period.ends[period.ends > 0]
# Adaptive Asset Allocation parameters
n.top = 5 # number of momentum positions
n.mom = 6*22 # length of momentum look back
n.vol = 1*22 # length of volatility look back
Next, let’s create portfolios as outlined in the whitepaper:
#*****************************************************************
# Equal Weight
#******************************************************************
data$weight[] = NA
data$weight[period.ends,] = ntop(prices[period.ends,], n)
models$equal.weight = bt.run.share(data, clean.signal=F)
#*****************************************************************
# Volatliliy Position Sizing
#******************************************************************
ret.log = bt.apply.matrix(prices, ROC, type='continuous')
hist.vol = bt.apply.matrix(ret.log, runSD, n = n.vol)
adj.vol = 1/hist.vol[period.ends,]
data$weight[] = NA
data$weight[period.ends,] = adj.vol / rowSums(adj.vol, na.rm=T)
models$volatility.weighted = bt.run.share(data, clean.signal=F)
#*****************************************************************
# Momentum Portfolio
#*****************************************************************
momentum = prices / mlag(prices, n.mom)
data$weight[] = NA
data$weight[period.ends,] = ntop(momentum[period.ends,], n.top)
models$momentum = bt.run.share(data, clean.signal=F)
#*****************************************************************
# Combo: weight positions in the Momentum Portfolio according to Volatliliy
#*****************************************************************
weight = ntop(momentum[period.ends,], n.top) * adj.vol
data$weight[] = NA
data$weight[period.ends,] = weight / rowSums(weight, na.rm=T)
models$combo = bt.run.share(data, clean.signal=F,trade.summary = TRUE)
Finally let’s create the Adaptive Asset Allocation portfolio:
#*****************************************************************
# Adaptive Asset Allocation (AAA)
# weight positions in the Momentum Portfolio according to
# the minimum variance algorithm
#*****************************************************************
weight = NA * prices
weight[period.ends,] = ntop(momentum[period.ends,], n.top)
for( i in period.ends[period.ends >= n.mom] ) {
hist = ret.log[ (i - n.vol + 1):i, ]
# require all assets to have full price history
include.index = count(hist)== n.vol
# also only consider assets in the Momentum Portfolio
index = ( weight[i,] > 0 ) & include.index
n = sum(index)
if(n > 0) {
hist = hist[ , index]
# create historical input assumptions
ia = create.historical.ia(hist, 252)
s0 = apply(coredata(hist),2,sd)
ia$cov = cor(coredata(hist), use='complete.obs',method='pearson') * (s0 %*% t(s0))
# create constraints: 0<=x<=1, sum(x) = 1
constraints = new.constraints(n, lb = 0, ub = 1)
constraints = add.constraints(rep(1, n), 1, type = '=', constraints)
# compute minimum variance weights
weight[i,] = 0
weight[i,index] = min.risk.portfolio(ia, constraints)
}
}
# Adaptive Asset Allocation (AAA)
data$weight[] = NA
data$weight[period.ends,] = weight[period.ends,]
models$aaa = bt.run.share(data, clean.signal=F,trade.summary = TRUE)
The last step is create reports for all models:
#*****************************************************************
# Create Report
#******************************************************************
models = rev(models)
plotbt.custom.report.part1(models)
plotbt.custom.report.part2(models)
plotbt.custom.report.part3(models$combo, trade.summary = TRUE)
plotbt.custom.report.part3(models$aaa, trade.summary = TRUE)
The AAA portfolio performs very well, producing the highest Sharpe ratio and smallest draw-down across all strategies. In the next post I will look at the sensitivity of AAA parameters.
To view the complete source code for this example, please have a look at the bt.aaa.test() function in bt.test.r at github.
Gini Efficient Frontier
David Varadi have recently wrote two posts about Gini Coefficient: I Dream of Gini, and Mean-Gini Optimization. I want to show how to use Gini risk measure to construct efficient frontier and compare it with alternative risk measures I discussed previously.
I will use Gini mean difference risk measure – the mean of the difference between every possible pair of returns to construct Mean-Gini Efficient Frontier. I will use methods presented in “The Generation of Mean Gini Efficient Sets” by J. Okunev (1991) paper to construct optimal portfolios.
Let x.i, i= 1,…,N be weights of instruments in the portfolio. Let us denote by r.it the return of i-th asset in the time period t for i= 1,…,N and t= 1,…,T. The portfolio’s Gini mean difference (page 5) can be written as:
It can be formulated as a linear programming problem
This linear programming problem can be easily implemented
min.gini.portfolio <- function
(
ia, # input assumptions
constraints # constraints
)
{
n = ia$n
nt = nrow(ia$hist.returns)
# objective : Gini mean difference - the mean of the difference between every possible pair of returns
# 1/(T^2) * [ SUM <over j = 1,...,T , k>j> a.long.jk + a.short.jk ]
f.obj = c(rep(0, n), (1/(nt^2)) * rep(1, nt*(nt-1)))
# adjust constraints, add a.long.jk , a.short.jk
constraints = add.variables(nt*(nt-1), constraints, lb=0)
# [ SUM <over i> x.i * (r.ij - r.ik) ] - a.long.jk + a.short.jk = 0
# for each j = 1,...,T , k>j
a = matrix(0, n + nt*(nt-1), nt*(nt-1)/2)
diag(a[(n+1) : (n + nt*(nt-1)/2), ]) = -1
diag(a[(n+1+nt*(nt-1)/2) : (n + nt*(nt-1)), ]) = 1
hist.returns = as.matrix(ia$hist.returns)
i.start = 0
for(t in 1:(nt-1)) {
index = (i.start+1) : (i.start + nt -t)
for(i in 1:n) {
a[i, index] = ( hist.returns[t,i] - hist.returns[,i] ) [ (t+1) : nt ]
}
i.start = i.start + nt -t
}
constraints = add.constraints(a, 0, '=', constraints)
# setup linear programming
f.con = constraints$A
f.dir = c(rep('=', constraints$meq), rep('>=', len(constraints$b) - constraints$meq))
f.rhs = constraints$b
# find optimal solution
x = NA
sol = try(solve.LP.bounds('min', f.obj, t(f.con), f.dir, f.rhs,
lb = constraints$lb, ub = constraints$ub), TRUE)
if(!inherits(sol, 'try-error')) {
x = sol$solution[1:n]
}
return( x )
}
Let’s examine efficient frontiers computed under Gini and Standard deviation risk measures using sample historical input assumptions.
###############################################################################
# Load Systematic Investor Toolbox (SIT)
# http://systematicinvestor.wordpress.com/systematic-investor-toolbox/
###############################################################################
con = gzcon(url('http://www.systematicportfolio.com/sit.gz', 'rb'))
source(con)
close(con)
#--------------------------------------------------------------------------
# Create Efficient Frontier
#--------------------------------------------------------------------------
ia = aa.test.create.ia.rebal()
n = ia$n
# 0 <= x.i <= 1
constraints = new.constraints(n, lb = 0, ub = 1)
# SUM x.i = 1
constraints = add.constraints(rep(1, n), 1, type = '=', constraints)
# create efficient frontier(s)
ef.risk = portopt(ia, constraints, 50, 'Risk')
ef.gini = portopt(ia, constraints, 50, 'GINI', min.gini.portfolio)
#--------------------------------------------------------------------------
# Create Plots
#--------------------------------------------------------------------------
layout( matrix(1:4, nrow = 2) )
plot.ef(ia, list(ef.risk, ef.gini), portfolio.risk, F)
plot.ef(ia, list(ef.risk, ef.gini), portfolio.gini.coefficient, F)
plot.transition.map(ef.risk)
plot.transition.map(ef.gini)
The Gini efficient frontier is almost identical to Standard deviation efficient frontier, labeled ‘Risk’. This is not a surprise because asset returns that are used in the sample input assumptions are well behaved. The Gini measure of risk would be most appropriate if asset returns contained large outliers.
To view the complete source code for this example, please have a look at the aa.gini.test() function in aa.test.r at github.
Next I added Gini risk measure to the mix of Asset Allocation strategies that I examined in the Backtesting Asset Allocation portfolios post.
The Gini portfolios and Minimum Variance portfolios show very similar perfromance
To view the complete source code for this example, please have a look at the bt.aa.test() function in bt.test.r at github.














