[Returnanalytics-commits] r3479 - in pkg/PortfolioAnalytics: R sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Jul 24 01:15:28 CEST 2014
Author: rossbennett34
Date: 2014-07-24 01:15:28 +0200 (Thu, 24 Jul 2014)
New Revision: 3479
Modified:
pkg/PortfolioAnalytics/R/constraint_fn_map.R
pkg/PortfolioAnalytics/sandbox/rp_transform2.R
Log:
refactor rp_transform2 code to modularize handling the constraint types
Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R
===================================================================
--- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2014-07-23 02:50:58 UTC (rev 3478)
+++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2014-07-23 23:15:28 UTC (rev 3479)
@@ -58,6 +58,7 @@
max_pos <- constraints$max_pos
max_pos_long <- constraints$max_pos_long
max_pos_short <- constraints$max_pos_short
+ leverage <- constraints$leverage
tolerance <- .Machine$double.eps^0.5
# We will modify the weights vector so create a temporary copy
@@ -70,6 +71,7 @@
tmp_max_pos <- max_pos
tmp_max_pos_long <- max_pos_long
tmp_max_pos_short <- max_pos_short
+ tmp_leverage <- leverage
# step 2: check that the vector of weights satisfies the constraints,
# transform weights if constraint is violated
@@ -86,7 +88,8 @@
groups=NULL, cLO=NULL, cUP=NULL,
max_pos=NULL, group_pos=NULL,
max_pos_long=NULL, max_pos_short=NULL,
- max_permutations=500), silent=TRUE) # FALSE for testing
+ leverage=tmp_leverage, max_permutations=500),
+ silent=TRUE) # FALSE for testing
if(inherits(tmp_weights, "try-error")){
# Default to initial weights
tmp_weights <- weights
@@ -104,7 +107,8 @@
groups=NULL, cLO=NULL, cUP=NULL,
max_pos=NULL, group_pos=NULL,
max_pos_long=NULL, max_pos_short=NULL,
- max_permutations=500), silent=TRUE) # FALSE for testing
+ leverage=tmp_leverage, max_permutations=500),
+ silent=TRUE) # FALSE for testing
if(inherits(tmp_weights, "try-error")){
# Default to initial weights
tmp_weights <- weights
@@ -132,7 +136,8 @@
groups=NULL, cLO=NULL, cUP=NULL,
max_pos=NULL, group_pos=NULL,
max_pos_long=NULL, max_pos_short=NULL,
- max_permutations=500), silent=TRUE) # FALSE for testing
+ leverage=tmp_leverage, 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
i <- i + 1
@@ -159,7 +164,8 @@
groups=groups, cLO=tmp_cLO, cUP=tmp_cUP,
max_pos=NULL, group_pos=group_pos,
max_pos_long=NULL, max_pos_short=NULL,
- max_permutations=500), silent=TRUE) # FALSE for testing
+ leverage=tmp_leverage, max_permutations=500),
+ silent=TRUE) # FALSE for testing
if(inherits(tmp_weights, "try-error")){
# Default to initial weights
tmp_weights <- weights
@@ -183,7 +189,8 @@
groups=groups, cLO=tmp_cLO, cUP=tmp_cUP,
max_pos=NULL, group_pos=group_pos,
max_pos_long=NULL, max_pos_short=NULL,
- max_permutations=500), silent=TRUE) # FALSE for testing
+ leverage=tmp_leverage, max_permutations=500),
+ silent=TRUE) # FALSE for testing
if(inherits(tmp_weights, "try-error")) tmp_weights <- weights
i <- i + 1
}
@@ -209,7 +216,8 @@
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,
- max_permutations=500), silent=TRUE) # FALSE for testing
+ leverage=tmp_leverage, max_permutations=500),
+ silent=TRUE) # FALSE for testing
if(inherits(tmp_weights, "try-error")){
# Default to initial weights
tmp_weights <- weights
@@ -227,7 +235,8 @@
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,
- max_permutations=500), silent=TRUE) # FALSE for testing
+ leverage=tmp_leverage, max_permutations=500),
+ silent=TRUE) # FALSE for testing
if(inherits(tmp_weights, "try-error")) tmp_weights <- weights
i <- i + 1
}
@@ -235,6 +244,43 @@
} # end try-error recovery
} # end check for position limit constraint violation
} # end check for NULL arguments
+
+ # check leverage constraints
+ if(!is.null(tmp_leverage)){
+ 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),
+ silent=TRUE) # FALSE for testing
+ if(inherits(tmp_weights, "try-error")){
+ # Default to initial weights
+ tmp_weights <- weights
+ if(relax){
+ i <- 1
+ while(sum(abs(tmp_weights)) > tmp_leverage & (i <= 5)){
+ # increment tmp_leverage by 1%
+ 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),
+ silent=TRUE) # FALSE for testing
+ if(inherits(tmp_weights, "try-error")) tmp_weights <- weights
+ i <- i + 1
+ }
+ } # end if(relax) statement
+ } # end try-error recovery
+ } # end check for leverage exposure violation
+ } # end check for NULL arguments
names(tmp_weights) <- names(weights)
return(list(weights=tmp_weights,
@@ -244,16 +290,20 @@
cUP=tmp_cUP,
max_pos=tmp_max_pos,
max_pos_long=tmp_max_pos_long,
- max_pos_short=tmp_max_pos_short))
+ max_pos_short=tmp_max_pos_short,
+ leverage=tmp_leverage))
}
-#' Transform a weights vector to satisfy leverage, box, group, and position_limit constraints using logic from \code{randomize_portfolio}
+#' Transform a weights vector to satisfy constraints
#'
#' This function uses a block of code from \code{\link{randomize_portfolio}}
#' to transform the weight vector if either the weight_sum (leverage)
-#' constraints, box constraints, group constraints, or position_limit constraints are violated.
+#' 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.
#' The resulting weights vector might be quite different from the original weights vector.
#'
#' @param w weights vector to be transformed
@@ -268,11 +318,25 @@
#' @param group_pos vector specifying maximum number assets with non-zero weights per group
#' @param max_pos_long maximum number of assets with long (i.e. buy) positions
#' @param max_pos_short maximum number of assets with short (i.e. sell) positions
+#' @param leverage maximum leverage exposure where leverage is defined as \code{sum(abs(weights))}
#' @param max_permutations integer: maximum number of iterations to try for a valid portfolio, default 200
#' @return named weighting vector
#' @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, max_pos=NULL, group_pos=NULL, max_pos_long=NULL, max_pos_short=NULL, max_permutations=200){
+rp_transform <- function(w,
+ min_sum=0.99,
+ max_sum=1.01,
+ min,
+ max,
+ groups,
+ cLO,
+ cUP,
+ max_pos=NULL,
+ group_pos=NULL,
+ max_pos_long=NULL,
+ max_pos_short=NULL,
+ leverage=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
@@ -286,6 +350,9 @@
# Set value for max_pos if it is not specified
if(is.null(max_pos)) max_pos <- length(w)
+ # Set value for leverage if it is not specified
+ if(is.null(leverage)) leverage <- Inf
+
# Determine maximum number of non-zero weights
if(!is.null(group_pos)) {
max_group_pos <- sum(group_pos)
@@ -315,7 +382,8 @@
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)){
+ !pos_limit_fail(w, max_pos, max_pos_long, max_pos_short) &
+ (sum(abs(w)) <= leverage)){
return(w)
}
@@ -330,8 +398,15 @@
# create a temporary weights vector that will be modified in the while loops
tmp_w <- w
- # while portfolio is outside min_sum/max_sum or tmp_min/max or group or postion_limit constraints 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))) & permutations <= max_permutations) {
+ # 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
@@ -399,8 +474,15 @@
}
i = 1
- # while sum of weights is less than min_sum or tmp_min/max box or group constraint is 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))) & i <= length(tmp_w)) {
+ # 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]
@@ -422,8 +504,15 @@
# 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
- # while sum of weights is greater than max_sum or tmp_min/max box or group constraint is 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))) & i <= length(tmp_w)) {
+ # 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]
cur_val <- tmp_w[cur_index]
@@ -441,6 +530,10 @@
}
i=i+1 # increment our counter
} # end decrease loop
+ #cat("permutations:", permutations, "\n")
+ #cat("weights:", tmp_w, "\n")
+ #cat("sum(weights):", sum(tmp_w), "\n")
+ #cat("sum(abs(weights)):", sum(abs(tmp_w)), "\n")
} # end final walk towards the edges
portfolio <- tmp_w
@@ -541,6 +634,30 @@
return(FALSE)
}
+min_sum_fail <- function(weights, min_sum){
+ # return FALSE if min_sum is null
+ if(is.null(min_sum)) return(FALSE)
+
+ # sum of weights violate min_sum constraint
+ return(sum(weights) < min_sum)
+}
+
+max_sum_fail <- function(weights, max_sum){
+ # return FALSE if max_sum is null
+ if(is.null(max_sum)) return(FALSE)
+
+ # sum of weights violate max_sum constraint
+ return(sum(weights) > max_sum)
+}
+
+leverage_fail <- function(weights, leverage){
+ # return FALSE if leverage is null
+ if(is.null(leverage)) return(FALSE)
+
+ # sum of absolute value of weight violates leverage constraint
+ return(sum(abs(weights)) > leverage)
+}
+
# test
# w <- c(0.1, 0.25, 0.3, 0.15, 0.05, 0.15)
# min <- rep(0.1, length(w))
Modified: pkg/PortfolioAnalytics/sandbox/rp_transform2.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/rp_transform2.R 2014-07-23 02:50:58 UTC (rev 3478)
+++ pkg/PortfolioAnalytics/sandbox/rp_transform2.R 2014-07-23 23:15:28 UTC (rev 3479)
@@ -1,28 +1,32 @@
-rp_transform2 <- function(weights,
- min_sum=NULL,
- max_sum=NULL,
- min_box=NULL,
- max_box=NULL,
- max_pos=NULL,
- max_pos_long=NULL,
- max_pos_short=NULL,
- leverage=NULL,
+rp_transform2 <- function(weights,
+ 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,
max_permutations=200){
tmp_w <- weights
# 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(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_pos)) max_pos_long <- length(tmp_w)
- if(is.null(max_pos)) max_pos_short <- length(tmp_w)
- if(is.null(leverage)) leverage <- Inf
+ #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
# Generate a weight sequence, we should check for portfolio$weight_seq
weight_seq <- generatesequence(min=min(min_box), max=max(max_box), by=0.002)
@@ -35,30 +39,25 @@
# while we have not reached max_permutations and the following constraints
# are violated:
- # - min_sum/max_sum
+ # - min_sum
+ # - max_sum
# - leverage
- # - max_pos
+ # - max_pos, max_pos_long, max_pos_short
+ # - group
-
-
# 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 (( (sum(tmp_w) < min_sum) |
- (sum(tmp_w) > max_sum) |
- (sum(abs(tmp_w)) > leverage) |
- (sum(abs(tmp_w) > tolerance) > max_pos) ) &
+ 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)) {
- cat("permutation #:", permutations, "\n")
+ # cat("permutation #:", permutations, "\n")
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, brobably 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
-
# 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
@@ -77,90 +76,322 @@
# randomly permute and increase a random portfolio element if the sum of
# the weights is less than min_sum
# set counter to 1 for increase loop
- i <- 1
- while (sum(tmp_w) <= min_sum & i <= length(tmp_w)) {
- print("Entering min_sum violation loop")
-
- cur_index <- random_index[i]
- cur_val <- tmp_w[cur_index]
- tmp_seq <- weight_seq[(weight_seq >= cur_val) & (weight_seq <= max_box[cur_index])]
- n_tmp_seq <- length(tmp_seq)
- if(n_tmp_seq > 1){
- # randomly sample one of the larger weights
- 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] <- tmp_seq
- }
- }
- i <- i + 1 # increment our counter
- } # end increase loop
+ # i <- 1
+ # while (sum(tmp_w) < min_sum & i <= length(tmp_w)) {
+ # print("min_sum violation loop")
+ #
+ # cur_index <- random_index[i]
+ # cur_val <- tmp_w[cur_index]
+ # tmp_seq <- weight_seq[(weight_seq >= cur_val) & (weight_seq <= max_box[cur_index])]
+ # n_tmp_seq <- length(tmp_seq)
+ # if(n_tmp_seq > 1){
+ # # randomly sample one of the larger weights
+ # 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] <- tmp_seq
+ # }
+ # }
+ # i <- i + 1 # increment our counter
+ # } # end increase loop
+ # 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)
+ }
+
# randomly permute and decrease a random portfolio element if the sum of
# the weights is greater than max_sum
# set counter to 1 for decrease loop
- i <- 1
- while (sum(tmp_w) >= max_sum & i <= length(tmp_w)) {
- print("Entering max_sum violation loop")
-
- cur_index <- random_index[i]
- cur_val <- tmp_w[cur_index]
- tmp_seq <- weight_seq[(weight_seq <= cur_val) & (weight_seq >= min_box[cur_index])]
- n_tmp_seq <- length(tmp_seq)
- if(n_tmp_seq > 1) {
- # randomly sample one of the smaller weights
- tmp_w[cur_index] <- tmp_seq[sample.int(n=n_tmp_seq, size=1L, replace=FALSE, prob=NULL)]
- } else {
- if(n_tmp_seq == 1){
- tmp_w[cur_index] <- tmp_seq
- }
- }
- i <- i + 1 # increment our counter
- } # end decrease loop
+ # i <- 1
+ # while (sum(tmp_w) > max_sum & i <= length(tmp_w)) {
+ # print("max_sum violation loop")
+ #
+ # cur_index <- random_index[i]
+ # cur_val <- tmp_w[cur_index]
+ # tmp_seq <- weight_seq[(weight_seq <= cur_val) & (weight_seq >= min_box[cur_index])]
+ # n_tmp_seq <- length(tmp_seq)
+ # if(n_tmp_seq > 1) {
+ # # randomly sample one of the smaller weights
+ # tmp_w[cur_index] <- tmp_seq[sample.int(n=n_tmp_seq, size=1L, replace=FALSE, prob=NULL)]
+ # } else {
+ # if(n_tmp_seq == 1){
+ # tmp_w[cur_index] <- tmp_seq
+ # }
+ # }
+ # i <- i + 1 # increment our counter
+ # } # end decrease loop
+ # 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)
+ }
+
# set counter to 1 for leverage violation loop
- i <- 1
- while (sum(abs(tmp_w)) >= leverage & i <= length(tmp_w)) {
- print("Entering leverage violation loop")
- # randomly permute and increae decrease a random portfolio element
- # according to leverage exposure
- cur_index <- random_index[i]
- cur_val <- tmp_w[cur_index]
-
- # check the sign of the current value
- if(cur_val < 0){
- # if the current value is negative, we want to increase to lower
- # sum(abs(weights)) while respecting uppper bound box constraint
- tmp_seq <- weight_seq[(weight_seq >= cur_val) & (weight_seq <= max_box[cur_index])]
- } else if(cur_val > 0){
- # if the current value is positive, we want to decrease to lower
- # sum(abs(weights)) while respecting lower bound box constraint
- tmp_seq <- weight_seq[(weight_seq <= cur_val) & (weight_seq >= min_box[cur_index])]
- }
- n_tmp_seq <- length(tmp_seq)
- if(n_tmp_seq > 1) {
- # randomly sample one of the weights
- tmp_w[cur_index] <- tmp_seq[sample.int(n=n_tmp_seq, size=1L, replace=FALSE, prob=NULL)]
- } else {
- if(n_tmp_seq == 1){
- tmp_w[cur_index] <- tmp_seq
+ # i <- 1
+ # while (sum(abs(tmp_w)) > leverage & i <= length(tmp_w)) {
+ # print("leverage violation loop")
+ # # randomly permute and increae decrease a random portfolio element
+ # # according to leverage exposure
+ # cur_index <- random_index[i]
+ # cur_val <- tmp_w[cur_index]
+ #
+ # # check the sign of the current value
+ # if(cur_val < 0){
+ # # if the current value is negative, we want to increase to lower
+ # # sum(abs(weights)) while respecting uppper bound box constraint
+ # tmp_seq <- weight_seq[(weight_seq >= cur_val) & (weight_seq <= max_box[cur_index])]
+ # } else if(cur_val > 0){
+ # # if the current value is positive, we want to decrease to lower
+ # # sum(abs(weights)) while respecting lower bound box constraint
+ # tmp_seq <- weight_seq[(weight_seq <= cur_val) & (weight_seq >= min_box[cur_index])]
+ # }
+ # n_tmp_seq <- length(tmp_seq)
+ # if(n_tmp_seq > 1) {
+ # # randomly sample one of the weights
+ # tmp_w[cur_index] <- tmp_seq[sample.int(n=n_tmp_seq, size=1L, replace=FALSE, prob=NULL)]
+ # } else {
+ # if(n_tmp_seq == 1){
+ # tmp_w[cur_index] <- tmp_seq
+ # }
+ # }
+ # i <- i + 1 # increment our counter
+ # } # end leverage violation loop
+
+ # 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)
+ }
+
+ # set counter to 1 for position limit violation loop
+ # i <- 1
+ # while (((sum(abs(tmp_w) > tolerance) > max_pos) |
+ # (sum(tmp_w >= 0) > max_pos_long) |
+ # (sum(tmp_w >= 0) > max_pos_long)) &
+ # i <= length(tmp_w)) {
+ # print("position limit violation loop")
+ #
+ # cur_index <- random_index[i]
+ # cur_val <- tmp_w[cur_index]
+ #
+ # # Check if max_pos_long is violated
+ # # If max_pos_long is violated, we we grab a positive weight and set it
+ # # to be between min_box and 0
+ # if(sum(tmp_w > tolerance) > max_pos_long){
+ # if(cur_val > tolerance){
+ # # subset such that min_box_i <= weight_i <= 0
+ # tmp_seq <- weight_seq[(weight_seq <= 0) & (weight_seq >= min_box[cur_index])]
+ # }
+ # n_tmp_seq <- length(tmp_seq)
+ # if(n_tmp_seq > 1){
+ # tmp_w[cur_index] <- tmp_seq[sample.int(n=n_tmp_seq, size=1L, replace=FALSE, prob=NULL)]
+ # } else if(n_tmp_seq == 1){
+ # tmp_w[cur_index] <- tmp_seq
+ # }
+ # } # end max_pos_long violation loop
+ #
+ # # Check if max_pos_short is violated
+ # # If max_pos_short is violated, we grab a negative weight and set it
+ # # to be between 0 and max_box
+ # if(sum(tmp_w < tolerance) > max_pos_short){
+ # if(cur_val < tolerance){
+ # # subset such that 0 <= weight_i <= max_box_i
+ # tmp_seq <- weight_seq[(weight_seq >= 0) & (weight_seq <= max_box[cur_index])]
+ # }
+ # n_tmp_seq <- length(tmp_seq)
+ # if(n_tmp_seq > 1){
+ # tmp_w[cur_index] <- tmp_seq[sample.int(n=n_tmp_seq, size=1L, replace=FALSE, prob=NULL)]
+ # } else if(n_tmp_seq == 1){
+ # tmp_w[cur_index] <- tmp_seq
+ # }
+ # } # end max_pos_short violation loop
+ #
+ # i <- i + 1 # increment our counter
+ # } # end position limit violation loop
+
+ # 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]
+
+ # 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 leverage violation loop
+ } # end group violation loop
- # set counter to 1 for position limit violation loop
- i <- 1
- while (((sum(abs(tmp_w) > tolerance) > max_pos) |
- (sum(tmp_w >= 0) > max_pos_long) |
- (sum(tmp_w >= 0) > max_pos_long)) &
- i <= length(tmp_w)) {
- print("Entering position limit violation loop")
-
- cur_index <- random_index[i]
- cur_val <- tmp_w[cur_index]
-
+ cat("weights:", tmp_w, "\n")
+ #cat("sum(weights):", sum(tmp_w), "\n")
+ #cat("sum(abs(weights)):", sum(abs(tmp_w)), "\n")
+ } # end final walk towards the edges
+ portfolio <- tmp_w
+
+ colnames(portfolio) <- colnames(weights)
+
+ # checks for infeasible portfolio
+ # Stop execution and return an error if an infeasible portfolio is created
+ # This will be useful in fn_map so that we can catch the error and take
+ # action (try again with more permutations, relax constraints, different
+ # method to normalize, etc.)
+ if (sum(portfolio) < min_sum | sum(portfolio) > max_sum){
+ portfolio <- weights
+ stop("Infeasible portfolio created, perhaps increase max_permutations and/or adjust your parameters.")
+ }
+ return(portfolio)
+}
+
+rp_increase <- function(weights, min_sum, max_box, weight_seq){
+ # randomly permute and increase a random portfolio element if the sum of
+ # the weights is less than min_sum while respecting box constraints
+
+ if(sum(weights) >= min_sum) return(weights)
+
+ tmp_w <- weights
+ n_weights <- length(weights)
+ # random_index <- sample(1:length(weights), max_pos)
+ random_index <- sample(1:n_weights, n_weights)
+ i <- 1
+ while (sum(tmp_w) < min_sum & i <= n_weights) {
+ # print("min_sum violation loop")
+
+ cur_index <- random_index[i]
+ cur_val <- tmp_w[cur_index]
+ tmp_seq <- weight_seq[(weight_seq > cur_val) & (weight_seq <= max_box[cur_index])]
+ n_tmp_seq <- length(tmp_seq)
+ if(n_tmp_seq > 1){
+ # randomly sample one of the larger weights
+ tmp_w[cur_index] <- tmp_seq[sample.int(n=n_tmp_seq, size=1L, replace=FALSE, prob=NULL)]
+ } else if(n_tmp_seq == 1){
+ tmp_w[cur_index] <- tmp_seq
+ }
+ i <- i + 1 # increment our counter
+ } # end increase loop
+ return(tmp_w)
+}
+
+rp_decrease <- function(weights, max_sum, min_box, weight_seq){
+ # randomly permute and decrease a random portfolio element if the sum of
+ # the weights is greater than max_sum while respecting box constraints
+
+ if(sum(weights) <= max_sum) return(weights)
+
+ tmp_w <- weights
+ n_weights <- length(weights)
+ # random_index <- sample(1:length(weights), max_pos)
+ random_index <- sample(1:n_weights, n_weights)
+
+ i <- 1
+ while (sum(tmp_w) > max_sum & i <= n_weights) {
+ # print("max_sum violation loop")
+
+ cur_index <- random_index[i]
+ cur_val <- tmp_w[cur_index]
+ tmp_seq <- weight_seq[(weight_seq < cur_val) & (weight_seq >= min_box[cur_index])]
+ n_tmp_seq <- length(tmp_seq)
+ if(n_tmp_seq > 1){
+ tmp_w[cur_index] <- tmp_seq[sample.int(n=n_tmp_seq, size=1L, replace=FALSE, prob=NULL)]
+ } else if(n_tmp_seq == 1){
+ tmp_w[cur_index] <- tmp_seq
+ }
+ i <- i + 1 # increment our counter
+ } # end decrease loop
+ return(tmp_w)
+}
+
+rp_decrease_leverage <- function(weights, max_box, min_box, leverage, weight_seq){
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/returnanalytics -r 3479
More information about the Returnanalytics-commits
mailing list