[Returnanalytics-commits] r3582 - in pkg/PortfolioAnalytics: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Jan 25 22:38:10 CET 2015
Author: rossbennett34
Date: 2015-01-25 22:38:09 +0100 (Sun, 25 Jan 2015)
New Revision: 3582
Modified:
pkg/PortfolioAnalytics/R/EntropyProg.R
pkg/PortfolioAnalytics/R/chart.concentration.R
pkg/PortfolioAnalytics/R/extract.efficient.frontier.R
pkg/PortfolioAnalytics/R/extractstats.R
pkg/PortfolioAnalytics/R/moment.functions.R
pkg/PortfolioAnalytics/R/optFUN.R
pkg/PortfolioAnalytics/R/optimize.portfolio.R
pkg/PortfolioAnalytics/R/random_portfolios.R
pkg/PortfolioAnalytics/man/optimize.portfolio.rebalancing.Rd
Log:
cleaning up global variables in code and documentation for R CMD check
Modified: pkg/PortfolioAnalytics/R/EntropyProg.R
===================================================================
--- pkg/PortfolioAnalytics/R/EntropyProg.R 2015-01-07 13:12:49 UTC (rev 3581)
+++ pkg/PortfolioAnalytics/R/EntropyProg.R 2015-01-25 21:38:09 UTC (rev 3582)
@@ -260,8 +260,8 @@
D = x[2] - x[1]
N = length(x)
- np = zeros(N , 1)
-
+ # np = zeros(N , 1)
+ np = matrix(0, nrow=N, ncol=1)
for (s in 1:N)
{
# The boolean Index is true is X is within the interval centered at x(s) and within a half-break distance
Modified: pkg/PortfolioAnalytics/R/chart.concentration.R
===================================================================
--- pkg/PortfolioAnalytics/R/chart.concentration.R 2015-01-07 13:12:49 UTC (rev 3581)
+++ pkg/PortfolioAnalytics/R/chart.concentration.R 2015-01-25 21:38:09 UTC (rev 3582)
@@ -51,6 +51,7 @@
conc.type <- match.arg(conc.type)
columnnames <- colnames(xtract)
+ R <- object$R
# Get the return and risk columns from xtract
return.column <- pmatch(return.col, columnnames)
@@ -136,7 +137,7 @@
y <- (x.hhi - min(x.hhi)) / (max(x.hhi) - min(x.hhi))
op <- par(no.readonly=TRUE)
- layout(matrix(c(1,2)),height=c(4,1.25),width=1)
+ layout(matrix(c(1,2)),heights=c(4,1.25),widths=1)
par(mar=c(5,4,1,2)+.1, cex=1) # c(bottom, left, top, right)
# plot the asset in risk-return space ordered based on degree of concentration
Modified: pkg/PortfolioAnalytics/R/extract.efficient.frontier.R
===================================================================
--- pkg/PortfolioAnalytics/R/extract.efficient.frontier.R 2015-01-07 13:12:49 UTC (rev 3581)
+++ pkg/PortfolioAnalytics/R/extract.efficient.frontier.R 2015-01-25 21:38:09 UTC (rev 3582)
@@ -60,6 +60,7 @@
}
set<-cbind(quantmod::Lag(set,1),as.matrix(set))[-1,]
+ i <- 1
result <- foreach(i=1:nrow(set),.inorder=TRUE, .combine=rbind, .errorhandling='remove') %do% {
tmp<-xtract[which(xtract[,mtc]>=set[i,1] & xtract[,mtc]<set[i,2]),]
#tmp<-tmp[which.min(tmp[,'out']),]
@@ -174,6 +175,7 @@
if(!is.null(risk_aversion)){
# Enable the return objective so we are doing quadratic utility
portfolio$objectives[[mean_idx]]$enabled <- TRUE
+ lambda <- risk_aversion[1]
out <- foreach(lambda=iter(risk_aversion), .inorder=TRUE, .combine=rbind, .errorhandling='remove', .packages='PortfolioAnalytics') %dopar% {
portfolio$objectives[[var_idx]]$risk_aversion <- lambda
extractStats(optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI", ...=...))
@@ -183,6 +185,7 @@
} else {
# Enable the return constraint
portfolio$constraints[[ret_constr_idx]]$enabled <- TRUE
+ ret <- ret_seq[1]
out <- foreach(ret=iter(ret_seq), .inorder=TRUE, .combine=rbind, .errorhandling='remove', .packages='PortfolioAnalytics') %dopar% {
portfolio$constraints[[ret_constr_idx]]$return_target <- ret
opt <- optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI", ...=...)
@@ -270,6 +273,7 @@
# }
stopifnot("package:foreach" %in% search() || require("foreach",quietly = TRUE))
stopifnot("package:iterators" %in% search() || require("iterators",quietly = TRUE))
+ ret <- ret_seq[1]
out <- foreach(ret=iter(ret_seq), .inorder=TRUE, .combine=rbind, .errorhandling='remove', .packages='PortfolioAnalytics') %dopar% {
portfolio$objectives[[mean_idx]]$target <- ret
extractStats(optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI", ef=TRUE, ...=...))
Modified: pkg/PortfolioAnalytics/R/extractstats.R
===================================================================
--- pkg/PortfolioAnalytics/R/extractstats.R 2015-01-07 13:12:49 UTC (rev 3581)
+++ pkg/PortfolioAnalytics/R/extractstats.R 2015-01-25 21:38:09 UTC (rev 3582)
@@ -191,6 +191,7 @@
# run constrained_objective on the weights to get the objective measures in a matrix
stopifnot("package:foreach" %in% search() || suppressMessages(require("foreach",quietly = TRUE)))
+ i <- 1
obj <- foreach(i=1:nrow(psoweights), .inorder=TRUE, .combine=rbind, .errorhandling='remove') %dopar% {
unlist(constrained_objective(w=psoweights[i,], R=R, portfolio=portfolio, trace=TRUE)$objective_measures)
}
@@ -255,7 +256,7 @@
extractStats.optimize.portfolio.rebalancing <- function(object, prefix=NULL, ...) {
if(!inherits(object, "optimize.portfolio.rebalancing")) stop("object must be of class optimize.portfolio.rebalancing")
- if(inherits(opt.rebal$portfolio, "regime.portfolios")){
+ if(inherits(object$portfolio, "regime.portfolios")){
return(extractStatsRegime(object, prefix=prefix))
} else {
return(lapply(object$opt_rebal, extractStats, ...))
Modified: pkg/PortfolioAnalytics/R/moment.functions.R
===================================================================
--- pkg/PortfolioAnalytics/R/moment.functions.R 2015-01-07 13:12:49 UTC (rev 3581)
+++ pkg/PortfolioAnalytics/R/moment.functions.R 2015-01-25 21:38:09 UTC (rev 3582)
@@ -179,7 +179,7 @@
clean <- unlist(lapply(portfolio$objectives, function(x) x$arguments$clean))
if(!is.null(clean)){
if(length(unique(clean)) > 1){
- warning(paste("Multiple methods detected for cleaning returns, default to use clean =", tmp[1]))
+ warning(paste("Multiple methods detected for cleaning returns, default to use clean =", clean[1]))
}
cleanR <- Return.clean(R, method=clean[1])
cleaned <- TRUE
@@ -394,7 +394,7 @@
clean <- unlist(lapply(portfolio$objectives, function(x) x$arguments$clean))
if(!is.null(clean)){
if(length(unique(clean)) > 1){
- warning(paste("Multiple methods detected for cleaning returns, default to use clean =", tmp[1]))
+ warning(paste("Multiple methods detected for cleaning returns, default to use clean =", clean[1]))
}
# This sets R as the cleaned returns for the rest of the function
# This is proably fine since the only other place R is used is for the
@@ -478,7 +478,7 @@
clean <- unlist(lapply(portfolio$objectives, function(x) x$arguments$clean))
if(!is.null(clean)){
if(length(unique(clean)) > 1){
- warning(paste("Multiple methods detected for cleaning returns, default to use clean =", tmp[1]))
+ warning(paste("Multiple methods detected for cleaning returns, default to use clean =", clean[1]))
}
# This sets R as the cleaned returns for the rest of the function
# This is proably fine since the only other place R is used is for the
Modified: pkg/PortfolioAnalytics/R/optFUN.R
===================================================================
--- pkg/PortfolioAnalytics/R/optFUN.R 2015-01-07 13:12:49 UTC (rev 3581)
+++ pkg/PortfolioAnalytics/R/optFUN.R 2015-01-25 21:38:09 UTC (rev 3582)
@@ -356,7 +356,7 @@
# Add the factor exposures to Amat, dir, and rhs
if(!is.null(constraints$B)){
- t.B <- t(B)
+ t.B <- t(constraints$B)
zeros <- matrix(data=0, nrow=nrow(t.B), ncol=ncol(t.B))
Amat <- rbind(Amat, cbind(t.B, zeros), cbind(-t.B, zeros))
dir <- c(dir, rep(">=", 2 * nrow(t.B)))
Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R
===================================================================
--- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2015-01-07 13:12:49 UTC (rev 3581)
+++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2015-01-25 21:38:09 UTC (rev 3582)
@@ -115,14 +115,41 @@
DEcformals$NP <- NP
DEcformals$itermax <- itermax
DEcformals[pm] <- dotargs[pm > 0L]
- if(!hasArg(strategy)) DEcformals$strategy=6 # use DE/current-to-p-best/1
- if(!hasArg(reltol)) DEcformals$reltol=.000001 # 1/1000 of 1% change in objective is significant
- if(!hasArg(steptol)) DEcformals$steptol=round(N*1.5) # number of assets times 1.5 tries to improve
- if(!hasArg(c)) DEcformals$c=.4 # JADE mutation parameter, this could maybe use some adjustment
- if(!hasArg(storepopfrom)) DEcformals$storepopfrom=1
+ if(!hasArg(strategy)) {
+ # use DE/current-to-p-best/1
+ strategy=6
+ DEcformals$strategy=strategy
+ }
+ if(!hasArg(reltol)) {
+ # 1/1000 of 1% change in objective is significant
+ reltol=.000001
+ DEcformals$reltol=reltol
+ }
+ if(!hasArg(steptol)) {
+ # number of assets times 1.5 tries to improve
+ steptol=round(N*1.5)
+ DEcformals$steptol=steptol
+ }
+ if(!hasArg(c)) {
+ # JADE mutation parameter, this could maybe use some adjustment
+ tmp.c=.4
+ DEcformals$c=tmp.c
+ }
+ if(!hasArg(storepopfrom)) {
+ storepopfrom=1
+ DEcformals$storepopfrom=storepopfrom
+ }
if(isTRUE(parallel) && 'package:foreach' %in% search()){
- if(!hasArg(parallelType) ) DEcformals$parallelType='auto' #use all cores
- if(!hasArg(packages) ) DEcformals$packages <- names(sessionInfo()$otherPkgs) #use all packages
+ if(!hasArg(parallelType)) {
+ #use all cores
+ parallelType='auto'
+ DEcformals$parallelType=parallelType
+ }
+ if(!hasArg(packages)) {
+ #use all packages
+ packages <- names(sessionInfo()$otherPkgs)
+ DEcformals$packages <- packages
+ }
}
#TODO FIXME also check for a passed in controlDE list, including checking its class, and match formals
@@ -190,6 +217,7 @@
if (isTRUE(trace)) out$random_portfolios<-rp
#' write foreach loop to call constrained_objective() with each portfolio
if ("package:foreach" %in% search() & !hasArg(parallel)){
+ ii <- 1
rp_objective_results<-foreach(ii=1:nrow(rp), .errorhandling='pass') %dopar% constrained_objective_v1(w=rp[ii,],R,constraints,trace=trace,...=dotargs)
} else {
rp_objective_results<-apply(rp, 1, constrained_objective_v1, R=R, constraints=constraints, trace=trace, ...=dotargs)
@@ -337,8 +365,15 @@
#NOTE reltol has a different meaning for pso than it has for DEoptim. for DEoptim, reltol is a stopping criteria, for pso,
# it is a restart criteria.
- if(!hasArg(s)) controlPSO$s<-N*10 #swarm size
- if(!hasArg(maxit.stagnate)) controlPSO$maxit.stagnate <- controlPSO$s #stopping criteria
+ if(!hasArg(s)) {
+ s <- N*10
+ controlPSO$s<-s
+ } #swarm size
+ if(!hasArg(maxit.stagnate)) {
+ #stopping criteria
+ maxit.stagnate <- controlPSO$s
+ controlPSO$maxit.stagnate <- maxit.stagnate
+ }
if(hasArg(trace) && try(trace==TRUE,silent=TRUE)) controlPSO$trace <- TRUE
if(hasArg(trace) && isTRUE(trace)) {
controlPSO$trace <- TRUE
@@ -652,14 +687,41 @@
DEcformals$NP <- NP
DEcformals$itermax <- itermax
DEcformals[pm] <- dotargs[pm > 0L]
- if(!hasArg(strategy)) DEcformals$strategy=6 # use DE/current-to-p-best/1
- if(!hasArg(reltol)) DEcformals$reltol=.000001 # 1/1000 of 1% change in objective is significant
- if(!hasArg(steptol)) DEcformals$steptol=round(N*1.5) # number of assets times 1.5 tries to improve
- if(!hasArg(c)) DEcformals$c=.4 # JADE mutation parameter, this could maybe use some adjustment
- if(!hasArg(storepopfrom)) DEcformals$storepopfrom=1
+ if(!hasArg(strategy)) {
+ # use DE/current-to-p-best/1
+ strategy=6
+ DEcformals$strategy=strategy
+ }
+ if(!hasArg(reltol)) {
+ # 1/1000 of 1% change in objective is significant
+ reltol=0.000001
+ DEcformals$reltol=reltol
+ }
+ if(!hasArg(steptol)) {
+ # number of assets times 1.5 tries to improve
+ steptol=round(N*1.5)
+ DEcformals$steptol=steptol
+ }
+ if(!hasArg(c)) {
+ # JADE mutation parameter, this could maybe use some adjustment
+ tmp.c=0.4
+ DEcformals$c=tmp.c
+ }
+ if(!hasArg(storepopfrom)) {
+ storepopfrom=1
+ DEcformals$storepopfrom=storepopfrom
+ }
if(isTRUE(parallel) && 'package:foreach' %in% search()){
- if(!hasArg(parallelType) ) DEcformals$parallelType='auto' #use all cores
- if(!hasArg(packages) ) DEcformals$packages <- names(sessionInfo()$otherPkgs) #use all packages
+ if(!hasArg(parallelType)) {
+ #use all cores
+ parallelType='auto'
+ DEcformals$parallelType=parallelType
+ }
+ if(!hasArg(packages)) {
+ #use all packages
+ packages <- names(sessionInfo()$otherPkgs)
+ DEcformals$packages <- packages
+ }
}
#TODO FIXME also check for a passed in controlDE list, including checking its class, and match formals
}
@@ -765,6 +827,7 @@
# 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)){
+ ii <- 1
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, env=dotargs)
@@ -1276,7 +1339,7 @@
#' @rdname optimize.portfolio.rebalancing
#' @name optimize.portfolio.rebalancing
#' @export
-optimize.portfolio.rebalancing_v1 <- function(R,constraints,optimize_method=c("DEoptim","random","ROI"), search_size=20000, trace=FALSE, ..., rp=NULL, rebalance_on=NULL, training_period=NULL, trailing_periods=NULL)
+optimize.portfolio.rebalancing_v1 <- function(R,constraints,optimize_method=c("DEoptim","random","ROI"), search_size=20000, trace=FALSE, ..., rp=NULL, rebalance_on=NULL, training_period=NULL, rolling_window=NULL)
{
stopifnot("package:foreach" %in% search() || require("foreach",quietly=TRUE))
start_t<-Sys.time()
@@ -1289,13 +1352,21 @@
rp<-random_portfolios(rpconstraints=constraints,permutations=search_size)
} else {
rp=NULL
- }
+ }
+ # check for trailing_periods argument and set rolling_window equal to
+ # trailing_periods for backwards compatibility
+ if(hasArg(trailing_periods)) {
+ trailing_periods=match.call(expand.dots=TRUE)$trailing_periods
+ rolling_window <- trailing_periods
+ }
+
if(is.null(training_period)) {if(nrow(R)<36) training_period=nrow(R) else training_period=36}
- if (is.null(trailing_periods)){
+ if (is.null(rolling_window)){
# define the index endpoints of our periods
ep.i<-endpoints(R,on=rebalance_on)[which(endpoints(R, on = rebalance_on)>=training_period)]
# now apply optimize.portfolio to the periods, in parallel if available
+ ep <- ep.i[1]
out_list<-foreach(ep=iter(ep.i), .errorhandling='pass', .packages='PortfolioAnalytics') %dopar% {
optimize.portfolio(R[1:ep,],constraints=constraints,optimize_method=optimize_method, search_size=search_size, trace=trace, rp=rp, parallel=FALSE, ...=...)
}
@@ -1304,7 +1375,7 @@
ep.i<-endpoints(R,on=rebalance_on)[which(endpoints(R, on = rebalance_on)>=training_period)]
# now apply optimize.portfolio to the periods, in parallel if available
out_list<-foreach(ep=iter(ep.i), .errorhandling='pass', .packages='PortfolioAnalytics') %dopar% {
- optimize.portfolio(R[(ifelse(ep-trailing_periods>=1,ep-trailing_periods,1)):ep,],constraints=constraints,optimize_method=optimize_method, search_size=search_size, trace=trace, rp=rp, parallel=FALSE, ...=...)
+ optimize.portfolio(R[(ifelse(ep-rolling_window>=1,ep-rolling_window,1)):ep,],constraints=constraints,optimize_method=optimize_method, search_size=search_size, trace=trace, rp=rp, parallel=FALSE, ...=...)
}
}
names(out_list)<-index(R[ep.i])
@@ -1505,6 +1576,7 @@
# define the index endpoints of our periods
ep.i<-endpoints(R,on=rebalance_on)[which(endpoints(R, on = rebalance_on)>=training_period)]
# now apply optimize.portfolio to the periods, in parallel if available
+ ep <- ep.i[1]
out_list<-foreach(ep=iter(ep.i), .errorhandling='pass', .packages='PortfolioAnalytics') %dopar% {
optimize.portfolio(R[1:ep,], portfolio=portfolio, optimize_method=optimize_method, search_size=search_size, trace=trace, rp=rp, parallel=FALSE, ...=...)
}
Modified: pkg/PortfolioAnalytics/R/random_portfolios.R
===================================================================
--- pkg/PortfolioAnalytics/R/random_portfolios.R 2015-01-07 13:12:49 UTC (rev 3581)
+++ pkg/PortfolioAnalytics/R/random_portfolios.R 2015-01-25 21:38:09 UTC (rev 3582)
@@ -540,6 +540,8 @@
# do the transformation to the set of weights to satisfy lower bounds
stopifnot("package:foreach" %in% search() || require("foreach",quietly = TRUE))
+ j <- 1
+ i <- 1
out <- foreach(j = 1:length(fev), .combine=c) %:% foreach(i=1:nrow(Umat)) %dopar% {
q <- 2^fev[j]
tmp <- L + (1 - sum(L)) * log(Umat[i,])^q / sum(log(Umat[i,])^q)
Modified: pkg/PortfolioAnalytics/man/optimize.portfolio.rebalancing.Rd
===================================================================
--- pkg/PortfolioAnalytics/man/optimize.portfolio.rebalancing.Rd 2015-01-07 13:12:49 UTC (rev 3581)
+++ pkg/PortfolioAnalytics/man/optimize.portfolio.rebalancing.Rd 2015-01-25 21:38:09 UTC (rev 3582)
@@ -7,7 +7,7 @@
optimize.portfolio.rebalancing_v1(R, constraints,
optimize_method = c("DEoptim", "random", "ROI"), search_size = 20000,
trace = FALSE, ..., rp = NULL, rebalance_on = NULL,
- training_period = NULL, trailing_periods = NULL)
+ training_period = NULL, rolling_window = NULL)
optimize.portfolio.rebalancing(R, portfolio = NULL, constraints = NULL,
objectives = NULL, optimize_method = c("DEoptim", "random", "ROI"),
More information about the Returnanalytics-commits
mailing list