[Returnanalytics-commits] r3281 - pkg/PortfolioAnalytics/inst/tests

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Mon Dec 16 00:14:09 CET 2013


Author: rossbennett34
Date: 2013-12-16 00:14:09 +0100 (Mon, 16 Dec 2013)
New Revision: 3281

Added:
   pkg/PortfolioAnalytics/inst/tests/test_all_constraints.R
   pkg/PortfolioAnalytics/inst/tests/test_objectives.R
Log:
Adding tests for constraints and objectives

Added: pkg/PortfolioAnalytics/inst/tests/test_all_constraints.R
===================================================================
--- pkg/PortfolioAnalytics/inst/tests/test_all_constraints.R	                        (rev 0)
+++ pkg/PortfolioAnalytics/inst/tests/test_all_constraints.R	2013-12-15 23:14:09 UTC (rev 3281)
@@ -0,0 +1,97 @@
+
+require(testthat)
+require(PortfolioAnalytics)
+
+context("constraints")
+
+N <- 4
+init.portf <- portfolio.spec(assets=N)
+# Weight_sum constraint
+init.portf <- add.constraint(portfolio=init.portf, 
+                             type="weight_sum", 
+                             min_sum=0.99, 
+                             max_sum=1.01)
+# Box constraint
+init.portf <- add.constraint(portfolio=init.portf, 
+                             type="box", 
+                             min=0, 
+                             max=1)
+# Group constraint
+init.portf <- add.constraint(portfolio=init.portf,
+                             type="group",
+                             groups=list(c(1, 3), c(2, 4)),
+                             group_min=c(0.15, 0.25),
+                             group_max=c(0.65, 0.55))
+# Turnover constraint
+init.portf <- add.constraint(portfolio=init.portf, 
+                             type="turnover", 
+                             turnover_target=0.6)
+# Diversification constraint
+init.portf <- add.constraint(portfolio=init.portf, 
+                             type="diversification", 
+                             div_target=0.55)
+# Position limit constraint
+init.portf <- add.constraint(portfolio=init.portf, 
+                             type="position_limit", 
+                             max_pos=3, 
+                             max_pos_long=2,
+                             max_pos_short=1)
+# Return constraint
+init.portf <- add.constraint(portfolio=init.portf, 
+                             type="return", 
+                             return_target=0.007)
+# Factor exposure constraint
+init.portf <- add.constraint(portfolio=init.portf, 
+                             type="factor_exposure",
+                             B=rep(1, N),
+                             lower=0.9, 
+                             upper=1.1)
+
+tmp_constraints <- PortfolioAnalytics:::get_constraints(init.portf)
+
+test_that("weight_sum constraint is consistent", {
+  expect_that(tmp_constraints$min_sum, equals(0.99))
+  expect_that(tmp_constraints$max_sum, equals(1.01))
+})
+
+test_that("box constraint is consistent", {
+  expect_that(as.numeric(tmp_constraints$min), equals(rep(0, N)))
+  expect_that(as.numeric(tmp_constraints$max), equals(rep(1, N)))
+})
+
+test_that("group constraint is consistent", {
+  expect_that(is.list(tmp_constraints$groups), is_true())
+  expect_that(tmp_constraints$groups[[1]], equals(c(1, 3)))
+  expect_that(tmp_constraints$groups[[2]], equals(c(2, 4)))
+  expect_that(tmp_constraints$group_labels, equals(c("group1", "group2")))
+  expect_that(tmp_constraints$cLO, equals(c(0.15, 0.25)))
+  expect_that(tmp_constraints$cUP, equals(c(0.65, 0.55)))
+})
+
+test_that("turnover constraint is consistent", {
+  expect_that(tmp_constraints$turnover_target, equals(0.6))
+})
+
+test_that("diversification constraint is consistent", {
+  expect_that(tmp_constraints$div_target, equals(0.55))
+})
+
+test_that("position limit constraint is consistent", {
+  expect_that(tmp_constraints$max_pos, equals(3))
+  expect_that(tmp_constraints$max_pos_long, equals(2))
+  expect_that(tmp_constraints$max_pos_short, equals(1))
+})
+
+test_that("return constraint is consistent", {
+  expect_that(tmp_constraints$return_target, equals(0.007))
+})
+
+B <- matrix(1, ncol=1, nrow=N)
+rownames(B) <- paste("Asset", 1:N, sep=".")
+colnames(B) <- "factor1"
+
+test_that("factor exposure constraint is consistent", {
+  expect_that(tmp_constraints$B, equals(B))
+  expect_that(tmp_constraints$lower, equals(0.9))
+  expect_that(tmp_constraints$upper, equals(1.1))
+})

Added: pkg/PortfolioAnalytics/inst/tests/test_objectives.R
===================================================================
--- pkg/PortfolioAnalytics/inst/tests/test_objectives.R	                        (rev 0)
+++ pkg/PortfolioAnalytics/inst/tests/test_objectives.R	2013-12-15 23:14:09 UTC (rev 3281)
@@ -0,0 +1,40 @@
+
+require(testthat)
+require(PortfolioAnalytics)
+
+context("objectives")
+
+N <- 4
+init.portf <- portfolio.spec(assets=N)
+init.portf <- add.objective(portfolio=init.portf, type="return", name="mean", target=0.005)
+init.portf <- add.objective(portfolio=init.portf, type="risk", name="ES", arguments=list(p=0.95))
+init.portf <- add.objective(portfolio=init.portf, type="risk_budget", name="ES")
+
+test_that("return objective is consistent", {
+  expect_that(init.portf$objectives[[1]]$name, equals("mean"))
+  expect_that(init.portf$objectives[[1]]$target, equals(0.005))
+  expect_that(init.portf$objectives[[1]]$enabled, is_true())
+  expect_that(init.portf$objectives[[1]]$multiplier, equals(-1))
+  expect_that(class(init.portf$objectives[[1]]), equals(c("return_objective", "objective")))
+})
+
+test_that("risk objective is consistent", {
+  expect_that(init.portf$objectives[[2]]$name, equals("ES"))
+  expect_that(is.null(init.portf$objectives[[2]]$target), is_true())
+  expect_that(init.portf$objectives[[2]]$arguments$portfolio_method, equals("single"))
+  expect_that(init.portf$objectives[[2]]$arguments$p, equals(0.95))
+  expect_that(init.portf$objectives[[2]]$enabled, is_true())
+  expect_that(init.portf$objectives[[2]]$multiplier, equals(1))
+  expect_that(class(init.portf$objectives[[2]]), equals(c("portfolio_risk_objective", "objective")))
+})
+
+test_that("risk objective is consistent", {
+  expect_that(init.portf$objectives[[3]]$name, equals("ES"))
+  expect_that(is.null(init.portf$objectives[[3]]$target), is_true())
+  expect_that(init.portf$objectives[[3]]$arguments$portfolio_method, equals("component"))
+  expect_that(init.portf$objectives[[3]]$enabled, is_true())
+  expect_that(init.portf$objectives[[3]]$multiplier, equals(1))
+  expect_that(init.portf$objectives[[3]]$min_concentration, is_true())
+  expect_that(init.portf$objectives[[3]]$min_difference, is_false())
+  expect_that(class(init.portf$objectives[[3]]), equals(c("risk_budget_objective", "objective")))
+})



More information about the Returnanalytics-commits mailing list