[Returnanalytics-commits] r3194 - in pkg/PortfolioAnalytics/sandbox/symposium2013: . docs

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sat Sep 28 21:01:52 CEST 2013


Author: peter_carl
Date: 2013-09-28 21:01:51 +0200 (Sat, 28 Sep 2013)
New Revision: 3194

Modified:
   pkg/PortfolioAnalytics/sandbox/symposium2013/analyze.HFindexes.R
   pkg/PortfolioAnalytics/sandbox/symposium2013/docs/symposium-slides-2013.Rmd
   pkg/PortfolioAnalytics/sandbox/symposium2013/optimize.HFindexes.R
   pkg/PortfolioAnalytics/sandbox/symposium2013/results.HFindexes.R
Log:
- several new slides and graphs
- modified RP to make more accurate portfolios
- modified buoy constraints per Ross' suggestions
- issue comparing RP to closed form solutions


Modified: pkg/PortfolioAnalytics/sandbox/symposium2013/analyze.HFindexes.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/symposium2013/analyze.HFindexes.R	2013-09-26 20:52:57 UTC (rev 3193)
+++ pkg/PortfolioAnalytics/sandbox/symposium2013/analyze.HFindexes.R	2013-09-28 19:01:51 UTC (rev 3194)
@@ -191,17 +191,19 @@
 # --------------------------------------------------------------------
 # ETL parameterization charts
 # --------------------------------------------------------------------
-  # @TODO: make these y-axes match?
-# source('~/devel/R/returnanalytics/pkg/PerformanceAnalytics/R/chart.VaRSensitivity.R')
+# Requires a recent modification to the chart in PerformanceAnalytics to make the y-axes match; in  revision 3191
+source('./R/chart.VaRSensitivity.R')
 png(filename=paste(resultsdir, dataname, "-ETL-sensitivity.png", sep=""), units="in", height=5.5, width=9, res=96)
 op <- par(no.readonly = TRUE)
 layout(matrix(c(1:8), nrow=2))
 par(mar = c(4, 4, 5, 2)+0.1) #c(bottom, left, top, right)
 for(i in 1:NCOL(R)){
-  chart.VaRSensitivity(R[,i], methods=c("ModifiedES","HistoricalES", "GaussianES"), legend.loc=NULL, clean=clean, colorset=c("orange", "black", "darkgray"), lty=c(3,1,2), lwd=3, main=R.names[i], ylim=c(-0.09,0), ylab="Expected Tail Loss")
+  chart.VaRSensitivity(R[,i], methods=c("ModifiedES","HistoricalES", "GaussianES"), legend.loc=NULL, clean=clean, colorset=c("orange", "black", "darkgray"), lty=c(2,1,2), lwd=3, main=R.names[i], ylim=c(-0.09,0), ylab="Expected Tail Loss")
   abline(v = 1-1/12, col = "red", lty = 2, lwd=1)
 }
   plot.new()
-  legend("center", legend=c("Modified \nETL","Historical \nETL", "Gaussian \nETL"), lty=c(3,1,2), lwd=3, col=c("orange", "black", "darkgray"), cex=1.2, y.intersp=2)
+  legend("center", legend=c("Modified \nETL","Historical \nETL", "Gaussian \nETL"), lty=c(2,1,2), lwd=3, col=c("orange", "black", "darkgray"), cex=1.2, y.intersp=2)
 par(op)
-dev.off()
\ No newline at end of file
+dev.off()
+  
+  
\ No newline at end of file

Modified: pkg/PortfolioAnalytics/sandbox/symposium2013/docs/symposium-slides-2013.Rmd
===================================================================
--- pkg/PortfolioAnalytics/sandbox/symposium2013/docs/symposium-slides-2013.Rmd	2013-09-26 20:52:57 UTC (rev 3193)
+++ pkg/PortfolioAnalytics/sandbox/symposium2013/docs/symposium-slides-2013.Rmd	2013-09-28 19:01:51 UTC (rev 3194)
@@ -181,7 +181,7 @@
 \includegraphics[width=1.0\textwidth]{../results/EDHEC-ETL-sensitivity.png}
 
 <!-- Comments:
-Modified ETL demonstrates a better fit for historical CVaR at lower confidence levels, and can break down at higher confidence levels
+Modified ETL demonstrates a better fit for historical CVaR at lower confidence levels, and can break down at higher confidence levels; 95% is fine in most cases, but lower usually works a little better; interpretation of 91.7%
 *** discuss cleaning method here 
 -->
 
@@ -239,18 +239,21 @@
 Table of Return, Volatility, Skew, Kurt, and Correlations by asset
 
 <!-- Comments:
-One of the largest challenges in optimization is improving the estimates of the moments
+* For strategic allocations, whether conventional or alternative, we want to use long-term return and risk characteristics.  
 
-For strategic allocations, whether conventional or alternative, we want to use long-term return and risk characteristics.  These estimates are not to be conditional on the current or near-term market and business cycle, but focus on the characteristics relevant to the portfolio over a long horizon.
+* These estimates are not to be conditional on the current or near-term market and business cycle, but focus on the characteristics relevant to the portfolio over a long horizon.
 
+* That said, one of the largest challenges in optimization is improving the estimates of the moments
+
 * Optimizer chooses portfolios based on forward looking estimates of risk and return based on the constituent moments
-* Usually explicitly making trade-offs between correlation and volatility among members 
+
+* In most cases explicitly making trade-offs between correlation and volatility among members 
+
 * Modified ETL extends the tradeoffs to the first four moments and co-moments
-* Historical sample moments are used here as predictors 
 
-Historical sample moments work fine in in normal market regimes, but seem to perform poorly when the market regime shifts.  
+* Historical sample moments are used here as predictors; that's fine in in normal market regimes, but seem to perform poorly when the market regime shifts.  
 
-Another thing we're not doing here is tying to put Alternatives on the same footing as asset classes with traded market prices.  So we're ignoring methods that could be used to "adjust" the returns here for known risks.
+* Another thing I'm not doing here is tying to put Alternatives on the same footing as asset classes with traded market prices.  So we're ignoring methods that could be used to "adjust" the returns here for known risks.
 
 For the purposes of this presentation, we're going to ignore this very important topic.
 *** We should discuss using some form of improved but standard method here as to not be completely stupid ***

Modified: pkg/PortfolioAnalytics/sandbox/symposium2013/optimize.HFindexes.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/symposium2013/optimize.HFindexes.R	2013-09-26 20:52:57 UTC (rev 3193)
+++ pkg/PortfolioAnalytics/sandbox/symposium2013/optimize.HFindexes.R	2013-09-28 19:01:51 UTC (rev 3194)
@@ -20,11 +20,9 @@
 
 ### Set script constants
 runname='historical.moments'
-
-# Select a rebalance period
-rebalance_period = 'quarters' # uses endpoints identifiers from xts; how to do semi-annual?
-clean = "boudt" #"none"
-permutations = 1000
+#rebalance_period = 'quarters' # uses endpoints identifiers from xts; how to do semi-annual?
+clean = "boudt" # "none" 
+permutations = 2000
 p=1-1/12 # set confidence for VaR/mETL for monthly data
 
 ### Description
@@ -89,7 +87,6 @@
 
 #------------------------------------------------------------------------
 ### Construct BUOY 1: Constrained Mean-StdDev Portfolio - using ROI
-MeanSD.portf <- init.portf
 # Add the return and sd objectives to the constraints created above
 MeanSD.portf <- add.objective(portfolio=init.portf,
                               type="return", # the kind of objective this is
@@ -133,11 +130,11 @@
 #@ - Add the sub-objectives first. Adding these 3 objectives means that we are
 #@ maximizing mean per unit StdDev with equal volatility contribution portfolios. - RB
 # Without a sub-objective, we get a somewhat undefined result, since there are (potentially) many Equal SD contribution portfolios.
+# EqSD.portf <- add.objective(portfolio=init.portf,
+#                             type="risk",
+#                             name="StdDev"
+# ) # OR
 EqSD.portf <- add.objective(portfolio=init.portf,
-                            type="risk",
-                            name="StdDev"
-) # OR
-EqSD.portf <- add.objective(portfolio=EqSD.portf,
                             type="return",
                             name="mean"
 )
@@ -148,19 +145,19 @@
                             arguments = list(clean=clean)
                             )
 
-EqSD.portf$constraints[[1]]$min_sum = 0.99 # set to speed up RP
-EqSD.portf$constraints[[1]]$max_sum = 1.01
+# EqSD.portf$constraints[[1]]$min_sum = 0.99 # set to speed up RP
+# EqSD.portf$constraints[[1]]$max_sum = 1.01
 
 ### Construct BUOY 6: Constrained Equal mETL Contribution Portfolio - using RP
 #@ Add the sub-objectives first. These should be added to the EqmETL portfolio.
 #@ All objectives below mean that we are maximizing mean return per unit ES with
 #@ equal ES contribution. - RB
 # Without a sub-objective, we get a somewhat undefined result, since there are (potentially) many Equal SD contribution portfolios.
+# EqmETL.portf <- add.objective(portfolio=init.portf,
+#                             type="risk",
+#                             name="ES"
+# ) # OR
 EqmETL.portf <- add.objective(portfolio=init.portf,
-                            type="risk",
-                            name="ES"
-) # OR
-EqmETL.portf <- add.objective(portfolio=EqmETL.portf,
                             type="return",
                             name="mean"
 )
@@ -168,7 +165,7 @@
                               type="risk_budget",
                               name="ES",
                               min_concentration=TRUE,
-                              arguments = list(p=(1-1/12), clean=clean)
+                              arguments = list(p=p, clean=clean)
 )
 # Calculate portfolio variance, but don't use it in the objective; used only for plots
 EqmETL.portf <- add.objective(portfolio=EqmETL.portf,
@@ -212,18 +209,18 @@
                                   )
 # Add a risk measure
 # Use ES to be consistent with risk measures in other BUOY portfolios
-RiskBudget.portf <- add.objective(portfolio=RiskBudget.portf,
-                                  type="risk",
-                                  name="ES",
-                                  multiplier=1,
-                                  arguments = list(p=(1-1/12), clean=clean)
-                                  )
+# RiskBudget.portf <- add.objective(portfolio=RiskBudget.portf,
+#                                   type="risk",
+#                                   name="ES",
+#                                   multiplier=1,
+#                                   arguments = list(p=(1-1/12), clean=clean)
+#                                   )
 
 # Set risk budget limits
 RiskBudget.portf <- add.objective(portfolio=RiskBudget.portf,
                                   type="risk_budget",
                                   name="ES",
-                                  max_prisk=0.4,
+                                  max_prisk=0.3,
                                   arguments = list(p=(1-1/12), clean=clean)
                                   )
 # Calculate portfolio variance, but don't use it in the objective; used only for plots
@@ -242,10 +239,12 @@
 
 # Modify the init.portf specification to get RP running 
 rp.portf <- init.portf
-rp.portf$constraints[[1]]$min_sum = 0.99 # set to speed up RP
-rp.portf$constraints[[1]]$max_sum = 1.01
-rp = random_portfolios(portfolio=init.portf, permutations=permutations)
-print(paste('done constructing random portfolios at',Sys.time()))
+# rp.portf$constraints[[1]]$min_sum = 0.99 # set to speed up RP
+# rp.portf$constraints[[1]]$max_sum = 1.01
+# rp = random_portfolios(portfolio=rp.portf, permutations=10000, max_permutations=400)
+# print(paste('done constructing random portfolios at',Sys.time()))
+# save(rp,file=paste(resultsdir, 'random-portfolios-', Sys.Date(), '-', runname, '.rda',sep=''))
+load(file=paste(resultsdir,'random-portfolios-2013-09-28.historical.moments.rda'))
 
 start_time<-Sys.time()
 print(paste('Starting optimization at',Sys.time()))
@@ -271,25 +270,33 @@
 save(MeanmETL.ROI,file=paste(resultsdir, 'MeanETL-', Sys.Date(), '-', runname, '.rda',sep=''))
 chart.EfficientFrontier(MeanmETL.RND)
 print(paste('Completed meanmETL optimization at',Sys.time(),'moving on to MinSD'))
+# OR with random portfolios
+# MeanmETL.RND<-optimize.portfolio(R=R,
+#                                  portfolio=MeanmETL.portf,
+#                                  optimize_method='random',
+#                                  rp=rp,
+#                                  trace=TRUE
+# ) 
+# plot(MeanmETL.RND, risk.col="StdDev", return.col="mean", chart.assets=TRUE, main="Mean-mETL Portfolio")
+# plot(MeanmETL.RND, risk.col="ES", return.col="mean", chart.assets=TRUE, main="Mean-mETL Portfolio")
 
-MeanmETL.RND<-optimize.portfolio(R=R,
-                                 portfolio=MeanmETL.portf,
-                                 optimize_method='random',
-                                 rp=rp,
-                                 trace=TRUE
-) 
-plot(MeanmETL.RND, risk.col="StdDev", return.col="mean", chart.assets=TRUE, main="Mean-mETL Portfolio")
-plot(MeanmETL.RND, risk.col="ES", return.col="mean", chart.assets=TRUE, main="Mean-mETL Portfolio")
-
 ### Evaluate BUOY 3: Constrained Minimum Variance Portfolio - with ROI
 MinSD.ROI<-optimize.portfolio(R=R,
   portfolio=MinSD.portf,
   optimize_method='ROI',
   trace=TRUE, verbose=TRUE
   ) # 
-plot(MinSD.ROI, risk.col="StdDev", return.col="mean", rp=permutations, chart.assets=TRUE, main="Minimum Volatility Portfolio")
+plot(MinSD.ROI, risk.col="StdDev", return.col="mean", rp=permutations, chart.assets=TRUE, main="Minimum Volatility Portfolio with ROI")
 save(MinSD.ROI,file=paste(resultsdir, 'MinSD-', Sys.Date(), '-', runname, '.rda',sep=''))
 print(paste('Completed MinSD optimization at',Sys.time(),'moving on to MinmETL'))
+# OR with random portfolios
+# MinSD.RND<-optimize.portfolio(R=R,
+#   portfolio=MinSD.portf,
+#   optimize_method='random',
+#   rp=rp,
+#   trace=TRUE, verbose=TRUE
+#   ) # 
+# plot(MinSD.RND, risk.col="StdDev", return.col="mean", chart.assets=TRUE, main="Minimum Volatility Portfolio with RP")
 
 ### Evaluate BUOY 4: Constrained Minimum mETL Portfolio - with ROI
 MinmETL.ROI<-optimize.portfolio(R=R,
@@ -315,15 +322,15 @@
 
 
 # or with DE
-EqSD.DE<-optimize.portfolio(R=R,
-  portfolio=EqSD.portf,
-  optimize_method='DEoptim',
-  search_size=1000, 
-  trace=TRUE, verbose=TRUE
-) 
-plot(EqSD.DE, risk.col="StdDev", return.col="mean", chart.assets=TRUE, main="Equal Volatility Contribution Portfolio")
-chart.RiskBudget(EqSD.DE, risk.type="percentage")
-save(EqSD.DE,file=paste(resultsdir, 'EqSD.DE-', Sys.Date(), '-', runname, '.rda',sep=''))
+# EqSD.DE<-optimize.portfolio(R=R,
+#   portfolio=EqSD.portf,
+#   optimize_method='DEoptim',
+#   search_size=1000, 
+#   trace=TRUE, verbose=TRUE
+# ) 
+# plot(EqSD.DE, risk.col="StdDev", return.col="mean", chart.assets=TRUE, main="Equal Volatility Contribution Portfolio")
+# chart.RiskBudget(EqSD.DE, risk.type="percentage")
+# save(EqSD.DE,file=paste(resultsdir, 'EqSD.DE-', Sys.Date(), '-', runname, '.rda',sep=''))
 
 print(paste('Completed EqSD optimization at',Sys.time(),'moving on to EqmETL'))
 
@@ -346,12 +353,12 @@
 
 
 ### Evaluate Risk Budget Portfolio - with DE
-registerDoSEQ() # turn off parallelization to keep the trace data
+# registerDoSEQ() # turn off parallelization to keep the trace data
 RiskBudget.DE<-optimize.portfolio(R=R,
                                portfolio=RiskBudget.portf,
                                optimize_method='DEoptim',
-                               search_size=1000, trace=TRUE
-                               ) # use the same random portfolios generated above
+                              search_size=1000 #, trace=TRUE
+                               ) 
 plot(RiskBudget.DE, risk.col="StdDev", return.col="mean")
 plot(RiskBudget.DE, risk.col="ES", return.col="mean") # several outlier portfolios
 chart.RiskBudget(RiskBudget.DE)
@@ -366,10 +373,6 @@
 
 # Combine optimization objects
 buoys <- combine.optimizations(list(MeanSD=MeanSD.ROI, MeanmETL=MeanmETL.ROI, MinSD=MinSD.ROI, MinmETL=MinmETL.ROI, EqSD=EqSD.RND, EqmETL=EqmETL.RND, RB=RiskBudget.DE, EqWt=EqWt.opt))
-# how to add an EqWgt to this list?
-#@ The elements of this list need to be optimize.portfolio objects, so unfortunately we
-#@ can't do this unless we created an optimize.portfolio object for an equal weight
-#@ portfolio. I'll add this. - RB
 chart.Weights(buoys, plot.type="bar", ylim=c(0,1))
 
 #@ Chart the portfolios that have mean and ES as objective measures. - RB
@@ -415,9 +418,17 @@
 
 # get the RP portfolios with risk and return pre-calculated
 xtract = extractStats(EqmETL.RND) 
+save(xtract,file=paste(resultsdir, 'xtract-RPs-', Sys.Date(), '-', runname, '.rda',sep=''))
 # columnnames = colnames(xtract)
 results.names=rownames(buoys.portfmeas)
 
+# by Asset metrics
+assets.portfmeas=as.matrix(scatterFUN(R, FUN="mean"))
+assets.portfmeas=cbind(assets.portfmeas, scatterFUN(R, FUN="StdDev"))
+assets.portfmeas=cbind(assets.portfmeas, scatterFUN(R, FUN="ES"))
+colnames(assets.portfmeas)=c("Mean", "StdDev", "mETL")
+rownames(assets.portfmeas)=colnames(Wgts)
+
 end_time<-Sys.time()
 end_time-start_time
 

Modified: pkg/PortfolioAnalytics/sandbox/symposium2013/results.HFindexes.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/symposium2013/results.HFindexes.R	2013-09-26 20:52:57 UTC (rev 3193)
+++ pkg/PortfolioAnalytics/sandbox/symposium2013/results.HFindexes.R	2013-09-28 19:01:51 UTC (rev 3194)
@@ -2,10 +2,6 @@
 
 op <- par(no.readonly=TRUE)
 
-xtract = extractStats(EqmETL.RND) # get the RP portfolios with risk and return pre-calculated
-# columnnames = colnames(xtract)
-results.names=rownames(portfmeas)
-
 # --------------------------------------------------------------------
 # Plot Ex Ante scatter of RP and ONLY Equal Weight portfolio in StdDev space
 # --------------------------------------------------------------------
@@ -13,14 +9,14 @@
 png(filename="RP-EqWgt-MeanSD-ExAnte.png", units="in", height=5.5, width=9, res=96) 
 par(mar=c(5, 4, 1, 2) + 0.1) #c(bottom, left, top, right)
 # Calculate chart bounds to unify with the charts below
-xlim.StdDev=c(min(c(xtract[,"StdDev"], unlist(portfmeas[,"StdDev"]))), max(c(xtract[,"StdDev"], unlist(portfmeas[,"StdDev"]))))
-ylim.mean=c(min(c(xtract[,"mean"], unlist(portfmeas[,"Mean"]))), max(c(xtract[,"mean"], unlist(portfmeas[,"Mean"]))))
+xlim.StdDev=c(min(c(xtract[,"StdDev"], buoys.portfmeas[,"StdDev"])), max(c(xtract[,"StdDev"], buoys.portfmeas[,"StdDev"])))
+ylim.mean=c(min(c(xtract[,"mean"], buoys.portfmeas[,"Mean"])), max(c(xtract[,"mean"], buoys.portfmeas[,"Mean"])))
 
 plot(xtract[,"StdDev"],xtract[,"mean"], xlab="Ex Ante Std Dev", ylab="Ex Ante Mean", col="darkgray", axes=FALSE, main="", cex=.7, xlim=xlim.StdDev, ylim=ylim.mean)
 grid(col = "darkgray")
 abline(h = 0, col = "darkgray")
 # Overplot the equal weight portfolio
-points(as.numeric(portfmeas[8,"StdDev"]),as.numeric(portfmeas[8,"Mean"]), col=tol8qualitative[8], pch=16, cex=1.5) # watch the order in portfmeas
+points(buoys.portfmeas[8,"StdDev"],buoys.portfmeas[8,"Mean"], col=tol8qualitative[8], pch=16, cex=1.5) # watch the order in portfmeas
 axis(1, cex.axis = 0.8, col = "darkgray")
 axis(2, cex.axis = 0.8, col = "darkgray")
 box(col = "darkgray")
@@ -32,18 +28,24 @@
 # Plot Ex Ante scatter of RP and ASSET portfolios in StdDev space
 # --------------------------------------------------------------------
 # @TODO: add the assets to this chart
-png(filename="RP-EqWgt-MeanSD-ExAnte.png", units="in", height=5.5, width=9, res=96) 
+png(filename="RP-Assets-MeanSD-ExAnte.png", units="in", height=5.5, width=9, res=96) 
+xlim.StdDev.assets =c(min(c(xtract[,"StdDev"], assets.portfmeas[,"StdDev"], 0)), max(c(xtract[,"StdDev"], assets.portfmeas[,"StdDev"],0.03)))
+ylim.mean.assets =c(min(c(xtract[,"mean"], assets.portfmeas[,"Mean"], 0)), max(c(xtract[,"mean"], assets.portfmeas[,"Mean"])))
 par(mar=c(5, 4, 1, 2) + 0.1) #c(bottom, left, top, right)
 # Revise the chart bounds to include the asssets
-plot(xtract[,"StdDev"],xtract[,"mean"], xlab="Ex Ante mETL", ylab="Ex Ante Mean", col="darkgray", axes=FALSE, main="", cex=.7)
+plot(xtract[,"StdDev"],xtract[,"mean"], xlab="Ex Ante mETL", ylab="Ex Ante Mean", col="darkgray", axes=FALSE, main="", cex=.7, xlim=xlim.StdDev.assets, ylim=ylim.mean.assets)
 grid(col = "darkgray")
 abline(h = 0, col = "darkgray")
+abline(v = 0, col = "darkgray")
 # Overplot the equal weight portfolio
-points(as.numeric(portfmeas[8,"StdDev"]),as.numeric(portfmeas[8,"Mean"]), col=tol8qualitative[8], pch=16, cex=1.5) # watch the order in portfmeas
+points(buoys.portfmeas[8,"StdDev"],buoys.portfmeas[8,"Mean"], col=tol8qualitative[8], pch=16, cex=1.5) # watch the order in portfmeas
+text(x=buoys.portfmeas[8,"StdDev"], y=buoys.portfmeas[8,"Mean"], labels=rownames(buoys.portfmeas)[8], pos=4, cex=1)
+points(assets.portfmeas[,"StdDev"],assets.portfmeas[,"Mean"], col=rich8equal, pch=18, cex=1.5) # watch the order in portfmeas
+text(x=assets.portfmeas[,"StdDev"], y=assets.portfmeas[,"Mean"], labels=rownames(assets.portfmeas), pos=4, cex=1)
 axis(1, cex.axis = 0.8, col = "darkgray")
 axis(2, cex.axis = 0.8, col = "darkgray")
 box(col = "darkgray")
-legend("bottomright",legend=results.names[8], col=tol8qualitative[8], pch=16, ncol=1,  border.col="darkgray", y.intersp=1.2, cex=0.8, inset=.02)
+#legend("right",legend=rownames(assets.portfmeas), col=rich8equal, pch=16, ncol=1,  border.col="darkgray", y.intersp=1.2, cex=0.8, inset=.02)
 par(op)
 dev.off()
 
@@ -53,11 +55,11 @@
 # Done
 png(filename="RP-BUOY-MeanSD-ExAnte.png", units="in", height=5.5, width=9, res=96) 
 par(mar=c(5, 4, 1, 2) + 0.1) #c(bottom, left, top, right)
-plot(xtract[,"StdDev"],xtract[,"mean"], xlab="Ex Ante mETL", ylab="Ex Ante Mean", col="darkgray", axes=FALSE, main="", cex=.7, xlim=xlim.StdDev, ylim=ylim.mean)
+plot(xtract[,"StdDev"],xtract[,"mean"], xlab="Ex Ante Std Dev", ylab="Ex Ante Mean", col="darkgray", axes=FALSE, main="", cex=.7, xlim=xlim.StdDev, ylim=ylim.mean)
 grid(col = "darkgray")
 abline(h = 0, col = "darkgray")
 # Overplot the buoy portfolios
-points(as.numeric(portfmeas[,"StdDev"]),as.numeric(portfmeas[,"Mean"]), col=tol8qualitative, pch=16, cex=1.5) # watch the order in portfmeas
+points(buoys.portfmeas[,"StdDev"],buoys.portfmeas[,"Mean"], col=tol8qualitative, pch=16, cex=1.5) # watch the order in portfmeas
 axis(1, cex.axis = 0.8, col = "darkgray")
 axis(2, cex.axis = 0.8, col = "darkgray")
 box(col = "darkgray")
@@ -71,12 +73,11 @@
 # Done
 png(filename="RP-BUOYS-mETL-ExAnte.png", units="in", height=5.5, width=9, res=96) 
 par(mar=c(5, 4, 1, 2) + 0.1) #c(bottom, left, top, right)
-xlim.ES=c(min(c(xtract[,"ES"], unlist(portfmeas[,"mETL"]))), max(c(xtract[,"ES"], unlist(portfmeas[,"mETL"]))))
+xlim.ES=c(min(c(xtract[,"ES"], buoys.portfmeas[,"mETL"])), max(c(xtract[,"ES"], buoys.portfmeas[,"mETL"])))
 plot(xtract[,"ES"],xtract[,"mean"], xlab="Ex Ante mETL", ylab="Ex Ante Mean", col="darkgray", axes=FALSE, main="", cex=.7, xlim=xlim.ES, ylim=ylim.mean)
 grid(col = "darkgray")
-abline(h = 0, col = "darkgray")
 # Overplot the buoy portfolios
-points(as.numeric(portfmeas[,"mETL"]),as.numeric(portfmeas[,"Mean"]), col=tol8qualitative, pch=16, cex=1.5) # watch the order in portfmeas
+points(buoys.portfmeas[,"mETL"],buoys.portfmeas[,"Mean"], col=tol8qualitative, pch=16, cex=1.5) # watch the order in portfmeas
 axis(1, cex.axis = 0.8, col = "darkgray")
 axis(2, cex.axis = 0.8, col = "darkgray")
 box(col = "darkgray")
@@ -89,7 +90,7 @@
 # --------------------------------------------------------------------
 # Done
 source('./R/chart.UnStackedBar.R')
-Wgts = extractWeights(buoys)
+# Wgts = extractWeights(buoys)
 png(filename=paste(resultsdir, "Weights-Buoys.png", sep=""), units="in", height=5.5, width=9, res=96)
 chart.UnStackedBar(t(Wgts), colorset=tol8qualitative, equal.line=TRUE)
 dev.off()
@@ -100,12 +101,48 @@
 # @TODO: revise for this result set
 # @TODO: add contribution to risk to portfmeas
 source('./R/chart.UnStackedBar.R')
-png(filename=paste(resultsdir, "Weights-Buoys.png", sep=""), units="in", height=5.5, width=9, res=96)
-chart.UnStackedBar(t(Wgts), colorset=tol8qualitative, equal.line=TRUE)
+png(filename=paste(resultsdir, "mETL-Perc-Contrib-Buoys.png", sep=""), units="in", height=5.5, width=9, res=96)
+chart.UnStackedBar(t(buoys.perc.es), colorset=tol8qualitative, equal.line=TRUE)
 dev.off()
 # Alternatively, use table function for ES
 
 # --------------------------------------------------------------------
+# Plot cumulative contribution to risk of Buoy portfolios
+# --------------------------------------------------------------------
+cumRisk=NULL
+for(i in 1:NROW(buoys.contrib.es)) {
+  y = cumsum(buoys.contrib.es[i,order(buoys.contrib.es[i,], decreasing=TRUE)])
+  cumRisk=rbind(cumRisk,y)
+}
+colnames(cumRisk)=c("Most",2:6,"Least")
+rownames(cumRisk)= results.names
+
+png(filename=paste(resultsdir, "mETL-CumulPerc-Contrib-Buoys.png", sep=""), units="in", height=5.5, width=9, res=96)
+par(mar=c(5, 4, 1, 4) + 0.1) #c(bottom, left, top, right)
+plot(cumRisk[8,], ylim=c(0,max(cumRisk)), col=tol8qualitative[8], type="l", lwd=2, axes=FALSE, main="", xlab="Rank of Contribution to Risk", ylab="Portfolio Risk")
+grid(col = "darkgray")
+abline(h = 0, col = "darkgray")
+axis(1, cex.axis = 0.8, col = "darkgray")
+axis(2, cex.axis = 0.8, col = "darkgray")
+box(col = "darkgray")
+for(i in 1:8) {
+  lines(cumRisk[i,], col=tol8qualitative[i], lwd=3)
+  # put the values of the rightmost dot on the plot; that's the portfolio risk 
+  points(7, cumRisk[i,7], col = tol8qualitative[i], pch=20, cex=1)
+	mtext(paste(round(100*cumRisk[i,7],2),"%", sep=""), line=.5, side = 4, at=cumRisk[i,7], adj=0, las=2, cex = 0.9, col = tol8qualitative[i])
+}
+# Add legend
+legend("bottomright",legend=results.names, col=tol8qualitative, pch=16, ncol=1,  border.col="darkgray", y.intersp=1.2, cex=.9, lwd=3, inset=.02)
+par(op)
+dev.off()
+
+
+# --------------------------------------------------------------------
+# Plot contribution of risk in EqWgt portfolio
+# --------------------------------------------------------------------
+
+
+# --------------------------------------------------------------------
 # Plot efficient frontier of mean-sd?
 # --------------------------------------------------------------------
 



More information about the Returnanalytics-commits mailing list