[Returnanalytics-commits] r2968 - in pkg/PortfolioAnalytics: . R man sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Sep 1 20:38:41 CEST 2013
Author: rossbennett34
Date: 2013-09-01 20:38:41 +0200 (Sun, 01 Sep 2013)
New Revision: 2968
Added:
pkg/PortfolioAnalytics/R/charts.groups.R
pkg/PortfolioAnalytics/man/chart.GroupWeights.Rd
pkg/PortfolioAnalytics/man/extractGroups.Rd
pkg/PortfolioAnalytics/sandbox/testing_groups.R
Modified:
pkg/PortfolioAnalytics/DESCRIPTION
pkg/PortfolioAnalytics/NAMESPACE
pkg/PortfolioAnalytics/R/extractstats.R
pkg/PortfolioAnalytics/R/portfolio.R
Log:
Adding functions to extract and chart weights by groups.
Modified: pkg/PortfolioAnalytics/DESCRIPTION
===================================================================
--- pkg/PortfolioAnalytics/DESCRIPTION 2013-09-01 01:48:57 UTC (rev 2967)
+++ pkg/PortfolioAnalytics/DESCRIPTION 2013-09-01 18:38:41 UTC (rev 2968)
@@ -54,3 +54,4 @@
'chart.RiskReward.R'
'charts.efficient.frontier.R'
'charts.risk.R'
+ 'charts.groups.R'
Modified: pkg/PortfolioAnalytics/NAMESPACE
===================================================================
--- pkg/PortfolioAnalytics/NAMESPACE 2013-09-01 01:48:57 UTC (rev 2967)
+++ pkg/PortfolioAnalytics/NAMESPACE 2013-09-01 18:38:41 UTC (rev 2968)
@@ -8,6 +8,7 @@
export(chart.EfficientFrontier.optimize.portfolio)
export(chart.EfficientFrontier)
export(chart.EfficientFrontierOverlay)
+export(chart.GroupWeights)
export(chart.RiskBudget)
export(chart.RiskReward.optimize.portfolio.DEoptim)
export(chart.RiskReward.optimize.portfolio.GenSA)
@@ -50,6 +51,7 @@
export(diversification)
export(extract.efficient.frontier)
export(extractEfficientFrontier)
+export(extractGroups)
export(extractObjectiveMeasures)
export(extractStats.optimize.portfolio.DEoptim)
export(extractStats.optimize.portfolio.GenSA)
Added: pkg/PortfolioAnalytics/R/charts.groups.R
===================================================================
--- pkg/PortfolioAnalytics/R/charts.groups.R (rev 0)
+++ pkg/PortfolioAnalytics/R/charts.groups.R 2013-09-01 18:38:41 UTC (rev 2968)
@@ -0,0 +1,81 @@
+#' Chart weights by group or category
+#'
+#' @param object object of class \code{optimize.portfolio}
+#' @param ... passthrough parameters to \code{\link{plot}}
+#' @param grouping
+#' \itemize{
+#' \item{groups: }{group the weights group constraints}
+#' \item{category_labels: }{group the weights by category_labels in portfolio object}
+#' }
+#' @param main an overall title for the plot: see \code{\link{title}}
+#' @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 element.color color for the default border and axis
+#' @param cex.axis The magnification to be used for x and y axis relative to the current setting of \code{cex}
+#' @author Ross Bennett
+#' @export
+chart.GroupWeights <- function(object, ..., grouping=c("groups", "category"), main="Group Weights", las = 3, xlab=NULL, cex.lab = 1, element.color = "darkgray", cex.axis=0.8){
+ if(!inherits(object, "optimize.portfolio.ROI")) stop("object must be of class 'optimize.portfolio'")
+
+ constraints <- get_constraints(object$portfolio)
+ tmp <- extractGroups(object)
+ grouping <- grouping[1]
+
+ if(grouping == "groups"){
+ weights <- tmp$group_weights
+ if(is.null(weights)) stop("No weights detected for groups")
+ if(any(is.infinite(constraints$cUP)) | any(is.infinite(constraints$cLO))){
+ # set ylim based on weights if box constraints contain Inf or -Inf
+ ylim <- range(weights)
+ } else {
+ # set ylim based on the range of box constraints min and max
+ ylim <- range(c(constraints$cLO, constraints$cUP))
+ }
+ }
+
+ if(grouping == "category"){
+ weights <- tmp$category_weights
+ if(is.null(weights)) stop("No weights detected for category")
+ ylim <- range(weights)
+ }
+
+ columnnames = names(weights)
+ numgroups = 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)
+ }
+ }
+ else {
+ bottommargin = minmargin
+ }
+ par(mar = c(bottommargin, 4, topmargin, 2) +.1)
+
+ plot(weights, axes=FALSE, xlab='', ylim=ylim, ylab="Weights", main=main, ...)
+ if(grouping == "groups"){
+ if(!any(is.infinite(constraints$cLO))){
+ points(constraints$cLO, type="b", col="darkgray", lty="solid", lwd=2, pch=24)
+ }
+ if(!any(is.infinite(constraints$cUP))){
+ points(constraints$cUP, type="b", col="darkgray", lty="solid", lwd=2, pch=25)
+ }
+ }
+ axis(2, cex.axis = cex.axis, col = element.color)
+ axis(1, labels=columnnames, at=1:numgroups, las=las, cex.axis = cex.axis, col = element.color)
+ box(col = element.color)
+}
Modified: pkg/PortfolioAnalytics/R/extractstats.R
===================================================================
--- pkg/PortfolioAnalytics/R/extractstats.R 2013-09-01 01:48:57 UTC (rev 2967)
+++ pkg/PortfolioAnalytics/R/extractstats.R 2013-09-01 18:38:41 UTC (rev 2968)
@@ -366,3 +366,56 @@
return(out)
}
+#' Extract the group and/or category weights
+#'
+#' This function extracts the weights by group and/or category from an object
+#' of class \code{optimize.portfolio}
+#'
+#' @param object object of class \code{optimize.portfolio}
+#' @param ... passthrough parameters. Not currently used
+#' @return a list with two elements
+#' \itemize{
+#' \item{weights: }{Optimal set of weights from the \code{optimize.portfolio} object}
+#' \item{category_weights: }{Weights by category if category_labels are supplied in the \code{portfolio} object}
+#' \item{group_weights: }{Weights by group if group is a constraint type}
+#' }
+#' @author Ross Bennett
+#' @export
+extractGroups <- function(object, ...){
+ if(!inherits(object, "optimize.portfolio")) stop("object must be of class 'optimize.portfolio'")
+
+ # Check category_labels in portfolio object
+ category_labels <- object$portfolio$category_labels
+
+ # Get the constraints to check for group constraints
+ constraints <- get_constraints(object$portfolio)
+
+ groups <- constraints$groups
+
+ cat_weights <- NULL
+ group_weights <- NULL
+
+ if(!is.null(category_labels)){
+ cat_names <- names(category_labels)
+ ncats <- length(category_labels)
+ cat_weights <- rep(0, ncats)
+ for(i in 1:ncats){
+ cat_weights[i] <- sum(object$weights[category_labels[[i]]])
+ }
+ names(cat_weights) <- cat_names
+ }
+
+ if(!is.null(groups)){
+ n.groups <- length(groups)
+ group_weights <- rep(0, n.groups)
+ for(i in 1:n.groups){
+ group_weights[i] <- sum(object$weights[groups[[i]]])
+ }
+ names(group_weights) <- constraints$group_labels
+ }
+ return(list(weights=object$weights,
+ category_weights=cat_weights,
+ group_weights=group_weights)
+ )
+}
+
Modified: pkg/PortfolioAnalytics/R/portfolio.R
===================================================================
--- pkg/PortfolioAnalytics/R/portfolio.R 2013-09-01 01:48:57 UTC (rev 2967)
+++ pkg/PortfolioAnalytics/R/portfolio.R 2013-09-01 18:38:41 UTC (rev 2968)
@@ -88,6 +88,13 @@
if(length(category_labels) != length(assets)) {
stop("length(category_labels) must be equal to length(assets)")
}
+ # Turn category_labels into a list that can be used with group constraints
+ unique_labels <- unique(category_labels)
+ tmp <- list()
+ for(i in 1:length(unique_labels)){
+ tmp[[unique_labels[i]]] <- which(category_labels == unique_labels[i])
+ }
+ category_labels <- tmp
}
## now structure and return
Added: pkg/PortfolioAnalytics/man/chart.GroupWeights.Rd
===================================================================
--- pkg/PortfolioAnalytics/man/chart.GroupWeights.Rd (rev 0)
+++ pkg/PortfolioAnalytics/man/chart.GroupWeights.Rd 2013-09-01 18:38:41 UTC (rev 2968)
@@ -0,0 +1,47 @@
+\name{chart.GroupWeights}
+\alias{chart.GroupWeights}
+\title{Chart weights by group or category}
+\usage{
+ chart.GroupWeights(object, ...,
+ grouping = c("groups", "category"),
+ main = "Group Weights", las = 3, xlab = NULL,
+ cex.lab = 1, element.color = "darkgray",
+ cex.axis = 0.8)
+}
+\arguments{
+ \item{object}{object of class \code{optimize.portfolio}}
+
+ \item{...}{passthrough parameters to \code{\link{plot}}}
+
+ \item{grouping}{\itemize{ \item{groups: }{group the
+ weights group constraints} \item{category_labels: }{group
+ the weights by category_labels in portfolio object} }}
+
+ \item{main}{an overall title for the plot: see
+ \code{\link{title}}}
+
+ \item{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.} }}
+
+ \item{xlab}{a title for the x axis: see
+ \code{\link{title}}}
+
+ \item{cex.lab}{The magnification to be used for x and y
+ labels relative to the current setting of \code{cex}}
+
+ \item{element.color}{color for the default border and
+ axis}
+
+ \item{cex.axis}{The magnification to be used for x and y
+ axis relative to the current setting of \code{cex}}
+}
+\description{
+ Chart weights by group or category
+}
+\author{
+ Ross Bennett
+}
+
Added: pkg/PortfolioAnalytics/man/extractGroups.Rd
===================================================================
--- pkg/PortfolioAnalytics/man/extractGroups.Rd (rev 0)
+++ pkg/PortfolioAnalytics/man/extractGroups.Rd 2013-09-01 18:38:41 UTC (rev 2968)
@@ -0,0 +1,28 @@
+\name{extractGroups}
+\alias{extractGroups}
+\title{Extract the group and/or category weights}
+\usage{
+ extractGroups(object, ...)
+}
+\arguments{
+ \item{object}{object of class \code{optimize.portfolio}}
+
+ \item{...}{passthrough parameters. Not currently used}
+}
+\value{
+ a list with two elements \itemize{ \item{weights:
+ }{Optimal set of weights from the
+ \code{optimize.portfolio} object} \item{category_weights:
+ }{Weights by category if category_labels are supplied in
+ the \code{portfolio} object} \item{group_weights:
+ }{Weights by group if group is a constraint type} }
+}
+\description{
+ This function extracts the weights by group and/or
+ category from an object of class
+ \code{optimize.portfolio}
+}
+\author{
+ Ross Bennett
+}
+
Added: pkg/PortfolioAnalytics/sandbox/testing_groups.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/testing_groups.R (rev 0)
+++ pkg/PortfolioAnalytics/sandbox/testing_groups.R 2013-09-01 18:38:41 UTC (rev 2968)
@@ -0,0 +1,59 @@
+library(PortfolioAnalytics)
+library(ROI)
+library(ROI.plugin.quadprog)
+library(ROI.plugin.glpk)
+
+
+# data(edhec)
+# R <- edhec[, 1:4]
+# colnames(R) <- c("CA", "CTAG", "DS", "EM")
+# funds <- colnames(R)
+
+load("~/Desktop/Testing/crsp.short.Rdata")
+R <- cbind(microcap.ts[, 1:2],
+ smallcap.ts[, 1:2],
+ midcap.ts[, 1:2],
+ largecap.ts[, 1:2])
+
+funds <- colnames(R)
+
+cap_labels <- c(rep("MICRO", 2), rep("SMALL", 2),
+ rep("MID", 2), rep("LARGE", 2))
+
+# Create initial portfolio object with category_labels
+init <- portfolio.spec(assets=funds, category_labels=cap_labels)
+# Add some weight constraints
+init <- add.constraint(portfolio=init, type="full_investment")
+init <- add.constraint(portfolio=init, type="long_only")
+# Add objective to minimize variance
+minvar <- add.objective(portfolio=init, type="risk", name="var")
+
+# Specify group constraints by passing in category_labels from initial
+# portfolio object
+group1 <- add.constraint(portfolio=init, type="group",
+ groups=init$category_labels,
+ group_min=c(0.15, 0.25, 0.15, 0.2),
+ group_max=c(0.4, 0.4, 0.6, 0.6))
+
+# Alternative way by specifying a list for group constraints
+group2 <- add.constraint(portfolio=init, type="group",
+ groups=list(MICRO=c(1, 2),
+ SMALL=c(3, 4),
+ MID=c(5, 6),
+ LARGE=c(7, 8)),
+ group_min=c(0.2, 0.1, 0.2, 0.2),
+ group_max=c(0.4, 0.4, 0.4, 0.45))
+group2$category_labels <- NULL
+
+all.equal(group1$constraints[[3]]$groups, group2$constraints[[3]]$groups)
+
+opt_group1 <- optimize.portfolio(R=R, portfolio=group1, optimize_method="ROI")
+extractGroups(opt_group1)
+chart.GroupWeights(opt_group1, type="b", col="blue", pch=15, lty=2)
+
+opt_group2 <- optimize.portfolio(R=R, portfolio=group2, optimize_method="ROI")
+extractGroups(opt_group2)
+chart.GroupWeights(opt_group2, type="b", col="black", pch=21, bg="gray")
+
+
+
\ No newline at end of file
More information about the Returnanalytics-commits
mailing list