Book a Demo!
CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutPoliciesSign UpSign In
braverock
GitHub Repository: braverock/portfolioanalytics
 Path: blob/master/inst/tests/test_demo_group_constraints.R
1433 views
1


2
##### Load packages #####

3
require(testthat)

4
require(PortfolioAnalytics)

5


6
##### Source Demo Script #####

7
source(system.file("demo/demo_group_constraints.R", package="PortfolioAnalytics"))

8


9
##### Test the constraints #####

10
context("demo_group_constraints")

11


12
group_constr <- init.portf$constraints[[3]]

13


14
test_that("init.portf contains groups as a constraint", 

15
          { expect_that(inherits(group_constr, "group_constraint"), is_true()) })

16


17
test_that("group constraint for groupA  is c(1, 3, 5)", 

18
          { expect_equal(group_constr$groups$groupA, c(1, 3, 5)) })

19


20
test_that("group constraint for groupB  is c(2, 4)", 

21
          { expect_equal(group_constr$groups$groupB, c(2, 4)) })

22


23
test_that("group constraint cLO  is c(0.05, 0.15)", 

24
          { expect_equal(group_constr$cLO, c(0.05, 0.15)) })

25


26
test_that("group constraint cUP  is c(0.7, 0.5)", 

27
          { expect_equal(group_constr$cUP, c(0.7, 0.5)) })

28


29
cLO <- group_constr$cLO

30
cUP <- group_constr$cUP

31


32
##### ROI Optimization #####

33
context("demo_group_constraints optimization")

34


35
test_that("minStdDev.ROI weights equal c(4.593895e-03, 2.540430e-01, -1.387779e-17, 4.595703e-02, 6.954061e-01)", 

36
          { expect_equal(as.numeric(extractWeights(minStdDev.ROI)), c(4.593895e-03, 2.540430e-01, -1.387779e-17, 4.595703e-02, 6.954061e-01),

37
                         tolerance=1e-6) })

38


39
test_that("minStdDev.ROI objective measure StdDev = 0.01042408", 

40
          { expect_equal(as.numeric(extractObjectiveMeasures(minStdDev.ROI)$StdDev), 0.01042408,

41
                         tolerance=1e-6) })

42


43
weights.ROI <- extractWeights(minStdDev.ROI)

44


45
test_that("minStdDev.ROI group weights are calculated correctly", 

46
          { expect_equal(as.numeric(extractGroups(minStdDev.ROI)$group_weights), 

47
                         c(sum(weights.ROI[c(1, 3, 5)]), sum(weights.ROI[c(2, 4)]))) })

48


49
test_that("minStdDev.ROI group constraint cLO is not violated", 

50
          { expect_that(all(extractGroups(minStdDev.ROI)$group_weights >= cLO), is_true()) })

51


52
test_that("minStdDev.ROI group constraint cUP is not violated", 

53
          { expect_that(all(extractGroups(minStdDev.ROI)$group_weights <= cUP), is_true()) })

54


55


56
##### RP Optimization #####

57
context("minStdDev.RP")

58


59
test_that("minStdDev.RP weights is a numeric vector", 

60
          { expect_that(is.numeric(extractWeights(minStdDev.RP)), is_true()) })

61


62
test_that("minStdDev.RP objective measure StdDev is numeric", 

63
          { expect_that(is.numeric(extractObjectiveMeasures(minStdDev.RP)$StdDev), is_true()) })

64


65
weights.RP <- extractWeights(minStdDev.RP)

66


67
test_that("minStdDev.RP group weights are calculated correctly", 

68
          { expect_equal(as.numeric(extractGroups(minStdDev.RP)$group_weights), 

69
                         c(sum(weights.RP[c(1, 3, 5)]), sum(weights.RP[c(2, 4)]))) })

70


71
test_that("minStdDev.RP group constraint cLO is not violated", 

72
          { expect_that(all(extractGroups(minStdDev.RP)$group_weights >= cLO), is_true()) })

73


74
test_that("minStdDev.RP group constraint cUP is not violated", 

75
          { expect_that(all(extractGroups(minStdDev.RP)$group_weights <= cUP), is_true()) })

76


77


78
##### DE Optimization #####

79
context("minStdDev.DE")

80


81
test_that("minStdDev.DE weights is a numeric vector", 

82
          { expect_that(is.numeric(extractWeights(minStdDev.DE)), is_true()) })

83


84
test_that("minStdDev.DE objective measure StdDev is numeric", 

85
          { expect_that(is.numeric(extractObjectiveMeasures(minStdDev.ROI)$StdDev), is_true()) })

86


87
weights.DE <- extractWeights(minStdDev.DE)

88


89
test_that("minStdDev.DE group weights are calculated correctly", 

90
          { expect_equal(as.numeric(extractGroups(minStdDev.DE)$group_weights), 

91
                         c(sum(weights.DE[c(1, 3, 5)]), sum(weights.DE[c(2, 4)]))) })

92


93
test_that("minStdDev.DE group constraint cLO is not violated", 

94
          { expect_that(all(extractGroups(minStdDev.DE)$group_weights >= cLO), is_true()) })

95


96
test_that("minStdDev.DE group constraint cUP is not violated", 

97
          { expect_that(all(extractGroups(minStdDev.DE)$group_weights <= cUP), is_true()) })

98


99