[Returnanalytics-commits] r3026 - in pkg/PortfolioAnalytics: . R man sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Sep 8 20:41:36 CEST 2013
Author: rossbennett34
Date: 2013-09-08 20:41:35 +0200 (Sun, 08 Sep 2013)
New Revision: 3026
Added:
pkg/PortfolioAnalytics/R/charts.multiple.R
pkg/PortfolioAnalytics/R/utility.combine.R
pkg/PortfolioAnalytics/man/optimizations.combine.Rd
pkg/PortfolioAnalytics/man/portfolios.combine.Rd
pkg/PortfolioAnalytics/sandbox/testing_mult_opt_weights.R
Modified:
pkg/PortfolioAnalytics/DESCRIPTION
pkg/PortfolioAnalytics/NAMESPACE
pkg/PortfolioAnalytics/R/chart.Weights.R
pkg/PortfolioAnalytics/R/extractstats.R
pkg/PortfolioAnalytics/man/chart.Weights.Rd
Log:
Adding functions to plot the weights of multiple optimize.portfolio objects
Modified: pkg/PortfolioAnalytics/DESCRIPTION
===================================================================
--- pkg/PortfolioAnalytics/DESCRIPTION 2013-09-08 12:58:11 UTC (rev 3025)
+++ pkg/PortfolioAnalytics/DESCRIPTION 2013-09-08 18:41:35 UTC (rev 3026)
@@ -56,3 +56,5 @@
'charts.efficient.frontier.R'
'charts.risk.R'
'charts.groups.R'
+ 'charts.multiple.R'
+ 'utility.combine.R'
Modified: pkg/PortfolioAnalytics/NAMESPACE
===================================================================
--- pkg/PortfolioAnalytics/NAMESPACE 2013-09-08 12:58:11 UTC (rev 3025)
+++ pkg/PortfolioAnalytics/NAMESPACE 2013-09-08 18:41:35 UTC (rev 3026)
@@ -1,3 +1,5 @@
+export("cex.legend=0.8,")
+export("colorset=NULL,")
export(add.constraint)
export(add.objective)
export(applyFUN)
@@ -9,7 +11,6 @@
export(chart.RiskBudget)
export(chart.RiskReward)
export(chart.Weights.EF)
-export(chart.Weights)
export(constrained_group_tmp)
export(constrained_objective_v2)
export(constrained_objective)
@@ -36,16 +37,20 @@
export(is.constraint)
export(is.objective)
export(is.portfolio)
+export(legend.loc="topright",)
export(meanetl.efficient.frontier)
export(meanvar.efficient.frontier)
export(minmax_objective)
export(objective)
+export(optimizations.combine)
export(optimize.portfolio_v2)
export(optimize.portfolio.parallel)
export(optimize.portfolio.rebalancing)
export(optimize.portfolio)
+export(plot.type="line")
export(portfolio_risk_objective)
export(portfolio.spec)
+export(portfolios.combine)
export(pos_limit_fail)
export(position_limit_constraint)
export(quadratic_utility_objective)
@@ -84,6 +89,7 @@
S3method(chart.RiskReward,optimize.portfolio.pso)
S3method(chart.RiskReward,optimize.portfolio.random)
S3method(chart.RiskReward,optimize.portfolio.ROI)
+S3method(chart.Weights,opt.list)
S3method(chart.Weights,optimize.portfolio.DEoptim)
S3method(chart.Weights,optimize.portfolio.GenSA)
S3method(chart.Weights,optimize.portfolio.pso)
@@ -97,6 +103,7 @@
S3method(extractStats,optimize.portfolio.pso)
S3method(extractStats,optimize.portfolio.random)
S3method(extractStats,optimize.portfolio.ROI)
+S3method(extractWeights,opt.list)
S3method(extractWeights,optimize.portfolio.rebalancing)
S3method(extractWeights,optimize.portfolio)
S3method(plot,optimize.portfolio.DEoptim)
Modified: pkg/PortfolioAnalytics/R/chart.Weights.R
===================================================================
--- pkg/PortfolioAnalytics/R/chart.Weights.R 2013-09-08 12:58:11 UTC (rev 3025)
+++ pkg/PortfolioAnalytics/R/chart.Weights.R 2013-09-08 18:41:35 UTC (rev 3026)
@@ -18,11 +18,15 @@
#' @param cex.lab The magnification to be used for x and y labels relative to the current setting of \code{cex}
#' @param element.color color for the default plot lines
#' @param cex.axis The magnification to be used for axis annotation relative to the current setting of \code{cex}
+#' @param colorset color palette or vector of colors to use
+#' @param legend.loc location of the legend. If NULL, the legend will not be plotted
+#' @param plot.type "line" or "barplot"
#' @seealso \code{\link{optimize.portfolio}}
#' @rdname chart.Weights
#' @name chart.Weights
-#' @aliases chart.Weights.optimize.portfolio.ROI chart.Weights.optimize.portfolio.DEoptim chart.Weights.optimize.portfolio.pso chart.Weights.optimize.portfolio.RP chart.Weights.optimize.portfolio.GenSA
+#' @aliases chart.Weights.optimize.portfolio.ROI chart.Weights.optimize.portfolio.DEoptim chart.Weights.optimize.portfolio.pso chart.Weights.optimize.portfolio.RP chart.Weights.optimize.portfolio.GenSA chart.Weights.opt.list
#' @export
+#' colorset=NULL, legend.loc="topright", cex.legend=0.8, plot.type="line"
chart.Weights <- function(object, neighbors = NULL, ..., main="Weights", las = 3, xlab=NULL, cex.lab = 1, element.color = "darkgray", cex.axis=0.8){
UseMethod("chart.Weights")
}
Added: pkg/PortfolioAnalytics/R/charts.multiple.R
===================================================================
--- pkg/PortfolioAnalytics/R/charts.multiple.R (rev 0)
+++ pkg/PortfolioAnalytics/R/charts.multiple.R 2013-09-08 18:41:35 UTC (rev 3026)
@@ -0,0 +1,65 @@
+# compare optimal weights of multiple portfolios
+
+#' @method chart.Weights opt.list
+#' @S3method chart.Weights opt.list
+#' @export
+chart.Weights.opt.list <- function(object, neighbors=NULL, ..., main="Weights", las=3, xlab=NULL, cex.lab=1, element.color="darkgray", cex.axis=0.8, colorset=NULL, legend.loc="topright", cex.legend=0.8, plot.type="line"){
+ if(!inherits(object, "opt.list")) stop("object must be of class 'opt.list'")
+
+ if(plot.type %in% c("bar", "barplot")){
+ barplotOptWeights(object=object, main=main, las=las, xlab=xlab, cex.lab=cex.lab, element.color=element.color, cex.axis=cex.axis, colorset=colorset, legend.loc=legend.loc, cex.legend=cex.legend, ...)
+ } else if(plot.type == "line"){
+
+ # get the optimal weights in a matrix
+ weights_mat <- extractWeights.opt.list(object)
+ opt_names <- rownames(weights_mat)
+
+ columnnames <- colnames(weights_mat)
+ numassets <- length(columnnames)
+
+ if(is.null(xlab))
+ minmargin = 3
+ else
+ minmargin = 5
+ if(main=="") topmargin=1 else topmargin=4
+ if(las > 1) {# set the bottom border to accommodate labels
+ bottommargin = max(c(minmargin, (strwidth(columnnames,units="in"))/par("cin")[1])) * cex.lab
+ if(bottommargin > 10 ) {
+ bottommargin<-10
+ columnnames<-substr(columnnames,1,19)
+ # par(srt=45) #TODO figure out how to use text() and srt to rotate long labels
+ }
+ }
+ else {
+ bottommargin = minmargin
+ }
+ par(mar = c(bottommargin, 4, topmargin, 2) +.1)
+
+ if(is.null(colorset)) colorset=1:nrow(weights_mat)
+ if(length(colorset) != nrow(weights_mat)) colorset <- rep(colorset[1], nrow(weights_mat))
+ plot(weights_mat[1,], type="n", axes=FALSE, xlab='', ylab="Weights", main=main, ...)
+ for(i in 1:nrow(weights_mat)){
+ points(weights_mat[i,], type="b", col=colorset[i], lty=1)
+ }
+ if(!is.null(legend.loc)) legend(legend.loc, legend=opt_names, col=colorset, bty="n", lty=1, cex=cex.legend)
+ axis(2, cex.axis=cex.axis, col=element.color)
+ axis(1, labels=columnnames, at=1:numassets, las=las, cex.axis=cex.axis, col=element.color)
+ box(col=element.color)
+ }
+}
+
+barplotOptWeights <- function(object, ..., main="Weights", las=3, xlab=NULL, cex.lab=1, element.color="darkgray", cex.axis=0.8, colorset=NULL, legend.loc="topright", cex.legend=0.8){
+ if(!inherits(object, "opt.list")) stop("object must be of class 'opt.list'")
+
+ # get the optimal weights in a matrix
+ weights_mat <- extractWeights.opt.list(object)
+ opt_names <- rownames(weights_mat)
+
+ if(is.null(colorset)) colorset <- 1:nrow(weights_mat)
+
+ barplot(weights_mat, beside=TRUE, main=main, cex.axis=cex.axis, cex.names=cex.lab, las=las, col=colorset, ...)
+ if(!is.null(legend.loc)){
+ legend(legend.loc, legend=opt_names, fill=colorset, bty="n", cex=cex.legend)
+ }
+ box(col=element.color)
+}
Modified: pkg/PortfolioAnalytics/R/extractstats.R
===================================================================
--- pkg/PortfolioAnalytics/R/extractstats.R 2013-09-08 12:58:11 UTC (rev 3025)
+++ pkg/PortfolioAnalytics/R/extractstats.R 2013-09-08 18:41:35 UTC (rev 3026)
@@ -366,3 +366,32 @@
)
}
+#' @method extractWeights opt.list
+#' @S3method extractWeights opt.list
+#' @export
+extractWeights.opt.list <- function(object, ...){
+ # get the optimal weights of each optimization in a list
+ weights_list <- list()
+ for(i in 1:length(object)){
+ weights_list[[i]] <- object[[i]]$weights
+ }
+
+ # get/set the names in the object
+ opt_names <- names(object)
+ if(is.null(opt_names)) opt_names <- paste("opt", 1:length(object))
+
+ # get the names of each element in weights_list
+ weights_names <- unlist(lapply(weights_list, names))
+
+ # unique names in weights_names
+ names_unique <- unique(weights_names)
+
+ # create a matrix of zeros to fill in with weights later
+ weights_mat <- matrix(0, nrow=length(weights_list), ncol=length(names_unique),
+ dimnames=list(opt_names, names_unique))
+ for(i in 1:length(weights_list)){
+ pm <- pmatch(x=names(weights_list[[i]]), table=names_unique)
+ weights_mat[i, pm] <- weights_list[[i]]
+ }
+ return(weights_mat)
+}
Added: pkg/PortfolioAnalytics/R/utility.combine.R
===================================================================
--- pkg/PortfolioAnalytics/R/utility.combine.R (rev 0)
+++ pkg/PortfolioAnalytics/R/utility.combine.R 2013-09-08 18:41:35 UTC (rev 3026)
@@ -0,0 +1,35 @@
+
+
+#' Combine objects created by optimize.portfolio
+#'
+#' This function takes a list of objects created by \code{\link{optimize.portfolio}}
+#' and sets the class name attribute to 'opt.list' for use in generic functions
+#'
+#' @param x a list of objects created by \code{\link{optimize.portfolio}}
+#' @return an \code{opt.list} object
+#' @export
+optimizations.combine <- function(x){
+ if(!is.list(x)) stop("x must be passed in as a list")
+ for(i in 1:length(x)){
+ if(!inherits(x[[i]], "optimize.portfolio")) stop("All objects in x must be of class 'optimize.portfolio'")
+ }
+ class(x) <- "opt.list"
+ return(x)
+}
+
+#' Combine objects created by portfolio
+#'
+#' This function takes a list of objects created by \code{\link{portfolio.spec}}
+#' and sets the class name attribute to 'portfolio.list' for use in generic functions
+#'
+#' @param x a list of objects created by \code{\link{portfolio.spec}}
+#' @return a \code{portfolio.list} object
+#' @export
+portfolios.combine <- function(x){
+ if(!is.list(x)) stop("x must be passed in as a list")
+ for(i in 1:length(x)){
+ if(!inherits(x[[i]], "portfolio")) stop("All objects in x must be of class 'portfolio'")
+ }
+ class(x) <- "portfolio.list"
+ return(x)
+}
Modified: pkg/PortfolioAnalytics/man/chart.Weights.Rd
===================================================================
--- pkg/PortfolioAnalytics/man/chart.Weights.Rd 2013-09-08 12:58:11 UTC (rev 3025)
+++ pkg/PortfolioAnalytics/man/chart.Weights.Rd 2013-09-08 18:41:35 UTC (rev 3026)
@@ -1,5 +1,6 @@
\name{chart.Weights}
\alias{chart.Weights}
+\alias{chart.Weights.opt.list}
\alias{chart.Weights.optimize.portfolio.DEoptim}
\alias{chart.Weights.optimize.portfolio.GenSA}
\alias{chart.Weights.optimize.portfolio.pso}
@@ -39,6 +40,13 @@
\item{cex.axis}{The magnification to be used for axis
annotation relative to the current setting of \code{cex}}
+
+ \item{colorset}{color palette or vector of colors to use}
+
+ \item{legend.loc}{location of the legend. If NULL, the
+ legend will not be plotted}
+
+ \item{plot.type}{"line" or "barplot"}
}
\description{
Chart the optimal weights and upper and lower bounds on
Added: pkg/PortfolioAnalytics/man/optimizations.combine.Rd
===================================================================
--- pkg/PortfolioAnalytics/man/optimizations.combine.Rd (rev 0)
+++ pkg/PortfolioAnalytics/man/optimizations.combine.Rd 2013-09-08 18:41:35 UTC (rev 3026)
@@ -0,0 +1,19 @@
+\name{optimizations.combine}
+\alias{optimizations.combine}
+\title{Combine objects created by optimize.portfolio}
+\usage{
+ optimizations.combine(x)
+}
+\arguments{
+ \item{x}{a list of objects created by
+ \code{\link{optimize.portfolio}}}
+}
+\value{
+ an \code{opt.list} object
+}
+\description{
+ This function takes a list of objects created by
+ \code{\link{optimize.portfolio}} and sets the class name
+ attribute to 'opt.list' for use in generic functions
+}
+
Added: pkg/PortfolioAnalytics/man/portfolios.combine.Rd
===================================================================
--- pkg/PortfolioAnalytics/man/portfolios.combine.Rd (rev 0)
+++ pkg/PortfolioAnalytics/man/portfolios.combine.Rd 2013-09-08 18:41:35 UTC (rev 3026)
@@ -0,0 +1,20 @@
+\name{portfolios.combine}
+\alias{portfolios.combine}
+\title{Combine objects created by portfolio}
+\usage{
+ portfolios.combine(x)
+}
+\arguments{
+ \item{x}{a list of objects created by
+ \code{\link{portfolio.spec}}}
+}
+\value{
+ a \code{portfolio.list} object
+}
+\description{
+ This function takes a list of objects created by
+ \code{\link{portfolio.spec}} and sets the class name
+ attribute to 'portfolio.list' for use in generic
+ functions
+}
+
Added: pkg/PortfolioAnalytics/sandbox/testing_mult_opt_weights.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/testing_mult_opt_weights.R (rev 0)
+++ pkg/PortfolioAnalytics/sandbox/testing_mult_opt_weights.R 2013-09-08 18:41:35 UTC (rev 3026)
@@ -0,0 +1,47 @@
+
+library(PortfolioAnalytics)
+library(ROI)
+library(ROI.plugin.glpk)
+library(ROI.plugin.quadprog)
+
+# We should be able to compare portfolios with different constraints,
+# objectives, and number of assets
+
+data(edhec)
+R <- edhec[, 1:4]
+funds <- colnames(R)
+
+##### Construct Portfolios #####
+# GMV long only
+port.gmv.lo <- portfolio.spec(assets=funds)
+port.gmv.lo <- add.constraint(portfolio=port.gmv.lo, type="full_investment")
+port.gmv.lo <- add.constraint(portfolio=port.gmv.lo, type="long_only")
+port.gmv.lo <- add.objective(portfolio=port.gmv.lo, type="risk", name="var")
+
+# GMV with shorting
+port.gmv.short <- portfolio.spec(assets=funds)
+port.gmv.short <- add.constraint(portfolio=port.gmv.short, type="full_investment")
+port.gmv.short <- add.constraint(portfolio=port.gmv.short, type="box", min=-0.3, max=1)
+port.gmv.short <- add.objective(portfolio=port.gmv.short, type="risk", name="var")
+
+# QU box constraints
+port.qu <- portfolio.spec(assets=funds)
+port.qu <- add.constraint(portfolio=port.qu, type="full_investment")
+port.qu <- add.constraint(portfolio=port.qu, type="box", min=0.05, max=0.6)
+port.qu <- add.objective(portfolio=port.qu, type="risk", name="var", risk_aversion=0.25)
+port.qu <- add.objective(portfolio=port.qu, type="return", name="mean")
+
+##### Run Optimizations #####
+opt.gmv.lo <- optimize.portfolio(R=R, portfolio=port.gmv.lo, optimize_method="ROI", trace=TRUE)
+opt.gmv.short <- optimize.portfolio(R=R, portfolio=port.gmv.short, optimize_method="ROI", trace=TRUE)
+opt.qu <- optimize.portfolio(R=R, portfolio=port.qu, optimize_method="ROI", trace=TRUE)
+
+
+opt <- optimizations.combine(list(GMV.LO=opt.gmv.lo, GMV.SHORT=opt.gmv.short, QU=opt.qu))
+class(opt)
+
+chart.Weights(opt, legend.loc="topleft", cex.legend=0.8, ylim=c(-0.3, 1))
+
+chart.Weights(opt, plot.type="bar", cex.lab=0.8, legend.loc="topleft", cex.legend=0.8, ylim=c(-0.3, 1))
+
+extractWeights(opt)
More information about the Returnanalytics-commits
mailing list