[R-SIG-Finance] rule delays

Fri May 27 08:43:41 CEST 2016

Hi

I am trying to implement Harry's Connor's RSI from his book Quantative 
Trading ...

I have it working as is and have varied it to some shares in the ASX.

However, I want to pursue the idea of a fixed time (8 day) sell rule 
that takes place if the normal rule doesn't produce a sale before.

I added this rule at line 127 of the file 3. strategy.R:

add.rule(strategy.st, name = "ruleSignal",
     arguments = list(sigcol = "longExit",
     sigval = TRUE,
     orderqty = "all", delay = 691200,
     ordertype = "market",
     orderside = "long", TxnFees = txnFees,
     replace = FALSE,
     prefer = "Open"), type= "exit", path.dep = TRUE)

but it seems to have no effect.

I attach all the code. You run it in the numbered order of the files.

I wonder if anyone can help me make this sort of rule work.

----------------------------------------------------------------------------------------------------------------------------------- 

Stephen Choularton PhD, FIoD
0413 545 182
-------------- next part --------------
######### FUNCTIONS #########################

######### CONNOR SRI FUNCTIONS ##########################################

library(TTR)

# compute Connor's RSI, depends on the RSI TTR function

connorsRSI <- function(price, nRSI = 3, nStreak = 2, nPercentLookBack = 100){

	priceRSI <- RSI(price, nRSI)
	streakRSI <- RSI(computeStreak(price), nStreak)
	percents <- round(runPercentRank(x = diff(log(price)), n = 100, cumulative = FALSE, exact.multiplier = 1) * 100)
	ret <- (priceRSI + streakRSI + percents) /3
	colnames(ret) <- "connorsRSI"
	return(ret)

}

# computes a running streak of positives and negatives of price changes

computeStreak <- function(priceSeries){

	signs <- sign(diff(priceSeries))
	posDiffs <- negDiffs <- rep(0, length(signs))
	posDiffs[signs == 1] <- 1
	posDiffs[signs == -1] <- -1

	# create vector of cumulatives sums and cumulative sums not incremented during streaks. Zero out any leading NAs after na.locf
	posCum <- cumsum(posDiffs)
	posNAcum <- posCum
	posNAcum[posDiffs == 1] <- NA
	posNAcum <- na.locf(posNAcum, na.rm = FALSE)
	posNAcum[is.na(posNAcum)] <- 0
	posStreak <- posCum - posNAcum

	# repeat for negative cumulative sums
	negCum <- cumsum(negDiffs)
	negNAcum <- negCum
	negNAcum[negDiffs == -1] <- NA
	negNAcum <- na.locf(negNAcum, na.rm = FALSE)
	negNAcum[is.na(negNAcum)] <- 0
	negStreak <- negCum - negNAcum

	streak <- posStreak + negStreak
	streak <- xts(streak, order.by = index(priceSeries))

}

sigAND <- function(label, data=mktdata, columns, cross = FALSE){

	ret_sig = NULL
	colNums <- rep(0, length(columns))
	for(i in 1:length(columns)){
		colNums[i] <- match.names(columns[i], colnames(data))
	}
	ret_sig <- data[, colNums[1]]
	if(isTRUE(cross)){
		ret_sig <- diff(ret_sig) == 1
	}
	colnames(ret_sig) <- label
	return(ret_sig)
}

cumCRSI <- function(price, nCum = 2, ...) {

	CSRI <- connorsRSI(price, ...)
	out <- runSum(CSRI, nCum)
	colnames(out) <- "cumCRSI"
	out

}

###########################################################################

######### ATR ORDER SIZING FUNCTIONS #######################################

lagATR <- function(HLC, n = 14, maType, lag = 1, ...) {
	ATR <- ATR(HLC, n = n, maType = maType, ...)
	ATR <- lag(ATR, lag)
	out <- ATR$atr
	colnames(out) <- "atr"
	return(out)
}

osDollarATR <- function(orderside, tradeSize, pctATR, maxPctATR = pctATR, data, timestamp, symbol, prefer = "Open", portfolio, integerQty = TRUE, strMod = "", rebal = FALSE, ...) {

	if(tradeSize > 0 & orderside == "short") {
		tradeSize <- tradeSize * -1
	}

	pos <- getPosQty(portfolio, symbol, timestamp)
	atrString <- paste0("atr", strMod)
	atrCol <- grep(atrString, colnames(mktdata))

	if(length(atrCol) == 0) {
		stop(paste("Term", atrString, "not found in mktdata column names."))
	}

	atrTimeStamp <- mktdata[timestamp, atrCol]
	if(is.na(atrTimeStamp) | atrTimeStamp == 0){
		stop(paste("ATR corresponding to ", atrString, " is invalid at this point in time.  Add a logical operator to account for this."))
	}

	dollarATR <- pos * atrTimeStamp
	desiredDollarATR <- pctATR * tradeSize
	remainingRiskCapacity <- tradeSize * maxPctATR - dollarATR

	if(orderside == "long") {
		qty <- min(tradeSize * pctATR / atrTimeStamp, remainingRiskCapacity / atrTimeStamp)
	} else {
		qty <- max(tradeSize * pctATR / atrTimeStamp, remainingRiskCapacity / atrTimeStamp)
	}

	if(integerQty) {
		qty <- trunc(qty)
	}

	if(!rebal){
		if(orderside == "long" & qty < 0) {
			qty <- 0
		} 
		if(orderside == "short" & qty > 0){
			qty <- 0
		}
	}

	if(rebal) {
		if(pos == 0) {
			qty <- 0
		}
	}

	return (qty)
}

-------------- next part --------------
# do I need these

library(quantstrat)
library(PerformanceAnalytics)
library(blotter)
library(TTR)

# trade size and initial equity settings ???????
#tradeSize <- 10000
#initEq <- tradeSize * length(symbols)

#rm(list = ls(.blotter), envir = .blotter)
initDate = "1990-01-01"
from = "2003-01-01"
to = "2013-12-31"
#initEq = 10000

#currency("USD")
#Sys.setenv(TZ="UTC")

# suppress warnings
options("getSymbols.warning4.0" = FALSE)

# do some house cleaning
rm(list = ls(.blotter), envir = .blotter)

# set the current and time zone
#currency(primary_id = 'USD') # must be first thing specified
#Sys.setenv(TZ = "UTC")

# define the symbols of interest
symbols <- c("AMP.AX",
		"ANZ.AX",
		"BHP.AX",
		"BXB.AX",
		"CBA.AX",
		"CSL.AX",
		"IAG.AX",
		"MQG.AX",
		"NAB.AX",
		"QBE.AX",
		"RIO.AX",
		"SCG.AX",
		"SUN.AX",
		"TCL.AX",
		"TLS.AX",
		"WBC.AX",
		"WES.AX",
		"WFD.AX",
		"WOW.AX",
		"WPL.AX"
		)

# SPDR EFTs first, iShares EFT's afterwards
#if(!"XLB" %in% ls()){
	#if data is not present get it from yahoo
	suppressMessages(getSymbols(symbols, from = from, to = to, src = "yahoo", adjust = TRUE))
#}

#  define the instrument type
stock(symbols, currency = "AUD", multiplier = 1)

-------------- next part --------------
# NEED TO ADD BROKERAGE AND SLIPPAGE?

########## SETUP AND BACKTEST ###############

########### SETUP #############################

#library(quantstrat)
#library(PerformanceAnalytics)
#library(blotter)
#library(TTR)

# trade size and initial equity settings ???????
tradeSize <- 10000
initEq <- tradeSize * length(symbols)
txnFees <- tradeSize * .0008 * -1

rm(list = ls(.blotter), envir = .blotter)
#initDate = "1990-01-01"
#from = "2003-01-01"
#to = "2013-12-31"
#initEq = 10000

currency("AUD")
Sys.setenv(TZ="UTC")

######## DATA SOURCE #########################################
#
# Just pasted in demoData.R at this point
#
###############################################################

#rm(list = ls("portfolio.st", "strategy.st", "account.st"))

strategy.st <- "CRSIcumStrat"
portfolio.st <- "CRSIcumStrat"
account.st <- "CRSIcumStrat"

rm.strat(portfolio.st)
rm.strat(strategy.st)

.blotter <- new.env()
.strategy <- new.env()

initPortf(portfolio.st, symbols=symbols, initDate = initDate, currency = 'USD')

initAcct(account.st, portfolios = portfolio.st, initDate = initDate, currency = 'USD', initEq = initEq)

initOrders(portfolio.st, initDate = initDate)

strategy(strategy.st, store = TRUE)

#### PARAMETERS #########################

cumThresh <- 40
exitThresh <- 75
nCum <- 2
nRSI <- 3
nStreak <- 2
nPercentLookBack <- 100
nSMA <- 200
pctATR <- .02
period <- 10

#### INDICATORS #########

add.indicator(strategy.st, name = "cumCRSI", 
	arguments = list(price = quote(Cl(mktdata)), nCum = nCum, 
	nRSI = nRSI, nStreak = nStreak, 
	nPercentLookBack = nPercentLookBack),
	label = "CRSIcum")

add.indicator(strategy.st, name = "connorsRSI",   
	arguments = list(price= quote(Cl(mktdata)), nRSI = nRSI,
	nStreak = nStreak,
	nPercentLookBack = nPercentLookBack),
	label= "CRSI")

add.indicator(strategy.st, name = "SMA", 
	arguments = list(x = quote(HLC(mktdata)), n = nSMA),
	label = "sma")

add.indicator(strategy.st, name = "lagATR",
	arguments = list(HLC = quote(HLC(mktdata)), n = period),
	label = "atrX")

test <- applyIndicators(strategy.st, mktdata = OHLC(CBA.AX))

#head(round(test, 2 ), 253)
head(round(test, 2 ), 10)

########## SIGNALS ######################

add.signal(strategy.st, name = "sigThreshold",
	arguments = list(column = "cumCRSI.CRSIcum",
	threshold = cumThresh, relationship = "lt", cross = FALSE),
	label = "cumCRSI.lt.thresh")

add.signal(strategy.st, name = "sigComparison",
	arguments = list(columns = c("Close", "SMA.sma"),
	realtionship = "gr"), label = "Cl.gt.SMA")

add.signal(strategy.st, name = "sigAND",
	arguments = list(columns = c("cumCRSI.lt.thresh",
	"Cl.gt.SMA"), cross = TRUE), label = "longEntry")

add.signal(strategy.st, name = "sigThreshold",
	arguments = list(column = "connorsRSI.CRSI",
	threshold = exitThresh, relationship = "gt",
	cross = TRUE), label = "longExit")

########## RULES ################################

add.rule(strategy.st, name = "ruleSignal",
	arguments = list(sigcol = "longEntry", 
	sigval = TRUE, ordertype = "market",
	orderside = "long", TxnFees = txnFees, replace = FALSE,
	prefer = "Open", osFUN = osDollarATR,
	tradeSize = tradeSize, pctATR= pctATR,
	atrMod = "X"), type = "enter", path.dep = TRUE)

add.rule(strategy.st, name = "ruleSignal",
	arguments = list(sigcol = "longExit",
	sigval = TRUE,
	orderqty = "all", delay = 691200,
	ordertype = "market",
	orderside = "long", TxnFees = txnFees,
	replace = FALSE, 
	prefer = "Open"), type= "exit", path.dep = TRUE)

add.rule(strategy.st, name = "ruleSignal",
	arguments = list(sigcol = "longExit",
	sigval = TRUE,
	orderqty = "all",
	ordertype = "market",
	orderside = "long", TxnFees = txnFees,
	replace = FALSE,
	prefer = "Open"), type= "exit", path.dep = TRUE)

######### APPLY #########################################

	t1 <- Sys.time()
	out <- applyStrategy(strategy = strategy.st, 
		portfolio = portfolio.st)
	t2 <- Sys.time()
	print(t2 - t1)

-------------- next part --------------

######### ANALYTICS ######################################

updatePortf(portfolio.st)
dateRange <- time(getPortfolio(portfolio.st)$summary)[-1]
updateAcct(portfolio.st, dateRange)
updateEndEq(account.st)

tStats <- tradeStats(Portfolios = portfolio.st, use = "trades", inclZeroDays = FALSE)
tStats[ ,4:ncol(tStats)] <- round(tStats[ ,4:ncol(tStats)], 2)
print(data.frame(t(tStats[ ,-c(1,2)])))

######### EVALUATE #####################################

aggPF <- sum(tStats$Gross.Profits) / - sum(tStats$Gross.Losses)
aggCorrect <- mean(tStats$Percent.Positive)
numTrades <- sum(tStats$Num.Trades)
meanAvgWLR <- mean(tStats$Avg.WinLoss.Ratio[tStats$Avg.WinLoss.Ratio < Inf], na.rm = TRUE)

# win to lose ratio
aggPF

#proportion winning trades
aggCorrect

#number of trades
numTrades

meanAvgWLR

############ GENERAL PERFORMANCE ################################

dStats <- dailyStats(Portfolios = portfolio.st, use = "Equity")
rownames(dStats) <- gsub(".DailyEndEq", "", rownames(dStats))
print(data.frame(t(dStats)))

############ ANALYTICS RELATING TO DURATION ######################

durationStatistics <- function(Portfolio, Symbols, includeOpenTrade = FALSE, ...){

	tmp <- list()
	length(tmp) <- length(Symbols)
	for(Symbol in Symbols){

		pts <- perTradeStats(Portfolio = Portfolio, Symbol = Symbol, includeOpenTrade = includeOpenTrade)
		pts$diff <- pts$End - pts$Start

		durationSummary <- summary(as.numeric(pts$diff))
		winDurationSummary <- summary(as.numeric(pts$diff[pts$Net.Trading.PL > 0]))
		lossDurationSummary <- summary(as.numeric(pts$diff[pts$Net.Trading.PL <= 0]))
		names(durationSummary) <- c("Min", "Q1", "Med", "Mean", "Q3", "Max")
		names(winDurationSummary) <- c("Min", "Q1", "Med", "Mean", "Q3", "Max")
		names(lossDurationSummary) <- c("Min", "Q1", "Med", "Mean", "Q3", "Max")
		names(winDurationSummary) <- paste0("W", names(winDurationSummary))
		names(lossDurationSummary) <- paste0("L", names(lossDurationSummary))

		dataRow <- data.frame(cbind(t(round(durationSummary)),
			t(round(winDurationSummary)),
			t(round(lossDurationSummary))))
		tmp[[Symbol]] <- dataRow

	}

	out <- do.call(rbind, tmp)
	return(out)

}

durStats <- durationStatistics(Portfolio = portfolio.st, Symbols=sort(symbols))
print(t(durStats))

############ MARKET EXPOSURE ##################################

tmp <- list()
length(tmp) <- length(symbols)
for(i in 1:nrow(dStats)){
	totalDays <- nrow(get(rownames(dStats)[i]))
	mktExposure <- dStats$Total.Days[i] / totalDays
	tmp[[i]] <- c(rownames(dStats)[i], round(mktExposure, 3))
}
mktExposure <- data.frame <-(do.call(rbind, tmp))
colnames(mktExposure) <- c("Symbol", "MktExposure")

print(mktExposure)

print(mean(as.numeric(mktExposure[ , 2])))

######### CHART AND STATS ###############################

instRate <- PortfReturns(account.st)

portfRets <- xts(rowMeans(instRate) * ncol(instRate), order.by = index(instRate))
cumPortfRets <- cumprod(1 + portfRets)
firstNonZeroDay <- as.character(index(portfRets)[min(which(portfRets != 0))])

# obtain symbol
getSymbols("^AXJO", from = firstNonZeroDay, to = to)
#getSymbols("SPY", from = from, to = to)
AXJOrets <- diff(log(Cl(AXJO)))[-1]
cumAXJOrets <- cumprod(1 + AXJOrets)
comparison <- cbind(cumPortfRets, cumAXJOrets)
colnames(comparison) <- c("Connors RSI trend following strategy", "SPI")

chart.TimeSeries(comparison, legend.loc = "topleft")

##################### CALCULATE THE RISK METRICS ##########################

SharpeRatio.annualized(portfRets)

Return.annualized(portfRets)

maxDrawdown(portfRets)

# win to lose ratio
aggPF

#proportion winning trades
aggCorrect

#number of trades
numTrades

meanAvgWLR

################### EQUITY CURVE OF XLB ##################################

#chart.Posn(portfolio.st, "XLB")