[Returnanalytics-commits] r3470 - in pkg/PortfolioAnalytics: . R man sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Jul 14 03:31:39 CEST 2014
Author: rossbennett34
Date: 2014-07-14 03:31:38 +0200 (Mon, 14 Jul 2014)
New Revision: 3470
Added:
pkg/PortfolioAnalytics/sandbox/opt_parallel.R
Modified:
pkg/PortfolioAnalytics/NAMESPACE
pkg/PortfolioAnalytics/R/generics.R
pkg/PortfolioAnalytics/R/optimize.portfolio.R
pkg/PortfolioAnalytics/R/random_portfolios.R
pkg/PortfolioAnalytics/man/optimize.portfolio.parallel.Rd
Log:
Adding support for analyzing uncertainty of optimizations
Modified: pkg/PortfolioAnalytics/NAMESPACE
===================================================================
--- pkg/PortfolioAnalytics/NAMESPACE 2014-07-09 20:49:39 UTC (rev 3469)
+++ pkg/PortfolioAnalytics/NAMESPACE 2014-07-14 01:31:38 UTC (rev 3470)
@@ -55,6 +55,7 @@
S3method(print,optimize.portfolio.DEoptim)
S3method(print,optimize.portfolio.GenSA)
S3method(print,optimize.portfolio.ROI)
+S3method(print,optimize.portfolio.parallel)
S3method(print,optimize.portfolio.pso)
S3method(print,optimize.portfolio.random)
S3method(print,optimize.portfolio.rebalancing)
@@ -65,6 +66,7 @@
S3method(print,summary.optimize.portfolio.rebalancing)
S3method(summary,efficient.frontier)
S3method(summary,optimize.portfolio)
+S3method(summary,optimize.portfolio.parallel)
S3method(summary,optimize.portfolio.rebalancing)
S3method(summary,portfolio)
S3method(update,constraint)
Modified: pkg/PortfolioAnalytics/R/generics.R
===================================================================
--- pkg/PortfolioAnalytics/R/generics.R 2014-07-09 20:49:39 UTC (rev 3469)
+++ pkg/PortfolioAnalytics/R/generics.R 2014-07-14 01:31:38 UTC (rev 3470)
@@ -1009,3 +1009,49 @@
print(portf[[i]])
}
}
+
+#' @method summary optimize.portfolio.parallel
+#' @S3method summary optimize.portfolio.parallel
+#' @export
+summary.optimize.portfolio.parallel <- function(object, ...){
+ out <- list()
+ out$call <- object$call
+ out$elapsed_time <- object$elapsed_time
+ out$n_optimizations <- length(object$optimizations)
+ xx <- lapply(object$optimizations, function(x) {
+ tmp <- extractStats(x)
+ out <- tmp[which.min(tmp[,"out"]),]
+ out})
+ stats <- do.call(rbind, xx)
+ out$stats <- stats
+ out$obj_val <- stats[,"out"]
+ class(out) <- "summary.optimize.portfolio.parallel"
+ return(out)
+}
+
+#' @method print optimize.portfolio.parallel
+#' @S3method print optimize.portfolio.parallel
+#' @export
+print.optimize.portfolio.parallel <- function(x, ..., probs = c(0.025, 0.975)){
+ cat(rep("*", 35) ,"\n", sep="")
+ cat("PortfolioAnalytics Optimization\n")
+ cat(rep("*", 35) ,"\n", sep="")
+
+ cat("\nCall:\n", paste(deparse(x$call), sep = "\n", collapse = "\n"),
+ "\n\n", sep = "")
+
+ # call the summary method
+ xx <- summary(x)
+
+ cat("Number of Optimizations:\n")
+ print(xx$n_optimizations)
+
+ cat("Objective Value Estimate:\n")
+ print(mean(xx$obj_val))
+
+ cat("Objective Value Estimate Percentiles:\n")
+ print(quantile(xx$obj_val, probs = probs))
+
+ cat("Elapsed Time:\n")
+ print(xx$elapsed_time)
+}
Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R
===================================================================
--- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2014-07-09 20:49:39 UTC (rev 3469)
+++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2014-07-14 01:31:38 UTC (rev 3470)
@@ -1518,10 +1518,8 @@
return(out)
}
-#'execute multiple optimize.portfolio calls, presumably in parallel
+#' Execute multiple optimize.portfolio calls, presumably in parallel
#'
-#' TODO write function to check sensitivity of optimal results by using optimize.portfolio.parallel results
-#'
#' This function will not speed up optimization!
#'
#' This function exists to run multiple copies of optimize.portfolio, presumabley in parallel using foreach.
@@ -1536,33 +1534,56 @@
#' this function.
#'
#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns
-#' @param constraints an object of type "constraints" specifying the constraints for the optimization, see \code{\link{constraint}}
-#' @param optimize_method one of "DEoptim" or "random"
+#' @param portfolio an object of type "portfolio" specifying the constraints and objectives for the optimization
+#' @param optimize_method one of "DEoptim", "random", "pso", "GenSA".
#' @param search_size integer, how many portfolios to test, default 20,000
#' @param trace TRUE/FALSE if TRUE will attempt to return additional information on the path or portfolios searched
#' @param \dots any other passthru parameters
+#' @param rp matrix of random portfolio weights, default NULL, mostly for automated use by rebalancing optimization or repeated tests on same portfolios
+#' @param momentFUN the name of a function to call to set portfolio moments, default \code{\link{set.portfolio.moments_v2}}
+#' @param message TRUE/FALSE. The default is message=FALSE. Display messages if TRUE.
#' @param nodes how many processes to run in the foreach loop, default 4
#'
#' @return a list containing the optimal weights, some summary statistics, the function call, and optionally trace information
#' @author Kris Boudt, Peter Carl, Brian G. Peterson
#' @export
-optimize.portfolio.parallel <- function(R,constraints,optimize_method=c("DEoptim","random"), search_size=20000, trace=FALSE, ..., nodes=4)
+optimize.portfolio.parallel <- function(R,
+ portfolio,
+ optimize_method=c("DEoptim","random","ROI","pso","GenSA"),
+ search_size=20000,
+ trace=FALSE, ...,
+ rp=NULL,
+ momentFUN='set.portfolio.moments',
+ message=FALSE,
+ nodes=4)
{
stopifnot("package:foreach" %in% search() || require("foreach",quietly=TRUE))
optimize_method=optimize_method[1]
- start_t<-Sys.time()
+ start_t <- Sys.time()
#store the call for later
call <- match.call()
- opt_out_list<-foreach(1:nodes, packages='PortfolioAnalytics') %dopar% optimize.portfolio(R=R,constraints=constraints,optimize_method=optimize_method, search_size=search_size, trace=trace, ...)
+ opt_out_list <- foreach(1:nodes, .errorhandling='pass', .packages='PortfolioAnalytics') %dopar% {
+ optimize.portfolio(R=R, portfolio=portfolio,
+ optimize_method=optimize_method,
+ search_size=search_size, trace=trace,
+ rp=rp, momentFUN=momentFUN, parallel=FALSE,
+ ...=...)
+ }
- end_t<-Sys.time()
- message(c("overall elapsed time:",end_t-start_t))
- class(opt_out_list)<-c("optimize.portfolio.parallel")
- return(opt_out_list)
+ end_t <- Sys.time()
+ elapsed_t <- end_t - start_t
+ if(message) message(c("overall elapsed time:", elapsed_t))
+ out <- list()
+ out$optimizations <- opt_out_list
+ out$call <- call
+ out$elapsed_time <- elapsed_t
+
+ class(out) <- c("optimize.portfolio.parallel")
+ return(out)
}
Modified: pkg/PortfolioAnalytics/R/random_portfolios.R
===================================================================
--- pkg/PortfolioAnalytics/R/random_portfolios.R 2014-07-09 20:49:39 UTC (rev 3469)
+++ pkg/PortfolioAnalytics/R/random_portfolios.R 2014-07-14 01:31:38 UTC (rev 3470)
@@ -390,11 +390,19 @@
)
if(eliminate){
# eliminate portfolios that do not satisfy constraints
- stopifnot("package:foreach" %in% search() || require("foreach",quietly = TRUE))
- check <- foreach(i=1:nrow(rp), .combine=c) %dopar% {
- # check_constraint returns TRUE if all constraints are satisfied
- check_constraints(weights=rp[i,], portfolio=portfolio)
+ check <- vector("numeric", nrow(rp))
+ for(i in 1:nrow(rp)){
+ check[i] <- check_constraints(weights=rp[i,], portfolio=portfolio)
}
+ # We probably don't need or want to do this part in parallel. It could
+ # also interfere with optimize.portfolio.parallel since this function
+ # will likely be called. Not sure how foreach handles nested loops
+ # in parallel so it is best to avoid that altogether.
+ #stopifnot("package:foreach" %in% search() || require("foreach",quietly = TRUE))
+ #check <- foreach(i=1:nrow(rp), .combine=c) %dopar% {
+ # # check_constraint returns TRUE if all constraints are satisfied
+ # check_constraints(weights=rp[i,], portfolio=portfolio)
+ #}
rp <- rp[which(check==TRUE),]
}
return(rp)
Modified: pkg/PortfolioAnalytics/man/optimize.portfolio.parallel.Rd
===================================================================
--- pkg/PortfolioAnalytics/man/optimize.portfolio.parallel.Rd 2014-07-09 20:49:39 UTC (rev 3469)
+++ pkg/PortfolioAnalytics/man/optimize.portfolio.parallel.Rd 2014-07-14 01:31:38 UTC (rev 3470)
@@ -1,17 +1,19 @@
% Generated by roxygen2 (4.0.1): do not edit by hand
\name{optimize.portfolio.parallel}
\alias{optimize.portfolio.parallel}
-\title{execute multiple optimize.portfolio calls, presumably in parallel}
+\title{Execute multiple optimize.portfolio calls, presumably in parallel}
\usage{
-optimize.portfolio.parallel(R, constraints, optimize_method = c("DEoptim",
- "random"), search_size = 20000, trace = FALSE, ..., nodes = 4)
+optimize.portfolio.parallel(R, portfolio, optimize_method = c("DEoptim",
+ "random", "ROI", "pso", "GenSA"), search_size = 20000, trace = FALSE, ...,
+ rp = NULL, momentFUN = "set.portfolio.moments", message = FALSE,
+ nodes = 4)
}
\arguments{
\item{R}{an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns}
-\item{constraints}{an object of type "constraints" specifying the constraints for the optimization, see \code{\link{constraint}}}
+\item{portfolio}{an object of type "portfolio" specifying the constraints and objectives for the optimization}
-\item{optimize_method}{one of "DEoptim" or "random"}
+\item{optimize_method}{one of "DEoptim", "random", "pso", "GenSA".}
\item{search_size}{integer, how many portfolios to test, default 20,000}
@@ -19,17 +21,21 @@
\item{\dots}{any other passthru parameters}
+\item{rp}{matrix of random portfolio weights, default NULL, mostly for automated use by rebalancing optimization or repeated tests on same portfolios}
+
+\item{momentFUN}{the name of a function to call to set portfolio moments, default \code{\link{set.portfolio.moments_v2}}}
+
+\item{message}{TRUE/FALSE. The default is message=FALSE. Display messages if TRUE.}
+
\item{nodes}{how many processes to run in the foreach loop, default 4}
}
\value{
a list containing the optimal weights, some summary statistics, the function call, and optionally trace information
}
\description{
-TODO write function to check sensitivity of optimal results by using optimize.portfolio.parallel results
+This function will not speed up optimization!
}
\details{
-This function will not speed up optimization!
-
This function exists to run multiple copies of optimize.portfolio, presumabley in parallel using foreach.
This is typically done to test your parameter settings, specifically
Added: pkg/PortfolioAnalytics/sandbox/opt_parallel.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/opt_parallel.R (rev 0)
+++ pkg/PortfolioAnalytics/sandbox/opt_parallel.R 2014-07-14 01:31:38 UTC (rev 3470)
@@ -0,0 +1,74 @@
+library(PortfolioAnalytics)
+
+data(edhec)
+R <- edhec[, 1:5]
+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")
+init.portf <- add.objective(portfolio=init.portf, type="risk", name="StdDev")
+
+# Run optimization with DEoptim
+minStdDev.DE <- optimize.portfolio(R=R, portfolio=init.portf,
+ optimize_method="DEoptim",
+ search_size=2000,
+ traceDE=0,
+ trace=TRUE)
+xtract.DE <- extractStats(minStdDev.DE)
+
+# Here we extract the objective value returned from the optimizer of each
+# iteration. I'm not sure how useful this information is.
+obj.DE <- xtract.DE[,"out"]
+hist(obj.DE)
+rug(obj.DE)
+plot(density(obj.DE))
+qqnorm(obj.DE)
+boxplot(obj.DE)
+
+# Run optimization with random portfolios
+minStdDev.RP <- optimize.portfolio(R=R, portfolio=init.portf,
+ optimize_method="random",
+ search_size=2000,
+ trace=TRUE)
+xtract.RP <- extractStats(minStdDev.RP)
+obj.RP <- xtract.RP[,"out"]
+hist(obj.RP)
+rug(obj.RP)
+plot(density(obj.RP))
+qqnorm(obj.RP)
+boxplot(obj.RP)
+
+# I think the best way is to do a sort of bootstrap by running several
+# hundred or thousand (depending on your resources) optimizations and
+# analyze the objective value from each optimal portfolio
+opt <- optimize.portfolio.parallel(R=R,
+ nodes=50,
+ portfolio=init.portf,
+ optimize_method="random",
+ search_size=2000,
+ trace=TRUE)
+opt
+xx <- summary(opt)
+obj_val <- xx$obj_val
+
+# estimate of the objective measures, objective value, and weights from the
+# optimal portfolio of each optimization
+apply(xx$stats, 2, mean)
+
+# plot the objective values from each optimization
+hist(obj_val)
+rug(obj_val)
+plot(density(obj_val))
+qqnorm(obj_val)
+qqline(obj_val)
+boxplot(obj_val)
+
+# These should match the print method
+# estimated objective value
+mean(obj_val)
+# percentile confidence interval estimate
+quantile(obj_val, probs = c(0.025, 0.975))
+
More information about the Returnanalytics-commits
mailing list