[Returnanalytics-commits] r3480 - pkg/PortfolioAnalytics/sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Jul 24 04:42:01 CEST 2014
Author: rossbennett34
Date: 2014-07-24 04:42:00 +0200 (Thu, 24 Jul 2014)
New Revision: 3480
Added:
pkg/PortfolioAnalytics/sandbox/test2_rp_transform2.R
Modified:
pkg/PortfolioAnalytics/sandbox/rp_transform2.R
Log:
fixing bugs rp_transform2 and adding test script
Modified: pkg/PortfolioAnalytics/sandbox/rp_transform2.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/rp_transform2.R 2014-07-23 23:15:28 UTC (rev 3479)
+++ pkg/PortfolioAnalytics/sandbox/rp_transform2.R 2014-07-24 02:42:00 UTC (rev 3480)
@@ -249,9 +249,9 @@
}
# treat this as if max_sum were violated
- if(sum(tmp_group_w) > cup[j]){
+ if(sum(tmp_group_w) > cUP[j]){
tmp_w[j_idx] <- rp_decrease(weights=tmp_group_w,
- max_sum=cUp[j],
+ max_sum=cUP[j],
min_box=min_box[j_idx],
weight_seq=weight_seq)
}
@@ -399,13 +399,13 @@
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
+ }
}
- 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
}
@@ -417,13 +417,13 @@
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
+ }
}
- 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
}
Added: pkg/PortfolioAnalytics/sandbox/test2_rp_transform2.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/test2_rp_transform2.R (rev 0)
+++ pkg/PortfolioAnalytics/sandbox/test2_rp_transform2.R 2014-07-24 02:42:00 UTC (rev 3480)
@@ -0,0 +1,168 @@
+
+min_sum <- 0.99
+max_sum <- 1.01
+min_box <- rep(-0.15, length(weights))
+max_box <- rep(0.6, length(weights))
+
+# violate min_sum and box constraint
+weights <- c(0.2, -0.2, 0.4, 0.5)
+sum(weights)
+
+rp_transform2(weights=weights,
+ min_sum=min_sum,
+ max_sum=max_sum,
+ min_box=min_box,
+ max_box=max_box)
+
+
+# violate max_sum and box constraints
+weights <- c(0.35, 0.05, 0.7, 0.1)
+sum(weights)
+
+rp_transform2(weights=weights,
+ min_sum=min_sum,
+ max_sum=max_sum,
+ min_box=min_box,
+ max_box=max_box)
+
+
+# violate box constraints and leverage
+weights <- c(-0.45, 0.45, 0.55, 0.45)
+sum(weights)
+sum(abs(weights))
+leverage <- 1.6
+
+rp_transform2(weights=weights,
+ min_sum=min_sum,
+ max_sum=max_sum,
+ min_box=min_box,
+ max_box=max_box,
+ leverage=leverage)
+
+
+# violate max position limit constraint
+weights <- c(0.15, 0.25, 0.4, 0.2)
+sum(weights)
+max_pos <- 3
+
+rp_transform2(weights=weights,
+ min_sum=min_sum,
+ max_sum=max_sum,
+ min_box=min_box,
+ max_box=max_box,
+ max_pos=max_pos)
+
+# violate position limit constraint
+weights <- c(-0.05, -0.05, 0.4, 0.7)
+sum(weights)
+
+max_pos_short <- 1
+
+rp_transform2(weights=weights,
+ min_sum=min_sum,
+ max_sum=max_sum,
+ min_box=min_box,
+ max_box=max_box,
+ max_pos_short=max_pos_short)
+
+# violate position limit constraint
+weights <- c(-0.05, -0.05, 0.4, 0.7)
+sum(weights)
+
+max_pos_long <- 3
+max_pos_short <- 1
+
+rp_transform2(weights=weights,
+ min_sum=min_sum,
+ max_sum=max_sum,
+ min_box=min_box,
+ max_box=max_box,
+ max_pos_long=max_pos_long,
+ max_pos_short=max_pos_short)
+
+
+# violate position limit constraint
+weights <- c(-0.05, -0.05, 0.4, 0.7)
+sum(weights)
+
+max_pos_long <- 3
+max_pos_short <- 1
+max_pos <- 3
+
+rp_transform2(weights=weights,
+ min_sum=min_sum,
+ max_sum=max_sum,
+ min_box=min_box,
+ max_box=max_box,
+ max_pos=max_pos,
+ max_pos_long=max_pos_long,
+ max_pos_short=max_pos_short)
+
+# violate position limit constraint
+weights <- c(-0.25, -0.15, 0.4, 0.7)
+sum(weights)
+sum(abs(weights))
+
+max_pos_long <- 3
+max_pos_short <- 1
+max_pos <- 3
+leverage <- 1.3
+
+rp_transform2(weights=weights,
+ min_sum=min_sum,
+ max_sum=max_sum,
+ min_box=min_box,
+ max_box=max_box,
+ max_pos=max_pos,
+ max_pos_long=max_pos_long,
+ max_pos_short=max_pos_short,
+ leverage=leverage)
+
+# The second group is above cUP and the fourth group is below cLO
+weights <- c(0.06, 0.1, 0.07, 0.2, 0.22, 0.10, 0.05, 0.08, 0.05, 0.04, 0.03)
+sum(weights[1:2])
+sum(weights[3:6])
+sum(weights[7:10])
+sum(weights[10:11])
+sum(weights)
+
+groups <- list(1:2,
+ 3:6,
+ 7:10,
+ 10:11)
+# group_pos <- c(2, 3, 2, 2)
+group_pos <- NULL
+cLO <- c(0.05, 0.10, 0.05, 0.08)
+cUP <- c(0.4, 0.55, 0.65, 0.45)
+min_sum <- 0.99
+max_sum <- 1.01
+min_box <- rep(0.05, length(weights))
+max_box <- rep(0.65, length(weights))
+
+group_fail(weights, groups, cLO, cUP, group_pos)
+
+rp_transform2(weights, min_sum, max_sum, min_box, max_box, groups, cLO, cUP)
+
+
+
+# Note that this was typically not working with max_permutations=200
+# Relax constraints or increase max_permutations
+
+# max_pos <- 3
+# max_pos_long <- 4
+# max_pos_short <- 4
+# leverage <- Inf
+# max_permutations <- 200
+#
+# rp_transform2(weights=weights,
+# min_sum=min_sum,
+# max_sum=max_sum,
+# min_box=min_box,
+# max_box=max_box,
+# max_pos=max_pos,
+# max_pos_long=max_pos_long,
+# max_pos_short=max_pos_short,
+# leverage=leverage,
+# max_permutations=max_permutations)
+
+
More information about the Returnanalytics-commits
mailing list