[Returnanalytics-commits] r3318 - in pkg/PortfolioAnalytics: . R demo man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Feb 20 19:24:48 CET 2014
Author: rossbennett34
Date: 2014-02-20 19:24:47 +0100 (Thu, 20 Feb 2014)
New Revision: 3318
Added:
pkg/PortfolioAnalytics/demo/multiple_portfolio_optimization.R
pkg/PortfolioAnalytics/man/combine.portfolios.Rd
Modified:
pkg/PortfolioAnalytics/NAMESPACE
pkg/PortfolioAnalytics/R/extractstats.R
pkg/PortfolioAnalytics/R/generics.R
pkg/PortfolioAnalytics/R/optimize.portfolio.R
pkg/PortfolioAnalytics/R/utility.combine.R
pkg/PortfolioAnalytics/demo/00Index
Log:
Adding functionality to handle multiple portfolio objects for optimization
Modified: pkg/PortfolioAnalytics/NAMESPACE
===================================================================
--- pkg/PortfolioAnalytics/NAMESPACE 2014-02-20 17:07:25 UTC (rev 3317)
+++ pkg/PortfolioAnalytics/NAMESPACE 2014-02-20 18:24:47 UTC (rev 3318)
@@ -12,6 +12,7 @@
export(chart.Weights.EF)
export(chart.Weights)
export(combine.optimizations)
+export(combine.portfolios)
export(constrained_objective_v2)
export(constrained_objective)
export(constraint_ROI)
@@ -46,7 +47,6 @@
export(optimize.portfolio)
export(portfolio_risk_objective)
export(portfolio.spec)
-export(portfolios.combine)
export(pos_limit_fail)
export(position_limit_constraint)
export(quadratic_utility_objective)
@@ -99,9 +99,12 @@
S3method(chart.Weights.EF,efficient.frontier)
S3method(chart.Weights.EF,optimize.portfolio)
S3method(extractObjectiveMeasures,opt.list)
+S3method(extractObjectiveMeasures,opt.rebal.list)
S3method(extractObjectiveMeasures,optimize.portfolio.rebalancing)
S3method(extractObjectiveMeasures,optimize.portfolio)
S3method(extractObjectiveMeasures,summary.optimize.portfolio.rebalancing)
+S3method(extractStats,opt.list)
+S3method(extractStats,opt.rebal.list)
S3method(extractStats,optimize.portfolio.DEoptim)
S3method(extractStats,optimize.portfolio.eqwt)
S3method(extractStats,optimize.portfolio.GenSA)
@@ -112,6 +115,7 @@
S3method(extractStats,optimize.portfolio.rebalancing)
S3method(extractStats,optimize.portfolio.ROI)
S3method(extractWeights,opt.list)
+S3method(extractWeights,opt.rebal.list)
S3method(extractWeights,optimize.portfolio.rebalancing)
S3method(extractWeights,optimize.portfolio)
S3method(extractWeights,summary.optimize.portfolio.rebalancing)
@@ -123,12 +127,15 @@
S3method(plot,optimize.portfolio)
S3method(print,constraint)
S3method(print,efficient.frontier)
+S3method(print,opt.list)
+S3method(print,opt.rebal.list)
S3method(print,optimize.portfolio.DEoptim)
S3method(print,optimize.portfolio.GenSA)
S3method(print,optimize.portfolio.pso)
S3method(print,optimize.portfolio.random)
S3method(print,optimize.portfolio.rebalancing)
S3method(print,optimize.portfolio.ROI)
+S3method(print,portfolio.list)
S3method(print,portfolio)
S3method(print,summary.optimize.portfolio.rebalancing)
S3method(print,summary.optimize.portfolio)
Modified: pkg/PortfolioAnalytics/R/extractstats.R
===================================================================
--- pkg/PortfolioAnalytics/R/extractstats.R 2014-02-20 17:07:25 UTC (rev 3317)
+++ pkg/PortfolioAnalytics/R/extractstats.R 2014-02-20 18:24:47 UTC (rev 3318)
@@ -595,3 +595,54 @@
return(out)
}
+#' @method extractStats opt.list
+#' @S3method extractStats opt.list
+#' @export
+extractStats.opt.list <- function(object, ...){
+ # get the stats of each optimization in a list
+ # each element in the list is an optimize.portfolio object
+ stats_list <- vector("list", length(object))
+ for(i in 1:length(stats_list)){
+ stats_list[[i]] <- extractStats(object[[i]])
+ }
+ return(stats_list)
+}
+
+#' @method extractWeights opt.rebal.list
+#' @S3method extractWeights opt.rebal.list
+#' @export
+extractWeights.opt.rebal.list <- function(object, ...){
+ # get the optimal weights of each optimization in a list
+ # each element in the list is an optimize.portfolio.rebalancing object
+ weights_list <- vector("list", length(object))
+ for(i in 1:length(weights_list)){
+ weights_list[[i]] <- extractWeights(object[[i]])
+ }
+ return(weights_list)
+}
+
+#' @method extractObjectiveMeasures opt.rebal.list
+#' @S3method extractObjectiveMeasures opt.rebal.list
+#' @export
+extractObjectiveMeasures.opt.rebal.list <- function(object, ...){
+ # get the optimal weights of each optimization in a list
+ # each element in the list is an optimize.portfolio.rebalancing object
+ obj_list <- vector("list", length(object))
+ for(i in 1:length(obj_list)){
+ obj_list[[i]] <- extractObjectiveMeasures(object[[i]])
+ }
+ return(obj_list)
+}
+
+#' @method extractStats opt.rebal.list
+#' @S3method extractStats opt.rebal.list
+#' @export
+extractStats.opt.rebal.list <- function(object, ...){
+ # get the stats of each optimization in a list
+ # each element in the list is an optimize.portfolio.rebalancing object
+ stats_list <- vector("list", length(object))
+ for(i in 1:length(stats_list)){
+ stats_list[[i]] <- extractStats(object[[i]])
+ }
+ return(stats_list)
+}
Modified: pkg/PortfolioAnalytics/R/generics.R
===================================================================
--- pkg/PortfolioAnalytics/R/generics.R 2014-02-20 17:07:25 UTC (rev 3317)
+++ pkg/PortfolioAnalytics/R/generics.R 2014-02-20 18:24:47 UTC (rev 3318)
@@ -962,3 +962,33 @@
invisible(list(weights=wts, metrics=riskret))
}
+#' @method print portfolio.list
+#' @S3method print portfolio.list
+#' @export
+print.portfolio.list <- function(x, ...){
+ for(i in 1:length(x)){
+ cat("Portfolio ", i, "\n", sep="")
+ print(x[[i]])
+ }
+}
+
+#' @method print opt.list
+#' @S3method print opt.list
+#' @export
+print.opt.list <- function(x, ...){
+ for(i in 1:length(x)){
+ cat("Optimization ", i, "\n", sep="")
+ print(x[[i]])
+ }
+}
+
+#' @method print opt.rebal.list
+#' @S3method print opt.rebal.list
+#' @export
+print.opt.rebal.list <- function(x, ...){
+ for(i in 1:length(x)){
+ cat("Optimization ", i, "\n", sep="")
+ print(x[[i]])
+ }
+}
+
Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R
===================================================================
--- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2014-02-20 17:07:25 UTC (rev 3317)
+++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2014-02-20 18:24:47 UTC (rev 3318)
@@ -446,6 +446,36 @@
message=FALSE
)
{
+ # This is the case where the user has passed in a list of portfolio objects
+ # for the portfolio argument.
+ # Loop through the portfolio list and recursively call optimize.portfolio
+ # Note that I return at the end of this block. I know it is not good practice
+ # to return before the end of a function, but I am not sure of another way
+ # to handle a list of portfolio objects with the recursive call to
+ # optimize.portfolio.
+ if(inherits(portfolio, "portfolio.list")){
+ n.portf <- length(portfolio)
+ opt.list <- vector("list", n.portf)
+ for(i in 1:length(opt.list)){
+ if(message) cat("Starting optimization of portfolio ", i, "\n")
+ opt.list[[i]] <- optimize.portfolio(R=R,
+ portfolio=portfolio[[i]],
+ constraints=constraints,
+ objectives=objectives,
+ optimize_method=optimize_method,
+ search_size=search_size,
+ trace=trace,
+ ...=...,
+ rp=rp,
+ momentFUN=momentFUN,
+ message=message)
+ }
+ out <- combine.optimizations(opt.list)
+ ##### return here for portfolio.list because this is a recursive call
+ ##### for optimize.portfolio
+ return(out)
+ }
+
optimize_method <- optimize_method[1]
tmptrace <- NULL
start_t <- Sys.time()
@@ -1246,6 +1276,40 @@
stopifnot("package:foreach" %in% search() || require("foreach",quietly=TRUE))
stopifnot("package:iterators" %in% search() || require("iterators",quietly=TRUE))
+ # This is the case where the user has passed in a list of portfolio objects
+ # for the portfolio argument.
+ # Loop through the portfolio list and recursively call
+ # optimize.portfolio.rebalancing.
+ #Note that I return at the end of this block. I know it is not good practice
+ # to return before the end of a function, but I am not sure of another way
+ # to handle a list of portfolio objects with the recursive call to
+ # optimize.portfolio.
+ if(inherits(portfolio, "portfolio.list")){
+ n.portf <- length(portfolio)
+ opt.list <- vector("list", n.portf)
+ for(i in 1:length(opt.list)){
+ if(hasArg(message)) message=match.call(expand.dots=TRUE)$message else message=FALSE
+ if(message) cat("Starting optimization of portfolio ", i, "\n")
+ opt.list[[i]] <- optimize.portfolio.rebalancing(R=R,
+ portfolio=portfolio[[i]],
+ constraints=constraints,
+ objectives=objectives,
+ optimize_method=optimize_method,
+ search_size=search_size,
+ trace=trace,
+ ...=...,
+ rp=rp,
+ rebalance_on=rebalance_on,
+ training_period=training_period,
+ trailing_periods=trailing_periods)
+ }
+ out <- combine.optimizations(opt.list)
+ class(out) <- "opt.rebal.list"
+ ##### return here for portfolio.list because this is a recursive call
+ ##### for optimize.portfolio.rebalancing
+ return(out)
+ }
+
# Store the call to return later
call <- match.call()
@@ -1255,6 +1319,8 @@
stop("you must pass in an object of class 'portfolio' to control the optimization")
}
+ if(hasArg(message)) message=match.call(expand.dots=TRUE)$message else message=FALSE
+
# Check for constraints and objectives passed in separately outside of the portfolio object
if(!is.null(constraints)){
if(inherits(constraints, "v1_constraint")){
@@ -1307,8 +1373,8 @@
names(out_list)<-index(R[ep.i])
end_t <- Sys.time()
- # message(c("overall elapsed time:",end_t-start_t))
elapsed_time <- end_t - start_t
+ if(message) message(c("overall elapsed time:", end_t-start_t))
# out object to return
out <- list()
Modified: pkg/PortfolioAnalytics/R/utility.combine.R
===================================================================
--- pkg/PortfolioAnalytics/R/utility.combine.R 2014-02-20 17:07:25 UTC (rev 3317)
+++ pkg/PortfolioAnalytics/R/utility.combine.R 2014-02-20 18:24:47 UTC (rev 3318)
@@ -11,13 +11,15 @@
combine.optimizations <- function(x){
if(!is.list(x)) stop("x must be passed in as a list")
for(i in 1:length(x)){
- if(!inherits(x[[i]], "optimize.portfolio")) stop("All objects in x must be of class 'optimize.portfolio'")
+ if(!(inherits(x[[i]], "optimize.portfolio") | inherits(x[[i]], "optimize.portfolio.rebalancing"))){
+ stop("All objects in x must be of class 'optimize.portfolio' or 'optimize.portfolio.rebalancing'")
+ }
}
class(x) <- "opt.list"
return(x)
}
-#' Combine objects created by portfolio
+#' Combine a list of portfolio objects
#'
#' This function takes a list of objects created by \code{\link{portfolio.spec}}
#' and sets the class name attribute to 'portfolio.list' for use in generic functions
@@ -25,12 +27,12 @@
#' @param x a list of objects created by \code{\link{portfolio.spec}}
#' @return a \code{portfolio.list} object
#' @export
-portfolios.combine <- function(x){
+combine.portfolios <- function(x){
if(!is.list(x)) stop("x must be passed in as a list")
for(i in 1:length(x)){
if(!inherits(x[[i]], "portfolio")) stop("All objects in x must be of class 'portfolio'")
}
- class(x) <- "portfolio.list"
+ class(x) <- c("portfolio.list", "portfolio")
return(x)
}
Modified: pkg/PortfolioAnalytics/demo/00Index
===================================================================
--- pkg/PortfolioAnalytics/demo/00Index 2014-02-20 17:07:25 UTC (rev 3317)
+++ pkg/PortfolioAnalytics/demo/00Index 2014-02-20 18:24:47 UTC (rev 3318)
@@ -27,3 +27,4 @@
demo_roi_solvers Demonstrate specifying a solver using ROI.
risk_budget_backtesting Demonstrate optimize.portfolio.rebalancing with standard deviation risk budget objective.
chart_concentration Demonstrate chart.Concentration
+multiple_portfolio_optimization Demonstrate passing a list of portfolios to optimize.portfolio and optimize.portfolio.rebalancing
\ No newline at end of file
Added: pkg/PortfolioAnalytics/demo/multiple_portfolio_optimization.R
===================================================================
--- pkg/PortfolioAnalytics/demo/multiple_portfolio_optimization.R (rev 0)
+++ pkg/PortfolioAnalytics/demo/multiple_portfolio_optimization.R 2014-02-20 18:24:47 UTC (rev 3318)
@@ -0,0 +1,74 @@
+
+library(PortfolioAnalytics)
+
+# Examples of passing a list portfolio objects to optimize.portfolio and
+# optimize.portfolio.rebalancing
+
+data(edhec)
+R <- edhec[, 1:4]
+funds <- colnames(R)
+
+# Construct initial portfolio
+init.portf <- portfolio.spec(assets=funds)
+init.portf <- add.constraint(portfolio=init.portf, type="weight_sum",
+ min_sum=0.99, max_sum=1.01)
+init.portf <- add.constraint(portfolio=init.portf, type="long_only")
+
+# Minimize portfolio standard deviation
+minSD.portf <- add.objective(portfolio=init.portf, type="risk", name="StdDev")
+
+# Maximize mean return per unit portfolio standard deviation
+meanSD.portf <- add.objective(portfolio=minSD.portf, type="return", name="mean")
+
+# Minimize expected shortfall
+minES.portf <- add.objective(portfolio=init.portf, type="risk", name="ES")
+
+# Maximize mean return per unit portfolio expected shortfall
+meanES.portf <- add.objective(portfolio=minES.portf, type="return", name="mean")
+
+# Combine the portfolios
+mult.portf <- combine.portfolios(list(minSD.portf, meanSD.portf, minES.portf, meanES.portf))
+mult.portf
+
+# run the optimization for mult.portf
+mult.opt <- optimize.portfolio(R, mult.portf, optimize_method="random",
+ search_size=2000, trace=TRUE, message = TRUE)
+
+class(mult.opt)
+mult.opt
+
+# This combines the weights for each portfolio optimized
+extractWeights(mult.opt)
+
+# This combines the objective measures for each portfolio
+extractObjectiveMeasures(mult.opt)
+
+# For N portfolios, this returns a list of length N with the stats
+# for each portfolio
+opt.xtract <- extractStats(mult.opt)
+
+# Run the rebalancing optimization for mult.portf
+mult.opt.rebal <- optimize.portfolio.rebalancing(R, mult.portf,
+ optimize_method="random",
+ search_size=2000,
+ trace=TRUE,
+ message=TRUE,
+ rebalance_on="quarters",
+ training_period=140)
+
+class(mult.opt.rebal)
+mult.opt.rebal
+
+# For N portfolios, this returns a list of length N with the optimal weights
+# at each rebalancing date
+extractWeights(mult.opt.rebal)
+
+# For N portfolios, this returns a list of length N with the objective measures
+# at each rebalancing date
+extractObjectiveMeasures(mult.opt.rebal)
+
+# For N portfolios, this returns a list of length N with the stats
+# for each portfolio
+opt.rebal.xtract <- extractStats(mult.opt.rebal)
+
+
Added: pkg/PortfolioAnalytics/man/combine.portfolios.Rd
===================================================================
--- pkg/PortfolioAnalytics/man/combine.portfolios.Rd (rev 0)
+++ pkg/PortfolioAnalytics/man/combine.portfolios.Rd 2014-02-20 18:24:47 UTC (rev 3318)
@@ -0,0 +1,20 @@
+\name{combine.portfolios}
+\alias{combine.portfolios}
+\title{Combine a list of portfolio objects}
+\usage{
+ combine.portfolios(x)
+}
+\arguments{
+ \item{x}{a list of objects created by
+ \code{\link{portfolio.spec}}}
+}
+\value{
+ a \code{portfolio.list} object
+}
+\description{
+ This function takes a list of objects created by
+ \code{\link{portfolio.spec}} and sets the class name
+ attribute to 'portfolio.list' for use in generic
+ functions
+}
+
More information about the Returnanalytics-commits
mailing list