[Returnanalytics-commits] r2972 - in pkg/PortfolioAnalytics: R sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Sep 3 04:35:11 CEST 2013
Author: rossbennett34
Date: 2013-09-03 04:35:10 +0200 (Tue, 03 Sep 2013)
New Revision: 2972
Modified:
pkg/PortfolioAnalytics/R/charts.efficient.frontier.R
pkg/PortfolioAnalytics/sandbox/testing_efficient_frontier.R
Log:
Adding functionality to plot group weights along the efficient frontier. Updated testing script with examples.
Modified: pkg/PortfolioAnalytics/R/charts.efficient.frontier.R
===================================================================
--- pkg/PortfolioAnalytics/R/charts.efficient.frontier.R 2013-09-02 17:24:46 UTC (rev 2971)
+++ pkg/PortfolioAnalytics/R/charts.efficient.frontier.R 2013-09-03 02:35:10 UTC (rev 2972)
@@ -272,6 +272,7 @@
#' @param ... passthrough parameters to \code{barplot}.
#' @param n.portfolios number of portfolios to extract along the efficient frontier.
#' This is only used for objects of class \code{optimize.portfolio}
+#' @param by.groups TRUE/FALSE. If TRUE, the weights by group are charted.
#' @param match.col match.col string name of column to use for risk (horizontal axis).
#' Must match the name of an objective.
#' @param main main title used in the plot.
@@ -283,13 +284,13 @@
#' @param legend.loc NULL, "topright", "right", or "bottomright". If legend.loc is NULL, the legend will not be plotted.
#' @author Ross Bennett
#' @export
-chart.Weights.EF <- function(object, colorset=NULL, ..., n.portfolios=25, match.col="ES", main="EF Weights", cex.lab=0.8, cex.axis=0.8, cex.legend=0.8, legend.labels=NULL, element.color="darkgray"){
+chart.Weights.EF <- function(object, colorset=NULL, ..., n.portfolios=25, by.groups=FALSE, match.col="ES", main="EF Weights", cex.lab=0.8, cex.axis=0.8, cex.legend=0.8, legend.labels=NULL, element.color="darkgray"){
UseMethod("chart.Weights.EF")
}
#' @rdname chart.Weights.EF
#' @export
-chart.Weights.EF.efficient.frontier <- function(object, colorset=NULL, ..., n.portfolios=25, match.col="ES", main="", cex.lab=0.8, cex.axis=0.8, cex.legend=0.8, legend.labels=NULL, element.color="darkgray", legend.loc="topright"){
+chart.Weights.EF.efficient.frontier <- function(object, colorset=NULL, ..., n.portfolios=25, by.groups=FALSE, match.col="ES", main="", cex.lab=0.8, cex.axis=0.8, cex.legend=0.8, legend.labels=NULL, element.color="darkgray", legend.loc="topright"){
# using ideas from weightsPlot.R in fPortfolio package
if(!inherits(object, "efficient.frontier")) stop("object must be of class 'efficient.frontier'")
@@ -308,6 +309,25 @@
wts_idx <- grep(pattern="^w\\.", cnames)
wts <- frontier[, wts_idx]
+ if(by.groups){
+ constraints <- get_constraints(object$portfolio)
+ groups <- constraints$groups
+ if(is.null(groups)) stop("group constraints not in portfolio object")
+ if(!is.null(groups)){
+ groupfun <- function(weights, groups){
+ # This function is to calculate weights by group given the group list
+ # and a matrix of weights along the efficient frontier
+ ngroups <- length(groups)
+ group_weights <- rep(0, ngroups)
+ for(i in 1:ngroups){
+ group_weights[i] <- sum(weights[groups[[i]]])
+ }
+ group_weights
+ }
+ wts <- t(apply(wts, 1, groupfun, groups=groups))
+ }
+ }
+
# return along the efficient frontier
# get the "mean" column
mean.mtc <- pmatch("mean", cnames)
@@ -357,7 +377,12 @@
if(legend.loc %in% c("topright", "right", "bottomright")){
# set the legend information
if(is.null(legend.labels)){
- legend.labels <- gsub(pattern="^w\\.", replacement="", cnames[wts_idx])
+ if(by.groups){
+ legend.labels <- names(groups)
+ if(is.null(legend.labels)) legend.labels <- constraints$group_labels
+ } else {
+ legend.labels <- gsub(pattern="^w\\.", replacement="", cnames[wts_idx])
+ }
}
legend(legend.loc, legend = legend.labels, bty = "n", cex = cex.legend, fill = colorset)
}
@@ -389,14 +414,14 @@
#' @rdname chart.Weights.EF
#' @export
-chart.Weights.EF.optimize.portfolio <- function(object, colorset=NULL, ..., n.portfolios=25, match.col="ES", main="", cex.lab=0.8, cex.axis=0.8, cex.legend=0.8, legend.labels=NULL, element.color="darkgray", legend.loc="topright"){
+chart.Weights.EF.optimize.portfolio <- function(object, colorset=NULL, ..., n.portfolios=25, by.groups=FALSE, match.col="ES", main="", cex.lab=0.8, cex.axis=0.8, cex.legend=0.8, legend.labels=NULL, element.color="darkgray", legend.loc="topright"){
# chart the weights along the efficient frontier of an objected created by optimize.portfolio
if(!inherits(object, "optimize.portfolio")) stop("object must be of class optimize.portfolio")
frontier <- extractEfficientFrontier(object=object, match.col=match.col, n.portfolios=n.portfolios)
PortfolioAnalytics:::chart.Weights.EF(object=frontier, colorset=colorset, ...,
- match.col=match.col, main=main, cex.lab=cex.lab,
+ match.col=match.col, by.groups=by.groups, main=main, cex.lab=cex.lab,
cex.axis=cex.axis, cex.legend=cex.legend,
legend.labels=legend.labels, element.color=element.color,
legend.loc=legend.loc)
Modified: pkg/PortfolioAnalytics/sandbox/testing_efficient_frontier.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/testing_efficient_frontier.R 2013-09-02 17:24:46 UTC (rev 2971)
+++ pkg/PortfolioAnalytics/sandbox/testing_efficient_frontier.R 2013-09-03 02:35:10 UTC (rev 2972)
@@ -22,7 +22,12 @@
init <- portfolio.spec(assets=funds)
# initial constraints
init <- add.constraint(portfolio=init, type="full_investment")
-init <- add.constraint(portfolio=init, type="box", min=0, max=1)
+init <- add.constraint(portfolio=init, type="box", min=0.15, max=0.45)
+init <- add.constraint(portfolio=init, type="group",
+ groups=list(c(1, 3),
+ c(2, 4, 5)),
+ group_min=0.05,
+ group_max=0.7)
# initial objective
init <- add.objective(portfolio=init, type="return", name="mean")
@@ -62,8 +67,12 @@
chart.EfficientFrontier(meanvar.ef, match.col="StdDev", type="l",
tangent.line=FALSE, labels.assets=FALSE, pch.assets=1)
+# Chart the asset weights along the efficient frontier
chart.Weights.EF(meanvar.ef, colorset=bluemono, match.col="StdDev")
+# Chart the group weights along the efficient frontier
+chart.Weights.EF(meanvar.ef, colorset=bluemono, by.groups=TRUE, match.col="StdDev")
+
# The labels for Mean, Weight, and StdDev can be increased or decreased with
# the cex.lab argument. The default is cex.lab=0.8
chart.Weights.EF(meanvar.ef, colorset=bluemono, match.col="StdDev", main="", cex.lab=1)
@@ -93,6 +102,8 @@
# optimize.portfolio output object
chart.Weights.EF(opt_meanvar, match.col="StdDev")
+chart.Weights.EF(opt_meanvar, match.col="StdDev", by.groups=TRUE)
+
# Extract the efficient frontier and then plot it
# Note that if you want to do multiple charts of the efficient frontier from
# the optimize.portfolio object, it is best to extractEfficientFrontier as shown
@@ -101,6 +112,7 @@
print(ef)
summary(ef, digits=5)
chart.Weights.EF(ef, match.col="StdDev", colorset=bluemono)
+chart.Weights.EF(ef, match.col="StdDev", colorset=bluemono, by.groups=TRUE)
# mean-etl efficient frontier
meanetl.ef <- create.EfficientFrontier(R=R, portfolio=meanetl.portf, type="mean-ES")
@@ -108,6 +120,7 @@
summary(meanetl.ef)
chart.EfficientFrontier(meanetl.ef, match.col="ES", main="mean-ETL Efficient Frontier", type="l", col="blue", RAR.text="STARR")
chart.Weights.EF(meanetl.ef, colorset=bluemono, match.col="ES")
+chart.Weights.EF(meanetl.ef, by.groups=TRUE, colorset=bluemono, match.col="ES")
# mean-etl efficient frontier using random portfolios
meanetl.rp.ef <- create.EfficientFrontier(R=R, portfolio=meanetl.portf, type="random", match.col="ES")
More information about the Returnanalytics-commits
mailing list