[Returnanalytics-commits] r3302 - in pkg/PortfolioAnalytics: . R sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Jan 19 20:52:42 CET 2014
Author: braverock
Date: 2014-01-19 20:52:42 +0100 (Sun, 19 Jan 2014)
New Revision: 3302
Modified:
pkg/PortfolioAnalytics/DESCRIPTION
pkg/PortfolioAnalytics/R/applyFUN.R
pkg/PortfolioAnalytics/R/chart.RiskReward.R
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/R/charts.efficient.frontier.R
pkg/PortfolioAnalytics/R/charts.groups.R
pkg/PortfolioAnalytics/R/charts.multiple.R
pkg/PortfolioAnalytics/R/charts.risk.R
pkg/PortfolioAnalytics/R/constrained_objective.R
pkg/PortfolioAnalytics/R/constraint_fn_map.R
pkg/PortfolioAnalytics/R/constraints.R
pkg/PortfolioAnalytics/R/constraintsFUN.R
pkg/PortfolioAnalytics/R/constraints_ROI.R
pkg/PortfolioAnalytics/R/equal.weight.R
pkg/PortfolioAnalytics/R/extract.efficient.frontier.R
pkg/PortfolioAnalytics/R/extractstats.R
pkg/PortfolioAnalytics/R/generics.R
pkg/PortfolioAnalytics/R/inverse.volatility.weight.R
pkg/PortfolioAnalytics/R/moment.functions.R
pkg/PortfolioAnalytics/R/objective.R
pkg/PortfolioAnalytics/R/objectiveFUN.R
pkg/PortfolioAnalytics/R/optFUN.R
pkg/PortfolioAnalytics/R/optimize.portfolio.R
pkg/PortfolioAnalytics/R/portfolio.R
pkg/PortfolioAnalytics/R/random_portfolios.R
pkg/PortfolioAnalytics/R/trailingFUN.R
pkg/PortfolioAnalytics/R/utility.combine.R
pkg/PortfolioAnalytics/R/utils.R
pkg/PortfolioAnalytics/sandbox/TAA.R
pkg/PortfolioAnalytics/sandbox/applylocalsearch.R
pkg/PortfolioAnalytics/sandbox/localsearch.R
pkg/PortfolioAnalytics/sandbox/optimizer.R
Log:
- update Copyright to 2014, bump version
Modified: pkg/PortfolioAnalytics/DESCRIPTION
===================================================================
--- pkg/PortfolioAnalytics/DESCRIPTION 2014-01-18 15:26:12 UTC (rev 3301)
+++ pkg/PortfolioAnalytics/DESCRIPTION 2014-01-19 19:52:42 UTC (rev 3302)
@@ -1,8 +1,8 @@
Package: PortfolioAnalytics
Type: Package
-Title: Portfolio Analysis, including Numeric Methods for Optimization
+Title: Portfolio Analysis, including Numerical Methods for Optimization
of Portfolios
-Version: 0.8.3
+Version: 0.9.0
Date: $Date$
Author: Brian G. Peterson, Peter Carl, Ross Bennett, Kris Boudt
Contributors: R. Douglas Martin, Guy Yollin, Hezky Varon
@@ -27,9 +27,10 @@
ROI.plugin.symphony (>= 0.0.2),
pso,
GenSA,
- corpcor
+ corpcor,
+ testthat
License: GPL
-Copyright: (c) 2004-2012
+Copyright: (c) 2004-2014
Collate:
'charts.DE.R'
'charts.RP.R'
Modified: pkg/PortfolioAnalytics/R/applyFUN.R
===================================================================
--- pkg/PortfolioAnalytics/R/applyFUN.R 2014-01-18 15:26:12 UTC (rev 3301)
+++ pkg/PortfolioAnalytics/R/applyFUN.R 2014-01-19 19:52:42 UTC (rev 3302)
@@ -154,3 +154,4116 @@
}
return(out)
}
+
+#' classic risk reward scatter
+#'
+#' This function charts the \code{optimize.portfolio} object in risk-return space.
+#'
+#' @details
+#' \code{neighbors} may be specified in three ways.
+#' The first is as a single number of neighbors. This will extract the \code{neighbors} closest
+#' portfolios in terms of the \code{out} numerical statistic.
+#' The second method consists of a numeric vector for \code{neighbors}.
+#' This will extract the \code{neighbors} with portfolio index numbers that correspond to the vector contents.
+#' The third method for specifying \code{neighbors} is to pass in a matrix.
+#' This matrix should look like the output of \code{\link{extractStats}}, and should contain
+#' \code{risk.col},\code{return.col}, and weights columns all properly named.
+#'
+#' @param object optimal portfolio created by \code{\link{optimize.portfolio}}.
+#' @param neighbors set of 'neighbor' portfolios to overplot, see Details.
+#' @param \dots any other passthru parameters.
+#' @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 chart.assets TRUE/FALSE. Includes a risk reward scatter of the assets in the chart.
+#' @param element.color color for the default plot scatter points.
+#' @param cex.axis The magnification to be used for axis annotation relative to the current setting of \code{cex}.
+#' @param xlim set the x-axis limit, same as in \code{\link{plot}}.
+#' @param ylim set the y-axis limit, same as in \code{\link{plot}}.
+#' @param rp TRUE/FALSE to generate random portfolios to plot the feasible space
+#' @param main a main title for the plot.
+#' @param labels.assets TRUE/FALSE to include the names in the plot.
+#' @param pch.assets plotting character of the assets, same as in \code{\link{plot}}
+#' @param cex.assets numerical value giving the amount by which the asset points should be magnified relative to the default.
+#' @param cex.lab numerical value giving the amount by which the labels should be magnified relative to the default.
+#' @param colorset color palette or vector of colors to use.
+#' @seealso \code{\link{optimize.portfolio}}
+#' @export
+chart.RiskReward <- function(object, ...){
+ UseMethod("chart.RiskReward")
+}
+
+
+#' Chart the efficient frontier and risk-return scatter
+#'
+#' Chart the efficient frontier and risk-return scatter of the assets for
+#' \code{optimize.portfolio} or \code{efficient.frontier} objects
+#'
+#' @details
+#' For objects created by optimize.portfolio with 'DEoptim', 'random', or 'pso'
+#' specified as the optimize_method:
+#' \itemize{
+#' \item The efficient frontier plotted is based on the the trace information (sets of
+#' portfolios tested by the solver at each iteration) in objects created by
+#' \code{optimize.portfolio}.
+#' }
+#'
+#' For objects created by optimize.portfolio with 'ROI' specified as the
+#' optimize_method:
+#' \itemize{
+#' \item The mean-StdDev or mean-ETL efficient frontier can be plotted for optimal
+#' portfolio objects created by \code{optimize.portfolio}.
+#'
+#' \item If \code{match.col="StdDev"}, the mean-StdDev efficient frontier is plotted.
+#'
+#' \item If \code{match.col="ETL"} (also "ES" or "CVaR"), the mean-ETL efficient frontier is plotted.
+#' }
+#'
+#' Note that \code{trace=TRUE} must be specified in \code{\link{optimize.portfolio}}
+#'
+#' GenSA does not return any useable trace information for portfolios tested at
+#' each iteration, therfore we cannot extract and chart an efficient frontier.
+#'
+#' By default, the tangency portfolio (maximum Sharpe Ratio or modified Sharpe Ratio)
+#' will be plotted using a risk free rate of 0. Set \code{rf=NULL} to omit
+#' this from the plot.
+#'
+#' @param object object to chart.
+#' @param \dots passthru parameters to \code{\link{plot}}
+#' @param match.col string name of column to use for risk (horizontal axis).
+#' \code{match.col} must match the name of an objective measure in the
+#' \code{objective_measures} or \code{opt_values} slot in the object created
+#' by \code{\link{optimize.portfolio}}.
+#' @param n.portfolios number of portfolios to use to plot the efficient frontier.
+#' @param xlim set the x-axis limit, same as in \code{\link{plot}}.
+#' @param ylim set the y-axis limit, same as in \code{\link{plot}}.
+#' @param cex.axis numerical value giving the amount by which the axis should be magnified relative to the default.
+#' @param element.color provides the color for drawing less-important chart elements, such as the box lines, axis lines, etc.
+#' @param main a main title for the plot.
+#' @param RAR.text string name for risk adjusted return text to plot in the legend.
+#' @param rf risk free rate. If \code{rf} is not null, the maximum Sharpe Ratio or modified Sharpe Ratio tangency portfolio will be plotted.
+#' @param tangent.line TRUE/FALSE to plot the tangent line.
+#' @param cex.legend numerical value giving the amount by which the legend should be magnified relative to the default.
+#' @param chart.assets TRUE/FALSE to include the assets.
+#' @param labels.assets TRUE/FALSE to include the asset names in the plot.
+#' \code{chart.assets} must be \code{TRUE} to plot asset names.
+#' @param pch.assets plotting character of the assets, same as in \code{\link{plot}}.
+#' @param cex.assets numerical value giving the amount by which the asset points and labels should be magnified relative to the default.
+#' @author Ross Bennett
+#' @rdname chart.EfficientFrontier
+#' @export
+chart.EfficientFrontier <- function(object, ...){
+ UseMethod("chart.EfficientFrontier")
+}
+
+#' @rdname chart.EfficientFrontier
+#' @method chart.EfficientFrontier optimize.portfolio.ROI
+#' @S3method chart.EfficientFrontier optimize.portfolio.ROI
+chart.EfficientFrontier.optimize.portfolio.ROI <- function(object, ..., match.col="ES", n.portfolios=25, xlim=NULL, ylim=NULL, cex.axis=0.8, element.color="darkgray", main="Efficient Frontier", RAR.text="SR", rf=0, tangent.line=TRUE, cex.legend=0.8, chart.assets=TRUE, labels.assets=TRUE, pch.assets=21, cex.assets=0.8){
+ if(!inherits(object, "optimize.portfolio.ROI")) stop("object must be of class optimize.portfolio.ROI")
+
+ portf <- object$portfolio
+ R <- object$R
+ if(is.null(R)) stop(paste("Not able to get asset returns from", object))
+ wts <- object$weights
+ objectclass <- class(object)[1]
+
+ # objnames <- unlist(lapply(portf$objectives, function(x) x$name))
+ # if(!(match.col %in% objnames)){
+ # stop("match.col must match an objective name")
+ # }
+
+ # get the optimal return and risk metrics
+ xtract <- extractStats(object=object)
+ columnames <- names(xtract)
+ if(!(("mean") %in% columnames)){
+ # we need to calculate the mean given the optimal weights
+ opt_ret <- applyFUN(R=R, weights=wts, FUN="mean")
+ } else {
+ opt_ret <- xtract["mean"]
+ }
+ # get the match.col column
+ mtc <- pmatch(match.col, columnames)
+ if(is.na(mtc)) {
+ mtc <- pmatch(paste(match.col,match.col,sep='.'), columnames)
+ }
+ if(is.na(mtc)){
+ # if(is.na(mtc)) stop("could not match match.col with column name of extractStats output")
+ opt_risk <- applyFUN(R=R, weights=wts, FUN=match.col)
+ } else {
+ opt_risk <- xtract[mtc]
+ }
+
+ # get the data to plot scatter of asset returns
+ asset_ret <- scatterFUN(R=R, FUN="mean")
+ asset_risk <- scatterFUN(R=R, FUN=match.col)
+ rnames <- colnames(R)
+
+ if(match.col %in% c("ETL", "ES", "CVaR")){
+ frontier <- meanetl.efficient.frontier(portfolio=portf, R=R, n.portfolios=n.portfolios)
+ rar <- "STARR"
+ }
+ if(match.col == "StdDev"){
+ frontier <- meanvar.efficient.frontier(portfolio=portf, R=R, n.portfolios=n.portfolios)
+ rar <- "SR"
+ }
+ # data points to plot the frontier
+ x.f <- frontier[, match.col]
+ y.f <- frontier[, "mean"]
+
+ # Points for the Sharpe Ratio ((mu - rf) / StdDev) or STARR ((mu - rf) / ETL)
+ if(!is.null(rf)){
+ sr <- (y.f - rf) / (x.f)
+ idx.maxsr <- which.max(sr)
+ srmax <- sr[idx.maxsr]
+ }
+
+ # set the x and y limits
+ if(is.null(xlim)){
+ xlim <- range(c(x.f, asset_risk))
+ # xlim[1] <- xlim[1] * 0.8
+ xlim[1] <- 0
+ xlim[2] <- xlim[2] * 1.15
+ }
+ if(is.null(ylim)){
+ ylim <- range(c(y.f, asset_ret))
+ # ylim[1] <- ylim[1] * 0.9
+ ylim[1] <- 0
+ ylim[2] <- ylim[2] * 1.1
+ }
+
+ # plot the efficient frontier line
+ plot(x=x.f, y=y.f, ylab="Mean", xlab=match.col, main=main, xlim=xlim, ylim=ylim, axes=FALSE, ...)
+
+ # Add the global minimum variance or global minimum ETL portfolio
+ points(x=x.f[1], y=y.f[1], pch=16)
+
+ if(chart.assets){
+ # risk-return scatter of the assets
+ points(x=asset_risk, y=asset_ret, pch=pch.assets, cex=cex.assets)
+ if(labels.assets) text(x=asset_risk, y=asset_ret, labels=rnames, pos=4, cex=cex.assets)
+ }
+
+ # plot the optimal portfolio
+ points(opt_risk, opt_ret, col="blue", pch=16) # optimal
+ text(x=opt_risk, y=opt_ret, labels="Optimal",col="blue", pos=4, cex=0.8)
+ if(!is.null(rf)){
+ # Plot tangency line and points at risk-free rate and tangency portfolio
+ if(tangent.line) abline(rf, srmax, lty=2)
+ points(0, rf, pch=16)
+ points(x.f[idx.maxsr], y.f[idx.maxsr], pch=16)
+ # text(x=x.f[idx.maxsr], y=y.f[idx.maxsr], labels="T", pos=4, cex=0.8)
+ # Add lengend with max Sharpe Ratio and risk-free rate
+ legend("topleft", paste(RAR.text, " = ", signif(srmax,3), sep = ""), bty = "n", cex=cex.legend)
+ legend("topleft", inset = c(0,0.05), paste("rf = ", signif(rf,3), sep = ""), bty = "n", cex=cex.legend)
+ }
+ axis(1, cex.axis = cex.axis, col = element.color)
+ axis(2, cex.axis = cex.axis, col = element.color)
+ box(col = element.color)
+}
+
+#' @rdname chart.EfficientFrontier
+#' @method chart.EfficientFrontier optimize.portfolio
+#' @S3method chart.EfficientFrontier optimize.portfolio
+chart.EfficientFrontier.optimize.portfolio <- function(object, ..., match.col="ES", n.portfolios=25, xlim=NULL, ylim=NULL, cex.axis=0.8, element.color="darkgray", main="Efficient Frontier", RAR.text="SR", rf=0, tangent.line=TRUE, cex.legend=0.8, chart.assets=TRUE, labels.assets=TRUE, pch.assets=21, cex.assets=0.8){
+ # This function will work with objects of class optimize.portfolio.DEoptim,
+ # optimize.portfolio.random, and optimize.portfolio.pso
+
+ if(inherits(object, "optimize.portfolio.GenSA")){
+ stop("GenSA does not return any useable trace information for portfolios tested, thus we cannot extract an efficient frontier.")
+ }
+
+ if(!inherits(object, "optimize.portfolio")) stop("object must be of class optimize.portfolio")
+
+ portf <- object$portfolio
+ R <- object$R
+ if(is.null(R)) stop(paste("Not able to get asset returns from", object))
+ wts <- object$weights
+
+ # get the stats from the object
+ xtract <- extractStats(object=object)
+ columnames <- colnames(xtract)
+
+ # Check if match.col is in extractStats output
+ if(!(match.col %in% columnames)){
+ stop(paste(match.col, "is not a column in extractStats output"))
+ }
+
+ # check if 'mean' is in extractStats output
+ if(!("mean" %in% columnames)){
+ stop("mean is not a column in extractStats output")
+ }
+
+ # get the stats of the optimal portfolio
+ optstats <- xtract[which.min(xtract[, "out"]), ]
+ opt_ret <- optstats["mean"]
+ opt_risk <- optstats[match.col]
+
+ # get the data to plot scatter of asset returns
+ asset_ret <- scatterFUN(R=R, FUN="mean")
+ asset_risk <- scatterFUN(R=R, FUN=match.col)
+ rnames <- colnames(R)
+
+ # get the data of the efficient frontier
+ frontier <- extract.efficient.frontier(object=object, match.col=match.col, n.portfolios=n.portfolios)
+
+ # data points to plot the frontier
+ x.f <- frontier[, match.col]
+ y.f <- frontier[, "mean"]
+
+ # Points for the Sharpe or Modified Sharpe Ratio
+ if(!is.null(rf)){
+ sr <- (y.f - rf) / (x.f)
+ idx.maxsr <- which.max(sr)
+ srmax <- sr[idx.maxsr]
+ }
+
+ # set the x and y limits
+ if(is.null(xlim)){
+ xlim <- range(c(x.f, asset_risk))
+ # xlim[1] <- xlim[1] * 0.8
+ xlim[1] <- 0
+ xlim[2] <- xlim[2] * 1.15
+ }
+ if(is.null(ylim)){
+ ylim <- range(c(y.f, asset_ret))
+ # ylim[1] <- ylim[1] * 0.9
+ ylim[1] <- 0
+ ylim[2] <- ylim[2] * 1.1
+ }
+
+ # plot the efficient frontier line
+ plot(x=x.f, y=y.f, ylab="Mean", xlab=match.col, main=main, xlim=xlim, ylim=ylim, axes=FALSE, ...)
+
+ # Add the global minimum variance or global minimum ETL portfolio
+ points(x=x.f[1], y=y.f[1], pch=16)
+
+ if(chart.assets){
+ # risk-return scatter of the assets
+ points(x=asset_risk, y=asset_ret, pch=pch.assets, cex=cex.assets)
+ if(labels.assets) text(x=asset_risk, y=asset_ret, labels=rnames, pos=4, cex=cex.assets)
+ }
+
+ # plot the optimal portfolio
+ points(opt_risk, opt_ret, col="blue", pch=16) # optimal
+ text(x=opt_risk, y=opt_ret, labels="Optimal",col="blue", pos=4, cex=0.8)
+ if(!is.null(rf)){
+ # Plot tangency line and points at risk-free rate and tangency portfolio
+ if(tangent.line) abline(rf, srmax, lty=2)
+ points(0, rf, pch=16)
+ points(x.f[idx.maxsr], y.f[idx.maxsr], pch=16)
+ # text(x=x.f[idx.maxsr], y=y.f[idx.maxsr], labels="T", pos=4, cex=0.8)
+ # Add lengend with max Sharpe Ratio and risk-free rate
+ legend("topleft", paste(RAR.text, " = ", signif(srmax,3), sep = ""), bty = "n", cex=cex.legend)
+ legend("topleft", inset = c(0,0.05), paste("rf = ", signif(rf,3), sep = ""), bty = "n", cex=cex.legend)
+ }
+ axis(1, cex.axis = cex.axis, col = element.color)
+ axis(2, cex.axis = cex.axis, col = element.color)
+ box(col = element.color)
+}
+
+
+#' Chart weights along an efficient frontier
+#'
+#' This function produces a stacked barplot of weights along an efficient frontier.
+#'
+#' @param object object of class \code{efficient.frontier} or \code{optimize.portfolio}.
+#' @param \dots passthru parameters to \code{barplot}.
+#' @param colorset color palette or vector of colors to use.
+#' @param n.portfolios number of portfolios to extract along the efficient frontier.
+#' @param by.groups TRUE/FALSE. If TRUE, the group weights are charted.
+#' @param match.col string name of column to use for risk (horizontal axis). Must match the name of an objective.
+#' @param main title used in the plot.
+#' @param cex.lab the magnification to be used for x-axis and y-axis labels relative to the current setting of 'cex'.
+#' @param cex.axis the magnification to be used for sizing the axis text relative to the current setting of 'cex', similar to \code{\link{plot}}.
+#' @param cex.legend the magnification to be used for sizing the legend relative to the current setting of 'cex', similar to \code{\link{plot}}.
+#' @param legend.labels character vector to use for the legend labels.
+#' @param element.color provides the color for drawing less-important chart elements, such as the box lines, axis lines, etc.
+#' @param legend.loc NULL, "topright", "right", or "bottomright". If legend.loc is NULL, the legend will not be plotted.
+#' @author Ross Bennett
+#' @rdname chart.Weights.EF
+#' @export
+chart.Weights.EF <- function(object, ...){
+ UseMethod("chart.Weights.EF")
+}
+
+
+#' @rdname chart.Weights.EF
+#' @method chart.Weights.EF efficient.frontier
+#' @S3method chart.Weights.EF efficient.frontier
+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'")
+
+ if(is.list(object)){
+ # Objects created with create.EfficientFrontier will be a list of 2 elements
+ frontier <- object$frontier
+ } else {
+ # Objects created with extractEfficientFrontier will only be an efficient.frontier object
+ frontier <- object
+ }
+
+
+ # get the columns with weights
+ cnames <- colnames(frontier)
+ 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)
+ if(is.na(mean.mtc)) {
+ mean.mtc <- pmatch("mean.mean", cnames)
+ }
+ if(is.na(mean.mtc)) stop("could not match 'mean' with column name of extractStats output")
+
+ # risk along the efficient frontier
+ # get the match.col column
+ mtc <- pmatch(match.col, cnames)
+ if(is.na(mtc)) {
+ mtc <- pmatch(paste(match.col,match.col,sep='.'),cnames)
+ }
+ if(is.na(mtc)) stop("could not match match.col with column name of extractStats output")
+
+ # compute the weights for the barplot
+ pos.weights <- +0.5 * (abs(wts) + wts)
+ neg.weights <- -0.5 * (abs(wts) - wts)
+
+ # Define Plot Range:
+ ymax <- max(rowSums(pos.weights))
+ ymin <- min(rowSums(neg.weights))
+ range <- ymax - ymin
+ ymax <- ymax + 0.005 * range
+ ymin <- ymin - 0.005 * range
+ dim <- dim(wts)
+ range <- dim[1]
+ xmin <- 0
+ if(is.null(legend.loc)){
+ xmax <- range
+ } else {
+ xmax <- range + 0.3 * range
+ }
+
+ # set the colorset if no colorset is passed in
+ if(is.null(colorset))
+ colorset <- 1:dim[2]
+
+ # plot the positive weights
+ barplot(t(pos.weights), col = colorset, space = 0, ylab = "",
+ xlim = c(xmin, xmax), ylim = c(ymin, ymax),
+ border = element.color, cex.axis=cex.axis,
+ axisnames=FALSE, ...)
+
+ if(!is.null(legend.loc)){
+ if(legend.loc %in% c("topright", "right", "bottomright")){
+ # set the legend information
+ if(is.null(legend.labels)){
+ 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)
+ }
+ }
+ # plot the negative weights
+ barplot(t(neg.weights), col = colorset, space = 0, add = TRUE, border = element.color,
+ cex.axis=cex.axis, axes=FALSE, axisnames=FALSE, ...)
+
+
+ # Add labels
+ ef.return <- frontier[, mean.mtc]
+ ef.risk <- frontier[, mtc]
+ n.risk <- length(ef.risk)
+ n.labels <- 6
+ M <- c(0, ( 1:(n.risk %/% n.labels) ) ) * n.labels + 1
+ # use 3 significant digits
+ axis(3, at = M, labels = signif(ef.risk[M], 3), cex.axis=cex.axis)
+ axis(1, at = M, labels = signif(ef.return[M], 3), cex.axis=cex.axis)
+
+ # axis labels and titles
+ mtext(match.col, side = 3, line = 2, adj = 0.5, cex = cex.lab)
+ mtext("Mean", side = 1, line = 2, adj = 0.5, cex = cex.lab)
+ mtext("Weight", side = 2, line = 2, adj = 0.5, cex = cex.lab)
+ # add title
+ title(main=main, line=3)
+ # mtext(main, adj = 0, line = 2.5, font = 2, cex = 0.8)
+ box(col=element.color)
+}
+
+#' @rdname chart.Weights.EF
+#' @method chart.Weights.EF optimize.portfolio
+#' @S3method chart.Weights.EF optimize.portfolio
+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, 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)
+}
+
+#' @rdname chart.EfficientFrontier
+#' @method chart.EfficientFrontier efficient.frontier
+#' @S3method chart.EfficientFrontier efficient.frontier
+chart.EfficientFrontier.efficient.frontier <- function(object, ..., match.col="ES", n.portfolios=NULL, xlim=NULL, ylim=NULL, cex.axis=0.8, element.color="darkgray", main="Efficient Frontier", RAR.text="SR", rf=0, tangent.line=TRUE, cex.legend=0.8, chart.assets=TRUE, labels.assets=TRUE, pch.assets=21, cex.assets=0.8){
+ if(!inherits(object, "efficient.frontier")) stop("object must be of class 'efficient.frontier'")
+
+ # get the returns and efficient frontier object
+ R <- object$R
+ frontier <- object$frontier
+
+ # get the column names from the frontier object
+ cnames <- colnames(frontier)
+
+ # get the "mean" column
+ mean.mtc <- pmatch("mean", cnames)
+ if(is.na(mean.mtc)) {
+ mean.mtc <- pmatch("mean.mean", cnames)
+ }
+ if(is.na(mean.mtc)) stop("could not match 'mean' with column name of efficient frontier")
+
+ # get the match.col column
+ mtc <- pmatch(match.col, cnames)
+ if(is.na(mtc)) {
+ mtc <- pmatch(paste(match.col,match.col,sep='.'),cnames)
+ }
+ if(is.na(mtc)) stop("could not match match.col with column name of efficient frontier")
+
+ # get the data to plot scatter of asset returns
+ asset_ret <- scatterFUN(R=R, FUN="mean")
+ asset_risk <- scatterFUN(R=R, FUN=match.col)
+ rnames <- colnames(R)
+
+ # set the x and y limits
+ if(is.null(xlim)){
+ xlim <- range(c(frontier[, mtc], asset_risk))
+ # xlim[1] <- xlim[1] * 0.8
+ xlim[1] <- 0
+ xlim[2] <- xlim[2] * 1.15
+ }
+ if(is.null(ylim)){
+ ylim <- range(c(frontier[, mean.mtc], asset_ret))
+ # ylim[1] <- ylim[1] * 0.9
+ ylim[1] <- 0
+ ylim[2] <- ylim[2] * 1.1
+ }
+
+ if(!is.null(rf)){
+ sr <- (frontier[, mean.mtc] - rf) / (frontier[, mtc])
+ idx.maxsr <- which.max(sr)
+ srmax <- sr[idx.maxsr]
+ }
+
+ # plot the efficient frontier line
+ plot(x=frontier[, mtc], y=frontier[, mean.mtc], ylab="Mean", xlab=match.col, main=main, xlim=xlim, ylim=ylim, axes=FALSE, ...)
+
+ # Add the global minimum variance or global minimum ETL portfolio
+ points(x=frontier[1, mtc], y=frontier[1, mean.mtc], pch=16)
+
+ if(chart.assets){
+ # risk-return scatter of the assets
+ points(x=asset_risk, y=asset_ret, pch=pch.assets, cex=cex.assets)
+ if(labels.assets) text(x=asset_risk, y=asset_ret, labels=rnames, pos=4, cex=cex.assets)
+ }
+
+ if(!is.null(rf)){
+ # Plot tangency line and points at risk-free rate and tangency portfolio
+ if(tangent.line) abline(rf, srmax, lty=2)
+ points(0, rf, pch=16)
+ points(frontier[idx.maxsr, mtc], frontier[idx.maxsr, mean.mtc], pch=16)
+ # text(x=frontier[idx.maxsr], y=frontier[idx.maxsr], labels="T", pos=4, cex=0.8)
+ # Add legend with max Risk adjusted Return ratio and risk-free rate
+ legend("topleft", paste(RAR.text, " = ", signif(srmax,3), sep = ""), bty = "n", cex=cex.legend)
+ legend("topleft", inset = c(0,0.05), paste("rf = ", signif(rf,3), sep = ""), bty = "n", cex=cex.legend)
+ }
+ axis(1, cex.axis = cex.axis, col = element.color)
+ axis(2, cex.axis = cex.axis, col = element.color)
+ box(col = element.color)
+}
+
+#' Plot multiple efficient frontiers
+#'
+#' Overlay the efficient frontiers of multiple portfolio objects on a single plot.
+#'
+#' @param R an xts object of asset returns
+#' @param portfolio_list list of portfolio objects created by \code{\link{portfolio.spec}}
+#' @param type type of efficient frontier, see \code{\link{create.EfficientFrontier}}
+#' @param n.portfolios number of portfolios to extract along the efficient frontier.
+#' This is only used for objects of class \code{optimize.portfolio}
+#' @param match.col string name of column to use for risk (horizontal axis).
+#' Must match the name of an objective.
+#' @param search_size passed to optimize.portfolio for type="DEoptim" or type="random".
+#' @param main title used in the plot.
+#' @param cex.axis the magnification to be used for sizing the axis text relative to the current setting of 'cex', similar to \code{\link{plot}}.
+#' @param element.color provides the color for drawing less-important chart elements, such as the box lines, axis lines, etc.
+#' @param legend.loc location of the legend; NULL, "bottomright", "bottom", "bottomleft", "left", "topleft", "top", "topright", "right" and "center".
+#' @param legend.labels character vector to use for the legend labels.
+#' @param cex.legend The magnification to be used for sizing the legend relative to the current setting of 'cex', similar to \code{\link{plot}}.
+#' @param xlim set the x-axis limit, same as in \code{\link{plot}}.
+#' @param ylim set the y-axis limit, same as in \code{\link{plot}}.
+#' @param \dots passthrough parameters to \code{\link{plot}}.
+#' @param chart.assets TRUE/FALSE to include the assets.
+#' @param labels.assets TRUE/FALSE to include the asset names in the plot.
+#' @param pch.assets plotting character of the assets, same as in \code{\link{plot}}.
+#' @param cex.assets A numerical value giving the amount by which the asset points and labels should be magnified relative to the default.
+#' @param col vector of colors with length equal to the number of portfolios in \code{portfolio_list}.
+#' @param lty vector of line types with length equal to the number of portfolios in \code{portfolio_list}.
+#' @param lwd vector of line widths with length equal to the number of portfolios in \code{portfolio_list}.
+#' @author Ross Bennett
+#' @export
+chart.EfficientFrontierOverlay <- function(R, portfolio_list, type, n.portfolios=25, match.col="ES", search_size=2000, main="Efficient Frontiers", cex.axis=0.8, element.color="darkgray", legend.loc=NULL, legend.labels=NULL, cex.legend=0.8, xlim=NULL, ylim=NULL, ..., chart.assets=TRUE, labels.assets=TRUE, pch.assets=21, cex.assets=0.8, col=NULL, lty=NULL, lwd=NULL){
+ # create multiple efficient frontier objects (one per portfolio in portfolio_list)
+ if(!is.list(portfolio_list)) stop("portfolio_list must be passed in as a list")
+ if(length(portfolio_list) == 1) warning("Only one portfolio object in portfolio_list")
+ # store in out
+ out <- list()
+ for(i in 1:length(portfolio_list)){
+ if(!is.portfolio(portfolio_list[[i]])) stop("portfolio in portfolio_list must be of class 'portfolio'")
+ out[[i]] <- create.EfficientFrontier(R=R, portfolio=portfolio_list[[i]], type=type, n.portfolios=n.portfolios, match.col=match.col, search_size=search_size)
+ }
+ # get the data to plot scatter of asset returns
+ asset_ret <- scatterFUN(R=R, FUN="mean")
+ asset_risk <- scatterFUN(R=R, FUN=match.col)
+ rnames <- colnames(R)
+
+ # set the x and y limits
+ if(is.null(xlim)){
+ xlim <- range(asset_risk)
+ # xlim[1] <- xlim[1] * 0.8
+ xlim[1] <- 0
+ xlim[2] <- xlim[2] * 1.15
+ }
+ if(is.null(ylim)){
+ ylim <- range(asset_ret)
+ # ylim[1] <- ylim[1] * 0.9
+ ylim[1] <- 0
+ ylim[2] <- ylim[2] * 1.1
+ }
+
+ # plot the assets
+ plot(x=asset_risk, y=asset_ret, xlab=match.col, ylab="Mean", main=main, xlim=xlim, ylim=ylim, axes=FALSE, type="n", ...)
+ axis(1, cex.axis = cex.axis, col = element.color)
+ axis(2, cex.axis = cex.axis, col = element.color)
+ box(col = element.color)
+
+ if(chart.assets){
+ # risk-return scatter of the assets
+ points(x=asset_risk, y=asset_ret, pch=pch.assets, cex=cex.assets)
+ if(labels.assets) text(x=asset_risk, y=asset_ret, labels=rnames, pos=4, cex=cex.assets)
+ }
+
+ # set some basic plot parameters
+ if(is.null(col)) col <- 1:length(out)
+ if(is.null(lty)) lty <- 1:length(out)
+ if(is.null(lwd)) lwd <- rep(1, length(out))
+
+ for(i in 1:length(out)){
+ tmp <- out[[i]]
+ tmpfrontier <- tmp$frontier
+ cnames <- colnames(tmpfrontier)
+
+ # get the "mean" column
+ mean.mtc <- pmatch("mean", cnames)
+ if(is.na(mean.mtc)) {
+ mean.mtc <- pmatch("mean.mean", cnames)
+ }
+ if(is.na(mean.mtc)) stop("could not match 'mean' with column name of extractStats output")
+
+ # get the match.col column
+ mtc <- pmatch(match.col, cnames)
+ if(is.na(mtc)) {
+ mtc <- pmatch(paste(match.col, match.col, sep='.'),cnames)
+ }
+ if(is.na(mtc)) stop("could not match match.col with column name of extractStats output")
+ # Add the efficient frontier lines to the plot
+ lines(x=tmpfrontier[, mtc], y=tmpfrontier[, mean.mtc], col=col[i], lty=lty[i], lwd=lwd[i])
+ }
+ if(!is.null(legend.loc)){
+ if(is.null(legend.labels)){
+ legend.labels <- paste("Portfolio", 1:length(out), sep=".")
+ }
+ legend(legend.loc, legend=legend.labels, col=col, lty=lty, lwd=lwd, cex=cex.legend, bty="n")
+ }
+ return(invisible(out))
+}
+
+
+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'")
+
+ 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)
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/returnanalytics -r 3302
More information about the Returnanalytics-commits
mailing list