Skip to content

Commit fe63b95

Browse files
aadleraadler
committed
1) Upgrade deprecated message to a warning. 2) Bring SLSQP testing in line with others.
1 parent bc1ed92 commit fe63b95

12 files changed

+74
-80
lines changed

‎R/auglag.R

+2-2
Original file line numberDiff line numberDiff line change
@@ -192,7 +192,7 @@ auglag <- function(x0, fn, gr = NULL, lower = NULL, upper = NULL, hin = NULL,
192192
# Inequality constraints
193193
if (!is.null(hin)) {
194194
if (deprecatedBehavior) {
195-
message("The old behavior for hin >= 0 has been deprecated. Please ",
195+
warning("The old behavior for hin >= 0 has been deprecated. Please ",
196196
"restate the inequality to be <=0. The ability to use the old ",
197197
"behavior will be removed in a future release.")
198198
.hin <- match.fun(hin)
@@ -203,7 +203,7 @@ auglag <- function(x0, fn, gr = NULL, lower = NULL, upper = NULL, hin = NULL,
203203
if (is.null(hinjac)) {
204204
hinjac <- function(x) nl.jacobian(x, hin)
205205
} else if (deprecatedBehavior) {
206-
message("The old behavior for hinjac >= 0 has been deprecated. Please ",
206+
warning("The old behavior for hinjac >= 0 has been deprecated. Please ",
207207
"restate the inequality to be <=0. The ability to use the old ",
208208
"behavior will be removed in a future release.")
209209
.hinjac <- match.fun(hinjac)

‎R/ccsaq.R

+2-2
Original file line numberDiff line numberDiff line change
@@ -129,7 +129,7 @@ ccsaq <- function(x0, fn, gr = NULL, lower = NULL, upper = NULL, hin = NULL,
129129

130130
if (!is.null(hin)) {
131131
if (deprecatedBehavior) {
132-
message("The old behavior for hin >= 0 has been deprecated. Please ",
132+
warning("The old behavior for hin >= 0 has been deprecated. Please ",
133133
"restate the inequality to be <=0. The ability to use the old ",
134134
"behavior will be removed in a future release.")
135135
.hin <- match.fun(hin)
@@ -138,7 +138,7 @@ ccsaq <- function(x0, fn, gr = NULL, lower = NULL, upper = NULL, hin = NULL,
138138
if (is.null(hinjac)) {
139139
hinjac <- function(x) nl.jacobian(x, hin)
140140
} else if (deprecatedBehavior) {
141-
message("The old behavior for hinjac >= 0 has been deprecated. Please ",
141+
warning("The old behavior for hinjac >= 0 has been deprecated. Please ",
142142
"restate the inequality to be <=0. The ability to use the old ",
143143
"behavior will be removed in a future release.")
144144
.hinjac <- match.fun(hinjac)

‎R/cobyla.R

+1-1
Original file line numberDiff line numberDiff line change
@@ -105,7 +105,7 @@ cobyla <- function(x0, fn, lower = NULL, upper = NULL, hin = NULL,
105105

106106
if (!is.null(hin)) {
107107
if (deprecatedBehavior) {
108-
message("The old behavior for hin >= 0 has been deprecated. Please ",
108+
warning("The old behavior for hin >= 0 has been deprecated. Please ",
109109
"restate the inequality to be <=0. The ability to use the old ",
110110
"behavior will be removed in a future release.")
111111
.hin <- match.fun(hin)

‎R/global.R

+1-1
Original file line numberDiff line numberDiff line change
@@ -197,7 +197,7 @@ isres <- function(x0, fn, lower, upper, hin = NULL, heq = NULL, maxeval = 10000,
197197

198198
if (!is.null(hin)) {
199199
if (deprecatedBehavior) {
200-
message("The old behavior for hin >= 0 has been deprecated. Please ",
200+
warning("The old behavior for hin >= 0 has been deprecated. Please ",
201201
"restate the inequality to be <=0. The ability to use the old ",
202202
"behavior will be removed in a future release.")
203203
.hin <- match.fun(hin)

‎R/mma.R

+2-2
Original file line numberDiff line numberDiff line change
@@ -138,7 +138,7 @@ mma <- function(x0, fn, gr = NULL, lower = NULL, upper = NULL, hin = NULL,
138138

139139
if (!is.null(hin)) {
140140
if (deprecatedBehavior) {
141-
message("The old behavior for hin >= 0 has been deprecated. Please ",
141+
warning("The old behavior for hin >= 0 has been deprecated. Please ",
142142
"restate the inequality to be <=0. The ability to use the old ",
143143
"behavior will be removed in a future release.")
144144
.hin <- match.fun(hin)
@@ -147,7 +147,7 @@ mma <- function(x0, fn, gr = NULL, lower = NULL, upper = NULL, hin = NULL,
147147
if (is.null(hinjac)) {
148148
hinjac <- function(x) nl.jacobian(x, hin)
149149
} else if (deprecatedBehavior) {
150-
message("The old behavior for hinjac >= 0 has been deprecated. Please ",
150+
warning("The old behavior for hinjac >= 0 has been deprecated. Please ",
151151
"restate the inequality to be <=0. The ability to use the old ",
152152
"behavior will be removed in a future release.")
153153
.hinjac <- match.fun(hinjac)

‎R/slsqp.R

+2-2
Original file line numberDiff line numberDiff line change
@@ -123,7 +123,7 @@ slsqp <- function(x0, fn, gr = NULL, lower = NULL, upper = NULL, hin = NULL,
123123

124124
if (!is.null(hin)) {
125125
if (deprecatedBehavior) {
126-
message("The old behavior for hin >= 0 has been deprecated. Please ",
126+
warning("The old behavior for hin >= 0 has been deprecated. Please ",
127127
"restate the inequality to be <=0. The ability to use the old ",
128128
"behavior will be removed in a future release.")
129129
.hin <- match.fun(hin)
@@ -133,7 +133,7 @@ slsqp <- function(x0, fn, gr = NULL, lower = NULL, upper = NULL, hin = NULL,
133133
if (is.null(hinjac)) {
134134
hinjac <- function(x) nl.jacobian(x, hin)
135135
} else if (deprecatedBehavior) {
136-
message("The old behavior for hinjac >= 0 has been deprecated. Please ",
136+
warning("The old behavior for hinjac >= 0 has been deprecated. Please ",
137137
"restate the inequality to be <=0. The ability to use the old ",
138138
"behavior will be removed in a future release.")
139139
.hinjac <- match.fun(hinjac)

‎inst/tinytest/test-wrapper-auglag.R

+4-4
Original file line numberDiff line numberDiff line change
@@ -20,8 +20,8 @@ depMess <- paste("The old behavior for hin >= 0 has been deprecated. Please",
2020
# Taken from example
2121
x0 <- c(1, 1)
2222
fn <- function(x) (x[1L] - 2) ^ 2 + (x[2L] - 1) ^ 2
23-
hin <- function(x) 0.25 * x[1L] ^ 2 + x[2L] ^ 2 - 1 # hin <= 0
24-
heq <- function(x) x[1L] - 2 * x[2L] + 1 # heq == 0
23+
hin <- function(x) 0.25 * x[1L] ^ 2 + x[2L] ^ 2 - 1 # hin <= 0
24+
heq <- function(x) x[1L] - 2 * x[2L] + 1 # heq = 0
2525
gr <- function(x) nl.grad(x, fn)
2626
hinjac <- function(x) nl.jacobian(x, hin)
2727
heqjac <- function(x) nl.jacobian(x, heq)
@@ -176,10 +176,10 @@ expect_identical(augTest$convergence, augControl$status)
176176
expect_identical(augTest$message, augControl$message)
177177

178178
# Test deprecated message
179-
expect_message(auglag(x0, fn, hin = hin2), depMess)
179+
expect_warning(auglag(x0, fn, hin = hin2), depMess)
180180

181181
# Test old behavior still works
182-
augTest <- suppressMessages(auglag(x0, fn, hin = hin2, hinjac = hinjac2,
182+
augTest <- suppressWarnings(auglag(x0, fn, hin = hin2, hinjac = hinjac2,
183183
heq = heq, localsolver = "MMA"))
184184

185185
expect_identical(augTest$par, augControl$solution)

‎inst/tinytest/test-wrapper-ccsaq.R

+2-2
Original file line numberDiff line numberDiff line change
@@ -127,10 +127,10 @@ expect_identical(ccsaqTest$convergence, ccsaqControlC$status)
127127
expect_identical(ccsaqTest$message, ccsaqControlC$message)
128128

129129
# Test deprecated behavior message
130-
expect_message(ccsaq(x0.hs100, fn.hs100, hin = hin2.hs100), depMess)
130+
expect_warning(ccsaq(x0.hs100, fn.hs100, hin = hin2.hs100), depMess)
131131

132132
# Test deprecated behavior
133-
ccsaqTest <- suppressMessages(ccsaq(x0.hs100, fn.hs100, gr = gr.hs100,
133+
ccsaqTest <- suppressWarnings(ccsaq(x0.hs100, fn.hs100, gr = gr.hs100,
134134
hin = hin2.hs100, hinjac = hinjac2.hs100,
135135
control = ctl))
136136

‎inst/tinytest/test-wrapper-cobyla.R

+2-2
Original file line numberDiff line numberDiff line change
@@ -69,10 +69,10 @@ expect_identical(cobylaTest$convergence, cobylaControl$status)
6969
expect_identical(cobylaTest$message, cobylaControl$message)
7070

7171
# Test deprecated message
72-
expect_message(cobyla(x0.hs100, fn.hs100, hin = hin2.hs100), depMess)
72+
expect_warning(cobyla(x0.hs100, fn.hs100, hin = hin2.hs100), depMess)
7373

7474
# Test deprecated behavior
75-
cobylaTest <- suppressMessages(cobyla(x0.hs100, fn.hs100, hin = hin2.hs100,
75+
cobylaTest <- suppressWarnings(cobyla(x0.hs100, fn.hs100, hin = hin2.hs100,
7676
control = ctl))
7777

7878
expect_identical(cobylaTest$par, cobylaControl$solution)

‎inst/tinytest/test-wrapper-global.R

+2-2
Original file line numberDiff line numberDiff line change
@@ -186,11 +186,11 @@ expect_identical(stogoTest$convergence, stogoControl$status)
186186
expect_identical(stogoTest$message, stogoControl$message)
187187

188188
# Test deprecated message
189-
expect_message(isres(x0, rbf, lower = lb, upper = ub, hin = hin2,
189+
expect_warning(isres(x0, rbf, lower = lb, upper = ub, hin = hin2,
190190
maxeval = 2e4L), depMess)
191191

192192
# Test deprecated behavior
193-
isresTest <- suppressMessages(isres(x0, rbf, lb, ub, hin = hin2,
193+
isresTest <- suppressWarnings(isres(x0, rbf, lb, ub, hin = hin2,
194194
maxeval = 2e4L))
195195

196196
expect_equal(isresTest$par, isresControl$solution, tolerance = 1e-4)

‎inst/tinytest/test-wrapper-mma.R

+2-2
Original file line numberDiff line numberDiff line change
@@ -104,10 +104,10 @@ expect_identical(mmaTest$convergence, mmaControl$status)
104104
expect_identical(mmaTest$message, mmaControl$message)
105105

106106
# Test deprecated message
107-
expect_message(mma(x0.hs100, fn.hs100, hin = hin.hs100), depMess)
107+
expect_warning(mma(x0.hs100, fn.hs100, hin = hin.hs100), depMess)
108108

109109
# Test deprecated behavior
110-
mmaTest <- suppressMessages(mma(x0.hs100, fn.hs100, gr = gr.hs100,
110+
mmaTest <- suppressWarnings(mma(x0.hs100, fn.hs100, gr = gr.hs100,
111111
hin = hin2.hs100, hinjac = hinjac2.hs100,
112112
control = ctl))
113113

‎inst/tinytest/test-wrapper-slsqp.R

+52-58
Original file line numberDiff line numberDiff line change
@@ -19,47 +19,44 @@ depMess <- paste("The old behavior for hin >= 0 has been deprecated. Please",
1919
"restate the inequality to be <=0. The ability to use the old",
2020
"behavior will be removed in a future release.")
2121

22-
## Functions for SLSQP
22+
# Taken from example
2323
x0.hs100 <- c(1, 2, 0, 4, 0, 1, 1)
24-
fn.hs100 <- function(x) {
25-
(x[1L] - 10) ^ 2 + 5 * (x[2L] - 12) ^ 2 + x[3L] ^ 4 + 3 * (x[4L] - 11) ^ 2 +
26-
10 * x[5L] ^ 6 + 7 * x[6L] ^ 2 + x[7L] ^ 4 - 4 * x[6L] * x[7L] -
27-
10 * x[6L] - 8 * x[7L]
24+
fn.hs100 <- function(x) {(x[1] - 10) ^ 2 + 5 * (x[2] - 12) ^ 2 + x[3] ^ 4 +
25+
3 * (x[4] - 11) ^ 2 + 10 * x[5] ^ 6 + 7 * x[6] ^ 2 +
26+
x[7] ^ 4 - 4 * x[6] * x[7] - 10 * x[6] - 8 * x[7]}
27+
28+
hin.hs100 <- function(x) {c(
29+
2 * x[1] ^ 2 + 3 * x[2] ^ 4 + x[3] + 4 * x[4] ^ 2 + 5 * x[5] - 127,
30+
7 * x[1] + 3 * x[2] + 10 * x[3] ^ 2 + x[4] - x[5] - 282,
31+
23 * x[1] + x[2] ^ 2 + 6 * x[6] ^ 2 - 8 * x[7] - 196,
32+
4 * x[1] ^ 2 + x[2] ^ 2 - 3 * x[1] * x[2] + 2 * x[3] ^ 2 + 5 * x[6] -
33+
11 * x[7])
2834
}
2935

3036
gr.hs100 <- function(x) {
31-
c(2 * x[1L] - 20,
32-
10 * x[2L] - 120,
33-
4 * x[3L] ^ 3,
34-
6 * x[4L] - 66,
35-
60 * x[5L] ^ 5,
36-
14 * x[6L] - 4 * x[7L] - 10,
37-
4 * x[7L] ^ 3 - 4 * x[6L] - 8)
38-
}
39-
40-
gr <- function(x) nl.grad(x, fn.hs100)
41-
42-
hin.hs100 <- function(x) {
43-
h <- double(4L)
44-
h[1L] <- 127 - 2 * x[1L] ^ 2 - 3 * x[2L] ^ 4 - x[3L] - 4 * x[4L] ^ 2 - 5 *
45-
x[5L]
46-
h[2L] <- 282 - 7 * x[1L] - 3 * x[2L] - 10 * x[3L] ^ 2 - x[4L] + x[5L]
47-
h[3L] <- 196 - 23 * x[1L] - x[2L] ^ 2 - 6 * x[6L] ^ 2 + 8 * x[7L]
48-
h[4L] <- -4 * x[1L] ^ 2 - x[2L] ^ 2 + 3 * x[1L] * x[2L] - 2 * x[3L] ^ 2 -
49-
5 * x[6L] + 11 * x[7L]
50-
return(h)
37+
c( 2 * x[1] - 20,
38+
10 * x[2] - 120,
39+
4 * x[3] ^ 3,
40+
6 * x[4] - 66,
41+
60 * x[5] ^ 5,
42+
14 * x[6] - 4 * x[7] - 10,
43+
4 * x[7] ^ 3 - 4 * x[6] - 8)
5144
}
5245

5346
hinjac.hs100 <- function(x) {
54-
matrix(c(4 * x[1L], 12 * x[2L] ^ 3, 1, 8 * x[4L], 5, 0, 0, 7, 3, 20 * x[3L],
55-
1, -1, 0, 0, 23, 2 * x[2L], 0, 0, 0, 12 * x[6L], -8,
56-
8 * x[1L] - 3 * x[2L], 2 * x[2L] - 3 * x[1L], 4 * x[3L], 0, 0, 5,
57-
-11), 4L, 7L, byrow = TRUE)
47+
matrix(c(4 * x[1], 12 * x[2] ^ 3, 1, 8 * x[4], 5, 0, 0,
48+
7, 3, 20 * x[3], 1, -1, 0, 0,
49+
23, 2 * x[2], 0, 0, 0, 12 * x[6], -8,
50+
8 * x[1] - 3 * x[2], 2 * x[2] - 3 * x[1], 4 * x[3], 0, 0, 5, -11),
51+
nrow = 4, byrow = TRUE)
5852
}
5953

60-
hin2.hs100 <- function(x) -hin.hs100(x) # Needed for nloptr call
61-
hinjac2.hs100 <- function(x) -hinjac.hs100(x) # Needed for nloptr call
62-
hinjac2b.hs100 <- function(x) nl.jacobian(x, hin2.hs100)# Needed for nloptr call
54+
hin2.hs100 <- function(x) -hin.hs100(x) # Needed to test old behavior
55+
hinjac2.hs100 <- function(x) -hinjac.hs100(x) # Needed to test old behavior
56+
57+
gr.hs100.computed <- function(x) nl.grad(x, fn.hs100)
58+
hinjac.hs100.computed <- function(x) nl.jacobian(x, hin.hs100)
59+
hinjac2.hs100.computed <- function(x) nl.jacobian(x, hin2.hs100)
6360

6461
# Test printout if nl.info passed. The word "Call:" should be in output if
6562
# passed and not if not passed.
@@ -69,13 +66,14 @@ expect_stdout(slsqp(x0.hs100, fn = fn.hs100, nl.info = TRUE),
6966
expect_silent(slsqp(x0.hs100, fn = fn.hs100))
7067

7168
# No passed gradient or Inequality Jacobians
72-
slsqpTest <- suppressMessages(slsqp(x0.hs100, fn.hs100, hin = hin.hs100))
69+
slsqpTest <- slsqp(x0.hs100, fn.hs100, hin = hin.hs100,
70+
deprecatedBehavior = FALSE)
7371

7472
slsqpControl <- nloptr(x0 = x0.hs100,
7573
eval_f = fn.hs100,
76-
eval_grad_f = gr,
77-
eval_g_ineq = hin2.hs100,
78-
eval_jac_g_ineq = hinjac2b.hs100,
74+
eval_grad_f = gr.hs100.computed,
75+
eval_g_ineq = hin.hs100,
76+
eval_jac_g_ineq = hinjac.hs100.computed,
7977
opts = list(algorithm = "NLOPT_LD_SLSQP",
8078
xtol_rel = 1e-6, maxeval = 1000L))
8179

@@ -86,15 +84,15 @@ expect_identical(slsqpTest$convergence, slsqpControl$status)
8684
expect_identical(slsqpTest$message, slsqpControl$message)
8785

8886
# Passed gradient or Inequality Jacobians
89-
slsqpTest <- suppressMessages(slsqp(x0.hs100, fn = fn.hs100, gr = gr.hs100,
90-
hin = hin.hs100, hinjac = hinjac.hs100))
87+
slsqpTest <- slsqp(x0.hs100, fn = fn.hs100, gr = gr.hs100, hin = hin.hs100,
88+
hinjac = hinjac.hs100, deprecatedBehavior = FALSE)
9189

9290
# Going to be reused below in new behavior test.
9391
slsqpControlhinjac <- nloptr(x0 = x0.hs100,
9492
eval_f = fn.hs100,
9593
eval_grad_f = gr.hs100,
96-
eval_g_ineq = hin2.hs100,
97-
eval_jac_g_ineq = hinjac2.hs100,
94+
eval_g_ineq = hin.hs100,
95+
eval_jac_g_ineq = hinjac.hs100,
9896
opts = list(algorithm = "NLOPT_LD_SLSQP",
9997
xtol_rel = 1e-6, maxeval = 1000L))
10098

@@ -105,13 +103,14 @@ expect_identical(slsqpTest$convergence, slsqpControlhinjac$status)
105103
expect_identical(slsqpTest$message, slsqpControlhinjac$message)
106104

107105
# Not passing equality Jacobian
108-
slsqpTest <- suppressMessages(slsqp(x0.hs100, fn = fn.hs100, heq = hin.hs100))
106+
slsqpTest <- slsqp(x0.hs100, fn = fn.hs100, heq = hin.hs100,
107+
deprecatedBehavior = FALSE)
109108

110109
slsqpControl <- nloptr(x0 = x0.hs100,
111110
eval_f = fn.hs100,
112-
eval_grad_f = gr.hs100,
113-
eval_g_eq = hin2.hs100,
114-
eval_jac_g_eq = hinjac2b.hs100,
111+
eval_grad_f = gr.hs100.computed,
112+
eval_g_eq = hin.hs100,
113+
eval_jac_g_eq = hinjac.hs100.computed,
115114
opts = list(algorithm = "NLOPT_LD_SLSQP",
116115
xtol_rel = 1e-6, maxeval = 1000L))
117116

@@ -122,14 +121,14 @@ expect_identical(slsqpTest$convergence, slsqpControl$status)
122121
expect_identical(slsqpTest$message, slsqpControl$message)
123122

124123
# Passing equality Jacobian
125-
slsqpTest <- suppressMessages(slsqp(x0.hs100, fn = fn.hs100, heq = hin.hs100,
126-
heqjac = hinjac.hs100))
124+
slsqpTest <- slsqp(x0.hs100, fn = fn.hs100, gr = gr.hs100, heq = hin.hs100,
125+
heqjac = hinjac.hs100, deprecatedBehavior = FALSE)
127126

128127
slsqpControl <- nloptr(x0 = x0.hs100,
129128
eval_f = fn.hs100,
130129
eval_grad_f = gr.hs100,
131-
eval_g_eq = hin2.hs100,
132-
eval_jac_g_eq = hinjac2.hs100,
130+
eval_g_eq = hin.hs100,
131+
eval_jac_g_eq = hinjac.hs100,
133132
opts = list(algorithm = "NLOPT_LD_SLSQP",
134133
xtol_rel = 1e-6, maxeval = 1000L))
135134

@@ -139,17 +138,12 @@ expect_identical(slsqpTest$iter, slsqpControl$iterations)
139138
expect_identical(slsqpTest$convergence, slsqpControl$status)
140139
expect_identical(slsqpTest$message, slsqpControl$message)
141140

142-
# Test deprecated behavor message; remove when old behavior made defucnt.
143-
expect_message(slsqp(x0.hs100, fn = fn.hs100, hin = hin.hs100), depMess)
141+
# Test deprecated message
142+
expect_warning(slsqp(x0.hs100, fn = fn.hs100, hin = hin2.hs100), depMess)
144143

145-
# Test new behavior. Adjust tests above when old behavior made defucnt.
146-
hinx <- function(x) -hin.hs100(x)
147-
hinjacx <- function(x) -hinjac.hs100(x)
148-
expect_silent(slsqp(x0.hs100, fn = fn.hs100, hin = hinx, hinjac = hinjacx,
149-
deprecatedBehavior = FALSE))
150-
151-
slsqpTest <- slsqp(x0.hs100, fn = fn.hs100, hin = hinx, hinjac = hinjacx,
152-
deprecatedBehavior = FALSE)
144+
# Test deprecated behavior Adjust tests above when old behavior made defunct.
145+
slsqpTest <- suppressWarnings(slsqp(x0.hs100, fn = fn.hs100, gr = gr.hs100,
146+
hin = hin2.hs100, hinjac = hinjac2.hs100))
153147

154148
expect_identical(slsqpTest$par, slsqpControlhinjac$solution)
155149
expect_identical(slsqpTest$value, slsqpControlhinjac$objective)

0 commit comments

Comments
 (0)