Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Patch: Fix for test-wrapper-global #166

Merged
merged 10 commits into from
Jun 27, 2024
Merged

Patch: Fix for test-wrapper-global #166

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
10 commits
Select commit Hold shift + click to select a range
ed11214
Correct no passed hin/heq message test.
aadler Jun 25, 2024
c24afc3
1) More reasonable equality constraint in the unit test to prevent no…
aadler Jun 25, 2024
61a0365
Correct the tests when passing hin.
aadler Jun 25, 2024
c4aa64b
Correct deprecated test.
aadler Jun 25, 2024
6e63963
Move entirety of hartmann function down to CRS2lM where it is actuall…
aadler Jun 25, 2024
77dd2a5
1) Change all tolerances to 1e-3
aadler Jun 25, 2024
02de38b
No longer used.
aadler Jun 25, 2024
cbae357
Bump to pre-release version and add note to NEWS.md
aadler Jun 25, 2024
c816922
Make lintr happy.
aadler Jun 25, 2024
26519d3
Merge branch 'master' into Hotfix-global-wrapper
astamm Jun 27, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
5 changes: 4 additions & 1 deletion NEWS.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,7 @@
# nloptr (development version)
# nloptr 2.1.1.9000
This is a patch (pre) release. It includes

* Correcting some of the unit tests in `test-global-wrapper`.

# nloptr 2.1.1

Expand Down
106 changes: 57 additions & 49 deletions inst/tinytest/test-wrapper-global.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,10 +9,15 @@
# algorithms have issues, this test suite may not be completed.
#
# Changelog:
# 2023-08-23: Change _output to _stdout
# 2023-08-23: Change _output to _stdout. (Avraham Adler)
# 2023-06-24: Reduce tolerance of ISRES tests to pass CRAN. (Aymeric Stamm)
# 2023-06-25: Use analytic gradients and Jacobians for hin/heq. Correct some
# of the ISRES tests which were pulling on Stogo results.
# (Avraham Adler)
#

library(nloptr)
tol <- 1e-3 # Stochastic algorithms require a weaker tolerance

depMess <- paste("The old behavior for hin >= 0 has been deprecated. Please",
"restate the inequality to be <=0. The ability to use the old",
Expand All @@ -23,38 +28,14 @@ rbf <- function(x) {(1 - x[1]) ^ 2 + 100 * (x[2] - x[1] ^ 2) ^ 2}
## Analytic gradient
gr <- function(x) {c(-2 * (1 - x[1]) - 400 * x[1] * (x[2] - x[1] ^ 2),
200 * (x[2] - x[1] ^ 2))}
gr.diff <- function(x) nl.grad(x, rbf)

hin <- function(x) 0.25 * x[1L] ^ 2 + x[2L] ^ 2 - 1 # hin <= 0
heq <- function(x) x[1L] - 2 * x[2L] + 1 # heq = 0
hinjac <- function(x) nl.jacobian(x, hin)
heqjac <- function(x) nl.jacobian(x, heq)
heq <- function(x) x[1L] + x[2L] - 1 # heq = 0
hinjac <- function(x) c(0.5 * x[1L], 2 * x[2L])
heqjac <- function(x) c(1, 1)
hin2 <- function(x) -hin(x) # Needed to test old behavior
hinjac2 <- function(x) nl.jacobian(x, hin2) # Needed to test old behavior

# Take these outside the function since they are unchanging; just pass them!
a <- c(1.0, 1.2, 3.0, 3.2)
A <- matrix(c(10, 0.05, 3, 17,
3, 10, 3.5, 8,
17, 17, 1.7, 0.05,
3.5, 0.1, 10, 10,
1.7, 8, 17, 0.1,
8, 14, 8, 14), nrow = 4)

B <- matrix(c(.1312, .2329, .2348, .4047,
.1696, .4135, .1451, .8828,
.5569, .8307, .3522, .8732,
.0124, .3736, .2883, .5743,
.8283, .1004, .3047, .1091,
.5886, .9991, .6650, .0381), nrow = 4)

hartmann6 <- function(x, a, A, B) {
fun <- 0
for (i in 1:4) {
fun <- fun - a[i] * exp(-sum(A[i, ] * (x - B[i, ]) ^ 2))
}

fun
}
hinjac2 <- function(x) -hinjac(x)

x0 <- c(-1.2, 1)
lb <- c(-3, -3)
Expand All @@ -73,7 +54,7 @@ stogoTest <- stogo(x0, rbf, lower = lb, upper = ub)

stogoControl <- nloptr(x0 = x0,
eval_f = rbf,
eval_grad_f = function(x) nl.grad(x, rbf),
eval_grad_f = gr.diff,
lb = lb,
ub = ub,
opts = list(algorithm = "NLOPT_GD_STOGO",
Expand Down Expand Up @@ -140,27 +121,29 @@ isresControl <- nloptr(x0 = x0,
maxeval = 2e4L, xtol_rel = 1e-6,
population = 60))

expect_equal(isresTest$par, isresControl$solution, tolerance = 1e-4)
expect_equal(isresTest$value, isresControl$objective, tolerance = 1e-4)
expect_identical(stogoTest$convergence, stogoControl$status)
expect_identical(stogoTest$message, stogoControl$message)
expect_equal(isresTest$par, isresControl$solution, tolerance = tol)
expect_equal(isresTest$value, isresControl$objective, tolerance = tol)
expect_identical(isresTest$convergence, isresControl$status)
expect_identical(isresTest$message, isresControl$message)

# Passing heq
# Need a ridiculously loose tolerance on ISRES now.
# (AA: 2023-02-06)
isresTest <- isres(x0, rbf, lb, ub, heq = heq, maxeval = 2e4L)
# Cannot check for value equivalence since the stochastic nature of the problem
# creates different solutions to this "improper" test even using the same seed
# and calls! So dropping maxeval to 1e4 for speed.
# (AA: 2024-06-25)
isresTest <- isres(x0, rbf, lb, ub, heq = heq, maxeval = 1e4L)

isresControl <- nloptr(x0 = x0,
eval_f = rbf,
eval_g_eq = heq,
lb = lb,
ub = ub,
opts = list(algorithm = "NLOPT_GN_ISRES",
maxeval = 2e4L, xtol_rel = 1e-6,
maxeval = 1e4L, xtol_rel = 1e-6,
population = 60))

expect_identical(stogoTest$convergence, stogoControl$status)
expect_identical(stogoTest$message, stogoControl$message)
expect_identical(isresTest$convergence, isresControl$status)
expect_identical(isresTest$message, isresControl$message)

# Passing hin
isresControl <- nloptr(x0 = x0,
Expand All @@ -178,10 +161,10 @@ expect_silent(isres(x0, rbf, lb, ub, hin = hin, maxeval = 2e4L,
isresTest <- isres(x0, rbf, lb, ub, hin = hin, maxeval = 2e4L,
deprecatedBehavior = FALSE)

expect_equal(isresTest$par, isresControl$solution, tolerance = 1e-4)
expect_equal(isresTest$value, isresControl$objective, tolerance = 1e-4)
expect_identical(stogoTest$convergence, stogoControl$status)
expect_identical(stogoTest$message, stogoControl$message)
expect_equal(isresTest$par, isresControl$solution, tolerance = tol)
expect_equal(isresTest$value, isresControl$objective, tolerance = tol)
expect_identical(isresTest$convergence, isresControl$status)
expect_identical(isresTest$message, isresControl$message)

# Test deprecated message
expect_warning(isres(x0, rbf, lower = lb, upper = ub, hin = hin2,
Expand All @@ -191,12 +174,37 @@ expect_warning(isres(x0, rbf, lower = lb, upper = ub, hin = hin2,
isresTest <- suppressWarnings(isres(x0, rbf, lb, ub, hin = hin2,
maxeval = 2e4L))

expect_equal(isresTest$par, isresControl$solution, tolerance = 1e-4)
expect_equal(isresTest$value, isresControl$objective, tolerance = 1e-3)
expect_identical(stogoTest$convergence, stogoControl$status)
expect_identical(stogoTest$message, stogoControl$message)
expect_equal(isresTest$par, isresControl$solution, tolerance = tol)
expect_equal(isresTest$value, isresControl$objective, tolerance = tol)
expect_identical(isresTest$convergence, isresControl$status)
expect_identical(isresTest$message, isresControl$message)

## CRS2LM
# Take these outside the function since they are unchanging; just pass them!
a <- c(1.0, 1.2, 3.0, 3.2)
A <- matrix(c(10, 0.05, 3, 17,
3, 10, 3.5, 8,
17, 17, 1.7, 0.05,
3.5, 0.1, 10, 10,
1.7, 8, 17, 0.1,
8, 14, 8, 14), nrow = 4)

B <- matrix(c(0.1312, 0.2329, 0.2348, 0.4047,
0.1696, 0.4135, 0.1451, 0.8828,
0.5569, 0.8307, 0.3522, 0.8732,
0.0124, 0.3736, 0.2883, 0.5743,
0.8283, 0.1004, 0.3047, 0.1091,
0.5886, 0.9991, 0.6650, 0.0381), nrow = 4)

hartmann6 <- function(x, a, A, B) {
fun <- 0
for (i in 1:4) {
fun <- fun - a[i] * exp(-sum(A[i, ] * (x - B[i, ]) ^ 2))
}

fun
}

# Test printout if nl.info passed. The word "Call:" should be in output if
# passed and not if not passed.
x0 <- lb <- rep(0, 6L)
Expand Down
Loading