[Returnanalytics-commits] r3483 - in pkg/PortfolioAnalytics: R inst/tests man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Jul 25 22:46:27 CEST 2014
Author: rossbennett34
Date: 2014-07-25 22:46:27 +0200 (Fri, 25 Jul 2014)
New Revision: 3483
Added:
pkg/PortfolioAnalytics/inst/tests/test_rp_sample.R
Modified:
pkg/PortfolioAnalytics/R/random_portfolios.R
pkg/PortfolioAnalytics/man/random_portfolios.Rd
Log:
Modifying randomize_portfolio to use rp_transform code for handling of more complex constraints. Adding test script for rp_sample method
Modified: pkg/PortfolioAnalytics/R/random_portfolios.R
===================================================================
--- pkg/PortfolioAnalytics/R/random_portfolios.R 2014-07-25 19:40:32 UTC (rev 3482)
+++ pkg/PortfolioAnalytics/R/random_portfolios.R 2014-07-25 20:46:27 UTC (rev 3483)
@@ -237,8 +237,28 @@
weight_seq <- generatesequence(min=min(constraints$min), max=max(constraints$max), by=0.002)
}
weight_seq <- as.vector(weight_seq)
+
+ # box constraints
max <- constraints$max
min <- constraints$min
+
+ # If any of the constraints below do not exist in the constraints object,
+ # then they are NULL values which rp_transform can handle in its checks.
+
+ # group constraints
+ groups <- constraints$groups
+ cLO <- constraints$cLO
+ cUP <- constraints$cUP
+ group_pos <- constraints$group_pos
+
+ # position limit constraints
+ max_pos <- constraints$max_pos
+ max_pos_long <- constraints$max_pos_long
+ max_pos_short <- constraints$max_pos_short
+
+ # leverage constraint
+ leverage <- constraints$leverage
+
# initial portfolio
iportfolio <- as.vector(seed)
rownames(iportfolio) <- NULL
@@ -257,53 +277,69 @@
tportfolio[cur_index] <- sample(weight_seq[(weight_seq >= cur_val * min_mult[cur_index]) & (weight_seq <= cur_val * max_mult[cur_index]) & (weight_seq <= max[cur_index]) & (weight_seq >= min[cur_index])], 1)
}
- #while portfolio is outside min/max sum and we have not reached max_permutations
- while ((sum(tportfolio) <= min_sum | sum(tportfolio) >= max_sum) & 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, 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
- random_index <- sample(1:length(tportfolio), length(tportfolio))
- i <- 1
- while (sum(tportfolio) <= min_sum & i <= length(tportfolio)) {
- # randomly permute and increase a random portfolio element
- cur_index <- random_index[i]
- cur_val <- tportfolio[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 one of the larger weights
- tportfolio[cur_index] <- tmp_seq[sample.int(n=n_tmp_seq, size=1L, replace=FALSE, prob=NULL)]
- # print(paste("new val:",tportfolio[cur_index]))
- } else {
- if(n_tmp_seq == 1){
- tportfolio[cur_index] <- tmp_seq
- }
- }
- i <- i + 1 # increment our counter
- } # end increase loop
- while (sum(tportfolio) >= max_sum & i <= length(tportfolio)) {
- # randomly permute and decrease a random portfolio element
- cur_index <- random_index[i]
- cur_val <- tportfolio[cur_index]
- tmp_seq <- weight_seq[(weight_seq <= cur_val) & (weight_seq >= min[cur_index])]
- n_tmp_seq <- length(tmp_seq)
- if(n_tmp_seq > 1) {
- # randomly sample one of the smaller weights
- tportfolio[cur_index] <- tmp_seq[sample.int(n=n_tmp_seq, size=1L, replace=FALSE, prob=NULL)]
- } else {
- if(n_tmp_seq == 1){
- tportfolio[cur_index] <- tmp_seq
- }
- }
- i <- i + 1 # increment our counter
- } # end decrease loop
- } # end final walk towards the edges
+ # random portfolios algorithm designed to handle multiple constraint types
+ fportfolio <- rp_transform(w=tportfolio,
+ min_sum=min_sum,
+ max_sum=max_sum,
+ min_box=min,
+ max_box=max,
+ groups=groups,
+ cLO=cLO,
+ cUP=cUP,
+ max_pos=max_pos,
+ group_pos=group_pos,
+ max_pos_long=max_pos_long,
+ max_pos_short=max_pos_short,
+ leverage=leverage,
+ weight_seq=weight_seq,
+ max_permutations=max_permutations)
- # final portfolio
- fportfolio <- fn_map(weights=tportfolio, portfolio=portfolio, relax=FALSE)$weights
+# #while portfolio is outside min/max sum and we have not reached max_permutations
+# while ((sum(tportfolio) <= min_sum | sum(tportfolio) >= max_sum) & 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, 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
+# random_index <- sample(1:length(tportfolio), length(tportfolio))
+# i <- 1
+# while (sum(tportfolio) <= min_sum & i <= length(tportfolio)) {
+# # randomly permute and increase a random portfolio element
+# cur_index <- random_index[i]
+# cur_val <- tportfolio[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 one of the larger weights
+# tportfolio[cur_index] <- tmp_seq[sample.int(n=n_tmp_seq, size=1L, replace=FALSE, prob=NULL)]
+# # print(paste("new val:",tportfolio[cur_index]))
+# } else {
+# if(n_tmp_seq == 1){
+# tportfolio[cur_index] <- tmp_seq
+# }
+# }
+# i <- i + 1 # increment our counter
+# } # end increase loop
+# while (sum(tportfolio) >= max_sum & i <= length(tportfolio)) {
+# # randomly permute and decrease a random portfolio element
+# cur_index <- random_index[i]
+# cur_val <- tportfolio[cur_index]
+# tmp_seq <- weight_seq[(weight_seq <= cur_val) & (weight_seq >= min[cur_index])]
+# n_tmp_seq <- length(tmp_seq)
+# if(n_tmp_seq > 1) {
+# # randomly sample one of the smaller weights
+# tportfolio[cur_index] <- tmp_seq[sample.int(n=n_tmp_seq, size=1L, replace=FALSE, prob=NULL)]
+# } else {
+# if(n_tmp_seq == 1){
+# tportfolio[cur_index] <- tmp_seq
+# }
+# }
+# i <- i + 1 # increment our counter
+# } # end decrease loop
+# } # end final walk towards the edges
+# # final portfolio
+# fportfolio <- fn_map(weights=tportfolio, portfolio=portfolio, relax=FALSE)$weights
colnames(fportfolio) <- colnames(seed)
if (sum(fportfolio) < min_sum | sum(fportfolio) > max_sum){
@@ -333,7 +369,7 @@
#' \item{sample: }{The 'sample' method to generate random portfolios is based
#' on an idea pioneerd by Pat Burns. This is the most flexible method, but
#' also the slowest, and can generate portfolios to satisfy leverage, box,
-#' group, and position limit constraints.}
+#' group, position limit, and leverage exposure constraints.}
#' \item{simplex: }{The 'simplex' method to generate random portfolios is
#' based on a paper by W. T. Shaw. The simplex method is useful to generate
#' random portfolios with the full investment constraint, where the sum of the
@@ -351,7 +387,8 @@
#' penalized in \code{constrained_objective}.}
#' }
#'
-#' The constraint types checked are leverage, box, group, and position limit. Any
+#' The constraint types checked are leverage, box, group, position limit, and
+#' leverage exposure. Any
#' portfolio that does not satisfy all these constraints will be eliminated. This
#' function is particularly sensitive to \code{min_sum} and \code{max_sum}
#' leverage constraints. For the sample method, there should be some
Added: pkg/PortfolioAnalytics/inst/tests/test_rp_sample.R
===================================================================
--- pkg/PortfolioAnalytics/inst/tests/test_rp_sample.R (rev 0)
+++ pkg/PortfolioAnalytics/inst/tests/test_rp_sample.R 2014-07-25 20:46:27 UTC (rev 3483)
@@ -0,0 +1,65 @@
+
+require(testthat)
+require(PortfolioAnalytics)
+
+context("random portfolios sample method")
+
+data(edhec)
+ret <- edhec[, 1:4]
+funds <- colnames(ret)
+
+init.portf <- portfolio.spec(assets=funds)
+init.portf <- add.constraint(init.portf, type="weight_sum",
+ min_sum=0.99, max_sum=1.01)
+init.portf <- add.constraint(init.portf, type="box",
+ min=-0.3, max=0.65)
+
+# generate portfolios to satisfy weight_sum and box constraints
+rp1 <- random_portfolios(init.portf, 1000, eliminate=FALSE)
+test_that("we have created at least 1 feasible portfolio to satisfy weight_sum and box constraints", {
+ expect_that(any(apply(rp1, 1, PortfolioAnalytics:::check_constraints, portfolio=group.portf)), is_true())
+})
+
+# portfolio with group constraints
+group.portf <- add.constraint(init.portf, type="group",
+ groups=list(1:2,3:4),
+ group_min=c(0.08, 0.05),
+ group_max=c(0.55, 0.85),
+ group_pos=c(2,2))
+
+# generate portfolios to satisfy weight_sum, box, and group constraints
+rp2 <- random_portfolios(group.portf, 1000, eliminate=FALSE)
+test_that("we have created at least 1 feasible portfolio to satisfy weight_sum, box, and group constraints", {
+ expect_that(any(apply(rp2, 1, PortfolioAnalytics:::check_constraints, portfolio=group.portf)), is_true())
+})
+
+# add leverage exposure constraint
+lev.portf <- add.constraint(init.portf, type="leverage_exposure",
+ leverage=1.6)
+
+# generate portfolios to satisfy weight_sum, box, and leverage constraints
+rp3 <- random_portfolios(lev.portf, 1000, eliminate=FALSE)
+test_that("we have created at least 1 feasible portfolio to satisfy weight_sum, box, and leverage constraints", {
+ expect_that(any(apply(rp3, 1, PortfolioAnalytics:::check_constraints, portfolio=group.portf)), is_true())
+})
+
+# add position limit constraint
+pos1.portf <- add.constraint(init.portf, type="position_limit",
+ max_pos=3)
+
+# generate portfolios to satisfy weight_sum, box, and position limit constraints
+rp4 <- random_portfolios(pos1.portf, 1000, eliminate=FALSE)
+test_that("we have created at least 1 feasible portfolio to satisfy weight_sum, box, and position limit constraints", {
+ expect_that(any(apply(rp4, 1, PortfolioAnalytics:::check_constraints, portfolio=group.portf)), is_true())
+})
+
+# add position limit constraint with long and short position limits
+pos2.portf <- add.constraint(init.portf, type="position_limit",
+ max_pos_long=3, max_pos_short=1)
+
+# generate portfolios to satisfy weight_sum, box, and position limit constraints
+rp5 <- random_portfolios(pos2.portf, 1000, eliminate=FALSE)
+test_that("we have created at least 1 feasible portfolio to satisfy weight_sum, box, and long/short position limit constraints", {
+ expect_that(any(apply(rp5, 1, PortfolioAnalytics:::check_constraints, portfolio=group.portf)), is_true())
+})
+
Modified: pkg/PortfolioAnalytics/man/random_portfolios.Rd
===================================================================
--- pkg/PortfolioAnalytics/man/random_portfolios.Rd 2014-07-25 19:40:32 UTC (rev 3482)
+++ pkg/PortfolioAnalytics/man/random_portfolios.Rd 2014-07-25 20:46:27 UTC (rev 3483)
@@ -31,7 +31,7 @@
\item{sample: }{The 'sample' method to generate random portfolios is based
on an idea pioneerd by Pat Burns. This is the most flexible method, but
also the slowest, and can generate portfolios to satisfy leverage, box,
- group, and position limit constraints.}
+ group, position limit, and leverage exposure constraints.}
\item{simplex: }{The 'simplex' method to generate random portfolios is
based on a paper by W. T. Shaw. The simplex method is useful to generate
random portfolios with the full investment constraint, where the sum of the
@@ -49,7 +49,8 @@
penalized in \code{constrained_objective}.}
}
-The constraint types checked are leverage, box, group, and position limit. Any
+The constraint types checked are leverage, box, group, position limit, and
+leverage exposure. Any
portfolio that does not satisfy all these constraints will be eliminated. This
function is particularly sensitive to \code{min_sum} and \code{max_sum}
leverage constraints. For the sample method, there should be some
More information about the Returnanalytics-commits
mailing list