[Returnanalytics-commits] r3239 - pkg/PortfolioAnalytics/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Oct 23 19:54:52 CEST 2013
Author: rossbennett34
Date: 2013-10-23 19:54:52 +0200 (Wed, 23 Oct 2013)
New Revision: 3239
Modified:
pkg/PortfolioAnalytics/R/extract.efficient.frontier.R
pkg/PortfolioAnalytics/R/optFUN.R
Log:
cleaning up meanvar.efficient.frontier so we no longer approximate max return and min return by manipulating the risk aversion parameter
Modified: pkg/PortfolioAnalytics/R/extract.efficient.frontier.R
===================================================================
--- pkg/PortfolioAnalytics/R/extract.efficient.frontier.R 2013-10-23 13:00:51 UTC (rev 3238)
+++ pkg/PortfolioAnalytics/R/extract.efficient.frontier.R 2013-10-23 17:54:52 UTC (rev 3239)
@@ -110,7 +110,7 @@
# for a mean-var efficient frontier, there must be two objectives 1) "mean" and 2) "var"
if(!((length(objnames) >= 2) & ("var" %in% objnames | "StdDev" %in% objnames | "sd" %in% objnames) & ("mean" %in% objnames))){
- stop("The portfolio object must have both 'mean' and 'var' specified as objectives")
+ stop("The portfolio object must have both 'mean' and 'var', 'StdDev', or'sd' specified as objectives")
}
# If the user has passed in a portfolio object with return_constraint, we need to disable it
@@ -125,29 +125,48 @@
# get the index number of the mean objective
mean_idx <- which(unlist(lapply(portfolio$objectives, function(x) x$name)) == "mean")
+ ##### get the maximum return #####
+
# set the risk_aversion to a very small number for equivalent to max return portfolio
- portfolio$objectives[[var_idx]]$risk_aversion <- 1e-6
+ # portfolio$objectives[[var_idx]]$risk_aversion <- 1e-6
+ # Disable the risk objective
+ portfolio$objectives[[var_idx]]$enabled <- FALSE
+
# run the optimization to get the maximum return
tmp <- optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI")
- maxret <- extractObjectiveMeasures(tmp)$mean
+ mean_ret <- colMeans(R)
+ maxret <- sum(extractWeights(tmp) * mean_ret)
+ ##### Get the return at the minimum variance portfolio #####
+
# set the risk_aversion to a very large number equivalent to a minvar portfolio
- portfolio$objectives[[var_idx]]$risk_aversion <- 1e6
+ # portfolio$objectives[[var_idx]]$risk_aversion <- 1e6
+
+ # Disable the return objective
+ portfolio$objectives[[mean_idx]]$enabled <- FALSE
+
+ # Enable the risk objective
+ portfolio$objectives[[var_idx]]$enabled <- TRUE
+
+ # Run the optimization to get the global minimum variance portfolio with the
+ # given constraints.
+ # Do we want to disable the turnover or transaction costs constraints here?
tmp <- optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI")
stats <- extractStats(tmp)
- minret <- stats["mean"]
+ minret <- sum(extractWeights(tmp) * mean_ret)
# length.out is the number of portfolios to create
ret_seq <- seq(from=minret, to=maxret, length.out=n.portfolios)
-# out <- matrix(0, nrow=length(ret_seq), ncol=length(extractStats(tmp)))
-# for(i in 1:length(ret_seq)){
-# portfolio$objectives[[mean_idx]]$target <- ret_seq[i]
-# out[i, ] <- extractStats(optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI"))
-# }
+ # Add target return constraint to step along the efficient frontier for target returns
+ portfolio <- add.constraint(portfolio=portfolio, type="return", return_target=minret, enabled=FALSE)
+ ret_constr_idx <- which(unlist(lapply(portfolio$constraints, function(x) inherits(x, "return_constraint"))))
+
stopifnot("package:foreach" %in% search() || require("foreach",quietly = TRUE))
if(!is.null(risk_aversion)){
+ # Enable the return objective so we are doing quadratic utility
+ portfolio$objectives[[mean_idx]]$enabled <- TRUE
out <- foreach(i=1:length(risk_aversion), .inorder=TRUE, .combine=rbind, .errorhandling='remove') %dopar% {
portfolio$objectives[[var_idx]]$risk_aversion <- risk_aversion[i]
extractStats(optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI"))
@@ -155,11 +174,14 @@
out <- cbind(out, risk_aversion)
colnames(out) <- c(names(stats), "lambda")
} else {
+ # Enable the return constraint
+ portfolio$constraints[[ret_constr_idx]]$enabled <- TRUE
out <- foreach(i=1:length(ret_seq), .inorder=TRUE, .combine=rbind, .errorhandling='remove') %dopar% {
- portfolio$objectives[[mean_idx]]$target <- ret_seq[i]
- extractStats(optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI"))
+ portfolio$constraints[[ret_constr_idx]]$return_target <- ret_seq[i]
+ opt <- optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI")
+ c(sum(extractWeights(opt) * mean_ret), extractStats(opt))
}
- colnames(out) <- names(stats)
+ colnames(out) <- c("mean", names(stats))
}
return(structure(out, class="frontier"))
}
Modified: pkg/PortfolioAnalytics/R/optFUN.R
===================================================================
--- pkg/PortfolioAnalytics/R/optFUN.R 2013-10-23 13:00:51 UTC (rev 3238)
+++ pkg/PortfolioAnalytics/R/optFUN.R 2013-10-23 17:54:52 UTC (rev 3239)
@@ -568,7 +568,7 @@
tmp_means <- moments$mean
}
} else {
- tmp_means <- moments$mean
+ tmp_means <- rep(0, N)
target <- 0
}
Amat <- c(tmp_means, rep(0, 2*N))
@@ -638,16 +638,20 @@
rhs <- c(rhs, constraints$lower, -constraints$upper)
}
- d <- rep(-moments$mean, 3)
- # print(Amat)
+ d <- rep(moments$mean, 3)
# Remove the rows of Amat and elements of rhs.vec where rhs is Inf or -Inf
Amat <- Amat[!is.infinite(rhs), ]
rhs <- rhs[!is.infinite(rhs)]
-
+ # print("Amat")
+ # print(Amat)
+ # print("rhs")
+ # print(rhs)
+ # print("d")
+ # print(d)
qp.result <- try(solve.QP(Dmat=make.positive.definite(2*lambda*V),
dvec=d, Amat=t(Amat), bvec=rhs, meq=meq), silent=TRUE)
- if(inherits(qp.result, "try-error")) stop(paste("No solution found:", result))
+ if(inherits(qp.result, "try-error")) stop(paste("No solution found:", qp.result))
wts <- qp.result$solution
# print(round(wts,4))
@@ -770,7 +774,7 @@
qp.result <- try(solve.QP(Dmat=make.positive.definite(2*lambda*V),
dvec=d, Amat=t(Amat), bvec=rhs, meq=meq), silent=TRUE)
- if(inherits(qp.result, "try-error")) stop(paste("No solution found:", result))
+ if(inherits(qp.result, "try-error")) stop(paste("No solution found:", qp.result))
wts <- qp.result$solution
w.buy <- qp.result$solution[(N+1):(2*N)]
More information about the Returnanalytics-commits
mailing list