[Returnanalytics-commits] r3482 - in pkg/PortfolioAnalytics: R man sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Jul 25 21:40:33 CEST 2014
Author: rossbennett34
Date: 2014-07-25 21:40:32 +0200 (Fri, 25 Jul 2014)
New Revision: 3482
Modified:
pkg/PortfolioAnalytics/R/constraint_fn_map.R
pkg/PortfolioAnalytics/man/fn_map.Rd
pkg/PortfolioAnalytics/man/rp_transform.Rd
pkg/PortfolioAnalytics/sandbox/rp_transform2.R
pkg/PortfolioAnalytics/sandbox/test2_rp_transform2.R
pkg/PortfolioAnalytics/sandbox/testing_fn_map.R
Log:
moving rp_transform into fn_map
Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R
===================================================================
--- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2014-07-24 22:23:29 UTC (rev 3481)
+++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2014-07-25 19:40:32 UTC (rev 3482)
@@ -21,6 +21,7 @@
#' @param weights vector of weights
#' @param portfolio object of class \code{portfolio}
#' @param relax TRUE/FALSE, default FALSE. Enable constraints to be relaxed.
+#' @param verbose print error messages for debuggin purposes
#' @param \dots any other passthru parameters
#' @return
#' \itemize{
@@ -32,7 +33,7 @@
#' }
#' @author Ross Bennett
#' @export
-fn_map <- function(weights, portfolio, relax=FALSE, ...){
+fn_map <- function(weights, portfolio, relax=FALSE, verbose=FALSE, ...){
if(!is.portfolio(portfolio)) stop("portfolio passed in is not of class 'portfolio'")
nassets <- length(portfolio$assets)
@@ -47,6 +48,13 @@
min_sum <- min_sum - 0.01
max_sum <- max_sum + 0.01
}
+
+ weight_seq <- portfolio$weight_seq
+ if(is.null(weight_seq)){
+ weight_seq <- generatesequence(min=min(constraints$min), max=max(constraints$max), by=0.002)
+ }
+ weight_seq <- as.vector(weight_seq)
+
min <- constraints$min
max <- constraints$max
groups <- constraints$groups
@@ -73,6 +81,10 @@
tmp_max_pos_short <- max_pos_short
tmp_leverage <- leverage
+ # Do we need to step through each constraint type sequentially or can we just
+ # call rp_transform once now that it has been modified to handle constraint
+ # types seperately?
+
# step 2: check that the vector of weights satisfies the constraints,
# transform weights if constraint is violated
# TRUE if the weights vector is in compliance with the constraints
@@ -81,14 +93,23 @@
# check leverage constraints
if(!is.null(min_sum) & !is.null(max_sum)){
if(!(sum(tmp_weights) >= min_sum & sum(tmp_weights) <= max_sum)){
+ print("foo")
# Try to transform only considering leverage and box constraints
tmp_weights <- try(rp_transform(w=tmp_weights,
- min_sum=min_sum, max_sum=max_sum,
- min=tmp_min, max=tmp_max,
- groups=NULL, cLO=NULL, cUP=NULL,
- max_pos=NULL, group_pos=NULL,
- max_pos_long=NULL, max_pos_short=NULL,
- leverage=tmp_leverage, max_permutations=500),
+ min_sum=min_sum,
+ max_sum=max_sum,
+ min_box=tmp_min,
+ max_box=tmp_max,
+ groups=NULL,
+ cLO=NULL,
+ cUP=NULL,
+ max_pos=NULL,
+ group_pos=NULL,
+ max_pos_long=NULL,
+ max_pos_short=NULL,
+ leverage=tmp_leverage,
+ weight_seq=weight_seq,
+ max_permutations=500),
silent=TRUE) # FALSE for testing
if(inherits(tmp_weights, "try-error")){
# Default to initial weights
@@ -102,14 +123,23 @@
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(w=tmp_weights,
- min_sum=min_sum, max_sum=max_sum,
- min=tmp_min, max=tmp_max,
- groups=NULL, cLO=NULL, cUP=NULL,
- max_pos=NULL, group_pos=NULL,
- max_pos_long=NULL, max_pos_short=NULL,
- leverage=tmp_leverage, max_permutations=500),
+ min_sum=min_sum,
+ max_sum=max_sum,
+ min_box=tmp_min,
+ max_box=tmp_max,
+ groups=NULL,
+ cLO=NULL,
+ cUP=NULL,
+ max_pos=NULL,
+ group_pos=NULL,
+ max_pos_long=NULL,
+ max_pos_short=NULL,
+ leverage=tmp_leverage,
+ weight_seq=weight_seq,
+ max_permutations=500),
silent=TRUE) # FALSE for testing
if(inherits(tmp_weights, "try-error")){
+ if(verbose) message(tmp_weights)
# Default to initial weights
tmp_weights <- weights
# Try to relax constraints if relax=TRUE
@@ -131,12 +161,20 @@
# Now try the transformation again
tmp_weights <- try(rp_transform(w=tmp_weights,
- min_sum=min_sum, max_sum=max_sum,
- min=tmp_min, max=tmp_max,
- groups=NULL, cLO=NULL, cUP=NULL,
- max_pos=NULL, group_pos=NULL,
- max_pos_long=NULL, max_pos_short=NULL,
- leverage=tmp_leverage, max_permutations=500),
+ min_sum=min_sum,
+ max_sum=max_sum,
+ min_box=tmp_min,
+ max_box=tmp_max,
+ groups=NULL,
+ cLO=NULL,
+ cUP=NULL,
+ max_pos=NULL,
+ group_pos=NULL,
+ max_pos_long=NULL,
+ max_pos_short=NULL,
+ leverage=tmp_leverage,
+ weight_seq=weight_seq,
+ max_permutations=500),
silent=TRUE) # FALSE for testing
# Default to original weights if this fails again
if(inherits(tmp_weights, "try-error")) tmp_weights <- weights
@@ -159,14 +197,23 @@
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(w=tmp_weights,
- min_sum=min_sum, max_sum=max_sum,
- min=tmp_min, max=tmp_max,
- groups=groups, cLO=tmp_cLO, cUP=tmp_cUP,
- max_pos=NULL, group_pos=group_pos,
- max_pos_long=NULL, max_pos_short=NULL,
- leverage=tmp_leverage, max_permutations=500),
+ min_sum=min_sum,
+ max_sum=max_sum,
+ min_box=tmp_min,
+ max_box=tmp_max,
+ groups=groups,
+ cLO=tmp_cLO,
+ cUP=tmp_cUP,
+ max_pos=NULL,
+ group_pos=group_pos,
+ max_pos_long=NULL,
+ max_pos_short=NULL,
+ leverage=tmp_leverage,
+ weight_seq=weight_seq,
+ max_permutations=500),
silent=TRUE) # FALSE for testing
if(inherits(tmp_weights, "try-error")){
+ if(verbose) message(tmp_weights)
# Default to initial weights
tmp_weights <- weights
# Try to relax constraints if relax=TRUE
@@ -184,12 +231,20 @@
}
# Now try the transformation again
tmp_weights <- try(rp_transform(w=tmp_weights,
- min_sum=min_sum, max_sum=max_sum,
- min=tmp_min, max=tmp_max,
- groups=groups, cLO=tmp_cLO, cUP=tmp_cUP,
- max_pos=NULL, group_pos=group_pos,
- max_pos_long=NULL, max_pos_short=NULL,
- leverage=tmp_leverage, max_permutations=500),
+ min_sum=min_sum,
+ max_sum=max_sum,
+ min_box=tmp_min,
+ max_box=tmp_max,
+ groups=groups,
+ cLO=tmp_cLO,
+ cUP=tmp_cUP,
+ max_pos=NULL,
+ group_pos=group_pos,
+ max_pos_long=NULL,
+ max_pos_short=NULL,
+ leverage=tmp_leverage,
+ weight_seq=weight_seq,
+ max_permutations=500),
silent=TRUE) # FALSE for testing
if(inherits(tmp_weights, "try-error")) tmp_weights <- weights
i <- i + 1
@@ -211,14 +266,23 @@
if(pos_limit_fail(tmp_weights, tmp_max_pos, tmp_max_pos_long, tmp_max_pos_short)){
# Try to transform only considering leverage, box, group, and position_limit constraints
tmp_weights <- try(rp_transform(w=tmp_weights,
- min_sum=min_sum, max_sum=max_sum,
- min=tmp_min, max=tmp_max,
- groups=groups, cLO=tmp_cLO, cUP=tmp_cUP,
- max_pos=tmp_max_pos, group_pos=group_pos,
- max_pos_long=tmp_max_pos_long, max_pos_short=tmp_max_pos_short,
- leverage=tmp_leverage, max_permutations=500),
+ min_sum=min_sum,
+ max_sum=max_sum,
+ min_box=tmp_min,
+ max_box=tmp_max,
+ groups=groups,
+ cLO=tmp_cLO,
+ cUP=tmp_cUP,
+ max_pos=tmp_max_pos,
+ group_pos=group_pos,
+ max_pos_long=tmp_max_pos_long,
+ max_pos_short=tmp_max_pos_short,
+ leverage=tmp_leverage,
+ weight_seq=weight_seq,
+ max_permutations=500),
silent=TRUE) # FALSE for testing
if(inherits(tmp_weights, "try-error")){
+ if(verbose) message(tmp_weights)
# Default to initial weights
tmp_weights <- weights
if(relax){
@@ -230,12 +294,20 @@
if(!is.null(tmp_max_pos_short)) tmp_max_pos_short <- min(nassets, tmp_max_pos_short + 1)
# Now try the transformation again
tmp_weights <- try(rp_transform(w=tmp_weights,
- min_sum=min_sum, max_sum=max_sum,
- min=tmp_min, max=tmp_max,
- groups=groups, cLO=tmp_cLO, cUP=tmp_cUP,
- max_pos=tmp_max_pos, group_pos=group_pos,
- max_pos_long=tmp_max_pos_long, max_pos_short=tmp_max_pos_short,
- leverage=tmp_leverage, max_permutations=500),
+ min_sum=min_sum,
+ max_sum=max_sum,
+ min_box=tmp_min,
+ max_box=tmp_max,
+ groups=groups,
+ cLO=tmp_cLO,
+ cUP=tmp_cUP,
+ max_pos=tmp_max_pos,
+ group_pos=group_pos,
+ max_pos_long=tmp_max_pos_long,
+ max_pos_short=tmp_max_pos_short,
+ leverage=tmp_leverage,
+ weight_seq=weight_seq,
+ max_permutations=500),
silent=TRUE) # FALSE for testing
if(inherits(tmp_weights, "try-error")) tmp_weights <- weights
i <- i + 1
@@ -250,14 +322,23 @@
if(sum(abs(tmp_weights)) > tmp_leverage){
# Try to transform only considering weight_sum, box, group, position_limit, and leverage exposure constraints
tmp_weights <- try(rp_transform(w=tmp_weights,
- min_sum=min_sum, max_sum=max_sum,
- min=tmp_min, max=tmp_max,
- groups=groups, cLO=tmp_cLO, cUP=tmp_cUP,
- max_pos=tmp_max_pos, group_pos=group_pos,
- max_pos_long=tmp_max_pos_long, max_pos_short=tmp_max_pos_short,
- leverage=tmp_leverage, max_permutations=500),
+ min_sum=min_sum,
+ max_sum=max_sum,
+ min_box=tmp_min,
+ max_box=tmp_max,
+ groups=groups,
+ cLO=tmp_cLO,
+ cUP=tmp_cUP,
+ max_pos=tmp_max_pos,
+ group_pos=group_pos,
+ max_pos_long=tmp_max_pos_long,
+ max_pos_short=tmp_max_pos_short,
+ leverage=tmp_leverage,
+ weight_seq=weight_seq,
+ max_permutations=500),
silent=TRUE) # FALSE for testing
if(inherits(tmp_weights, "try-error")){
+ if(verbose) message(tmp_weights)
# Default to initial weights
tmp_weights <- weights
if(relax){
@@ -267,12 +348,20 @@
tmp_leverage <- tmp_leverage * 1.01
# Now try the transformation again
tmp_weights <- try(rp_transform(w=tmp_weights,
- min_sum=min_sum, max_sum=max_sum,
- min=tmp_min, max=tmp_max,
- groups=groups, cLO=tmp_cLO, cUP=tmp_cUP,
- max_pos=tmp_max_pos, group_pos=group_pos,
- max_pos_long=tmp_max_pos_long, max_pos_short=tmp_max_pos_short,
- leverage=tmp_leverage, max_permutations=500),
+ min_sum=min_sum,
+ max_sum=max_sum,
+ min_box=tmp_min,
+ max_box=tmp_max,
+ groups=groups,
+ cLO=tmp_cLO,
+ cUP=tmp_cUP,
+ max_pos=tmp_max_pos,
+ group_pos=group_pos,
+ max_pos_long=tmp_max_pos_long,
+ max_pos_short=tmp_max_pos_short,
+ leverage=tmp_leverage,
+ weight_seq=weight_seq,
+ max_permutations=500),
silent=TRUE) # FALSE for testing
if(inherits(tmp_weights, "try-error")) tmp_weights <- weights
i <- i + 1
@@ -302,15 +391,15 @@
#' to transform the weight vector if either the weight_sum (leverage)
#' constraints, box constraints, group constraints, position_limit constraints,
#' or leverage exposure constraints are violated. The logic from
-#' \code{randomize_portfolio} is heavily utilized here with some modifications
-#' to handle more complex constraints.
+#' \code{randomize_portfolio} is heavily utilized here with extensions to
+#' handle more complex constraints.
#' The resulting weights vector might be quite different from the original weights vector.
#'
#' @param w weights vector to be transformed
#' @param min_sum minimum sum of all asset weights, default 0.99
#' @param max_sum maximum sum of all asset weights, default 1.01
-#' @param min numeric or named vector specifying minimum weight box constraints
-#' @param max numeric or named vector specifying maximum weight box constraints
+#' @param min_box numeric or named vector specifying minimum weight box constraints
+#' @param max_box numeric or named vector specifying maximum weight box constraints
#' @param groups vector specifying the groups of the assets
#' @param cLO numeric or vector specifying minimum weight group constraints
#' @param cUP numeric or vector specifying minimum weight group constraints
@@ -324,221 +413,158 @@
#' @author Peter Carl, Brian G. Peterson, Ross Bennett (based on an idea by Pat Burns)
#' @export
rp_transform <- function(w,
- min_sum=0.99,
- max_sum=1.01,
- min,
- max,
- groups,
- cLO,
- cUP,
+ min_sum,
+ max_sum,
+ min_box,
+ max_box,
+ groups=NULL,
+ cLO=NULL,
+ cUP=NULL,
max_pos=NULL,
group_pos=NULL,
max_pos_long=NULL,
max_pos_short=NULL,
leverage=NULL,
+ weight_seq=NULL,
max_permutations=200){
- # Uses logic from randomize_portfolio to "normalize" a weights vector to
- # satisfy min_sum and max_sum while accounting for box and group constraints
- # Modified from randomize_portfolio to trigger the while loops if any weights
- # violate min or max box constraints. A weights vector would not be transformed
- # in randomize_portfolio if min_sum and max_sum were satisfied, but the
- # min/max constraints were violated.
+ tmp_w <- w
- # Set the tolerance to determine non-zero weights
- tolerance=.Machine$double.eps^0.5
+ # Set some reasonable default values
+ # Maybe I should leave these as NULL values and incorporate that into the
+ # checks
+ #if(is.null(min_sum)) min_sum <- 0.99
+ #if(is.null(max_sum)) max_sum <- 1.01
+ #if(is.null(min_box)) min_box <- rep(-Inf, length(tmp_w))
+ #if(is.null(max_box)) max_box <- rep(Inf, length(tmp_w))
+ if(is.null(max_pos)) max_pos <- length(tmp_w)
+ #if(is.null(max_poslong)) max_pos_long <- length(tmp_w)
+ #if(is.null(max_pos_short)) max_pos_short <- length(tmp_w)
+ #if(is.null(leverage)) leverage <- Inf
- # Set value for max_pos if it is not specified
- if(is.null(max_pos)) max_pos <- length(w)
+ # Generate a weight sequence, we should check for portfolio$weight_seq
+ if(is.null(weight_seq))
+ weight_seq <- generatesequence(min=min(min_box), max=max(max_box), by=0.002)
- # Set value for leverage if it is not specified
- if(is.null(leverage)) leverage <- Inf
+ # make sure there is a 0 in weight_seq if we have a position limit constraint
+ if((!is.null(max_pos) | !is.null(group_pos) | !is.null(max_pos_long) | !is.null(max_pos_short)) & !is.element(0, weight_seq)) weight_seq <- c(0, weight_seq)
- # Determine maximum number of non-zero weights
- if(!is.null(group_pos)) {
- max_group_pos <- sum(group_pos)
- } else {
- max_group_pos <- length(w)
- }
+ # Tolerance for "non-zero" definition for position limit constraints
+ tolerance <- .Machine$double.eps^0.5
- # Set maximum number of assets based on max_pos and group_pos
- max_assets <- min(max_pos, max_group_pos)
-
- # Create a temporary min vector that will be modified, because a feasible
- # portfolio is rarely created if all(min > 0). This is due to the while
- # loop that checks any(tmp_w < min).
- tmp_min <- min
-
- # If weight_i = 0 and min_i > 0, then this will violate box constraints
- # even though weight_i = 0 to satisfy position_limit constraints. Modify
- # the tmp_min vector and set tmp_min_i equal to zero where weights_i = 0.
- # If w is less than or equal to tolerance then it is essentially 0
- if(any(abs(w) <= tolerance)){
- if(any(tmp_min[which(abs(w) <= tolerance)] > 0)){
- tmp_min[which(abs(w) <= tolerance)] <- -tolerance
- }
- }
-
- # return w if all constraints are satisfied
- if((sum(w) >= min_sum & sum(w) <= max_sum) &
- (all(w >= tmp_min) & all(w <= max)) &
- (all(!group_fail(w, groups, cLO, cUP, group_pos))) &
- !pos_limit_fail(w, max_pos, max_pos_long, max_pos_short) &
- (sum(abs(w)) <= leverage)){
- return(w)
- }
-
- # generate a sequence of weights based on min/max box constraints
- weight_seq <- generatesequence(min=min(min), max=max(max), by=0.002)
- # make sure there is a 0 in weight_seq
- if((!is.null(max_pos) | !is.null(group_pos) | !is.null(max_pos_long) | !is.null(max_pos_short)) & !is.element(0, weight_seq)) weight_seq <- c(0, weight_seq)
-
- # start the permutations counter
+ # initialize the outer while loop
permutations <- 1
- # create a temporary weights vector that will be modified in the while loops
- tmp_w <- w
+ # while we have not reached max_permutations and the following constraints
+ # are violated:
+ # - min_sum
+ # - max_sum
+ # - leverage
+ # - max_pos, max_pos_long, max_pos_short
+ # - group
- # while any constraint is violated and we have not reached max_permutations
- while ((sum(tmp_w) < min_sum |
- sum(tmp_w) > max_sum |
- any(tmp_w < tmp_min) |
- any(tmp_w > max) |
- any(group_fail(tmp_w, groups, cLO, cUP, group_pos)) |
- pos_limit_fail(tmp_w, max_pos, max_pos_long, max_pos_short) |
- sum(abs(w)) > leverage) &
- permutations <= max_permutations) {
- permutations = permutations + 1
- # check our box constraints on total portfolio weight
- # reduce(increase) total portfolio size till you get a match
- # 1> check to see which bound you've failed on, probably set this as a pair of while loops
- # 2> randomly select a column and move only in the direction *towards the bound*, maybe call a function inside a function
- # 3> check and repeat
+ # Do we want to check all constraints in here?
+ # Box constraints should be satisfied by construction so we should not need
+ # to check those here
+ while (( min_sum_fail(tmp_w, min_sum) |
+ max_sum_fail(tmp_w, max_sum) |
+ leverage_fail(tmp_w, leverage) |
+ pos_limit_fail(tmp_w, max_pos, max_pos_long, max_pos_short) |
+ any(group_fail(tmp_w, groups, cLO, cUP)) ) &
+ (permutations < max_permutations)) {
- # reset tmp_w and tmp_min to their original values
- tmp_w <- w
- tmp_min <- min
+ # cat("permutation #:", permutations, "\n")
+ permutations <- permutations+1
- random_index <- sample(1:length(tmp_w), max_assets)
+ # Reset tmp_w to original weights vector
+ # I'm not sure we want to do this here because it puts us back to where we
+ # started, but it seems to help with the position limit constraint
+ # tmp_w <- weights
+ # Reset the random index based on the maximum position constraint
+ # This basically allows us to generate a portfolio of max_pos assets
+ # with the given constraints and then add assets with zero weight
+ random_index <- sample(1:length(tmp_w), max_pos)
+
# Get the index values that are not in random_index and set them equal to 0
full_index <- 1:length(tmp_w)
not_index <- setdiff(full_index, random_index)
tmp_w[not_index] <- 0
- # set some tmp_min values equal to zero so the while loops do not see a
- # violation of any(tmp_w < tmp_min). This tends to force weights to 0 and
- # works well for long only, but we may want to allow negative weights.
- # tmp_min[not_index] <- 0
- # Only set values of tmp_min that are greater than 0 to 0
- tmp_min[not_index[which(tmp_min[not_index] > 0)]] <- 0
+ # min_sum violation
+ if(min_sum_fail(tmp_w, min_sum)){
+ tmp_w <- rp_increase(weights=tmp_w,
+ min_sum=min_sum,
+ max_box=max_box,
+ weight_seq=weight_seq)
+ }
- # Transform weights to satisfy max_pos_long and max_pos_short before being
- # passed into the main loops
- # Both max_pos_long and max_pos_short should be specified
- if(!is.null(max_pos_long)){
- pos_idx <- which(tmp_w > 0)
- neg_idx <- which(tmp_w < 0)
-
- # Check if number of positive weights exceeds max_pos_long
- if(length(pos_idx) > max_pos_long){
- # Randomly sample positive weights that cause violation of max_pos_long
- # and replace with randomly sampled negative weights from weight_seq
- make_neg_idx <- sample(pos_idx, length(pos_idx) - max_pos_long)
- for(i in make_neg_idx){
- tmp_idx <- weight_seq[weight_seq < 0 & weight_seq >= min[i]]
- if(length(tmp_idx) > 0){
- tmp_w[i] <- sample(tmp_idx, 1)
- } else {
- # This should never happen if the correct weight_seq and min is specified
- tmp_w[i] <- -tmp_w[i]
- }
- }
- }
+ # max_sum violation
+ if(max_sum_fail(tmp_w, max_sum)){
+ tmp_w <- rp_decrease(weights=tmp_w,
+ max_sum=max_sum,
+ min_box=min_box,
+ weight_seq=weight_seq)
}
- if(!is.null(max_pos_short)){
- # Check if number of negative weights exceeds max_pos_short
- if(length(neg_idx) > max_pos_short){
- # Randomly sample negative weights that cause violation of max_pos_short
- # and replace with randomly sampled positive weights from weight_seq
- make_pos_idx <- sample(neg_idx, length(neg_idx) - max_pos_short)
- for(i in make_pos_idx){
- tmp_seq <- weight_seq[weight_seq > 0 & weight_seq <= max[i]]
- if(length(tmp_seq) > 0){
- tmp_w[i] <- sample(tmp_seq, 1)
- } else {
- # This should never happen if the correct weight_seq and max is specified
- tmp_w[i] <- -tmp_w[i]
- }
- }
- }
+
+ # leverage violation
+ if(leverage_fail(tmp_w, leverage)){
+ tmp_w <- rp_decrease_leverage(weights=tmp_w,
+ max_box=max_box,
+ min_box=min_box,
+ leverage=leverage,
+ weight_seq=weight_seq)
}
- i = 1
- # We increase elements here if the sum of the weights exceeds max_sum or
- # any of the other constraints are violated
- while ((sum(tmp_w) < min_sum |
- any(tmp_w < tmp_min) |
- any(tmp_w > max) |
- any(group_fail(tmp_w, groups, cLO, cUP, group_pos)) |
- pos_limit_fail(tmp_w, max_pos, max_pos_long, max_pos_short) |
- sum(abs(tmp_w)) > leverage) &
- i <= length(tmp_w)) {
- # randomly permute and increase a random portfolio element
- cur_index <- random_index[i]
- cur_val <- tmp_w[cur_index]
- tmp_seq <- weight_seq[(weight_seq >= cur_val) & (weight_seq <= max[cur_index])]
- n_tmp_seq <- length(tmp_seq)
- if (n_tmp_seq > 1) {
- # randomly sample an element from weight_seq that is greater than cur_val and less than max
- # tmp_w[cur_index] <- sample(weight_seq[(weight_seq >= cur_val) & (weight_seq <= max[cur_index])], 1)
- tmp_w[cur_index] <- tmp_seq[sample.int(n=n_tmp_seq, size=1L, replace=FALSE, prob=NULL)]
- # print(paste("new val:",tmp_w[cur_index]))
- } else {
- if (n_tmp_seq == 1) {
- # tmp_w[cur_index] <- weight_seq[(weight_seq >= cur_val) & (weight_seq <= max[cur_index])]
- tmp_w[cur_index] <- tmp_seq
- }
+ # position limit violation
+ if(pos_limit_fail(tmp_w, max_pos, max_pos_long, max_pos_short)){
+ tmp_w <- rp_position_limit(weights=tmp_w,
+ min_box=min_box,
+ max_box=max_box,
+ max_pos=max_pos,
+ max_pos_long=max_pos_long,
+ max_pos_short=max_pos_short,
+ weight_seq=weight_seq)
+ }
+
+ # group violation
+ if(any(group_fail(tmp_w, groups, cLO, cUP, group_pos))){
+ n_groups <- length(groups)
+ for(j in 1:n_groups){
+ # index of the weights vector belonging to the jth group
+ j_idx <- groups[[j]]
+ # weights of the jth group
+ tmp_group_w <- tmp_w[j_idx]
+
+ # May be easier to just make a recursive call and treat each group
+ # as a portfolio of weight vectors
+ tmp_w[j_idx] <- rp_transform(w=tmp_group_w,
+ min_sum=cLO[j],
+ max_sum=cUP[j],
+ min_box=min_box[j_idx],
+ max_box=max_box[j_idx],
+ group_pos=group_pos[j])
+
+ # treat this as if min_sum were violated
+ # if(sum(tmp_group_w) < cLO[j]){
+ # tmp_w[j_idx] <- rp_increase(weights=tmp_group_w,
+ # min_sum=cLO[j],
+ # max_box=max_box[j_idx],
+ # weight_seq=weight_seq)
+ # }
+
+ # treat this as if max_sum were violated
+ # if(sum(tmp_group_w) > cUP[j]){
+ # tmp_w[j_idx] <- rp_decrease(weights=tmp_group_w,
+ # max_sum=cUP[j],
+ # min_box=min_box[j_idx],
+ # weight_seq=weight_seq)
+ # }
}
- i=i+1 # increment our counter
- } # end increase loop
- # need to reset i here otherwise the decreasing loop will be ignored
- # group_fail does not test for direction of violation, just that group constraints were violated
- i = 1
- # We decrease elements here if the sum of the weights exceeds max_sum or
- # any of the other constraints are violated
- while ((sum(tmp_w) > max_sum |
- any(tmp_w < tmp_min) |
- any(tmp_w > max) |
- any(group_fail(tmp_w, groups, cLO, cUP, group_pos)) |
- pos_limit_fail(tmp_w, max_pos, max_pos_long, max_pos_short) |
- sum(abs(tmp_w)) > leverage) &
- i <= length(tmp_w)) {
- # randomly permute and decrease a random portfolio element
- cur_index <- random_index[i]
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/returnanalytics -r 3482
More information about the Returnanalytics-commits
mailing list