[Returnanalytics-commits] r2946 - in pkg/PortfolioAnalytics: R man sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Aug 31 00:02:54 CEST 2013
Author: rossbennett34
Date: 2013-08-31 00:02:53 +0200 (Sat, 31 Aug 2013)
New Revision: 2946
Added:
pkg/PortfolioAnalytics/sandbox/testing_diversification.R
Modified:
pkg/PortfolioAnalytics/R/constraints.R
pkg/PortfolioAnalytics/R/optFUN.R
pkg/PortfolioAnalytics/R/optimize.portfolio.R
pkg/PortfolioAnalytics/man/diversification_constraint.Rd
pkg/PortfolioAnalytics/man/gmv_opt.Rd
Log:
Adding diversification for quadratic utility and min var problems. This is implemented as an over concentration penalty in the objective.
Modified: pkg/PortfolioAnalytics/R/constraints.R
===================================================================
--- pkg/PortfolioAnalytics/R/constraints.R 2013-08-30 18:09:31 UTC (rev 2945)
+++ pkg/PortfolioAnalytics/R/constraints.R 2013-08-30 22:02:53 UTC (rev 2946)
@@ -706,6 +706,7 @@
}
if(inherits(constraint, "diversification_constraint")){
out$div_target <- constraint$div_target
+ out$conc_aversion <- constraint$conc_aversion
}
if(inherits(constraint, "position_limit_constraint")){
out$max_pos <- constraint$max_pos
@@ -783,6 +784,8 @@
#'
#' @param type character type of the constraint
#' @param div_target diversification target value
+#' @param conc_aversion concentration aversion parameter. Penalizes over
+#' concentration for quadratic utility and minimum variance problems.
#' @param enabled TRUE/FALSE
#' @param message TRUE/FALSE. The default is message=FALSE. Display messages if TRUE.
#' @param \dots any other passthru parameters to specify box and/or group constraints
@@ -796,9 +799,10 @@
#'
#' pspec <- add.constraint(portfolio=pspec, type="diversification", div_target=0.7)
#' @export
-diversification_constraint <- function(type="diversification", div_target, enabled=TRUE, message=FALSE, ...){
+diversification_constraint <- function(type="diversification", div_target=NULL, conc_aversion=NULL, enabled=TRUE, message=FALSE, ...){
Constraint <- constraint_v2(type, enabled=enabled, constrclass="diversification_constraint", ...)
Constraint$div_target <- div_target
+ Constraint$conc_aversion <- conc_aversion
return(Constraint)
}
Modified: pkg/PortfolioAnalytics/R/optFUN.R
===================================================================
--- pkg/PortfolioAnalytics/R/optFUN.R 2013-08-30 18:09:31 UTC (rev 2945)
+++ pkg/PortfolioAnalytics/R/optFUN.R 2013-08-30 22:02:53 UTC (rev 2946)
@@ -9,8 +9,9 @@
#' @param moments object of moments computed based on objective functions
#' @param lambda risk_aversion parameter
#' @param target target return value
+#' @param lambda_hhi concentration aversion parameter
#' @author Ross Bennett
-gmv_opt <- function(R, constraints, moments, lambda, target){
+gmv_opt <- function(R, constraints, moments, lambda, target, lambda_hhi){
N <- ncol(R)
# Applying box constraints
@@ -57,9 +58,14 @@
rhs.vec <- c(rhs.vec, constraints$lower, -constraints$upper)
}
+ print(constraints$conc_aversion)
+ print(lambda_hhi)
# set up the quadratic objective
- ROI_objective <- Q_objective(Q=2*lambda*moments$var, L=-moments$mean)
-
+ if(!is.null(constraints$conc_aversion)){
+ ROI_objective <- Q_objective(Q=2*lambda*moments$var + lambda_hhi * diag(N), L=-moments$mean)
+ } else {
+ ROI_objective <- Q_objective(Q=2*lambda*moments$var, L=-moments$mean)
+ }
# set up the optimization problem and solve
opt.prob <- OP(objective=ROI_objective,
constraints=L_constraint(L=Amat, dir=dir.vec, rhs=rhs.vec),
Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R
===================================================================
--- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-08-30 18:09:31 UTC (rev 2945)
+++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-08-30 22:02:53 UTC (rev 2946)
@@ -683,6 +683,11 @@
} else {
target <- NA
}
+ if(!is.null(constraints$conc_aversion)){
+ lambda_hhi <- constraints$conc_aversion
+ } else {
+ lambda_hhi <- 0
+ }
lambda <- 1
for(objective in portfolio$objectives){
if(objective$enabled){
@@ -709,7 +714,7 @@
obj_vals <- constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures
out <- list(weights=weights, objective_measures=obj_vals, opt_values=obj_vals, out=roi_result$out, call=call)
} else {
- roi_result <- gmv_opt(R=R, constraints=constraints, moments=moments, lambda=lambda, target=target)
+ roi_result <- gmv_opt(R=R, constraints=constraints, moments=moments, lambda=lambda, target=target, lambda_hhi=lambda_hhi)
weights <- roi_result$weights
obj_vals <- constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures
out <- list(weights=weights, objective_measures=obj_vals, opt_values=obj_vals, out=roi_result$out, call=call)
Modified: pkg/PortfolioAnalytics/man/diversification_constraint.Rd
===================================================================
--- pkg/PortfolioAnalytics/man/diversification_constraint.Rd 2013-08-30 18:09:31 UTC (rev 2945)
+++ pkg/PortfolioAnalytics/man/diversification_constraint.Rd 2013-08-30 22:02:53 UTC (rev 2946)
@@ -3,13 +3,18 @@
\title{constructor for diversification_constraint}
\usage{
diversification_constraint(type = "diversification",
- div_target, enabled = TRUE, message = FALSE, ...)
+ div_target = NULL, conc_aversion = NULL,
+ enabled = TRUE, message = FALSE, ...)
}
\arguments{
\item{type}{character type of the constraint}
\item{div_target}{diversification target value}
+ \item{conc_aversion}{concentration aversion parameter.
+ Penalizes over concentration for quadratic utility and
+ minimum variance problems.}
+
\item{enabled}{TRUE/FALSE}
\item{message}{TRUE/FALSE. The default is message=FALSE.
Modified: pkg/PortfolioAnalytics/man/gmv_opt.Rd
===================================================================
--- pkg/PortfolioAnalytics/man/gmv_opt.Rd 2013-08-30 18:09:31 UTC (rev 2945)
+++ pkg/PortfolioAnalytics/man/gmv_opt.Rd 2013-08-30 22:02:53 UTC (rev 2946)
@@ -2,7 +2,8 @@
\alias{gmv_opt}
\title{Optimization function to solve minimum variance or maximum quadratic utility problems}
\usage{
- gmv_opt(R, constraints, moments, lambda, target)
+ gmv_opt(R, constraints, moments, lambda, target,
+ lambda_hhi)
}
\arguments{
\item{R}{xts object of asset returns}
@@ -16,6 +17,8 @@
\item{lambda}{risk_aversion parameter}
\item{target}{target return value}
+
+ \item{lambda_hhi}{concentration aversion parameter}
}
\description{
This function is called by optimize.portfolio to solve
Added: pkg/PortfolioAnalytics/sandbox/testing_diversification.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/testing_diversification.R (rev 0)
+++ pkg/PortfolioAnalytics/sandbox/testing_diversification.R 2013-08-30 22:02:53 UTC (rev 2946)
@@ -0,0 +1,49 @@
+library(PortfolioAnalytics)
+library(ROI)
+library(ROI.plugin.quadprog)
+
+data(edhec)
+R <- edhec[, 1:4]
+funds <- colnames(R)
+
+init <- portfolio.spec(assets=funds)
+init <- add.constraint(portfolio=init, type="full_investment")
+init <- add.constraint(portfolio=init, type="long_only")
+init <- add.constraint(portfolio=init, type="diversification",
+ conc_aversion=1, enabled=FALSE)
+
+minvar <- add.objective(portfolio=init, type="risk", name="var")
+
+qu <- add.objective(portfolio=init, type="risk", name="var", risk_aversion=1e6)
+qu <- add.objective(portfolio=qu, type="return", name="mean")
+
+# minimum variance optimization with full investment and long only constraints
+opt_mv <- optimize.portfolio(R=R, portfolio=minvar, optimize_method="ROI", trace=TRUE)
+
+# minimum variance optimization with full investment, long only, and diversification constraints
+minvar$constraints[[3]]$enabled=TRUE
+minvar$constraints[[3]]$conc_aversion=0
+opt_mv_div1 <- optimize.portfolio(R=R, portfolio=minvar, optimize_method="ROI", trace=TRUE)
+
+# The concentration aversion parameter is zero so we should have the same
+# result as opt_mv
+all.equal(opt_mv$weights, opt_mv_div1$weights)
+
+# Making the conc_aversion parameter high enough should result in an equal
+# weight portfolio.
+minvar$constraints[[3]]$conc_aversion=20
+opt_mv_div2 <- optimize.portfolio(R=R, portfolio=minvar, optimize_method="ROI", trace=TRUE)
+
+# Now using quadratic utility
+opt_qu <- optimize.portfolio(R=R, portfolio=qu, optimize_method="ROI", trace=TRUE)
+# equal to the minvar portfolio to 4 significant digits
+all.equal(signif(opt_qu$weights, 4), signif(opt_mv$weights, 4))
+
+# both the risk aversion and concentration aversion parameters will have to be
+# adjusted to result in an equal weight portfolio
+qu$constraints[[3]]$enabled=TRUE
+qu$constraints[[3]]$conc_aversion=1e6
+qu$objectives[[1]]$risk_aversion=1
+opt_mv_qu <- optimize.portfolio(R=R, portfolio=qu, optimize_method="ROI", trace=TRUE)
+opt_mv_qu$weights
+
More information about the Returnanalytics-commits
mailing list