Created
January 28, 2013 04:20
-
-
Save rbresearch/4652998 to your computer and use it in GitHub Desktop.
etfReplayRank backtest
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
# Backtest of ETF Replay Ranking Algorithm | |
# clear the workspace | |
rm(list=ls()) | |
# step-by-step example of ETF Replay Ranking Algorithm | |
##### etfReplayRank Function ##### | |
# we can use the same step-by-step approach outlined above to write a function | |
# to rank instruments based on ETF Replay | |
etfReplayRank <- function(x, periods=c(6, 3, 3), w=c(0.4, 0.3, 0.3)) { | |
# x : xts object of close prices | |
# periods : vector of periods used for ret1, ret2, vol | |
# w : vector of weights | |
# xts objects of returns and volatility | |
# for this example, volatility is the standard deviation of 1-month returns | |
ret1 <- ROC(x, n=periods[1], type="discrete") | |
ret2 <- ROC(x, n=periods[2], type="discrete") | |
tmp.ret <- ROC(x, n=1, type="discrete") | |
vol <- as.xts(apply(tmp.ret, 2, runSD, n=periods[3]), order.by=index(x)) | |
# apply the rank function row-wise | |
ret1.rank <- as.xts(t(apply(-ret1, 1, rank, na.last="keep"))) | |
ret2.rank <- as.xts(t(apply(-ret2, 1, rank, na.last="keep"))) | |
vol.rank <- as.xts(t(apply(vol, 1, rank, na.last="keep"))) | |
# multiply the factor weights into the rank objects | |
tmp1 <- ret1.rank * w[1] | |
tmp2 <- ret2.rank * w[2] | |
tmp3 <- vol.rank * w[3] | |
# add the tmp objects to get the weighted factor rank | |
wf.rank <- tmp1 + tmp2 + tmp3 | |
# overall rank | |
out.rank <- as.xts(t(apply(wf.rank, 1, rank, na.last="keep"))) | |
out.rank | |
} | |
##### MonthlyAd function ##### | |
MonthlyAd <- function(x){ | |
# Converts daily data to monthly and returns only the monthly close | |
# Note: only used with Yahoo Finance data so far | |
# Thanks to Joshua Ulrich for the Monthly Ad function | |
# | |
# args: | |
# x = daily price data from Yahoo Finance | |
# | |
# Returns: | |
# xts object with the monthly adjusted close prices | |
sym <- sub("\\..*$", "", names(x)[1]) | |
Ad(to.monthly(x, indexAt = 'lastof', drop.time = TRUE, name = sym)) | |
} | |
##### SimpleMomentumTest function ##### | |
SimpleMomentumTest <- function(xts.ret, xts.rank, n = 1, ret.fill.na = 3){ | |
# returns a list containing a matrix of individual asset returns | |
# and the comnbined returns | |
# args: | |
# xts.ret = xts of one period returns | |
# xts.rank = xts of ranks | |
# n = number of top ranked assets to trade | |
# ret.fill.na = number of return periods to fill with NA | |
# | |
# Returns: | |
# returns an xts object of simple returns | |
# trade the top n asset(s) | |
# if the rank of last period is less than or equal to n, | |
# then I would experience the return for this month. | |
# lag the rank object by one period to avoid look ahead bias | |
lag.rank <- lag(xts.rank, k = 1, na.pad = TRUE) | |
n2 <- nrow(lag.rank[is.na(lag.rank[,1]) == TRUE]) | |
z <- max(n2, ret.fill.na) | |
# for trading the top ranked asset, replace all ranks above n | |
# with NA to set up for element wise multiplication to get | |
# the realized returns | |
lag.rank <- as.matrix(lag.rank) | |
lag.rank[lag.rank > n] <- NA | |
# set the element to 1 for assets ranked <= to rank | |
lag.rank[lag.rank <= n] <- 1 | |
# element wise multiplication of the | |
# 1 period return matrix and lagged rank matrix | |
mat.ret <- as.matrix(xts.ret) * lag.rank | |
# average the rows of the mat.ret to get the | |
# return for that period | |
vec.ret <- rowMeans(mat.ret, na.rm = TRUE) | |
vec.ret[1:z] <- NA | |
# convert to an xts object | |
vec.ret <- xts(x = vec.ret, order.by = index(xts.ret)) | |
f <- list(mat = mat.ret, ret = vec.ret, rank = lag.rank) | |
return(f) | |
} | |
# test out the etfReplayRank function on real assets | |
library(FinancialInstrument) | |
currency("USD") | |
symbols <- c("XLY", "XLP", "XLE") | |
stock(symbols, currency="USD") | |
# new environment for symbols | |
symEnv <- new.env() | |
getSymbols(symbols, from="2012-01-01", to="2012-12-31", env=symEnv) | |
# create an xts object of monthly adjusted close prices | |
symbols.close <- do.call(merge, eapply(symEnv, MonthlyAd)) | |
# monthly returns | |
monthly.returns <- ROC(x = symbols.close, n = 1, type = "discrete", | |
na.pad = TRUE) | |
# call the ranking function | |
etf.rank <- etfReplayRank(x=symbols.close, periods=c(6, 3, 3), | |
w=c(0.4, 0.3, 0.3)) | |
# simple momentum test based on etfReplayRank | |
case1 <- SimpleMomentumTest(xts.ret = monthly.returns, xts.rank = etf.rank, | |
n = 1, ret.fill.na = 7) | |
# the SimpleMomentumTest returns a list of 3 objects | |
# you can explore them to understand the function | |
str(case1) | |
# matrix of returns | |
case1$mat | |
# matrix of rank | |
case1$rank | |
# xts vector of returns | |
case1$ret | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment