[Returnanalytics-commits] r2485 - pkg/PortfolioAnalytics/R

[noreply at r-forge.r-project.org]

Author: rossbennett34
Date: 2013-07-02 06:04:06 +0200 (Tue, 02 Jul 2013)
New Revision: 2485

Modified:
   pkg/PortfolioAnalytics/R/constraint_fn_map.R
Log:
adding postion_limit constraint transformation function to constraint_fn_map

Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R
===================================================================
--- pkg/PortfolioAnalytics/R/constraint_fn_map.R	2013-07-01 13:56:05 UTC (rev 2484)
+++ pkg/PortfolioAnalytics/R/constraint_fn_map.R	2013-07-02 04:04:06 UTC (rev 2485)
@@ -21,6 +21,9 @@
     stop("Portfolio passed in is not of class portfolio")
   }
   
+  # number of assets
+  nassets <- length(portfolio$assets)
+  
   # This is in a loop so the order of transformation depends on how the constraints are added by the user.
   # Maybe take this out of a loop because the order of transformation is important
   for(constraint in portfolio$constraints) {
@@ -72,6 +75,15 @@
       
       # Diversification constraints
       # TODO
+      
+      ## position_limit constraint
+      if(inherits(constraint, "group_constraint")){
+        max_pos <- constraint$max_pos
+        
+        w <- txfrm_position_limit_constraint(weights=weights, max_pos=max_pos, nassets=nassets)
+        
+      } # end position_limit_constraint transformation
+      
     }
   }
   return(w)
@@ -164,6 +176,26 @@
   return(weights)
 }
 
+#' Transform weights for position_limit constraints
+#' 
+#' This is a helper function called inside constraint_fnMap to transform the weights vector to satisfy position_limit constraints.
+#' This function sets the minimum nassets-max_pos assets equal to 0 such that the max_pos number of assets will have non-zero weights.
+#' 
+#' @param weights vector of weights
+#' @param max_pos maximum position of assets with non_zero weights
+#' @param nassets number of assets
+#' @author Ross Bennett
+#' @export
+txfrm_position_limit_constraint <- function(weights, max_pos, nassets, tolerance=.Machine$double.eps^0.5){
+  # account for weights that are very small (less than .Machine$double.eps^0.5) and are basically zero
+  # check if max_pos is violated
+  if(sum(abs(weights) > tolerance) > max_pos){
+    # set the minimum nassets-max_pos weights equal to 0
+    weights[head(order(weights), nassets - max_pos)] <- 0
+  }
+  return(weights)
+}
+
 # library(PortfolioAnalytics)
 # data(edhec)
 # ret <- edhec[, 1:4]