[Returnanalytics-commits] r2511 - in pkg/PortfolioAnalytics: R sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Jul 6 21:36:06 CEST 2013
Author: rossbennett34
Date: 2013-07-06 21:36:06 +0200 (Sat, 06 Jul 2013)
New Revision: 2511
Modified:
pkg/PortfolioAnalytics/R/constraint_fn_map.R
pkg/PortfolioAnalytics/sandbox/testing_fn_map.R
Log:
Modified fn_map() to relax box constraints if a feasible portfolio could not be created with rp_transform(). Added example of this in testing script.
Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R
===================================================================
--- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-06 16:42:48 UTC (rev 2510)
+++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-06 19:36:06 UTC (rev 2511)
@@ -12,8 +12,6 @@
#' transformations will violate the box constraints, and we'll need to
#' transform back again.
#'
-#' This function will replace constraint_fn_map
-#'
#' leverage, box, group, and position limit constraints are transformed
#' diversification and turnover constraints are penalized
#'
@@ -56,7 +54,11 @@
out <- 0
+ # We will modify the weights vector so create a temporary copy
+ # modified for transformation or to relax constraints
tmp_weights <- weights
+ tmp_min <- min
+ tmp_max <- max
# step 2: check that the vector of weights satisfies the constraints,
# transform weights if constraint is violated
@@ -66,7 +68,8 @@
# check leverage constraints
if(!is.null(min_sum) & !is.null(max_sum)){
if(!(sum(tmp_weights) >= min_sum & sum(tmp_weights) <= max_sum)){
- tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, max_pos, 500))
+ # Try to transform only considering leverage and box constraints
+ tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, min, max, groups=NULL, cLO=NULL, cUP=NULL, max_pos=NULL, 500), silent=TRUE)
if(inherits(tmp_weights, "try-error")){
# Default to initial weights
tmp_weights <- weights
@@ -82,12 +85,40 @@
}
# check box constraints
- if(!is.null(min) & !is.null(max)){
- if(!(all(tmp_weights >= min) & all(tmp_weights <= max))){
- tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, max_pos, 500))
+ if(!is.null(tmp_min) & !is.null(tmp_max)){
+ if(!(all(tmp_weights >= tmp_min) & all(tmp_weights <= tmp_max))){
+ # Try to transform only considering leverage and box constraints
+ tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups=NULL, cLO=NULL, cUP=NULL, max_pos=NULL, 500), silent=TRUE)
if(inherits(tmp_weights, "try-error")){
# Default to initial weights
tmp_weights <- weights
+ i <- 1
+ # loop while constraints are violated and relax constraints
+ while((sum(tmp_weights) < min_sum | sum(tmp_weights) > max_sum | any(tmp_weights < tmp_min) | any(tmp_weights > tmp_max)) & i <= 5){
+ # check if min is violated
+ if(any(tmp_weights < tmp_min)){
+ # Find which elements of min are violated and decrease by a random amount
+ tmp_min[which(tmp_weights < tmp_min)] <- tmp_min[which(tmp_weights < tmp_min)] - runif(1, 0.01, 0.05)
+ }
+ # check if max is violated
+ if(any(tmp_weights > tmp_max)){
+ # Find which elements of min are violated and increase by a random amount
+ tmp_max[which(tmp_weights < tmp_max)] <- tmp_max[which(tmp_weights < tmp_max)] + runif(1, 0.01, 0.05)
+ }
+
+ # Now try the transformation again
+ tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups=NULL, cLO=NULL, cUP=NULL, max_pos=NULL, 500), silent=TRUE)
+ # Default to original weights if this fails again
+ if(inherits(tmp_weights, "try-error")) tmp_weights <- weights
+ i <- i + 1
+ }
+ # We have a feasible portfolio in terms of min_sum and max_sum,
+ # but were unable to produce a portfolio that satisfies box constraints
+ if(isTRUE(all.equal(tmp_weights, weights))){
+ # reset min and max to their original values and penalize later
+ tmp_min <- min
+ tmp_max <- max
+ }
# Other actions to consider
# relax constraints (rp_transform checks all constraints together so we may not know which constraint is too restrictive)
# different normalization method
@@ -102,7 +133,8 @@
# check group constraints
if(!is.null(groups) & !is.null(cLO) & !is.null(cUP)){
if(any(group_fail(tmp_weights, groups, cLO, cUP))){
- tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, max_pos, 500))
+ # Try to transform only considering leverage, box, and group constraints
+ tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, max_pos=NULL, 500), silent=TRUE)
if(inherits(tmp_weights, "try-error")){
# Default to initial weights
tmp_weights <- weights
@@ -120,7 +152,8 @@
# check position_limit constraints
if(!is.null(max_pos)){
if(!(sum(abs(tmp_weights) > tolerance) <= max_pos)){
- tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, max_pos, 500))
+ # Try to transform only considering leverage, box, group, and position_limit constraints
+ tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, max_pos, 500), silent=TRUE)
if(inherits(tmp_weights, "try-error")){
# Default to initial weights
tmp_weights <- weights
@@ -157,7 +190,7 @@
}
}
names(tmp_weights) <- names(weights)
- return(list(weights=tmp_weights, out=out))
+ return(list(weights=tmp_weights, min=tmp_min, max=tmp_max, out=out))
}
#' Transform weights that violate min or max box constraints
Modified: pkg/PortfolioAnalytics/sandbox/testing_fn_map.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/testing_fn_map.R 2013-07-06 16:42:48 UTC (rev 2510)
+++ pkg/PortfolioAnalytics/sandbox/testing_fn_map.R 2013-07-06 19:36:06 UTC (rev 2511)
@@ -33,7 +33,7 @@
fn_map(weights, portfolio)
-# group constraints are violated
+# group and position limit constraints are violated
weights <- c(0.1, 0.65, 0.1, 0.15)
sum(weights)
@@ -44,3 +44,19 @@
sum(weights)
fn_map(weights, portfolio)
+
+##### relaxing box constraints #####
+pspec <- portfolio.spec(assets=funds)
+
+pspec <- add.constraint(portfolio=pspec, type="full_investment", enabled=T)
+# make min infeasible and too restrictive
+pspec <- add.constraint(portfolio=pspec, type="box", min=0.3, max=0.75, enabled=T)
+
+# weights satisfy leverage constraints but not box constraints
+weights <- c(0.15, 0.05, 0.25, 0.55)
+sum(weights)
+
+# min constraint needs to be relaxed
+# note how min has been changed
+fn_map(weights, pspec)
+
More information about the Returnanalytics-commits
mailing list