[Returnanalytics-commits] r2735 - pkg/PortfolioAnalytics/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Aug 7 00:18:06 CEST 2013
Author: rossbennett34
Date: 2013-08-07 00:18:06 +0200 (Wed, 07 Aug 2013)
New Revision: 2735
Added:
pkg/PortfolioAnalytics/R/charts.PSO.R
Log:
adding chart methods for pso optimization method
Added: pkg/PortfolioAnalytics/R/charts.PSO.R
===================================================================
--- pkg/PortfolioAnalytics/R/charts.PSO.R (rev 0)
+++ pkg/PortfolioAnalytics/R/charts.PSO.R 2013-08-06 22:18:06 UTC (rev 2735)
@@ -0,0 +1,165 @@
+#' boxplot of the weights in the portfolio
+#'
+#' @param pso object created by \code{\link{optimize.portfolio}}
+#' @param neighbors set of 'neighbor' portfolios to overplot
+#' @param las numeric in \{0,1,2,3\}; the style of axis labels
+#' \describe{
+#' \item{0:}{always parallel to the axis [\emph{default}],}
+#' \item{1:}{always horizontal,}
+#' \item{2:}{always perpendicular to the axis,}
+#' \item{3:}{always vertical.}
+#' }
+#' @param xlab a title for the x axis: see \code{\link{title}}
+#' @param cex.lab The magnification to be used for x and y labels relative to the current setting of \code{cex}
+#' @param cex.axis The magnification to be used for axis annotation relative to the current setting of \code{cex}
+#' @param element.color color for the default plot lines
+#' @param ... any other passthru parameters
+#' @param main an overall title for the plot: see \code{\link{title}}
+#' @seealso \code{\link{optimize.portfolio}}
+#' @author Ross Bennett
+#' @export
+chart.Weights.pso <- function(pso, neighbors = NULL, ..., main="Weights", las = 3, xlab=NULL, cex.lab = 1, element.color = "darkgray", cex.axis=0.8){
+
+ if(!inherits(pso, "optimize.portfolio.pso")) stop("pso must be of class 'optimize.portfolio.pso'")
+
+ columnnames = names(pso$weights)
+ numassets = length(columnnames)
+
+ constraints <- get_constraints(pso$portfolio)
+
+ 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)
+ plot(pso$weights, type="b", col="blue", axes=FALSE, xlab='', ylim=c(0,max(constraints$max)), ylab="Weights", main=main, pch=16, ...)
+ points(constraints$min, type="b", col="darkgray", lty="solid", lwd=2, pch=24)
+ points(constraints$max, type="b", col="darkgray", lty="solid", lwd=2, pch=25)
+ # if(!is.null(neighbors)){
+ # if(is.vector(neighbors)){
+ # xtract=extractStats(ROI)
+ # weightcols<-grep('w\\.',colnames(xtract)) #need \\. to get the dot
+ # if(length(neighbors)==1){
+ # # overplot nearby portfolios defined by 'out'
+ # orderx = order(xtract[,"out"])
+ # subsetx = head(xtract[orderx,], n=neighbors)
+ # for(i in 1:neighbors) points(subsetx[i,weightcols], type="b", col="lightblue")
+ # } else{
+ # # assume we have a vector of portfolio numbers
+ # subsetx = xtract[neighbors,weightcols]
+ # for(i in 1:length(neighbors)) points(subsetx[i,], type="b", col="lightblue")
+ # }
+ # }
+ # if(is.matrix(neighbors) | is.data.frame(neighbors)){
+ # # the user has likely passed in a matrix containing calculated values for risk.col and return.col
+ # nbweights<-grep('w\\.',colnames(neighbors)) #need \\. to get the dot
+ # for(i in 1:nrow(neighbors)) points(as.numeric(neighbors[i,nbweights]), type="b", col="lightblue")
+ # # note that here we need to get weight cols separately from the matrix, not from xtract
+ # # also note the need for as.numeric. points() doesn't like matrix inputs
+ # }
+ # }
+ # points(ROI$weights, type="b", col="blue", pch=16)
+ 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)
+}
+
+
+#' classic risk return scatter of random portfolios
+#'
+#'
+#' \code{return.col} must be the name of a function used to compute the return metric on the portfolio weights
+#' \code{risk.col} must be the name of a function used to compute the risk metric on the portfolio weights
+#'
+#' @param pso object created by \code{\link{optimize.portfolio}}
+#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns, used to recalulate the risk and return metric
+#' @param return.col string matching the objective of a 'return' objective, on vertical axis
+#' @param risk.col string matching the objective of a 'risk' objective, on horizontal axis
+#' @param ... any other passthru parameters
+#' @param cex.axis The magnification to be used for axis annotation relative to the current setting of \code{cex}
+#' @param element.color color for the default plot scatter points
+#' @seealso \code{\link{optimize.portfolio}}
+#' @author Ross Bennett
+#' @export
+chart.Scatter.pso <- function(pso, R, return.col="mean", risk.col="StdDev", ..., element.color = "darkgray", cex.axis=0.8, main=""){
+ if(!inherits(pso, "optimize.portfolio.pso")) stop("pso must be of class 'optimize.portfolio.pso'")
+
+ # Object with the "out" value in the first column and the normalized weights
+ # The first row is the optimal "out" value and the optimal weights
+ tmp <- extractStats(pso)
+
+ # Get the weights
+ wts <- tmp[,-1]
+
+ returnpoints <- applyFUN(R=R, weights=wts, FUN=return.col, ...=...)
+ riskpoints <- applyFUN(R=R, weights=wts, FUN=risk.col, ...=...)
+
+ plot(x=riskpoints, y=returnpoints, xlab=risk.col, ylab=return.col, col="darkgray", axes=FALSE, main=main)
+ points(x=riskpoints[1], y=returnpoints[1], col="blue", pch=16) # optimal
+ axis(1, cex.axis = cex.axis, col = element.color)
+ axis(2, cex.axis = cex.axis, col = element.color)
+ box(col = element.color)
+}
+
+#' scatter and weights chart for portfolios
+#'
+#' \code{return.col} must be the name of a function used to compute the return metric on the random portfolio weights
+#' \code{risk.col} must be the name of a function used to compute the risk metric on the random portfolio weights
+#'
+#' @param pso object created by \code{\link{optimize.portfolio}}
+#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns, used to recalulate the risk and return metric
+#' @param return.col string matching the objective of a 'return' objective, on vertical axis
+#' @param risk.col string matching the objective of a 'risk' objective, on horizontal axis
+#' @param ... any other passthru parameters
+#' @param cex.axis The magnification to be used for axis annotation relative to the current setting of \code{cex}
+#' @param element.color color for the default plot scatter points
+#' @param neighbors set of 'neighbor' portfolios to overplot
+#' @param main an overall title for the plot: see \code{\link{title}}
+#' @seealso \code{\link{optimize.portfolio}}
+#' @author Ross Bennett
+#' @export
+charts.pso <- function(pso, R, return.col="mean", risk.col="StdDev",
+ cex.axis=0.8, element.color="darkgray", neighbors=NULL, main="PSO.Portfolios", ...){
+ # Specific to the output of the optimize_method=pso
+ op <- par(no.readonly=TRUE)
+ layout(matrix(c(1,2)),height=c(2,2),width=1)
+ par(mar=c(4,4,4,2))
+ chart.Scatter.pso(pso=pso, R=R, return.col=return.col, risk.col=risk.col, element.color=element.color, cex.axis=cex.axis, main=main, ...=...)
+ par(mar=c(2,4,0,2))
+ chart.Weights.pso(pso=pso, neighbors=neighbors, las=3, xlab=NULL, cex.lab=1, element.color=element.color, cex.axis=cex.axis, ...=..., main="")
+ par(op)
+}
+
+#' scatter and weights chart for portfolios
+#'
+#' \code{return.col} must be the name of a function used to compute the return metric on the random portfolio weights
+#' \code{risk.col} must be the name of a function used to compute the risk metric on the random portfolio weights
+#'
+#' @param pso object created by \code{\link{optimize.portfolio}}
+#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns, used to recalulate the risk and return metric
+#' @param return.col string matching the objective of a 'return' objective, on vertical axis
+#' @param risk.col string matching the objective of a 'risk' objective, on horizontal axis
+#' @param ... any other passthru parameters
+#' @param cex.axis The magnification to be used for axis annotation relative to the current setting of \code{cex}
+#' @param element.color color for the default plot scatter points
+#' @param neighbors set of 'neighbor' portfolios to overplot
+#' @param main an overall title for the plot: see \code{\link{title}}
+#' @seealso \code{\link{optimize.portfolio}}
+#' @author Ross Bennett
+#' @export
+plot.optimize.portfolio.pso <- function(pso, R, return.col="mean", risk.col="StdDev",
+ cex.axis=0.8, element.color="darkgray", neighbors=NULL, main="PSO.Portfolios", ...){
+ charts.pso(pso=pso, R=R, return.col=return.col, risk.col=risk.col, cex.axis=cex.axis, element.color=element.color, neighbors=neighbors, main=main, ...=...)
+}
More information about the Returnanalytics-commits
mailing list