[Returnanalytics-commits] r2782 - in pkg/PortfolioAnalytics: R sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Aug 14 18:15:37 CEST 2013
Author: rossbennett34
Date: 2013-08-14 18:15:37 +0200 (Wed, 14 Aug 2013)
New Revision: 2782
Added:
pkg/PortfolioAnalytics/sandbox/testing_factor_exposure.R
Modified:
pkg/PortfolioAnalytics/R/constraints.R
pkg/PortfolioAnalytics/R/optFUN.R
Log:
Cleaning up how factor exposures are added to Amat in QP and LP solvers. Adding testing script for factor exposures with optimize_method='ROI'.
Modified: pkg/PortfolioAnalytics/R/constraints.R
===================================================================
--- pkg/PortfolioAnalytics/R/constraints.R 2013-08-14 02:06:48 UTC (rev 2781)
+++ pkg/PortfolioAnalytics/R/constraints.R 2013-08-14 16:15:37 UTC (rev 2782)
@@ -822,6 +822,7 @@
# The user passed in a vector of betas, lower and upper must be scalars
if(length(lower) != 1) stop("lower must be a scalar")
if(length(upper) != 1) stop("upper must be a scalar")
+ B <- matrix(B, ncol=1)
}
# The user has passed in a matrix for B
if(is.matrix(B)){
Modified: pkg/PortfolioAnalytics/R/optFUN.R
===================================================================
--- pkg/PortfolioAnalytics/R/optFUN.R 2013-08-14 02:06:48 UTC (rev 2781)
+++ pkg/PortfolioAnalytics/R/optFUN.R 2013-08-14 16:15:37 UTC (rev 2782)
@@ -40,8 +40,9 @@
# Add the factor exposures to Amat, dir.vec, and rhs.vec
if(!is.null(constraints$B)){
- Amat <- rbind(Amat, t(B), -t(B))
- dir.vec <- c(dir.vec, rep(">=", 2 * ncol(B)))
+ t.B <- t(constraints$B)
+ Amat <- rbind(Amat, t.B, -t.B)
+ dir.vec <- c(dir.vec, rep(">=", 2 * nrow(t.B)))
rhs.vec <- c(rhs.vec, constraints$lower, -constraints$upper)
}
@@ -104,8 +105,9 @@
# Add the factor exposures to Amat, dir.vec, and rhs.vec
if(!is.null(constraints$B)){
- Amat <- rbind(Amat, t(B), -t(B))
- dir.vec <- c(dir.vec, rep(">=", 2 * ncol(B)))
+ t.B <- t(constraints$B)
+ Amat <- rbind(Amat, t.B, -t.B)
+ dir.vec <- c(dir.vec, rep(">=", 2 * nrow(t.B)))
rhs.vec <- c(rhs.vec, constraints$lower, -constraints$upper)
}
@@ -194,7 +196,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)))
@@ -266,7 +268,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=(T+1))
Amat <- rbind(Amat, cbind(t.B, zeros), cbind(-t.B, zeros))
dir.vec <- c(dir.vec, rep(">=", 2 * nrow(t.B)))
@@ -372,7 +374,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=(m + n + 2))
tmpAmat <- rbind(tmpAmat, cbind(t.B, zeros), cbind(-t.B, zeros))
dir <- c(dir, rep(">=", 2 * nrow(t.B)))
Added: pkg/PortfolioAnalytics/sandbox/testing_factor_exposure.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/testing_factor_exposure.R (rev 0)
+++ pkg/PortfolioAnalytics/sandbox/testing_factor_exposure.R 2013-08-14 16:15:37 UTC (rev 2782)
@@ -0,0 +1,89 @@
+library(PortfolioAnalytics)
+library(ROI)
+require(ROI.plugin.quadprog)
+require(ROI.plugin.glpk)
+library(Rglpk)
+
+data(edhec)
+ret <- edhec[, 1:4]
+
+# Create portfolio object
+pspec <- portfolio.spec(assets=colnames(ret))
+# Leverage constraint
+lev_constr <- weight_sum_constraint(min_sum=1, max_sum=1)
+# box constraint
+lo_constr <- box_constraint(assets=pspec$assets, min=c(0.01, 0.02, 0.03, 0.04), max=0.65)
+# group constraint
+grp_constr <- group_constraint(assets=pspec$assets, groups=c(2, 1, 1), group_min=0.1, group_max=0.4)
+# position limit constraint
+pl_constr <- position_limit_constraint(assets=pspec$assets, max_pos=4)
+
+# Make up a B matrix for an industry factor model
+# dummyA, dummyB, and dummyC could be industries, sectors, etc.
+B <- cbind(c(1, 1, 0, 0),
+ c(0, 0, 1, 0),
+ c(0, 0, 0, 1))
+rownames(B) <- colnames(ret)
+colnames(B) <- c("dummyA", "dummyB", "dummyC")
+print(B)
+lower <- c(0.1, 0.1, 0.1)
+upper <- c(0.4, 0.4, 0.4)
+
+# Industry exposure constraint
+# The exposure constraint and group constraint are equivalent to test that they
+# result in the same solution
+exp_constr <- factor_exposure_constraint(assets=pspec$assets, B=B, lower=lower, upper=upper)
+
+# objective to minimize variance
+var_obj <- portfolio_risk_objective(name="var")
+# objective to maximize return
+ret_obj <- return_objective(name="mean")
+# objective to minimize ETL
+etl_obj <- portfolio_risk_objective(name="ETL")
+
+# group constraint and exposure constraint should result in same solution
+
+##### minimize var objective #####
+opta <- optimize.portfolio(R=ret, portfolio=pspec,
+ constraints=list(lev_constr, lo_constr, grp_constr),
+ objectives=list(var_obj),
+ optimize_method="ROI")
+opta
+
+optb <- optimize.portfolio(R=ret, portfolio=pspec,
+ constraints=list(lev_constr, lo_constr, exp_constr),
+ objectives=list(var_obj),
+ optimize_method="ROI")
+optb
+
+all.equal(opta$weights, optb$weights)
+
+##### maximize return objective #####
+optc <- optimize.portfolio(R=ret, portfolio=pspec,
+ constraints=list(lev_constr, lo_constr, grp_constr),
+ objectives=list(ret_obj),
+ optimize_method="ROI")
+optc
+
+optd <- optimize.portfolio(R=ret, portfolio=pspec,
+ constraints=list(lev_constr, lo_constr, exp_constr),
+ objectives=list(ret_obj),
+ optimize_method="ROI")
+optd
+
+all.equal(optc$weights, optd$weights)
+
+##### minimize ETL objective #####
+opte <- optimize.portfolio(R=ret, portfolio=pspec,
+ constraints=list(lev_constr, lo_constr, grp_constr),
+ objectives=list(etl_obj),
+ optimize_method="ROI")
+opte
+
+optf <- optimize.portfolio(R=ret, portfolio=pspec,
+ constraints=list(lev_constr, lo_constr, exp_constr),
+ objectives=list(etl_obj),
+ optimize_method="ROI")
+optf
+
+all.equal(opte$weights, optf$weights)
More information about the Returnanalytics-commits
mailing list