[Returnanalytics-commits] r2675 - pkg/PortfolioAnalytics/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Jul 30 01:03:54 CEST 2013
Author: rossbennett34
Date: 2013-07-30 01:03:53 +0200 (Tue, 30 Jul 2013)
New Revision: 2675
Modified:
pkg/PortfolioAnalytics/R/charts.RP.R
Log:
modifying chart.Weights.Rp to work with new interface
Modified: pkg/PortfolioAnalytics/R/charts.RP.R
===================================================================
--- pkg/PortfolioAnalytics/R/charts.RP.R 2013-07-29 21:42:03 UTC (rev 2674)
+++ pkg/PortfolioAnalytics/R/charts.RP.R 2013-07-29 23:03:53 UTC (rev 2675)
@@ -29,61 +29,67 @@
#' @seealso \code{\link{optimize.portfolio}}
#' @export
chart.Weights.RP <- function(RP, neighbors = NULL, ..., main="Weights", las = 3, xlab=NULL, cex.lab = 1, element.color = "darkgray", cex.axis=0.8){
-# Specific to the output of the random portfolio code with constraints
- # @TODO: check that RP is of the correct class
- columnnames = names(RP$weights)
- 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
- }
+ # Specific to the output of the random portfolio code with constraints
+ # @TODO: check that RP is of the correct class
+ # FIXED
+ if(!inherits(RP, "optimize.portfolio.random")){
+ stop("RP must be of class 'optimize.portfolio.random'")
+ }
+ columnnames = names(RP$weights)
+ numassets = length(columnnames)
+
+ constraints <- get_constraints(RP$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
+ }
+ else {
+ bottommargin = minmargin
+ }
+ par(mar = c(bottommargin, 4, topmargin, 2) +.1)
+ plot(RP$random_portfolios[1,], type="b", col="orange", axes=FALSE, xlab='', ylim=c(0,max(constraints$max)), ylab="Weights", main=main, ...)
+ 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(RP)
+ 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")
+ }
}
- par(mar = c(bottommargin, 4, topmargin, 2) +.1)
- plot(RP$random_portfolios[1,], type="b", col="orange", axes=FALSE, xlab='', ylim=c(0,max(RP$constraints$max)), ylab="Weights", main=main, ...)
- points(RP$constraints$min, type="b", col="darkgray", lty="solid", lwd=2, pch=24)
- points(RP$constraints$max, type="b", col="darkgray", lty="solid", lwd=2, pch=25)
- if(!is.null(neighbors)){
- if(is.vector(neighbors)){
- xtract=extractStats(RP)
- 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
- }
+ 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(RP$random_portfolios[1,], type="b", col="orange", pch=16) # to overprint neighbors
- points(RP$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)
-
+ }
+
+ points(RP$random_portfolios[1,], type="b", col="orange", pch=16) # to overprint neighbors
+ points(RP$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
More information about the Returnanalytics-commits
mailing list