#start exploring Buffett's cash as a call option #as described in #http://www.theglobeandmail.com/globe-investor/investment-ideas/streetwise/for-warren-buffett-the-cash-option-is-priceless/article4565468/ require(latticeExtra) require(directlabels) require(reshape2) require(quantmod) require(PerformanceAnalytics) #get sp500 for first attempt getSymbols("SP500", src="FRED") SP500.monthly <- to.monthly(SP500)[,4] index(SP500.monthly) <- as.Date(index(SP500.monthly)) roc <- ROC(SP500.monthly, n = 1, type = "discrete") #get 1 year t-bill for risk-free getSymbols("GS1", src = "FRED") #combine the monthly SP500 return with a monthly return of GS1 1 year treasury returns <- na.omit( merge(roc, ((1+lag(GS1,1) / 100) ^ (1/12)) - 1) ) #do cumulative returns since 1960 so skip the 1950s cumreturns <- cumprod(1+returns["1960::",]) cumreturns.df <- as.data.frame(cbind(index(cumreturns),coredata(cumreturns))) colnames(cumreturns.df) <- c("Date","S&P500.Price","US1y") cumreturns.df[,"Date"] <- as.Date(cumreturns.df[,"Date"]) cumreturns.melt <- melt(cumreturns.df,id.vars=1) colnames(cumreturns.melt) <- c("Date","Index","CumulReturns") #make the cumulative return line chart with latticeExtra direct.label(asTheEconomist(xyplot(CumulReturns~Date, data = cumreturns.melt, groups=Index, main = "S&P 500 (Price Only) Compared to US 1 Year Treasury Cumulative Growth")), ,method = list("last.points",hjust=1,vjust=0,cex=1.2)) #make a barplot for comparison of cumulative returns barplot(t(table.Stats(returns["1960::",])[7,] + 1) ^ 12 - 1, beside=TRUE, ylim=c(0,0.07), names.arg=colnames(cumreturns.df)[2:3], col=theEconomist.theme()$superpose.line$col, las=1, cex.axis=0.8, main="") abline(h=0) title(main="S&P 500 (Price Only) and US 1 Year Cumulative Return Since 1960", adj=0.05,outer=TRUE,line=-2,cex.main=0.95)