Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

deleting some files

  • Loading branch information...
commit 2862831f65bf7fe86ff26c2bfd3c1d173e3ea5e3 1 parent 070933b
@rbresearch rbresearch authored
View
2  .Rhistory
@@ -1,4 +1,3 @@
-mean(boot.data)
}
b <- foreach(i=1:999, .combine=c) %dopar% {
boot.data <- sample(x, n.obs, replace=TRUE)
@@ -510,3 +509,4 @@ source('~/Documents/R Projects/Ranking/test-rank.R', echo=TRUE)
source('~/Documents/R Projects/Ranking/test-rank.R', echo=TRUE)
source('~/Documents/R Projects/Ranking/test-rank.R', echo=TRUE)
source('~/Documents/R Projects/Ranking/test-rank.R', echo=TRUE)
+source('~/Documents/R Projects/Ranking/test-rank.R', echo=TRUE)
View
73 quantstrat-rank-backtest.R
@@ -0,0 +1,73 @@
+# quantstrat-rank.R
+
+rm(list=ls())
+
+library(quantstrat)
+library(PerformanceAnalytics)
+
+# Rank.R contains functions for different ranking algorithms
+source("/Users/rossbennett/Documents/R Projects/Ranking/rank-functions/Rank.R")
+
+# monthly-fun.R contains functions for prepping monthly data
+source("/Users/rossbennett/Documents/R Projects/Ranking/rank-functions/monthly-fun.R")
+
+# qstratRank.R contains the function to run the Rank backtest using the
+# quantstrat framework
+source("/Users/rossbennett/Documents/R Projects/Ranking/rank-functions/qstratRank.R")
+
+currency("USD")
+symbols <- c("XLY", "XLP", "XLE", "AGG", "IVV")
+stock(symbols, currency="USD")
+
+# get data for the symbols
+getSymbols(symbols, from="2012-01-01", to="2012-12-31")
+
+# create an xts object of monthly adjusted close prices
+symbols.close <- monthlyPrices(symbols)
+
+# create an xts object of the symbol ranks
+sym.rank <- applyRank(x=symbols.close, rankFun=ave3ROC, n=c(2, 4, 6))
+
+# this is an important step in naming the columns, e.g. XLY.Rank
+# the "Rank" column is used as the trade signal (similar to an indicator)
+# in the qstratRank function
+colnames(sym.rank) <- gsub(".Adjusted", ".Rank", colnames(sym.rank))
+
+# ensure the order of order symbols is equal to the order of columns
+# in symbols.close
+stopifnot(all.equal(gsub(".Adjusted", "", colnames(symbols.close)), symbols))
+
+# bind the rank column to the appropriate symbol market data
+# loop through symbols, convert the data to monthly and cbind the data
+# to the rank
+for(i in 1:length(symbols)) {
+ x <- get(symbols[i])
+ x <- to.monthly(x,indexAt='lastof',drop.time=TRUE)
+ indexFormat(x) <- '%Y-%m-%d'
+ colnames(x) <- gsub("x",symbols[i],colnames(x))
+ x <- cbind(x, sym.rank[,i])
+ assign(symbols[i],x)
+}
+
+# run the backtest
+bt <- qstratRank(symbols=symbols, init.equity=100000, top.N=2,
+ max.size=1000, max.levels=1)
+
+# get trade stats
+bt.stats <- <-bt$stats
+
+# chart of returns
+charts.PerformanceSummary(bt1$returns[,"total"], geometric=FALSE,
+ wealth.index=TRUE, main="Total Performance")
+
+
+###############################################################################
+# R (http://r-project.org/) Quantitative Strategy Model Framework
+#
+# Copyright (c) 2009-2012
+# Peter Carl, Dirk Eddelbuettel, Brian G. Peterson, Jeffrey Ryan, and Joshua Ulrich
+#
+# This library is distributed under the terms of the GNU Public License (GPL)
+# for full details see the file COPYING
+#
+###############################################################################
View
0  rank-functions/.Rhistory
No changes.
View
180 rank-functions/Rank.R
@@ -0,0 +1,180 @@
+# Functions for ways to rank assets based on rate of change
+# TODO - add functions to rank based on other factors
+
+# The functions defined below depend on functions in the xts and TTR packages
+# library(TTR)
+
+##### applyRank #####
+applyRank <- function(x, rankFun, ...) {
+ # symbols : character vector of symbols
+ # rankFun : function that returns the rank
+ # rankFun should be ave3ROC, weightAve3ROC, strengthROC, strengthAve3ROC,
+ # etfReplayRank, or strengthSMA.
+ # x : xts object of prices
+ # ... : arguments to rankFun
+
+ FUN <- match.fun(rankFun)
+ FUN(x, ...)
+}
+
+##### symbolRank #####
+symbolRank <- function(symbols, rank.obj) {
+ # loop through symbols
+ # convert the market data to monthly periodicity
+ # cbind the appropriate column from rank.obj to the market data
+ # makes the assumption that the order symbols and rank.obj are equal
+
+ # symbols : character vector of symbols
+ # rank.obj : xts object of ranks of each symbol
+
+ for(i in 1:length(symbols)) {
+ x <- get(symbols[i])
+ x <- to.monthly(x,indexAt='lastof',drop.time=TRUE)
+ indexFormat(x) <- '%Y-%m-%d'
+ colnames(x) <- gsub("x", symbols[i], colnames(x))
+ x <- cbind(x, rank.obj[,i])
+ assign(symbols[i],x)
+ }
+}
+
+##### rowRank #####
+rowRank <- function(x){
+ # Computes the rank of an xts object of ranking factors
+ # ranking factors are the factors that are ranked (i.e. asset returns)
+ #
+ # x : xts object of ranking factors
+ #
+ # Returns an xts object with ranks
+ # For ranking asset returns, the asset with the greatest return
+ # receives a rank of 1
+
+ as.xts(t(apply(-x, 1, rank, na.last = "keep")))
+}
+
+#Use the supplied TTR::ROC function for a straight ROC computation
+
+##### ave3ROC #####
+ave3ROC <- function(x, n=c(1, 3, 6)){
+ # Computes the average rate of change based on averaging 3 periods
+ #
+ # x : xts object of prices
+ # n : vector of periods to use n = (period1, period2, period3)
+ # ave : xts object of asset rate of change by averaging 3 periods
+
+ roc1 <- ROC(x, n = n[1], type = "discrete")
+ roc2 <- ROC(x, n = n[2], type = "discrete")
+ roc3 <- ROC(x, n = n[3], type = "discrete")
+ ave <- (roc1 + roc2 + roc3)/3
+ rowRank(ave)
+}
+
+##### weightAve3ROC #####
+weightAve3ROC <- function(x, n = c(1, 3, 6), weights = c(1/3, 1/3, 1/3)){
+ # Computes the weighted average rate of change based on a vector of periods
+ # and a vector of weights
+ #
+ # x : xts object of prices
+ # n : vector of periods to use n = (period1, period2, period3)
+ # weights : a vector of weights for computing the weighted average
+ #
+ # Returns:
+ # xts object of weighted average asset rate of change
+
+ if((sum(weights) != 1) || (length(n) != 3) || (length(weights) != 3)){
+ stop("The sum of the weights must equal 1 and the length of n and weights must be 3")
+ } else {
+ roc1 <- ROC(x, n = n[1], type = "discrete")
+ roc2 <- ROC(x, n = n[2], type = "discrete")
+ roc3 <- ROC(x, n = n[3], type = "discrete")
+ wave <- (roc1 * weights[1] + roc2 * weights[2] + roc3 * weights[3]) / sum(weights)
+ rowRank(wave)
+ }
+}
+
+##### strengthROC #####
+strengthROC <- function(x, roc_n = 3, sd_n = 3){
+ # Computes the strength of asset returns
+ # strength is defined as ROC / SD
+ #
+ # x : xts object prices
+ # roc_n : number of periods to use for ROC
+ # sd_n : number of periods to use for runSD
+ # out : xts object of the strength of asset rate of change
+
+ roc <- ROC(x, n = roc_n, type = "discrete")
+ sd <- apply(x, 2, runSD, n = sd_n)
+ strength <- roc/sd
+ rowRank(strength)
+}
+
+ ##### strengthAve3ROC #####
+# strengthAve3ROC <- function(x, n = c(1, 3, 6), weights = c(1/3, 1/3, 1/3), sd_n = 3){
+# # Computes the strength of asset returns based on weighted average ROC
+# # strength is defined as ROC / SD
+# #
+# # x : xts object of prices
+# # n : vector of periods to use n = (period1, period2, period3)
+# # weights : a vector of weights for computing the weighted average
+# # sd_n : number of periods to use for runSD
+# # out : xts object of asset strength based on weighted average
+# # rate of change
+#
+# if((sum(weights) != 1) || (length(n) != 3) || (length(weights) != 3)){
+# stop("The sum of the weights must equal 1 and the length of n and weights must be 3")
+# } else{
+# wave <- weightAve3ROC(x, n, weights)
+# sd <- apply(x, 2, runSD, n = sd_n)
+# reclass(sd, x)
+# out <- wave$x / sd
+# rank.obj <- rowRank(out)
+# return(list(x=out, rank=rank.obj))
+# }
+# }
+
+##### etfReplayRank #####
+etfReplayRank <- function(x, n=c(1, 3, 6), w=c(0.4, 0.3, 0.3)) {
+ # function to rank assets based on the ETF Replay ranking algorithm
+ #
+ # x : xts object of close prices
+ # n : vector of n 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=n[1], type="discrete")
+ ret2 <- ROC(x, n=n[2], type="discrete")
+ tmp.ret <- ROC(x, n=1, type="discrete")
+ vol <- as.xts(apply(tmp.ret, 2, runSD, n=n[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
+}
+
+##### strengthSMA #####
+strengthSMA <- function(x) {
+ # function to rank assets based on Price, SMA, and sd of returns
+ # (Price - SMA) / sigma
+ # x : xts object of prices
+
+ ret <- ROC(x, n=1, type="discrete")
+ sigma <- apply(ret, 2, runSD, n=5)
+ sma <- apply(x, 2, SMA, n=10)
+ out <- (x - sma) / sigma
+ rowRank(out)
+}
+
+
View
43 rank-functions/backtest.R
@@ -0,0 +1,43 @@
+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)
+}
View
43 rank-functions/monthly-fun.R
@@ -0,0 +1,43 @@
+##### 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))
+}
+
+##### monthlyReturns function #####
+monthlyReturns <- function(symbols) {
+ # The function takes a character vector of symbols loaded into
+ # the environment and returns an xts object of simple returns
+ # Currently this is only for prepping monthly data
+
+ # symbols : character vector of symbols
+
+ ROC(x = monthlyPrices(symbols), n = 1, type = "discrete", na.pad = TRUE)
+}
+
+##### monthlyPrices function #####
+monthlyPrices <- function(symbols) {
+ # The function takes a character vector of symbols loaded into
+ # the environment and returns an xts object of Adjusted close prices
+ # Currently this is only for prepping monthly data
+
+ # symbols : character vector of symbols
+ # list.sym : list of symbols with market data
+
+ list.sym <- list()
+ for(i in 1:length(symbols)) {
+ list.sym[[symbols[i]]] <- get(symbols[i])
+ }
+
+ do.call(merge, lapply(list.sym, monthlyAd))
+}
View
111 rank-functions/qstratRank.R
@@ -0,0 +1,111 @@
+# qstratRank.R
+qstratRank <- function(symbols, init.equity=100000, top.N=1,
+ max.size=1000, max.levels=1) {
+ # The qstratRank function uses the quantstrat framework to backtest a
+ # ranking or relative strength strategy
+ #
+ # args
+ # symbols : character vector of symbols
+ # init.equity : initial equity
+ # top.N : trade the top N ranked assets
+ # max.size : maximum position size
+ # max.levels : maximum levels to scale in a trade
+ # max.size and max.levels are passed to addPosLimit
+ #
+ # return value
+ # returns a list: end.eq, returns, book, stats
+
+ # remove variables
+ suppressWarnings(rm("order_book.Rank", pos=.strategy))
+ suppressWarnings(rm("account.Rank", "portfolio.Rank", pos=.blotter))
+ suppressWarnings(rm("account.st", "port.st", "stock.str", "stratRank",
+ "initDate", "initEq", 'start_t', 'end_t'))
+
+
+ # set initial variables
+ initDate <- "1900-01-01"
+ initEq <- init.equity
+ port.st <- "Rank"
+ account.st <- "Rank"
+
+ # trade the top "N" ranked symbols
+ N <- top.N
+
+ # initialize quantstrat objects
+ initPortf(port.st, symbols=symbols, initDate=initDate)
+ initAcct(account.st, portfolios=port.st, initDate=initDate,initEq=initEq)
+ initOrders(portfolio=port.st, initDate=initDate)
+
+ # initialize a strategy object
+ stratRank <- strategy("Rank")
+
+ # there are two signals
+ # the first signal is when Rank is less than or equal to N
+ # (i.e. trades the #1 ranked symbol if N=1)
+ stratRank <- add.signal(strategy=stratRank, name="sigThreshold",
+ arguments=list(threshold=N, column="Rank",
+ relationship="lte", cross=FALSE),
+ label="Rank.lte.N")
+
+ # the second signal is when Rank is greter than or equal to N
+ # (i.e. trades the #1 ranked symbol if N=1)
+ stratRank <- add.signal(strategy=stratRank, name="sigThreshold",
+ arguments=list(threshold=N, column="Rank",
+ relationship="gt", cross=FALSE),
+ label="Rank.gt.N")
+
+ # add buy rule
+ stratRank <- add.rule(strategy=stratRank, name='ruleSignal',
+ arguments = list(sigcol="Rank.lte.N", sigval=TRUE,
+ orderqty=max.size, ordertype='market',
+ orderside='long', pricemethod='market',
+ replace=FALSE, osFUN=osMaxPos),
+ type='enter', path.dep=TRUE)
+
+ # add exit rule
+ stratRank <- add.rule(strategy = stratRank, name='ruleSignal',
+ arguments = list(sigcol="Rank.gt.N", sigval=TRUE,
+ orderqty='all', ordertype='market',
+ orderside='long', pricemethod='market',
+ replace=FALSE),
+ type='exit', path.dep=TRUE)
+
+ #set max position size and levels
+ for(symbol in symbols){ addPosLimit(port.st, symbol, initDate, max.size, max.levels) }
+
+ print("setup completed")
+
+ # apply the strategy to the portfolio
+ start_t <- Sys.time()
+ out <- try(applyStrategy(strategy=stratRank, portfolios=port.st))
+ end_t <- Sys.time()
+ print(end_t-start_t)
+
+ # update Portfolio
+ start_t <- Sys.time()
+ updatePortf(Portfolio=port.st, Dates=paste('::', as.Date(Sys.time()), sep=''))
+ end_t <- Sys.time()
+ print("trade blotter portfolio update:")
+ print(end_t - start_t)
+
+ # update account
+ updateAcct(account.st)
+
+ # update ending equity
+ updateEndEq(account.st)
+
+ # get ending equity
+ eq <- getEndEq(account.st, Sys.Date()) + initEq
+
+ # view order book to confirm trades
+ order.book <- getOrderBook(port.st)
+
+ # get trade statistics
+ stats <- tradeStats(port.st)
+
+ # portfolio returns
+ ret1 <- PortfReturns(port.st)
+ ret1$total <- rowSums(ret1, na.rm=TRUE)
+
+ return(list(end.eq=eq, returns=ret1, book=order.book, stats=stats))
+}
View
4 test-rank.R
@@ -8,8 +8,8 @@ library(FinancialInstrument)
setwd("/Users/rossbennett/Documents/R Projects/Ranking")
-source("/Users/rossbennett/Documents/R Projects/Ranking/r-functions/Rank.R")
-source("/Users/rossbennett/Documents/R Projects/Ranking/r-functions/monthly-fun.R")
+source("/Users/rossbennett/Documents/R Projects/Ranking/rank-functions/Rank.R")
+source("/Users/rossbennett/Documents/R Projects/Ranking/rank-functions/monthly-fun.R")
##### load data to use for testing #####
currency("USD")
Please sign in to comment.
Something went wrong with that request. Please try again.