**Timely Portfolio**, and kindly contributed to R-bloggers)

When I see extremes, I feel compelled to explore. The US 10y Treasury yield is at an extreme versus the annualized 3 month CPI rate of change.

From TimelyPortfolio |

Of course, I have to try to build a system around the idea. While this 3 month CPI rate of change generates a decent signal of entry and exit for the S&P 500, it appears the 6 to 12 month rate of change works better. Let’s just use US 10y Treasury minus the lagged (since CPI released middle of following month) 9 month rate of change on CPI. If the 9 month S&P 500 rate of change exceeds this US10y-9monthCPI rate by –5%, then enter a long S&P 500 position.

From TimelyPortfolio |

Results are better than I would have expected, and the degrees of freedom are fairly robust.

From TimelyPortfolio |

From TimelyPortfolio |

I use these for illustrative purposes. In no way am I providing financial advice. You are responsible for your own profits and losses.

R code:

require(PerformanceAnalytics)

require(quantmod)

getSymbols("CPIAUCNS",src="FRED") #load CPI from Fed Fred

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

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

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

getSymbols("SP500",src="FRED") #load SP500 from Fed Fred

#fill 20y gap from discontinued 20y Treasuries with 30y

GS20["1987-01::1993-09"]<-GS30["1987-01::1993-09"]

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

#subtract the annualized 3mo ROC of CPI from US 10y

US10yMinus3moCPI<-GS10/100-((1+ROC(CPIAUCNS,3))^4-1)

chartSeries(US10yMinus3moCPI,theme="white.mono")

#get the 12 month rate of change on CPI

#subtract the lagged amount from the 10y Treasury

#I retrieved the 20y series also if you would like to use that here

#it does not make much difference

US10yMinusCPI<-GS10/100-lag(ROC(CPIAUCNS,9,type="discrete"),k=1)

signal<-ifelse(ROC(SP500,n=9)-lag(US10yMinusCPI) > -0.05,1,0)

signal<-lag(signal,k=1)

signal[is.na(signal)]<-0

SPreturn<-ROC(SP500,1,type="discrete") # 1 month SP500 rate of change

SPreturn[1]<-0

SystemReturn<-signal*SPreturn

SystemEquity<-cumprod(1+signal*SPreturn)*coredata(SP500)[1]

return_compare<-merge(SystemReturn,SPreturn)

colnames(return_compare)<-c("SP500 System based on US10y & CPI","SP500")

charts.PerformanceSummary(return_compare,ylog=TRUE,

main="Performance Comparison of SP500 and System",

colorset=c("cadetblue","darkolivegreen3"))

chartSeries(SystemEquity,theme="white.mono",log=TRUE,

TA="addTA(SP500,on=1);addTA(ROC(SP500,n=9)-lag(US10yMinusCPI))",

name="Performance Comparison of SP500 and System with Signal")

#now with some hindsight optimization to really limit the drawdown

#add an extreme upside filter and 1987 magically disappears

#don't recommend this approach but a good example

signal<-ifelse(ROC(SP500,n=9)-lag(US10yMinusCPI) > -0.05 & ROC(SP500,n=9)-lag(US10yMinusCPI) < 0.2,1,0)

signal<-lag(signal,k=1)

signal[is.na(signal)]<-0

SPreturn<-ROC(SP500,1,type="discrete") # 1 month SP500 rate of change

SPreturn[1]<-0

SystemReturn<-signal*SPreturn

SystemEquity<-cumprod(1+signal*SPreturn)*coredata(SP500)[1]

return_compare<-merge(SystemReturn,return_compare)

colnames(return_compare)[1]<-"System with Upside filter"

charts.PerformanceSummary(return_compare,ylog=TRUE,

main="Performance Comparison of SP500 and System with Upside Extreme Limit",

colorset=c("gray70","darkolivegreen3","cadetblue"))

**leave a comment**for the author, please follow the link and comment on his blog:

**Timely Portfolio**.

R-bloggers.com offers

**daily e-mail updates**about R news and tutorials on topics such as: visualization (ggplot2, Boxplots, maps, animation), programming (RStudio, Sweave, LaTeX, SQL, Eclipse, git, hadoop, Web Scraping) statistics (regression, PCA, time series, trading) and more...