[R-SIG-Finance] rule delays

Stephen Choularton stephen at organicfoodmarkets.com.au
Fri May 27 08:43:41 CEST 2016

```Hi

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

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:

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") {
}

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

if(length(atrCol) == 0) {
}

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
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 ???????

#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 ???????
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 #########

arguments = list(price = quote(Cl(mktdata)), nCum = nCum,
nRSI = nRSI, nStreak = nStreak,
nPercentLookBack = nPercentLookBack),
label = "CRSIcum")

arguments = list(price= quote(Cl(mktdata)), nRSI = nRSI,
nStreak = nStreak,
nPercentLookBack = nPercentLookBack),
label= "CRSI")

arguments = list(x = quote(HLC(mktdata)), n = nSMA),
label = "sma")

arguments = list(HLC = quote(HLC(mktdata)), n = period),
label = "atrX")

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

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

arguments = list(column = "cumCRSI.CRSIcum",
threshold = cumThresh, relationship = "lt", cross = FALSE),
label = "cumCRSI.lt.thresh")

arguments = list(columns = c("Close", "SMA.sma"),
realtionship = "gr"), label = "Cl.gt.SMA")

arguments = list(columns = c("cumCRSI.lt.thresh",
"Cl.gt.SMA"), cross = TRUE), label = "longEntry")

arguments = list(column = "connorsRSI.CRSI",
threshold = exitThresh, relationship = "gt",
cross = TRUE), label = "longExit")

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

arguments = list(sigcol = "longEntry",
sigval = TRUE, ordertype = "market",
orderside = "long", TxnFees = txnFees, replace = FALSE,
prefer = "Open", osFUN = osDollarATR,
atrMod = "X"), type = "enter", path.dep = TRUE)

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)

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[ ,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)
meanAvgWLR <- mean(tStats\$Avg.WinLoss.Ratio[tStats\$Avg.WinLoss.Ratio < Inf], na.rm = TRUE)

# win to lose ratio
aggPF

aggCorrect

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\$diff <- pts\$End - pts\$Start

durationSummary <- summary(as.numeric(pts\$diff))
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

aggCorrect