[Returnanalytics-commits] r3284 - pkg/PortfolioAnalytics/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Dec 16 06:32:31 CET 2013
Author: rossbennett34
Date: 2013-12-16 06:32:31 +0100 (Mon, 16 Dec 2013)
New Revision: 3284
Modified:
pkg/PortfolioAnalytics/R/constrained_objective.R
pkg/PortfolioAnalytics/R/optimize.portfolio.R
Log:
Slight modifications to how moments and arguments are passed for calculating tmp_measure. Test and benchmark with this before using an environment.
Modified: pkg/PortfolioAnalytics/R/constrained_objective.R
===================================================================
--- pkg/PortfolioAnalytics/R/constrained_objective.R 2013-12-16 05:28:36 UTC (rev 3283)
+++ pkg/PortfolioAnalytics/R/constrained_objective.R 2013-12-16 05:32:31 UTC (rev 3284)
@@ -345,7 +345,7 @@
#' @aliases constrained_objective constrained_objective_v1
#' @rdname constrained_objective
#' @export
-constrained_objective_v2 <- function(w, R, portfolio, ..., trace=FALSE, normalize=TRUE, storage=FALSE, moments=NULL)
+constrained_objective_v2 <- function(w, R, portfolio, ..., trace=FALSE, normalize=TRUE, storage=FALSE, env=NULL)
{
if (ncol(R) > length(w)) {
R <- R[ ,1:length(w)]
@@ -474,7 +474,7 @@
# penalize weights that violate return target constraint
if(!is.null(constraints$return_target)){
return_target <- constraints$return_target
- mean_return <- port.mean(weights=w, mu=moments$mu)
+ mean_return <- port.mean(weights=w, mu=env$mu)
mult <- 1
out = out + penalty * mult * abs(mean_return - return_target)
} # End return constraint penalty
@@ -524,8 +524,12 @@
# trust that all the moments are correctly set in optimize.portfolio through
# momentFUN?
- if(!is.null(moments)){
- nargs <- moments
+ # Add R and w to the environment with the moments
+ # env$R <- R
+ # env$weights <- w
+
+ if(!is.null(env)){
+ nargs <- env
} else {
# print("calculating moments")
# calculating the moments
@@ -546,6 +550,9 @@
# should be avoided because nargs could be large because it contains the moments.
tmp_args <- list()
+ # JMU: Add all the variables in 'env' to tmp_args as names/symbols
+ # tmp_args[ls(env)] <- lapply(ls(env), as.name)
+
if(is.null(portfolio$objectives)) {
warning("no objectives specified in portfolio")
} else{
@@ -576,7 +583,7 @@
VaR = {
fun = match.fun(VaR)
if(!inherits(objective,"risk_budget_objective") & is.null(objective$arguments$portfolio_method) & is.null(nargs$portfolio_method)) tmp_args$portfolio_method='single'
- if(is.null(objective$arguments$invert)) objective$arguments$invert = FALSE
+ if(is.null(objective$arguments$invert)) tmp_args$invert = FALSE
},
es =,
mES =,
@@ -587,7 +594,7 @@
ES = {
fun = match.fun(ES)
if(!inherits(objective,"risk_budget_objective") & is.null(objective$arguments$portfolio_method) & is.null(nargs$portfolio_method)) tmp_args$portfolio_method='single'
- if(is.null(objective$arguments$invert)) objective$arguments$invert = FALSE
+ if(is.null(objective$arguments$invert)) tmp_args$invert = FALSE
},
turnover = {
fun = match.fun(turnover) # turnover function included in objectiveFUN.R
@@ -609,11 +616,12 @@
# Add R and weights if necessary
if("R" %in% names(.formals)) .formals <- modify.args(formals=.formals, arglist=NULL, R=R, dots=TRUE)
if("weights" %in% names(.formals)) .formals <- modify.args(formals=.formals, arglist=NULL, weights=w, dots=TRUE)
+ # .formals <- modify.args(formals=.formals, arglist=tmp_args, dots=TRUE)
.formals$... <- NULL
}
- # print(.formals)
- tmp_measure <- try((do.call(fun,.formals)), silent=TRUE)
+ # tmp_measure <- try(do.call(fun, .formals, envir=env), silent=TRUE)
+ tmp_measure <- try(do.call(fun, .formals), silent=TRUE)
if(isTRUE(trace) | isTRUE(storage)) {
# Subsitute 'StdDev' if the objective name is 'var'
Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R
===================================================================
--- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-12-16 05:28:36 UTC (rev 3283)
+++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-12-16 05:32:31 UTC (rev 3284)
@@ -511,9 +511,16 @@
# call momentFUN
mout <- try(do.call(momentFUN, .formals), silent=TRUE)
- if(inherits(mout,"try-error")) {
- message(paste("portfolio moment function failed with message",mout))
+
+ if(inherits(mout, "try-error")) {
+ message(paste("portfolio moment function failed with message", mout))
} else {
+ #.args_env <- as.environment(mout)
+ #.args_env <- new.env()
+ # Assign each element of mout to the .args_env environment
+ #for(name in names(mout)){
+ # .args_env[[name]] <- mout[[name]]
+ #}
dotargs <- mout
}
@@ -614,14 +621,15 @@
# 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
- rp <- random_portfolios(portfolio=portfolio, permutations=NP, rp_method=rp_method, eliminate=eliminate, ...)
+ 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
# transformation so we need to force normalize=FALSE in call to constrained_objective
- minw = try(DEoptim( constrained_objective, lower=lower[1:N], upper=upper[1:N], control=controlDE, R=R, portfolio=portfolio, moments = dotargs, normalize=FALSE, fnMap=function(x) fn_map(x, portfolio=portfolio)$weights)) # add ,silent=TRUE here?
+ minw = try(DEoptim( constrained_objective, lower=lower[1:N], upper=upper[1:N], control=controlDE, R=R, portfolio=portfolio, env=dotargs, normalize=FALSE, fnMap=function(x) fn_map(x, portfolio=portfolio)$weights), silent=TRUE)
if(inherits(minw, "try-error")) { minw=NULL }
if(is.null(minw)){
@@ -636,7 +644,7 @@
# is it necessary to normalize the weights here?
# weights <- normalize_weights(weights)
names(weights) <- colnames(R)
- obj_vals <- constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE, moments=dotargs)$objective_measures
+ obj_vals <- constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE, env=dotargs)$objective_measures
out <- list(weights=weights, objective_measures=obj_vals, opt_values=obj_vals, out=minw$optim$bestval, call=call)
if (isTRUE(trace)){
out$DEoutput <- minw
@@ -658,16 +666,17 @@
if(missing(rp) | is.null(rp)){
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
- rp <- random_portfolios(portfolio=portfolio, permutations=search_size, rp_method=rp_method, eliminate=eliminate, ...)
+ if(hasArg(fev)) fev=match.call(expand.dots=TRUE)$fev else fev=0:5
+ rp <- random_portfolios(portfolio=portfolio, permutations=search_size, rp_method=rp_method, eliminate=eliminate, fev=fev)
}
#' store matrix in out if trace=TRUE
if (isTRUE(trace)) out$random_portfolios <- rp
# rp is already being generated with a call to fn_map so set normalize=FALSE in the call to constrained_objective
#' write foreach loop to call constrained_objective() with each portfolio
if ("package:foreach" %in% search() & !hasArg(parallel)){
- rp_objective_results <- foreach(ii=1:nrow(rp), .errorhandling='pass') %dopar% constrained_objective(w=rp[ii,], R=R, portfolio=portfolio, trace=trace, moments=dotargs, normalize=FALSE)
+ rp_objective_results <- foreach(ii=1:nrow(rp), .errorhandling='pass') %dopar% constrained_objective(w=rp[ii,], R=R, portfolio=portfolio, trace=trace, env=dotargs, normalize=FALSE)
} else {
- rp_objective_results <- apply(rp, 1, constrained_objective, R=R, portfolio=portfolio, trace=trace, normalize=FALSE, moments=dotargs)
+ rp_objective_results <- apply(rp, 1, constrained_objective, R=R, portfolio=portfolio, trace=trace, normalize=FALSE, env=dotargs)
}
#' if trace=TRUE , store results of foreach in out$random_results
if(isTRUE(trace)) out$random_portfolio_objective_results <- rp_objective_results
@@ -691,7 +700,7 @@
}
#' re-call constrained_objective on the best portfolio, as above in DEoptim, with trace=TRUE to get results for out list
out$weights <- min_objective_weights
- obj_vals <- try(constrained_objective(w=min_objective_weights, R=R, portfolio=portfolio, trace=TRUE, normalize=FALSE, moments=dotargs)$objective_measures)
+ obj_vals <- try(constrained_objective(w=min_objective_weights, R=R, portfolio=portfolio, trace=TRUE, normalize=FALSE, env=dotargs)$objective_measures)
out$objective_measures <- obj_vals
out$opt_values <- obj_vals
out$call <- call
@@ -898,7 +907,7 @@
upper <- constraints$max
lower <- constraints$min
- minw <- try(psoptim( par = rep(NA, N), fn = constrained_objective, R=R, portfolio=portfolio, moments=dotargs,
+ minw <- try(psoptim( par = rep(NA, N), fn = constrained_objective, R=R, portfolio=portfolio, env=dotargs,
lower = lower[1:N] , upper = upper[1:N] , control = controlPSO)) # add ,silent=TRUE here?
if(inherits(minw,"try-error")) { minw=NULL }
@@ -910,7 +919,7 @@
weights <- as.vector( minw$par)
weights <- normalize_weights(weights)
names(weights) <- colnames(R)
- obj_vals <- constrained_objective(w=weights, R=R, portfolio=portfolio, trace=TRUE, moments=dotargs)$objective_measures
+ obj_vals <- constrained_objective(w=weights, R=R, portfolio=portfolio, trace=TRUE, env=dotargs)$objective_measures
out <- list(weights=weights,
objective_measures=obj_vals,
opt_values=obj_vals,
@@ -944,7 +953,7 @@
lower <- constraints$min
minw = try(GenSA( par = rep(1/N, N), lower = lower[1:N] , upper = upper[1:N], control = controlGenSA,
- fn = constrained_objective , R=R, portfolio=portfolio, moments=dotargs)) # add ,silent=TRUE here?
+ fn = constrained_objective , R=R, portfolio=portfolio, env=dotargs)) # add ,silent=TRUE here?
if(inherits(minw,"try-error")) { minw=NULL }
if(is.null(minw)){
@@ -955,7 +964,7 @@
weights <- as.vector(minw$par)
weights <- normalize_weights(weights)
names(weights) <- colnames(R)
- obj_vals <- constrained_objective(w=weights, R=R, portfolio=portfolio, trace=TRUE, moments=dotargs)$objective_measures
+ obj_vals <- constrained_objective(w=weights, R=R, portfolio=portfolio, trace=TRUE, env=dotargs)$objective_measures
out = list(weights=weights,
objective_measures=obj_vals,
opt_values=obj_vals,
More information about the Returnanalytics-commits
mailing list