newguy — Jul 30, 2013, 10:47 PM
require(quantmod)# make sure you have library installed
Loading required package: quantmod
Loading required package: Defaults
Loading required package: xts
Loading required package: zoo
Attaching package: 'zoo'
The following object(s) are masked from 'package:base':
as.Date, as.Date.numeric
Loading required package: TTR
Version 0.4-0 included new data defaults. See ?getSymbols.
getSymbols(c("VWESX","VFINX"), src='yahoo', from="1990-01-01")#dnld data
As of 0.4-0, 'getSymbols' uses env=parent.frame() and auto.assign=TRUE by
default.
This behavior will be phased out in 0.5-0 when the call will default to
use auto.assign=FALSE. getOption("getSymbols.env") and
getOptions("getSymbols.auto.assign") are now checked for alternate
defaults
This message is shown once per session and may be disabled by setting
options("getSymbols.warning4.0"=FALSE). See ?getSymbol for more details
[1] "VWESX" "VFINX"
VWESX<-VWESX[,"VWESX.Adjusted"]# only need adjusted price column
VFINX<-VFINX[,"VFINX.Adjusted"]
VWESX<-dailyReturn(VWESX)#convert to daily returns
VFINX<-dailyReturn(VFINX)
data<-merge.xts(VWESX,VFINX) # put data in one object
rm(VFINX) # remove old data
rm(VWESX)
data<-merge(data,0,0,0,0,0,0,0,0,0,0,0,0) # add dummy columns
names(data)<-c("vwesxRet","vfinxRet",
"vwesxBal0", "vfinxBal0", "bal0", "pct0",
"vwesxBal1", "vfinxBal1", "bal1", "pct1",
"vwesxBal2", "vfinxBal2", "bal2", "pct2") # rename columns
data[1,"vwesxBal0"]=0.3 # init values to 30/70%
data[1,"vfinxBal0"]=0.7
data[1,"bal0"]=1.0
data[1,"pct0"]=0.3
data[1,"vwesxBal1"]=0.3
data[1,"vfinxBal1"]=0.7
data[1,"bal1"]=1.0
data[1,"pct1"]=0.3
data[1,"vwesxBal2"]=0.3
data[1,"vfinxBal2"]=0.7
maxBal = minBal = data[1,"vfinxBal2"] # max min stock balance so far
stockAlloc = 0.7 #current alloc, will change with stops
data[1,"bal2"]=1.0
data[1,"pct2"]=0.3
dates<-index(data)#save dates
years = as.numeric(end(data) - start(data))/365.25
data<-coredata(data)#remove dates for speed, convert to matrix
for(i in 2:length(data[,1])){
#calc the no rebal series
data[i,"vwesxBal0"]=data[i-1,"vwesxBal0"]*(1+data[i,"vwesxRet"])
data[i,"vfinxBal0"]=data[i-1,"vfinxBal0"]*(1+data[i,"vfinxRet"])
data[i,"bal0"]=data[i,"vfinxBal0"]+data[i,"vwesxBal0"]
data[i,"pct0"]=data[i,"vwesxBal0"]/data[i,"bal0"]
# the normal rebal series
data[i,"vwesxBal1"]=data[i-1,"vwesxBal1"]*(1+data[i,"vwesxRet"])
data[i,"vfinxBal1"]=data[i-1,"vfinxBal1"]*(1+data[i,"vfinxRet"])
data[i,"bal1"]=data[i,"vfinxBal1"]+data[i,"vwesxBal1"]
data[i,"pct1"]=data[i,"vwesxBal1"]/data[i,"bal1"]
prevPct1 = data[i-1,"pct1"]
if(prevPct1 > 0.35 | prevPct1 < 0.25 ){
data[i,"vwesxBal1"]=data[i,"bal1"]*0.3
data[i,"vfinxBal1"]=data[i,"bal1"]*0.7
}
# the stop rebal series
data[i,"vwesxBal2"]=data[i-1,"vwesxBal2"]*(1+data[i,"vwesxRet"])
data[i,"vfinxBal2"]=data[i-1,"vfinxBal2"]*(1+data[i,"vfinxRet"])
data[i,"bal2"]=data[i,"vfinxBal2"]+data[i,"vwesxBal2"]
data[i,"pct2"]=data[i,"vwesxBal2"]/data[i,"bal2"]
#if stocks gained as of yesterday
if ((as.numeric(data[i-1,"vfinxBal2"]/minBal) > 1.1) |
(as.numeric(data[i-1,"vfinxBal2"]/maxBal) < 0.9))
{
if(as.numeric(data[i-1,"vfinxBal2"]/minBal) > 1.1){
# stocks up yesterday so rebal to new stock pct at today's price
stockAlloc = min(stockAlloc+0.1,0.8) #max of 80%
data[i,"vwesxBal2"]=data[i,"bal2"]*(1-stockAlloc)
data[i,"vfinxBal2"]=data[i,"bal2"]*stockAlloc
}
#if stocks dropped
if(as.numeric(data[i-1,"vfinxBal2"]/maxBal) < 0.9){
# stocks dn so rebal
stockAlloc = max(stockAlloc-0.1, 0.2) #min of 20%
data[i,"vwesxBal2"]=data[i,"bal2"]*(1-stockAlloc)
data[i,"vfinxBal2"]=data[i,"bal2"]*stockAlloc
}
maxBal=minBal=data[i,"vfinxBal2"]
}
maxBal = max(maxBal,data[i,"vfinxBal2"]) # new max balance
minBal = min(minBal,data[i,"vfinxBal2"])
}
cagr<-c(
((data[length(data[,1]),"vwesxBal0"] - data[1,"vwesxBal0"])/data[1,"vwesxBal0"])^(1/years)-1,
((data[length(data[,1]),"vfinxBal0"] - data[1,"vfinxBal0"])/data[1,"vfinxBal0"])^(1/years)-1,
(data[length(data[,1]),"bal0"] - data[1,"bal0"])^(1/years)-1,
(data[length(data[,1]),"bal1"] - data[1,"bal1"])^(1/years)-1,
(data[length(data[,1]),"bal2"] - data[1,"bal2"])^(1/years)-1)
data<-xts(data,order.by = dates)#convert back to xts
returns<-merge.xts(
annualReturn(data$vwesxBal0),
annualReturn(data$vfinxBal0),
annualReturn(data$bal0),
annualReturn(data$bal1),
annualReturn(data$bal2))
names(returns)<-c("bonds", "stocks", "no rebal","rebal","stop")
stdDev<-apply(returns, 2, sd)
names(cagr)<-names(returns)
sharpe = cagr/stdDev
#plots
colors=c("red","green","blue")
plot.zoo(as.xts(merge(data$bal0,data$bal1,data$bal2)),
plot.type="single", col=colors, xlab="", ylab="balance")
grid()
legend("topleft", lty=c(1), lwd=c(2), col=colors, names(cagr)[-c(1,2)])
plot.zoo(as.xts(merge(data$pct0,data$pct1,data$pct2)),
plot.type="single", col=colors, xlab="", ylab="Percent Bonds")
grid()
legend("topleft", lty=c(1), lwd=c(2), col=colors, names(cagr)[-c(1,2)])
barplot(rbind(cagr,stdDev), beside=TRUE, col=c("grey","beige"))
legend("topleft",c("CAGR","StdDev"), fill=c("grey","beige"))
barplot(returns[,-c(1,2)], beside=TRUE, names.arg=format(index(returns),"%Y"),
col=colors, main = "Annual returns")
legend("bottomleft", names(returns)[-c(1,2)], fill=colors)
plot.zoo(merge.xts(data$bal2-data$bal1,data$bal2-data$bal0,data$bal1-data$bal0),
screen=1,col=colors, xlab="", ylab="Outperformace", main="Difference in balance among strategies")
grid()
legend("topleft", lty=c(1), lwd=c(2), col=colors, c("stop - rebal", "stop - none", "rebal - none"))
#tables
require(xtable)
Loading required package: xtable
cat("<style type = 'text/css'>
tr:nth-child(odd) td{background:#eeeeee}
td {width:90px}
th {text-align:right}
</style>\n",file="tbl.html")
tbl<-xtable(as.data.frame(returns))
digits(tbl)<-c(0,4,4,4,4,4)
caption(tbl)<-"Annual Returns"
print(tbl, type="html", file="tbl.html", append = TRUE, caption.placement = "top",
html.table.attributes="style = 'border-collapse:collapse'")
stats<-rbind(stdDev,cagr,sharpe)
cat("<br>", file="tbl.html", append = TRUE)
tbl<-xtable(stats)
digits(tbl)<-c(0,4,4,4,4,4)
caption(tbl)<-"Summary Statistics"
print(tbl, type="html", file="tbl.html", append = TRUE, caption.placement = "top",
html.table.attributes="style = 'border-collapse:collapse'")
Annual Returns
bonds stocks no rebal rebal stop
1990-12-31 0.0629 -0.0506 -0.0165 -0.0165 -0.0181
1991-12-31 0.2071 0.3021 0.2713 0.2713 0.2806
1992-12-31 0.0980 0.0822 0.0871 0.0871 0.0854
1993-12-31 0.1473 0.0912 0.1087 0.1087 0.1026
1994-12-30 -0.0545 0.0117 -0.0096 -0.0096 -0.0014
1995-12-29 0.2675 0.3746 0.3417 0.3417 0.3529
1996-12-31 0.0130 0.2287 0.1661 0.1668 0.1842
1997-12-31 0.1378 0.3317 0.2828 0.2731 0.2897
1998-12-31 0.0930 0.2861 0.2429 0.2311 0.2308
1999-12-31 -0.0619 0.2109 0.1572 0.1289 0.1478
2000-12-29 0.1181 -0.0905 -0.0572 -0.0304 -0.0517
2001-12-31 0.0958 -0.1204 -0.0795 -0.0481 -0.0369
2002-12-31 0.1345 -0.2217 -0.1415 -0.1223 0.0056
2003-12-31 0.0652 0.2849 0.2196 0.2203 0.1893
2004-12-31 0.0853 0.1074 0.1016 0.1022 0.1025
2005-12-30 0.0513 0.0477 0.0486 0.0488 0.0486
2006-12-29 0.0293 0.1564 0.1238 0.1179 0.1301
2007-12-31 0.0379 0.0540 0.0502 0.0495 0.0517
2008-12-31 0.0228 -0.3703 -0.2790 -0.2643 -0.2038
2009-12-31 0.0878 0.2652 0.2068 0.2110 0.1933
2010-12-31 0.1026 0.1491 0.1353 0.1363 0.1426
2011-12-30 0.1737 0.0196 0.0640 0.0719 0.0522
2012-12-31 0.1163 0.1582 0.1449 0.1456 0.1512
2013-07-30 -0.0663 0.1951 0.1140 0.1177 0.1397
Summary Statistics
bonds stocks no rebal rebal stop
stdDev 0.0802 0.1823 0.1429 0.1357 0.1244
cagr 0.0725 0.0831 0.0801 0.0840 0.0970
sharpe 0.9032 0.4558 0.5609 0.6191 0.7794
#Esimated percent rebal bonus X1X2(Var1/2 + Var2/2 - Covar1,2)
# from http://www.efficientfrontier.com/ef/996/rebal.htm
est<-0.7*0.3*(var(returns$bonds)/2+var(returns$stocks)/2-cov(returns$bonds,returns$stocks))*100
#Actual rebalancing bonus
actual<-(cagr[4]-cagr[3])*100
cat("estimated %->", est, "actual %->", actual, "diff->",actual-est)
estimated %-> 0.3603 actual %-> 0.3897 diff-> 0.02945
#Pretty good prediction but not much of a bonus
