After the slightly unconventional use of LSPM presented in Slightly Different Use of Ralph Vince’s Leverage Space Trading Model, I thought I should follow up with something that more closely resembles my interpretation of Ralph Vince’s book.

LSPM seems to work well for portfolio allocation problems. In this tactical allocation system, I will use optimal f derived in R with the LSPM package to build a portfolio with SP500, US10y, and the CRB. If we use the optimal f as our allocation to SP500 and CRB, then the results look like this.

From TimelyPortfolio |

From TimelyPortfolio |

In general, my biggest problem is applying my systems to an entire portfolio. The components are easy, but the blending is troublesome. If I apply a basic method of monthly rebalancing of the SP500 and CRB, I get something like this (not using any leverage).

From TimelyPortfolio |

SP500 component improves, but because of my 50% limit on the more mean reverting CRB, the CRB component underperforms the straight optimal f allocation.

From TimelyPortfolio |

Since most clients don’t like cash, we can fill the portfolio with bonds when there is room left over after the CRB and SP500 allocation. The total package look like this.

From TimelyPortfolio |

As always, I would like my posts to stimulate discussion and thought. The drawdown here is much more severe than I would like. Please let me know how you would improve this system.

R code:

#Please see au.tra.sy blog http://www.automated-trading-system.com/

#for original walkforward/optimize code and http://www.fosstrading.com

#for other techniques

require(PerformanceAnalytics)

require(quantmod)

require(RQuantLib)

#get bond returns to avoid proprietary data problems

#see previous timelyportfolio blogposts for explanation

#probably need to make this a function since I will be using so much

getSymbols("GS10",src="FRED") #load US Treasury 10y from Fed Fred

GS10pricereturn<-GS10 #set this up to hold price returns

GS10pricereturn[1,1]<-0

colnames(GS10pricereturn)<-"PriceReturn"

#I know I need to vectorize this but not qualified enough yet

#Please feel free to comment to show me how to do this

for (i in 1:(NROW(GS10)-1)) {

GS10pricereturn[i+1,1]<-FixedRateBondPriceByYield(yield=GS10[i+1,1]/100,issueDate=Sys.Date(),

maturityDate= advance("UnitedStates/GovernmentBond", Sys.Date(), 10, 3),

rates=GS10[i,1]/100,period=2)[1]/100-1

}

#interest return will be yield/12 for one month

GS10interestreturn<-lag(GS10,k=1)/12/100

colnames(GS10interestreturn)<-"Interest Return"

#total return will be the price return + interest return

GS10totalreturn<-GS10pricereturn+GS10interestreturn

colnames(GS10totalreturn)<-"Bond Total Return"

#get sp500 returns from FRED

getSymbols("SP500",src="FRED") #load SP500

#unfortunately cannot get substitute for proprietary CRB data

#get data series from csv file

CRB<-as.xts(read.csv("spxcrbndrbond.csv",row.names=1))[,2]

#do a little manipulation to get the data lined up on monthly basis

GS10totalreturn<-to.monthly(GS10totalreturn)[,4]

SP500<-to.monthly(SP500)[,4]

#get monthly format to yyyy-mm-dd with the first day of the month

index(SP500)<-as.Date(index(SP500))

#my CRB data is end of month; could change but more fun to do in R

CRB<-to.monthly(CRB)[,4]

index(CRB)<-as.Date(index(CRB))

#now lets merge to get asset class returns

assetROC<-na.omit(merge(ROC(SP500,type="discrete"),CRB,GS10totalreturn))

# Set Walk-Forward parameters (number of periods)

optim<-12 #1 year = 12 monthly returns

wf<-1 #walk forward 1 monthly returns

numsys<-2

# Calculate number of WF cycles

numCycles = floor((nrow(assetROC)-optim)/wf)

# Define JPT function

# this is now part of LSPM package, but fails when no negative returns

# so I still include this where I can force a negative return

jointProbTable <- function(x, n=3, FUN=median, ...) {

# Load LSPM

if(!require(LSPM,quietly=TRUE)) stop(warnings())

# handle case with no negative returns

for (sys in 1:numsys) {

if (min(x[,sys])> -1) x[,sys][which.min(x[,sys])]<- -0.03

}

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

}

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

# specify number of bins; does not seem to drastically affect results

numbins<-6

jpt <- jointProbTable(assetROC[start:end,1:numsys],n=rep(numbins,numsys))

outcomes<-jpt[[1]]

probs<-jpt[[2]]

port<-lsp(outcomes,probs)

# DEoptim parameters (see ?DEoptim)

np=numsys*10 # 10 * number of mktsys

imax=1000 #maximum number of iterations

crossover=0.6 #probability of crossover

NR <- NROW(port$f)

DEctrl <- list(NP=np, itermax=imax, CR=crossover, trace=TRUE)

# Optimize f

res <- optimalf(port, control=DEctrl)

# use upper to restrict to a level that you might feel comfortable

#res <- optimalf(port, control=DEctrl, lower=rep(0,13), upper=rep(0.2,13))

# these are other possibilities but I gave up after 24 hours

#maxProbProfit from Foss Trading

#res<-maxProbProfit(port, 1e-6, 6, probDrawdown, 0.1, DD=0.2, control=DEctrl)

#probDrawdown from Foss Trading

#res<-optimalf(port,probDrawdown,0.1,DD=0.2,horizon=6,control=DEctrl)

# Save leverage amounts as optimal f

# Examples in the book Ralph Vince Leverage Space Trading Model

# all in dollar terms which confuses me

# until I resolve I changed lev line to show optimal f output

lev<-res$f[1:numsys]

#lev<-c(res$f[1]/(-jpt$maxLoss[1]/10),res$f[2]/(-jpt$maxLoss[2]/10))

levmat<-c(rep(1,wf)) %o% lev #so that we can multiply with the wfassetROC

# Get the returns for the next Walk-Forward period

wfassetROC <- assetROC[(end+1):(end+wf),1:numsys]

wflevassetROC <- wfassetROC*levmat #apply leverage to the returns

if (i==0) fullassetROC<-wflevassetROC else fullassetROC<-rbind(fullassetROC,wflevassetROC)

if (i==0) levered<-levmat else levered<-rbind(levered,levmat)

}

#not super familiar with xts, but this add dates to levered

levered<-xts(levered,order.by=index(fullassetROC) )

colnames(levered)<-c("sp500 optimal f","crb optimal f")

chart.TimeSeries(levered, legend.loc="topleft", cex.legend=0.6)

#review the optimal f values

#I had to fill the window to my screen to avoid a error from R on margins

par(mfrow=c(numsys,1))

for (i in 1:numsys) {

chart.TimeSeries(levered[,i],xlab=NULL)

}

#charts.PerformanceSummary(fullassetROC, ylog=TRUE, main="Performance Summary with Optimal f Applied as Allocation")

assetROCAnalyze<-merge(assetROC,fullassetROC)

colnames(assetROCAnalyze)<-c("sp500","crb","US10y","sp500 f","crb f")

charts.PerformanceSummary(assetROCAnalyze,ylog=TRUE,main="Performance Summary with Optimal f Applied as Allocation")

#build a portfolio with sp500 and crb

leveredadjust<-levered

#allow up to 50% allocation in CRB

leveredadjust[,2]<-ifelse(levered[,2]<0.25,0,0.5)

#allow up to 100% allocation in SP500 but portfolio constrained to 1 leverage

leveredadjust[,1]<-ifelse(levered[,1]<0.25,0,1-levered[,2])

colnames(leveredadjust)<-c("sp500 portfolio allocation","crb portfolio allocation")

assetROCadjust<-merge(assetROCAnalyze,leveredadjust[,1:2]*assetROC[,1:2])

colnames(assetROCadjust)<-c("sp500","crb","US10y","sp500 f","crb f","sp500 system component","crb system component")

charts.PerformanceSummary(assetROCadjust,ylog=TRUE)

#review the allocations versus optimal f

#I had to fill the window to my screen to avoid a error from R on margins

par(mfrow=c(numsys,1))

for (i in 1:numsys) {

chart.TimeSeries(merge(levered[,i],leveredadjust[,i]),xlab=NULL,legend.loc="topleft",main="")

}

#add bonds when out of sp500 or crb

assetROCportfolio<-assetROCadjust[,6]+assetROCadjust[,7]+ifelse(leveredadjust[,1]+leveredadjust[,2] >= 1,0,(1-leveredadjust[,1]-leveredadjust[,2])*assetROC[,3])

assetROCadjust<-merge(assetROCAnalyze,assetROCportfolio)

colnames(assetROCadjust)<-c("sp500","crb","US10y","sp500 f","crb f","system portfolio")

charts.PerformanceSummary(assetROCadjust[,c(1:3,6)],ylog=TRUE,main="Optimal f System Portfolio with Bond Filler")