Quick View on Correlations of Different Instruments

In this post, I will demonstrate how to quickly visualize correlations using the PerformanceAnalytics package. Thanks to the package creators, it is really easy correlation and many other performance metrics.

The first chart looks at the rolling 252 day correlation of nine sector ETFs using SPY as the benchmark. As expected the correlation is rather high because the sector ETFs are part of the S&P 500 index, but has been even more pronounced the last few years.


Chart 2 shows the correlation of five ETFs. Note that there is no single instrument I am using as a benchmark, all five ETFs will be benchmarked against one another. (note that I removed the legend because it literally took up the entire plot).


Chart 3 shows the same 4 ETFs, this time using SPY as a benchmark.


In my opinion, the beauty of the chart.RollingCorrelation function is that the inputs are time series returns. This means that the correlations of instruments (ETFs, stocks, mutual funds, etc.), hedge fund managers, portfolios, and even strategies we test in quantstrat.

Here is the R code used to generate the first chart. To do you own correlation analysis, just change the symbols or add in new data sets of different returns.

#Correlations of Sector ETFs to benchmarked against SPY

#Load the packages used

#create a list of symbols
symbols = c("XLY", "XLP", "XLE", "XLF", "XLV", "XLI", "XLK", "XLB", "XLU")
retsymbols <- paste("ret", symbols, sep = ".")

#Downlad the data from yahoo
getSymbols(symbols, src = 'yahoo', index.class = c("POSIXt","POSIXct"), from = '2000-01-01')
getSymbols("SPY", src = 'yahoo', index.class = c("POSIXt","POSIXct"), from = '2000-01-01')

#The benchmark is the return vector of which the other assets will be benchmarked against
benchmark <- ROC(Ad(SPY), n=1, type="continuous", na.pad=TRUE)
colnames(benchmark) <- "SPY"

#Loop to create new xts objects with just the returns
for (symbol in symbols){
  x <- get(symbol)
  x1 <- ROC(Ad(x), n=1, type="continuous", na.pad=TRUE)
  assign(paste("ret", symbol, sep = "."),x1)

#this merges all of the objects in 'retsymbols' into one object named 'ret'
ret <- do.call(merge, lapply(retsymbols, get))

suppressWarnings(chart.RollingCorrelation(ret[,1:ncol(ret)], benchmark, width = 252, xaxis = TRUE, 
                          colorset = rich8equal, legend.loc = "bottomright",
                         main = "Rolling 252 Day Correlation"))

Created by Pretty R at inside-R.org


Simple Moving Average Strategy with a Volatility Filter: Follow-Up Part 3

In part 2, we saw that adding a volatility filter to a single instrument test did little to improve performance or risk adjusted returns. How will the volatility filter impact a multiple instrument portfolio?

In part 3 of the follow up, I will evaluate the impact of the volatility filter on a multiple instrument test.

The tests will use nine of the Select Sector SPDR ETFs listed below.

XLY – Consumer Discretionary Select Sector SPDR
XLP – Consumer Staples Select Sector SPDR
XLE – Energy Select Sector SPDR
XLF – Financial Select Sector SPDR
XLV – Health Care Select Sector SPDR
XLI – Industrial Select Sector SPDR
XLK – Technology Select Sector SPDR
XLB – Materials Select Sector SPDR
XLU – Utilities Select Sector SPDR

Test #1 – without volatility filter

Start Date*: 2001-01-01

Test#2 – with volatility filter

Start Date*: 2000-01-01

*Note the difference in start dates. The volatility filter requires an extra 52 periodsto process the RBrev1 indicator so the test dates are offset by 52 weeks (one year).

Both tests will risk 1% of account equity and the stop size is 1 standard deviation.

Test #1 is a simple moving average strategy without a volatility filter on a portfolio of the nine sector ETFs mentioned previously. This will be the baseline for comparison of the strategy with the volatility filter.

Test #1 Buy and Exit Rules

  • Buy Rule: Go long if close crosses above the 52 period SMA
  • Exit Rule: Exit if close crosses below the 52 period SMA
Test #1 Performance Statistics
Test CAGR (%) MaxDD (%) MAR
Test#1 7.976377 -14.92415 0.534461


Test #2 will be a simple moving average strategy with a volatility filter on the same 9 ETFs. The volatility filter is the same measure used in Follow-Up Part 2. The volatility filter is simply the 52 period standard deviation of close prices.

Test #2 Buy and Exit Rules

The new volatility filter will be the 52 period standard deviation of close prices. Now, the buy rule can be interpreted as follows:

  • Buy Rule: Go long if close is greater than the 52 period SMA and the 52 period standard deviation of close prices is less than its median over the last 52 periods.
  • Exit Rule: Exit if long and close is less than the 52 period SMA

Test#2 Performance Statistics

Test CAGR (%) MaxDD (%) MAR
Test#2 7.6694587 -14.6590123 0.523191


Both strategies perform fairly well. I would give a slight edge to Test#1, the strategy without a volatility filter. The strategy without a volatility filter has a slightly higher maximum drawdown (MaxDD), but also a higher CAGR.

Test CAGR (%) MaxDD (%) MAR
Test#1 7.976377 -14.92415 0.534461
Test#2 7.6694587 -14.65901 0.523191

Below I will include the R code for the test#2, shoot me an email if you want the code for test#1.

#Weekly Timing Strategy with Volatility Filter


##### Begin Functions #####

#Custom Order Sizing Function to trade percent of equity based on a stopsize
osPCTEQ <- function(timestamp, orderqty, portfolio, symbol, ruletype, ...){
  tempPortfolio <- getPortfolio(portfolio.st)
  dummy <- updatePortf(Portfolio=portfolio.st, Dates=paste('::',as.Date(timestamp),sep=''))
  trading.pl <- sum(getPortfolio(portfolio.st)$summary$Realized.PL) #change to ..$summary$Net.Trading.PL for Total Equity Position Sizing
  total.equity <- initEq+trading.pl
  DollarRisk <- total.equity * trade.percent
  ClosePrice <- as.numeric(Cl(mktdata[timestamp,]))
  mavg <- as.numeric(mktdata$SMA[timestamp,])
  sign1 <- ifelse(ClosePrice > mavg, 1, -1)
  sign1[is.na(sign1)] <- 1
  Posn = getPosQty(Portfolio = portfolio.st, Symbol = symbol, Date = timestamp)
  StopSize <- as.numeric(mktdata$SDEV[timestamp,]*StopMult) #Stop = SDAVG * StopMult !Must have SDAVG or other indictor to determine stop size
  #orderqty <- round(DollarRisk/StopSize, digits=0)
  orderqty <- ifelse(Posn == 0, sign1*round(DollarRisk/StopSize), 0) # number contracts traded is equal to DollarRisk/StopSize

#Function that calculates the n period standard deviation of close prices.
#This is used in place of ATR so that I can use only close prices.
SDEV <- function(x, n){
  sdev <- runSD(x, n, sample = FALSE)
  colnames(sdev) <- "SDEV"

#Custom indicator function 
RBrev1 <- function(x,n){
  x <- x
  sd <- runSD(x, n, sample= FALSE)
  med <- runMedian(sd,n)
  mavg <- SMA(x,n)
  signal <- ifelse(sd < med & x > mavg,1,0)
  colnames(signal) <- "RB"
  #ret <- cbind(x,roc,sd,med,mavg,signal) #Only use for further analysis of indicator
  #colnames(ret) <- c("close","roc","sd","med","mavg","RB") #Only use for further analysis of indicator

##### End Functions #####

#Symbols to be used in test
#XLY - Consumer Discretionary Select Sector SPDR
#XLP - Consumer Staples Select Sector SPDR
#XLE - Energy Select Sector SPDR
#XLF - Financial Select Sector SPDR
#XLV - Health Care Select Sector SPDR
#XLI - Industrial Select Sector SPDR
#XLK - Technology Select Sector SPDR
#XLB - Materials Select Sector SPDR
#XLU - Utilities Select Sector SPDR

#Symbol list to pass to the getSymbols function
symbols = c("XLY", "XLP", "XLE", "XLF", "XLV", "XLI", "XLK", "XLB", "XLU")

#Load ETFs from yahoo
stock(symbols, currency="USD",multiplier=1)
getSymbols(symbols, src='yahoo', index.class=c("POSIXt","POSIXct"), from='2000-01-01')

#Data is downloaded as daily data
#Convert to weekly
for(symbol in symbols) {

#Use the adjusted close prices
#this for loop sets the "Close" column equal to the "Adjusted Close" column
#because the trades are executed based on the "Close" column
for(symbol in symbols) {
  x[,4] <- x[,6]

initEq <- 100000

trade.percent <- 0.01 #percent risk used in sizing function
StopMult = 1 #stop size used in sizing function

#Name the portfolio and account
portfolio.st = 'TimingWeekly'
account.st = 'TimingWeekly'

initPortf(portfolio.st, symbols=symbols, initPosQty=0, initDate=initDate, currency="USD")
initAcct(account.st,portfolios=portfolio.st, initDate=initDate, initEq=initEq)

#Name the strategy
strat <- strategy('TimingWeekly')

#Add indicators
#The first indicator is the 52 period SMA
#The second indicator is the SDEV indicator used for stop and position sizing
strat <- add.indicator(strategy = strat, name = "SMA", arguments = list(x = quote(Cl(mktdata)), n=52), label="SMA")
strat <- add.indicator(strategy = strat, name = "RBrev1", arguments = list(x = quote(Cl(mktdata)), n=52), label="RB")
strat <- add.indicator(strategy = strat, name = "SDEV", arguments = list(x = quote(Cl(mktdata)), n=52), label="SDEV")

#Add signals
#The buy signal is when the RB indicator crosses from 0 to 1
#The exit signal is when the close crosses below the SMA
strat <- add.signal(strategy = strat, name="sigThreshold", arguments = list(threshold=1, column="RB",relationship="gte", cross=TRUE),label="RB.gte.1")
strat <- add.signal(strategy = strat, name="sigCrossover", arguments = list(columns=c("Close","SMA"),relationship="lt"),label="Cl.lt.SMA")

#Add rules
strat <- add.rule(strategy = strat, name='ruleSignal', arguments = list(sigcol="RB.gte.1", sigval=TRUE, orderqty=1000, ordertype='market', orderside='long', osFUN = 'osPCTEQ', pricemethod='market', replace=FALSE), type='enter', path.dep=TRUE)
strat <- add.rule(strategy = strat, name='ruleSignal', arguments = list(sigcol="Cl.lt.SMA", sigval=TRUE, orderqty='all', ordertype='market', orderside='long', pricemethod='market',TxnFees=0), type='exit', path.dep=TRUE)

# Process the indicators and generate trades
out<-try(applyStrategy(strategy = strat, portfolios = portfolio.st))
print("Strategy Loop:")

print("updatePortf execution time:")


#Update Account

#Update Ending Equity

#ending equity
getEndEq(account.st, Sys.Date()) + initEq

tstats <- tradeStats(Portfolio=portfolio.st, Symbol=symbols)

#View order book to confirm trades

#Trade Statistics for CAGR, Max DD, and MAR
#calculate total equity curve performance Statistics
ec <- tail(cumsum(getPortfolio(portfolio.st)$summary$Net.Trading.PL),-1)
ec$initEq <- initEq
ec$totalEq <- ec$Net.Trading.PL + ec$initEq
ec$maxDD <- ec$totalEq/cummax(ec$totalEq)-1
ec$logret <- ROC(ec$totalEq, n=1, type="continuous")
ec$logret[is.na(ec$logret)] <- 0

WI <- exp(cumsum(ec$logret)) #growth of $1
#write.zoo(nofilterWI, file = "E:\\nofiltertest.csv", sep=",")

period.count <- NROW(ec)-104 #Use 104 because there is a 104 week lag for the 52 week SD and 52 week median of SD
year.count <- period.count/52
maxDD <- min(ec$maxDD)*100
totret <- as.numeric(last(ec$totalEq))/as.numeric(first(ec$totalEq))
CAGR <- (totret^(1/year.count)-1)*100
MAR <- CAGR/abs(maxDD)

Perf.Stats <- c(CAGR, maxDD, MAR)
names(Perf.Stats) <- c("CAGR", "maxDD", "MAR")

#transactions <- getTxns(Portfolio = portfolio.st, Symbol = symbols)
#write.zoo(transactions, file = "E:\\nofiltertxn.csv")

charts.PerformanceSummary(ec$logret, wealth.index = TRUE, ylog = TRUE, colorset = "steelblue2", main = "Strategy with Volatility Filter")

Created by Pretty R at inside-R.org