Thursday, April 28, 2011

Slightly Different Use of Ralph Vince’s Leverage Space Trading Model

In honor of the press release Dow Jones Indexes To Develop, Co-Brand Index Family With LSP Partners two days ago, I thought I would show another slightly different use of Ralph Vince’s The Leverage Space Trading Model.

Using the R LSPM package, we can build a monthly system around the probProfit calculation.  This particular system will enter long when the short term (12 month) probProfit exceeds the longer term (36 month) probProfit.  It exits when the short term falls below the longer term.

From TimelyPortfolio
From TimelyPortfolio

Feel free to substitute any index.  Some of my favorites are German Dax GDAXI, Japan Nikkei N225, Korea Kospi KS11, and Signapore Straits Times STI for international testing.  Additional US testing might look at NDX, RUT, CYC, XBD, HGX, REI, DJUSBK, OSX or anything that you can think of to break it.

The results are not fantastic, but the considerable drawdown reductions is nice.  Let me know how you would improve.

R code:

#Please see au.tra.sy blog http://www.automated-trading-system.com/
#for original code and http://www.fosstrading.com for some of the
#other techniques

require(PerformanceAnalytics)
require(PApages)
require(quantmod)
require(LSPM)

tckr<-"^GSPC"

start<-"1929-01-01"
end<- format(Sys.Date(),"%Y-%m-%d") # yyyy-mm-dd

# Pull tckr index data from Yahoo! Finance
getSymbols(tckr, from=start, to=end)

GSPC<-adjustOHLC(GSPC,use.Adjusted=T)

GSPC<-to.monthly(GSPC)
rtn<-monthlyReturn(GSPC[,4])
# Define JPT function
jointProbTable <- function(x, n=3, FUN=median, ...) {
  # handle case with no negative returns; use -0.01
  for (sys in 1:numsys) {
      if (min(x[,sys])> -1) x[,sys][which.min(x[,sys])]<- -0.01
  }
  # Function to bin data
  quantize <- function(x, n, FUN=median, ...) {
    if(is.character(FUN)) FUN <- get(FUN)
    bins <- cut(x, n, labels=FALSE)
    res <- sapply(1:NROW(x), function(i) FUN(x[bins==bins[i]], ...))
  }
  # Allow for different values of 'n' for each system in 'x'
  if(NROW(n)==1) {
    n <- rep(n,NCOL(x))
  } else
  if(NROW(n)!=NCOL(x)) stop("invalid 'n'")
  # Bin data in 'x'
  qd <- sapply(1:NCOL(x), function(i) quantize(x[,i],n=n[i],FUN=FUN,...))
  # Aggregate probabilities
  probs <- rep(1/NROW(x),NROW(x))
  res <- aggregate(probs, by=lapply(1:NCOL(qd), function(i) qd[,i]), sum)
  # Clean up output, return lsp object
  colnames(res) <- colnames(x)
  res <- lsp(res[,1:NCOL(x)],res[,NCOL(res)])
  return(res)
}

# I know there are prettier ways to accomplish
# but I have to live within my limits

numsys<-1
numbins<-12

# Set Walk-Forward parameters (number of periods) for short
optim<-9 # 9 monthly returns
wf<-1 #walk forward 1 month; we'll set horizon separately
# Calculate number of WF cycles
numCycles = floor((nrow(rtn)-optim)/wf)

for (i in 0:(numCycles-1)) {
            # Define cycle boundaries
            start<-1+(i*wf)
            end<-optim+(i*wf)
            # Get returns for optimization cycle and create the JPT
            jpt <- jointProbTable(rtn[start:end,1:numsys],n=rep(numbins,numsys))
            outcomes<-jpt[[1]]
            probs<-jpt[[2]]
            port<-lsp(outcomes,probs)
            profitProb<-probProfit(port,target=0,horizon=6)
        profitProbWF<-c(rep(1,wf)) %o% profitProb
        maxLossWF<-c(rep(1,wf)) %o% jpt$maxLoss
        #make xts
        profitProbWF<-xts(profitProbWF,order.by=index(rtn[(end+1):(end+wf)]))
        maxLossWF<-xts(maxLossWF,order.by=index(rtn[(end+1):(end+wf)]))

            if (i==0) profitProbHistory<-profitProbWF else profitProbHistory<-rbind(profitProbHistory,profitProbWF)
            if (i==0) maxLossHistory<-maxLossWF else maxLossHistory<-rbind(maxLossHistory,maxLossWF)       
}

# Set Walk-Forward parameters (number of periods) for long
optim<-30 # 30 monthly returns
wf<-1 #walk forward 1 month; we'll set horizon separately
# Calculate number of WF cycles
numCycles = floor((nrow(rtn)-optim)/wf)

for (i in 0:(numCycles-1)) {
            # Define cycle boundaries
            start<-1+(i*wf)
            end<-optim+(i*wf)
            # Get returns for optimization cycle and create the JPT
            jpt <- jointProbTable(rtn[start:end,1:numsys],n=rep(numbins,numsys))
            outcomes<-jpt[[1]]
            probs<-jpt[[2]]
            port<-lsp(outcomes,probs)
            profitProb<-probProfit(port,target=0,horizon=3)
        profitProbWF<-c(rep(1,wf)) %o% profitProb
        maxLossWF<-c(rep(1,wf)) %o% jpt$maxLoss
        #make xts
        profitProbWFlong<-xts(profitProbWF,order.by=index(rtn[(end+1):(end+wf)]))
        maxLossWFlong<-xts(maxLossWF,order.by=index(rtn[(end+1):(end+wf)]))

            if (i==0) profitProbHistorylong<-profitProbWFlong else profitProbHistorylong<-rbind(profitProbHistorylong,profitProbWFlong)
            if (i==0) maxLossHistorylong<-maxLossWFlong else maxLossHistorylong<-rbind(maxLossHistorylong,maxLossWFlong)       
}

signalshortterm<-profitProbHistory
#adjust the long term with maxLoss to hopefully reduce drawdown
signallongterm<-profitProbHistorylong - maxLossHistorylong

chartSeries(signalshortterm,TA="addTA(signallongterm,on=1)", theme="white", name="Short and Long Term Probability of Profit")

# Create the signals and enter when long term is < short term
sigup <- ifelse(signallongterm < signalshortterm,1,0)

# no need for lag since signal generated from previous months]
# sigup <- lag(sigup,1) # Note k=1 implies a move *forward*

# Replace missing signals with no position
# (generally just at beginning of series)
sigup[is.na(sigup)] <- 0

#Calculate equity curves
eq_up <- cumprod(1+(rtn)*sigup)

perf_compare<-merge(sigup*rtn,rtn[(optim+1):NROW(rtn)])
colnames(perf_compare)<-c("LSPM probProfit System",tckr)

charts.PerformanceSummary(perf_compare,ylog=TRUE,legend.loc="topleft",main="LSPM probProfit System Performance Comparison")

3 comments:

  1. great example thanks very much, although still trying to figure out exactly what i'm looking at in the code and decipher everything. I did notice that the model was able to accurately exit the market in the 2000 crash and the last crash as well, and if you run from 1990 on it outperformed the market.. the big problem was the crash of '87 which had no warning signal for it. going to mess around with this some more but very helpful.. thanks

    ReplyDelete
  2. i do have a question the settings for 'optim' in the WF parameters. were those arbitrary settings?
    i noticed above that you mentioned using 12m and 36m return series as signal generator but it looks like you are using the 9m and 30m for the signals. from 1990 on it looks like a better performance using 12m/36m.

    ReplyDelete
  3. thanks so much for the great comments and questions. 12m and 36m are some of my standard settings, but you're right after testing with additional international markets, 9m and 30m seemed to generally outperform. The 1987 experience probably could be minimized with daily or weekly data. Maybe I will try weekly in a post to confirm or deny that thought and extend the example. thanks again for reading and commenting

    ReplyDelete