[Returnanalytics-commits] r2588 - in pkg/PortfolioAnalytics: R sandbox

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed Jul 17 14:18:00 CEST 2013


Author: rossbennett34
Date: 2013-07-17 14:17:59 +0200 (Wed, 17 Jul 2013)
New Revision: 2588

Modified:
   pkg/PortfolioAnalytics/R/constraint_fn_map.R
   pkg/PortfolioAnalytics/sandbox/testing_rp_transform.R
Log:
added group_pos to testing and corrected bug in rp_transform

Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R
===================================================================
--- pkg/PortfolioAnalytics/R/constraint_fn_map.R	2013-07-17 11:49:18 UTC (rev 2587)
+++ pkg/PortfolioAnalytics/R/constraint_fn_map.R	2013-07-17 12:17:59 UTC (rev 2588)
@@ -78,7 +78,7 @@
   if(!is.null(min_sum) & !is.null(max_sum)){
     if(!(sum(tmp_weights) >= min_sum & sum(tmp_weights) <= max_sum)){
       # 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, group_pos=NULL, 500), silent=TRUE)
+      tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, min, max, groups=NULL, cLO=NULL, cUP=NULL, max_pos=NULL, group_pos=NULL, 500), silent=FALSE) # FALSE for testing
       if(inherits(tmp_weights, "try-error")){
         # Default to initial weights
         tmp_weights <- weights
@@ -90,7 +90,7 @@
   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, group_pos=NULL, 500), silent=TRUE)
+      tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups=NULL, cLO=NULL, cUP=NULL, max_pos=NULL, group_pos=NULL, 500), silent=FALSE) # FALSE for testing
       if(inherits(tmp_weights, "try-error")){
         # Default to initial weights
         tmp_weights <- weights
@@ -112,7 +112,7 @@
             }
             
             # 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, group_pos, 500), silent=TRUE)
+            tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups=NULL, cLO=NULL, cUP=NULL, max_pos=NULL, group_pos, 500), silent=FALSE) # FALSE for testing
             # Default to original weights if this fails again
             if(inherits(tmp_weights, "try-error")) tmp_weights <- weights
             i <- i + 1
@@ -133,7 +133,7 @@
   if(!is.null(groups) & !is.null(tmp_cLO) & !is.null(tmp_cUP)){
     if(any(group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP, group_pos))){
       # Try to transform only considering leverage, box, and group constraints
-      tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, max_pos=NULL, group_pos, 500), silent=TRUE)
+      tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, max_pos=NULL, group_pos, 500), silent=FALSE) # FALSE for testing
       if(inherits(tmp_weights, "try-error")){
         # Default to initial weights
         tmp_weights <- weights
@@ -151,7 +151,7 @@
               tmp_cUP[group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP)] <- tmp_cUP[group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP)] + 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, tmp_cLO, tmp_cUP, max_pos=NULL, group_pos, 500), silent=TRUE)
+            tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, max_pos=NULL, group_pos, 500), silent=FALSE) # FALSE for testing
             if(inherits(tmp_weights, "try-error")) tmp_weights <- weights
             i <- i + 1
           }
@@ -171,7 +171,7 @@
   if(!is.null(tmp_max_pos)){
     if(!(sum(abs(tmp_weights) > tolerance) <= tmp_max_pos)){
       # Try to transform only considering leverage, box, group, and position_limit constraints
-      tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, tmp_max_pos, group_pos, 500), silent=TRUE)
+      tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, tmp_max_pos, group_pos, 500), silent=FALSE) # FALSE for testing
       if(inherits(tmp_weights, "try-error")){
         # Default to initial weights
         tmp_weights <- weights
@@ -181,7 +181,7 @@
             # increment tmp_max_pos by 1
             tmp_max_pos <- tmp_max_pos + 1
             # Now try the transformation again
-            tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, tmp_max_pos, group_pos, 500), silent=TRUE)
+            tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, tmp_max_pos, group_pos, 500), silent=FALSE) # FALSE for testing
             if(inherits(tmp_weights, "try-error")) tmp_weights <- weights
             i <- i + 1
           }
@@ -338,7 +338,11 @@
   tolerance=.Machine$double.eps^0.5
   if(is.null(max_pos)) max_pos <- length(w)
   
-  if(!is.null(group_pos)) max_group_pos <- sum(group_pos)
+  if(!is.null(group_pos)) {
+    max_group_pos <- sum(group_pos)
+  } else {
+    max_group_pos <- length(w)
+  }
   max_assets <- min(max_pos, max_group_pos)
   
   # Create a temporary min vector that will be modified, because a feasible

Modified: pkg/PortfolioAnalytics/sandbox/testing_rp_transform.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/testing_rp_transform.R	2013-07-17 11:49:18 UTC (rev 2587)
+++ pkg/PortfolioAnalytics/sandbox/testing_rp_transform.R	2013-07-17 12:17:59 UTC (rev 2588)
@@ -8,6 +8,7 @@
 sum(weights)
 
 groups <- c(2, 1)
+group_pos <- c(1, 1)
 cLO <- c(0.1, 0.10)
 cUP <- c(0.45, 0.8)
 min_sum <- 0.99
@@ -15,11 +16,11 @@
 min <- rep(0.05, length(weights))
 max <- rep(0.65, length(weights))
 
-group_fail(weights, groups, cLO, cUP)
+group_fail(weights, groups, cLO, cUP, group_pos)
 
-w <- rp_transform(weights, min_sum, max_sum, min, max, groups, cLO, cUP, 2, 200)
+w <- rp_transform(weights, min_sum, max_sum, min, max, groups, cLO, cUP, 2, group_pos, 200)
 w
-group_fail(w, groups, cLO, cUP)
+group_fail(w, groups, cLO, cUP, group_pos)
 
 ##### EX2 #####
 # The assets are grouped into 3 groups of 2
@@ -32,6 +33,7 @@
 sum(weights)
 
 groups <- c(2, 2, 2)
+group_pos <- c(2, 2, 1)
 cLO <- c(0.05, 0.10, 0.05)
 cUP <- c(0.4, 0.45, 0.35)
 min_sum <- 0.99
@@ -40,17 +42,17 @@
 max <- rep(0.65, length(weights))
 
 
-group_fail(weights, groups, cLO, cUP)
+group_fail(weights, groups, cLO, cUP, group_pos)
 
 # groups and max_pos are NULL and box and leverage constraints are satisfied so this should
 # just return the original weights vector
-w <- rp_transform(weights, min_sum, max_sum, min, max, groups=NULL, cLO, cUP, max_pos=NULL, 500)
+w <- rp_transform(weights, min_sum, max_sum, min, max, groups=NULL, cLO, cUP, max_pos=NULL, group_pos, 500)
 w
 
 # The first group exceeds cUP so the weights vector should be modified
-w <- rp_transform(weights, min_sum, max_sum, min, max, groups, cLO, cUP, 4, 1000)
+w <- rp_transform(weights, min_sum, max_sum, min, max, groups, cLO, cUP, max_pos=NULL, group_pos, 1000)
 w
-group_fail(w, groups, cLO, cUP)
+group_fail(w, groups, cLO, cUP, group_pos)
 
 ##### Ex3 #####
 # The second group is below cLO and the third weight is below min
@@ -58,6 +60,7 @@
 sum(weights)
 
 groups <- c(2, 1, 3)
+group_pos <- c(1, 1, 3)
 cLO <- c(0.05, 0.10, 0.05)
 cUP <- c(0.4, 0.45, 0.65)
 min_sum <- 0.99
@@ -66,11 +69,11 @@
 max <- rep(0.65, length(weights))
 
 
-group_fail(weights, groups, cLO, cUP)
+group_fail(weights, groups, cLO, cUP, group_pos)
 
-w <- rp_transform(weights, min_sum, max_sum, min, max, groups, cLO, cUP, 5, 500)
+w <- rp_transform(weights, min_sum, max_sum, min, max, groups, cLO, cUP, 5, group_pos, 500)
 w
-group_fail(w, groups, cLO, cUP)
+group_fail(w, groups, cLO, cUP, group_pos)
 
 ##### Ex4 #####
 # The second group is above cUP and the fourth group is below cLO
@@ -82,6 +85,7 @@
 sum(weights)
 
 groups <- c(2, 4, 3, 2)
+group_pos <- c(2, 3, 2, 2)
 cLO <- c(0.05, 0.10, 0.05, 0.08)
 cUP <- c(0.4, 0.55, 0.65, 0.45)
 min_sum <- 0.99
@@ -89,9 +93,10 @@
 min <- rep(0.05, length(weights))
 max <- rep(0.65, length(weights))
 
-group_fail(weights, groups, cLO, cUP)
+group_fail(weights, groups, cLO, cUP, group_pos)
 
 # Note that this was typically not working with max_permutations=200
 # Relax constraints or increase max_permutations
-w <- rp_transform(weights, min_sum, max_sum, min, max, groups, cLO, cUP, 7, 1000)
+w <- rp_transform(weights, min_sum, max_sum, min, max, groups, cLO, cUP, 7, group_pos, 500)
 w
+group_fail(w, groups, cLO, cUP, group_pos)
\ No newline at end of file



More information about the Returnanalytics-commits mailing list