[Returnanalytics-commits] r3029 - in pkg/PortfolioAnalytics: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Sep 9 04:07:59 CEST 2013
Author: rossbennett34
Date: 2013-09-09 04:07:57 +0200 (Mon, 09 Sep 2013)
New Revision: 3029
Modified:
pkg/PortfolioAnalytics/R/chart.Weights.R
pkg/PortfolioAnalytics/R/charts.DE.R
pkg/PortfolioAnalytics/R/charts.GenSA.R
pkg/PortfolioAnalytics/R/charts.PSO.R
pkg/PortfolioAnalytics/R/charts.ROI.R
pkg/PortfolioAnalytics/R/charts.RP.R
pkg/PortfolioAnalytics/man/chart.Weights.Rd
Log:
Adding option to plot the weights as a barplot
Modified: pkg/PortfolioAnalytics/R/chart.Weights.R
===================================================================
--- pkg/PortfolioAnalytics/R/chart.Weights.R 2013-09-08 23:37:26 UTC (rev 3028)
+++ pkg/PortfolioAnalytics/R/chart.Weights.R 2013-09-09 02:07:57 UTC (rev 3029)
@@ -31,3 +31,63 @@
UseMethod("chart.Weights")
}
+barplotWeights <- function(object, ..., main="Weights", las=3, xlab=NULL, cex.lab=1, element.color="darkgray", cex.axis=0.8, legend.loc="topright", cex.legend=0.8, colorset=NULL){
+ weights <- object$weights
+ columnnames <- names(weights)
+
+ 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:length(weights)
+ barplot(height=weights, las=las, main=main, xlab=xlab, ylab="Weights", cex.axis=cex.axis, cex.names=cex.lab, col=colorset, ...)
+ if(!is.null(legend.loc)){
+ legend(legend.loc, legend=names(weights), cex=cex.legend, fill=colorset, bty="n")
+ }
+ box(col=element.color)
+}
+
+
+barplotWeights <- function(object, ..., main="Weights", las=3, xlab=NULL, cex.lab=1, element.color="darkgray", cex.axis=0.8, legend.loc="topright", cex.legend=0.8, colorset=NULL){
+ weights <- object$weights
+ columnnames <- names(weights)
+
+ 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:length(weights)
+ barplot(height=weights, las=las, main=main, xlab=xlab, ylab="Weights", cex.axis=cex.axis, cex.names=cex.lab, col=colorset, ...)
+ if(!is.null(legend.loc)){
+ legend(legend.loc, legend=names(weights), cex=cex.legend, fill=colorset, bty="n")
+ }
+ box(col=element.color)
+}
Modified: pkg/PortfolioAnalytics/R/charts.DE.R
===================================================================
--- pkg/PortfolioAnalytics/R/charts.DE.R 2013-09-08 23:37:26 UTC (rev 3028)
+++ pkg/PortfolioAnalytics/R/charts.DE.R 2013-09-09 02:07:57 UTC (rev 3029)
@@ -11,74 +11,79 @@
###############################################################################
-chart.Weights.DE <- function(object, neighbors = NULL, ..., main="Weights", las = 3, xlab=NULL, cex.lab = 1, element.color = "darkgray", cex.axis=0.8){
+chart.Weights.DE <- 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"){
# Specific to the output of optimize.portfolio with optimize_method="DEoptim"
if(!inherits(object, "optimize.portfolio.DEoptim")) stop("object must be of class 'optimize.portfolio.DEoptim'")
- columnnames = names(object$weights)
- numassets = length(columnnames)
-
- constraints <- get_constraints(object$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
+ if(plot.type %in% c("bar", "barplot")){
+ barplotWeights(object=object, ..., main=main, las=las, xlab=xlab, cex.lab=cex.lab, element.color=element.color, cex.axis=cex.axis, legend.loc=legend.loc, cex.legend=cex.legend, colorset=colorset)
+ } else if(plot.type == "line"){
+
+ columnnames = names(object$weights)
+ numassets = length(columnnames)
+
+ constraints <- get_constraints(object$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)
+ if(any(is.infinite(constraints$max)) | any(is.infinite(constraints$min))){
+ # set ylim based on weights if box constraints contain Inf or -Inf
+ ylim <- range(object$weights)
+ } else {
+ # set ylim based on the range of box constraints min and max
+ ylim <- range(c(constraints$min, constraints$max))
+ }
+ plot(object$weights, type="b", col="blue", axes=FALSE, xlab='', ylim=ylim, ylab="Weights", main=main, pch=16, ...)
+ if(!any(is.infinite(constraints$min))){
+ points(constraints$min, type="b", col="darkgray", lty="solid", lwd=2, pch=24)
+ }
+ if(!any(is.infinite(constraints$max))){
+ points(constraints$max, type="b", col="darkgray", lty="solid", lwd=2, pch=25)
+ }
+ # if(!is.null(neighbors)){
+ # if(is.vector(neighbors)){
+ # xtract=extractStats(object)
+ # 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(object$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)
}
- else {
- bottommargin = minmargin
- }
- par(mar = c(bottommargin, 4, topmargin, 2) +.1)
- if(any(is.infinite(constraints$max)) | any(is.infinite(constraints$min))){
- # set ylim based on weights if box constraints contain Inf or -Inf
- ylim <- range(object$weights)
- } else {
- # set ylim based on the range of box constraints min and max
- ylim <- range(c(constraints$min, constraints$max))
- }
- plot(object$weights, type="b", col="blue", axes=FALSE, xlab='', ylim=ylim, ylab="Weights", main=main, pch=16, ...)
- if(!any(is.infinite(constraints$min))){
- points(constraints$min, type="b", col="darkgray", lty="solid", lwd=2, pch=24)
- }
- if(!any(is.infinite(constraints$max))){
- points(constraints$max, type="b", col="darkgray", lty="solid", lwd=2, pch=25)
- }
- # if(!is.null(neighbors)){
- # if(is.vector(neighbors)){
- # xtract=extractStats(object)
- # 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(object$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)
}
#' @rdname chart.Weights
Modified: pkg/PortfolioAnalytics/R/charts.GenSA.R
===================================================================
--- pkg/PortfolioAnalytics/R/charts.GenSA.R 2013-09-08 23:37:26 UTC (rev 3028)
+++ pkg/PortfolioAnalytics/R/charts.GenSA.R 2013-09-09 02:07:57 UTC (rev 3029)
@@ -1,71 +1,76 @@
-chart.Weights.GenSA <- function(object, neighbors = NULL, ..., main="Weights", las = 3, xlab=NULL, cex.lab = 1, element.color = "darkgray", cex.axis=0.8){
+chart.Weights.GenSA <- 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, "optimize.portfolio.GenSA")) stop("object must be of class 'optimize.portfolio.GenSA'")
- columnnames = names(object$weights)
- numassets = length(columnnames)
-
- constraints <- get_constraints(object$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
+ if(plot.type %in% c("bar", "barplot")){
+ barplotWeights(object=object, ..., main=main, las=las, xlab=xlab, cex.lab=cex.lab, element.color=element.color, cex.axis=cex.axis, legend.loc=legend.loc, cex.legend=cex.legend, colorset=colorset)
+ } else if(plot.type == "line"){
+
+ columnnames = names(object$weights)
+ numassets = length(columnnames)
+
+ constraints <- get_constraints(object$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)
+ if(any(is.infinite(constraints$max)) | any(is.infinite(constraints$min))){
+ # set ylim based on weights if box constraints contain Inf or -Inf
+ ylim <- range(object$weights)
+ } else {
+ # set ylim based on the range of box constraints min and max
+ ylim <- range(c(constraints$min, constraints$max))
+ }
+ plot(object$weights, type="b", col="blue", axes=FALSE, xlab='', ylim=ylim, ylab="Weights", main=main, pch=16, ...)
+ if(!any(is.infinite(constraints$min))){
+ points(constraints$min, type="b", col="darkgray", lty="solid", lwd=2, pch=24)
+ }
+ if(!any(is.infinite(constraints$max))){
+ 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)
}
- else {
- bottommargin = minmargin
- }
- par(mar = c(bottommargin, 4, topmargin, 2) +.1)
- if(any(is.infinite(constraints$max)) | any(is.infinite(constraints$min))){
- # set ylim based on weights if box constraints contain Inf or -Inf
- ylim <- range(object$weights)
- } else {
- # set ylim based on the range of box constraints min and max
- ylim <- range(c(constraints$min, constraints$max))
- }
- plot(object$weights, type="b", col="blue", axes=FALSE, xlab='', ylim=ylim, ylab="Weights", main=main, pch=16, ...)
- if(!any(is.infinite(constraints$min))){
- points(constraints$min, type="b", col="darkgray", lty="solid", lwd=2, pch=24)
- }
- if(!any(is.infinite(constraints$max))){
- 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)
}
#' @rdname chart.Weights
Modified: pkg/PortfolioAnalytics/R/charts.PSO.R
===================================================================
--- pkg/PortfolioAnalytics/R/charts.PSO.R 2013-09-08 23:37:26 UTC (rev 3028)
+++ pkg/PortfolioAnalytics/R/charts.PSO.R 2013-09-09 02:07:57 UTC (rev 3029)
@@ -1,71 +1,76 @@
-chart.Weights.pso <- function(object, neighbors = NULL, ..., main="Weights", las = 3, xlab=NULL, cex.lab = 1, element.color = "darkgray", cex.axis=0.8){
+chart.Weights.pso <- 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, "optimize.portfolio.pso")) stop("object must be of class 'optimize.portfolio.pso'")
- columnnames = names(object$weights)
- numassets = length(columnnames)
-
- constraints <- get_constraints(object$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
+ if(plot.type %in% c("bar", "barplot")){
+ barplotWeights(object=object, ..., main=main, las=las, xlab=xlab, cex.lab=cex.lab, element.color=element.color, cex.axis=cex.axis, legend.loc=legend.loc, cex.legend=cex.legend, colorset=colorset)
+ } else if(plot.type == "line"){
+
+ columnnames = names(object$weights)
+ numassets = length(columnnames)
+
+ constraints <- get_constraints(object$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)
+ if(any(is.infinite(constraints$max)) | any(is.infinite(constraints$min))){
+ # set ylim based on weights if box constraints contain Inf or -Inf
+ ylim <- range(object$weights)
+ } else {
+ # set ylim based on the range of box constraints min and max
+ ylim <- range(c(constraints$min, constraints$max))
+ }
+ plot(object$weights, type="b", col="blue", axes=FALSE, xlab='', ylim=ylim, ylab="Weights", main=main, pch=16, ...)
+ if(!any(is.infinite(constraints$min))){
+ points(constraints$min, type="b", col="darkgray", lty="solid", lwd=2, pch=24)
+ }
+ if(!any(is.infinite(constraints$max))){
+ 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)
}
- else {
- bottommargin = minmargin
- }
- par(mar = c(bottommargin, 4, topmargin, 2) +.1)
- if(any(is.infinite(constraints$max)) | any(is.infinite(constraints$min))){
- # set ylim based on weights if box constraints contain Inf or -Inf
- ylim <- range(object$weights)
- } else {
- # set ylim based on the range of box constraints min and max
- ylim <- range(c(constraints$min, constraints$max))
- }
- plot(object$weights, type="b", col="blue", axes=FALSE, xlab='', ylim=ylim, ylab="Weights", main=main, pch=16, ...)
- if(!any(is.infinite(constraints$min))){
- points(constraints$min, type="b", col="darkgray", lty="solid", lwd=2, pch=24)
- }
- if(!any(is.infinite(constraints$max))){
- 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)
}
#' @rdname chart.Weights
Modified: pkg/PortfolioAnalytics/R/charts.ROI.R
===================================================================
--- pkg/PortfolioAnalytics/R/charts.ROI.R 2013-09-08 23:37:26 UTC (rev 3028)
+++ pkg/PortfolioAnalytics/R/charts.ROI.R 2013-09-09 02:07:57 UTC (rev 3029)
@@ -1,71 +1,76 @@
-chart.Weights.ROI <- function(object, neighbors = NULL, ..., main="Weights", las = 3, xlab=NULL, cex.lab = 1, element.color = "darkgray", cex.axis=0.8){
-
+chart.Weights.ROI <- 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, "optimize.portfolio.ROI")) stop("object must be of class 'optimize.portfolio.ROI'")
- columnnames = names(object$weights)
- numassets = length(columnnames)
-
- constraints <- get_constraints(object$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
+ if(plot.type %in% c("bar", "barplot")){
+ barplotWeights(object=object, ..., main=main, las=las, xlab=xlab, cex.lab=cex.lab, element.color=element.color, cex.axis=cex.axis, legend.loc=legend.loc, cex.legend=cex.legend, colorset=colorset)
+ } else if(plot.type == "line"){
+
+ columnnames = names(object$weights)
+ numassets = length(columnnames)
+
+ constraints <- get_constraints(object$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)
+ if(any(is.infinite(constraints$max)) | any(is.infinite(constraints$min))){
+ # set ylim based on weights if box constraints contain Inf or -Inf
+ ylim <- range(object$weights)
+ } else {
+ # set ylim based on the range of box constraints min and max
+ ylim <- range(c(constraints$min, constraints$max))
+ }
+ plot(object$weights, type="b", col="blue", axes=FALSE, xlab='', ylim=ylim, ylab="Weights", main=main, pch=16, ...)
+ if(!any(is.infinite(constraints$min))){
+ points(constraints$min, type="b", col="darkgray", lty="solid", lwd=2, pch=24)
+ }
+ if(!any(is.infinite(constraints$max))){
+ points(constraints$max, type="b", col="darkgray", lty="solid", lwd=2, pch=25)
+ }
+ # if(!is.null(neighbors)){
+ # if(is.vector(neighbors)){
+ # xtract=extractStats(object)
+ # 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(object$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)
}
- else {
- bottommargin = minmargin
- }
- par(mar = c(bottommargin, 4, topmargin, 2) +.1)
- if(any(is.infinite(constraints$max)) | any(is.infinite(constraints$min))){
- # set ylim based on weights if box constraints contain Inf or -Inf
- ylim <- range(object$weights)
- } else {
- # set ylim based on the range of box constraints min and max
- ylim <- range(c(constraints$min, constraints$max))
- }
- plot(object$weights, type="b", col="blue", axes=FALSE, xlab='', ylim=ylim, ylab="Weights", main=main, pch=16, ...)
- if(!any(is.infinite(constraints$min))){
- points(constraints$min, type="b", col="darkgray", lty="solid", lwd=2, pch=24)
- }
- if(!any(is.infinite(constraints$max))){
- points(constraints$max, type="b", col="darkgray", lty="solid", lwd=2, pch=25)
- }
- # if(!is.null(neighbors)){
- # if(is.vector(neighbors)){
- # xtract=extractStats(object)
- # 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(object$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)
}
#' @rdname chart.Weights
Modified: pkg/PortfolioAnalytics/R/charts.RP.R
===================================================================
--- pkg/PortfolioAnalytics/R/charts.RP.R 2013-09-08 23:37:26 UTC (rev 3028)
+++ pkg/PortfolioAnalytics/R/charts.RP.R 2013-09-09 02:07:57 UTC (rev 3029)
@@ -10,76 +10,82 @@
#
###############################################################################
-chart.Weights.RP <- function(object, neighbors = NULL, ..., main="Weights", las = 3, xlab=NULL, cex.lab = 1, element.color = "darkgray", cex.axis=0.8){
+chart.Weights.RP <- 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"){
# Specific to the output of the random portfolio code with constraints
if(!inherits(object, "optimize.portfolio.random")){
stop("object must be of class 'optimize.portfolio.random'")
}
- columnnames = names(object$weights)
- numassets = length(columnnames)
- constraints <- get_constraints(object$portfolio)
-
- if(is.null(xlab))
- minmargin = 3
- else
- minmargin = 5
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/returnanalytics -r 3029
More information about the Returnanalytics-commits
mailing list