CoCalc -- test_glpk

GitHub Repository: braverock/portfolioanalytics
Path: blob/master/inst/tests/test_glpk_minES.R
¹⁴³³ views
1
library(PortfolioAnalytics)
2
library(ROI)
3
library(ROI.plugin.glpk)
4
library(Rglpk)
5
library(testthat)
6

7
# Test that ROI.plugin.glpk solutions equal Rglpk solutions
8
context("Minimum ES Portfolios: PortfolioAnalytics with ROI.plugin.glpk and Rglpk")
9

10

11
##### Data #####
12
data(edhec)
13
R <- edhec[, 1:5]
14
funds <- colnames(R)
15

16
##### Parameters #####
17
m <- ncol(R)
18
n <- nrow(R)
19
alpha <- 0.05
20

21
portf <- portfolio.spec(funds)
22
portf <- add.constraint(portf, type="full_investment")
23
portf <- add.constraint(portf, type="box", min=-Inf, max=Inf)
24
portf <- add.objective(portf, type="risk", name="ES", arguments=list(p=1-alpha))
25

26
# Linear part of objective function
27
objL <- c(rep(0, m), rep(1 / (alpha * n), n), 1)
28

29
# Constraints matrix
30
Amat <- cbind(rbind(1, zoo::coredata(R)), 
31
              rbind(0, cbind(diag(n), 1)))
32

33
# right hand side of constraints
34
rhs <- c(1, rep(0, n))
35

36
# direction of inequality of constraints
37
dir <- c("==", rep(">=", n))
38

39
##### Long Only #####
40
# Upper and lower bounds (i.e. box constraints)
41
min_box <- rep(0, m)
42
max_box <- rep(1, m)
43

44
lb <- c(min_box, rep(0, n), -1)
45
ub <- c(max_box, rep(Inf, n), 1)
46

47
bnds <- list(lower = list(ind = seq.int(1L, m+n+1), val = lb),
48
             upper = list(ind = seq.int(1L, m+n+1), val = ub))
49

50
# Update box constraints in portfolio
51
portf$constraints[[2]]$min <- min_box
52
portf$constraints[[2]]$max <- max_box
53

54
# Solve optimization with Rglpk
55
opt.glpk <- Rglpk_solve_LP(obj=objL, mat=Amat, dir=dir, rhs=rhs, bounds=bnds)
56

57
# Solve optimization with PortfolioAnalytics
58
opt.pa <- optimize.portfolio(R, portf, optimize_method="glpk")
59
weights <- as.numeric(extractWeights(opt.pa))
60

61
test_that("Long Only: PortfolioAnalytics and Rglpk solution weights are equal", {
62
  expect_that(weights, equals(opt.glpk$solution[1:m]))
63
})
64

65
test_that("Long Only: PortfolioAnalytics bounds are respected", {
66
  expect_that(all(weights >= min_box) & all(weights <= max_box), is_true())
67
})
68

69
test_that("Long Only: Rglpk bounds are respected", {
70
  expect_that(all(opt.glpk$solution[1:m] >= min_box) & all(opt.glpk$solution[1:m] <= max_box), is_true())
71
})
72

73
test_that("Long Only: PortfolioAnalytics and Rglpk solution objective values are equal", {
74
  expect_that(opt.pa$out, equals(opt.glpk$optimum))
75
})
76

77
##### Box #####
78
# Upper and lower bounds (i.e. box constraints)
79
min_box <- rep(0.05, m)
80
max_box <- rep(0.55, m)
81

82
lb <- c(min_box, rep(0, n), -1)
83
ub <- c(max_box, rep(Inf, n), 1)
84

85
bnds <- list(lower = list(ind = seq.int(1L, m+n+1), val = lb),
86
             upper = list(ind = seq.int(1L, m+n+1), val = ub))
87

88
# Update box constraints in portfolio
89
portf$constraints[[2]]$min <- min_box
90
portf$constraints[[2]]$max <- max_box
91

92
# Solve optimization with Rglpk
93
opt.glpk <- Rglpk_solve_LP(obj=objL, mat=Amat, dir=dir, rhs=rhs, bounds=bnds)
94

95
# Solve optimization with PortfolioAnalytics
96
opt.pa <- optimize.portfolio(R, portf, optimize_method="glpk")
97
weights <- as.numeric(extractWeights(opt.pa))
98

99
test_that("Box: PortfolioAnalytics and Rglpk solution weights are equal", {
100
  expect_that(weights, equals(opt.glpk$solution[1:m]))
101
})
102

103
test_that("Box: PortfolioAnalytics bounds are respected", {
104
  expect_that(all(weights >= min_box) & all(weights <= max_box), is_true())
105
})
106

107
test_that("Box: Rglpk bounds are respected", {
108
  expect_that(all(opt.glpk$solution[1:m] >= min_box) & all(opt.glpk$solution[1:m] <= max_box), is_true())
109
})
110

111
test_that("Box: PortfolioAnalytics and Rglpk solution objective values are equal", {
112
  expect_that(opt.pa$out, equals(opt.glpk$optimum))
113
})
114

115
##### Box with Shorting #####
116
# Upper and lower bounds (i.e. box constraints)
117
min_box <- rep(-0.05, m)
118
max_box <- rep(0.55, m)
119

120
lb <- c(min_box, rep(0, n), -1)
121
ub <- c(max_box, rep(Inf, n), 1)
122

123
bnds <- list(lower = list(ind = seq.int(1L, m+n+1), val = lb),
124
             upper = list(ind = seq.int(1L, m+n+1), val = ub))
125

126
# Update box constraints in portfolio
127
portf$constraints[[2]]$min <- min_box
128
portf$constraints[[2]]$max <- max_box
129

130
# Solve optimization with Rglpk
131
opt.glpk <- Rglpk_solve_LP(obj=objL, mat=Amat, dir=dir, rhs=rhs, bounds=bnds)
132

133
# Solve optimization with PortfolioAnalytics
134
opt.pa <- optimize.portfolio(R, portf, optimize_method="glpk")
135
weights <- as.numeric(extractWeights(opt.pa))
136

137
test_that("Box with Shorting: PortfolioAnalytics and Rglpk solution weights are equal", {
138
  expect_that(weights, equals(opt.glpk$solution[1:m]))
139
})
140

141
test_that("Box with Shorting: PortfolioAnalytics bounds are respected", {
142
  expect_that(all(weights >= min_box) & all(weights <= max_box), is_true())
143
})
144

145
test_that("Box with Shorting: Rglpk bounds are respected", {
146
  expect_that(all(opt.glpk$solution[1:m] >= min_box) & all(opt.glpk$solution[1:m] <= max_box), is_true())
147
})
148

149
test_that("Box with Shorting: PortfolioAnalytics and Rglpk solution objective values are equal", {
150
  expect_that(opt.pa$out, equals(opt.glpk$optimum))
151
})
152

153

154

155
Product

Resources

Company
