[Returnanalytics-commits] r3289 - in pkg/PortfolioAnalytics: R sandbox/benchmarking
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Dec 17 22:06:09 CET 2013
Author: rossbennett34
Date: 2013-12-17 22:06:07 +0100 (Tue, 17 Dec 2013)
New Revision: 3289
Added:
pkg/PortfolioAnalytics/sandbox/benchmarking/benchmark_output.txt
Modified:
pkg/PortfolioAnalytics/R/optimize.portfolio.R
pkg/PortfolioAnalytics/sandbox/benchmarking/benchmark_opt.R
Log:
Simplifying how initialpop is set for DEoptim with random portfolios. Adding benchmarking script and output file with results.
Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R
===================================================================
--- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-12-17 21:03:01 UTC (rev 3288)
+++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-12-17 21:06:07 UTC (rev 3289)
@@ -609,22 +609,37 @@
consider relaxing. e.g. 'full_investment' constraint should be min_sum=0.99 and max_sum=1.01")
}
- if(hasArg(rpseed)){
- seed <- match.call(expand.dots=TRUE)$rpseed
+ #if(hasArg(rpseed)){
+ # seed <- match.call(expand.dots=TRUE)$rpseed
+ # DEcformals$initialpop <- seed
+ # rpseed <- FALSE
+ #} else {
+ # rpseed <- TRUE
+ #}
+ #if(hasArg(rpseed) & isTRUE(rpseed)) {
+ # # initial seed population is generated with random_portfolios function
+ # # if(hasArg(eps)) eps=match.call(expand.dots=TRUE)$eps else eps = 0.01
+ # if(hasArg(rp_method)) rp_method=match.call(expand.dots=TRUE)$rp_method else rp_method="sample"
+ # if(hasArg(eliminate)) eliminate=match.call(expand.dots=TRUE)$eliminate else eliminate=TRUE
+ # if(hasArg(fev)) fev=match.call(expand.dots=TRUE)$fev else fev=0:5
+ # rp <- random_portfolios(portfolio=portfolio, permutations=NP, rp_method=rp_method, eliminate=eliminate, fev=fev)
+ # DEcformals$initialpop <- rp
+ #}
+
+ # Use rp as the initial population or generate from random portfolios
+ if(!is.null(rp)){
+ rp_len <- min(nrow(rp), NP)
+ seed <- rp[1:rp_len,]
DEcformals$initialpop <- seed
- rpseed <- FALSE
- } else {
- rpseed <- TRUE
- }
- if(hasArg(rpseed) & isTRUE(rpseed)) {
- # initial seed population is generated with random_portfolios function
- # if(hasArg(eps)) eps=match.call(expand.dots=TRUE)$eps else eps = 0.01
+ } else{
+ # Initial seed population is generated with random_portfolios function if rp is not passed in
if(hasArg(rp_method)) rp_method=match.call(expand.dots=TRUE)$rp_method else rp_method="sample"
if(hasArg(eliminate)) eliminate=match.call(expand.dots=TRUE)$eliminate else eliminate=TRUE
if(hasArg(fev)) fev=match.call(expand.dots=TRUE)$fev else fev=0:5
rp <- random_portfolios(portfolio=portfolio, permutations=NP, rp_method=rp_method, eliminate=eliminate, fev=fev)
DEcformals$initialpop <- rp
}
+
controlDE <- do.call(DEoptim.control, DEcformals)
# We are passing fn_map to the optional fnMap function to do the
Modified: pkg/PortfolioAnalytics/sandbox/benchmarking/benchmark_opt.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/benchmarking/benchmark_opt.R 2013-12-17 21:03:01 UTC (rev 3288)
+++ pkg/PortfolioAnalytics/sandbox/benchmarking/benchmark_opt.R 2013-12-17 21:06:07 UTC (rev 3289)
@@ -1,7 +1,8 @@
+# The purpose of this script is to set a baseline for performance of optimize.portfolio
library(PortfolioAnalytics)
-library(rbenchmark)
+library(microbenchmark)
data(edhec)
returns <- edhec[,1:10]
@@ -11,47 +12,54 @@
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="box", min=0, max=0.45)
-# init.portf <- add.objective(portfolio=init.portf, type="return", name="mean")
+init.portf <- add.constraint(portfolio=init.portf, type="box", min=0, max=1)
init.portf <- add.objective(portfolio=init.portf, type="risk", name="ES")
-n_portfolios <- 1000
+# Generate N random portfolios. Random portfolios should be generated outside
+# of optimize.portfolio so that the time to generate random portfolios is not
+# included in the timing
+n_portfolios <- 5000
rp <- random_portfolios(portfolio=init.portf,
permutations=n_portfolios,
rp_method="sample",
eliminate=FALSE)
-opt1 <- optimize.portfolio(R=returns, portfolio=init.portf, optimize_method="random", rp=rp, reuse_moments=FALSE, trace=TRUE)
-opt2 <- optimize.portfolio(R=returns, portfolio=init.portf, optimize_method="random", rp=rp, reuse_moments=TRUE, trace=TRUE)
+opt_rp <- function(){
+ optimize.portfolio(R=returns,
+ portfolio=init.portf,
+ optimize_method="random",
+ rp=rp,
+ trace=TRUE)
+}
-all.equal(opt1, opt2)
-# Component 6, 10, and 11 do not match
-# Component 6 is the call
-# Component 10 the elapsed time
-# Component 11 the end_t
+opt_de <- function(){
+ optimize.portfolio(R=returns,
+ portfolio=init.portf,
+ optimize_method="DEoptim",
+ search_size=n_portfolios,
+ rp=rp,
+ traceDE=0,
+ trace=TRUE)
+}
-# Make sure the results of opt1 and opt2 are equal
-all.equal(extractStats(opt1), extractStats(opt2))
+opt_benchmark <- microbenchmark(opt_rp(), opt_de(), times=10)
+comment_string <- "ES optimization benchmark with random portfolios and DEoptim"
-# benchmark different ways of passing the moments to constrained_objective
-benchmark(
- reuse=optimize.portfolio(R=returns, portfolio=init.portf, optimize_method="random", rp=rp, reuse_moments=TRUE),
- no_reuse=optimize.portfolio(R=returns, portfolio=init.portf, optimize_method="random", rp=rp, reuse_moments=FALSE),
- replications=1
-)[,1:4]
+zz <- file(description="sandbox/benchmarking/benchmark_output.txt", open="at")
+sink(zz, append=TRUE)
+cat("******\n")
+Sys.time()
+cat(comment_string, "\n")
+opt_benchmark
+cat("******\n")
+sink()
+close(zz)
# Rprof runs
-# new uses modify.args to evaluate arguments
-Rprof(filename="rp_profile_reuse.txt")
-optimize.portfolio(R=returns, portfolio=init.portf, optimize_method="random", rp=rp, reuse_moments=TRUE)
-Rprof(NULL)
+# Rprof(filename="rp_profile_reuse.txt")
+# optimize.portfolio(R=returns, portfolio=init.portf, optimize_method="random", rp=rp, trace=TRUE)
+# Rprof(NULL)
-Rprof(filename="rp_profile_no_reuse.txt")
-optimize.portfolio(R=returns, portfolio=init.portf, optimize_method="random", rp=rp, reuse_moments=FALSE)
-Rprof(NULL)
+# out_reuse <- summaryRprof("rp_profile_reuse.txt")
+# out_no_reuse <- summaryRprof("rp_profile_no_reuse.txt")
-out_reuse <- summaryRprof("rp_profile_reuse.txt")
-out_no_reuse <- summaryRprof("rp_profile_no_reuse.txt")
-
-lapply(out_reuse, head)
-lapply(out_no_reuse, head)
\ No newline at end of file
Added: pkg/PortfolioAnalytics/sandbox/benchmarking/benchmark_output.txt
===================================================================
--- pkg/PortfolioAnalytics/sandbox/benchmarking/benchmark_output.txt (rev 0)
+++ pkg/PortfolioAnalytics/sandbox/benchmarking/benchmark_output.txt 2013-12-17 21:06:07 UTC (rev 3289)
@@ -0,0 +1,8 @@
+******
+[1] "2013-12-17 10:45:18 PST"
+ES optimization benchmark with random portfolios and DEoptim
+Unit: seconds
+ expr min lq median uq max neval
+ opt_rp() 8.539322 8.581483 8.685236 9.019323 9.510726 10
+ opt_de() 42.417468 98.721399 113.836677 128.932124 142.691423 10
+******
More information about the Returnanalytics-commits
mailing list