1) Upgrade deprecated message to a warning. 2) Bring SLSQP testing in…

… line with others.

R/auglag.R

@@ -192,7 +192,7 @@ auglag <- function(x0, fn, gr = NULL, lower = NULL, upper = NULL, hin = NULL,
   # Inequality constraints
   if (!is.null(hin)) {
     if (deprecatedBehavior) {
-      message("The old behavior for hin >= 0 has been deprecated. Please ",
+      warning("The old behavior for hin >= 0 has been deprecated. Please ",
               "restate the inequality to be <=0. The ability to use the old ",
               "behavior will be removed in a future release.")
       .hin <- match.fun(hin)
@@ -203,7 +203,7 @@ auglag <- function(x0, fn, gr = NULL, lower = NULL, upper = NULL, hin = NULL,
     if (is.null(hinjac)) {
       hinjac <- function(x) nl.jacobian(x, hin)
     } else if (deprecatedBehavior) {
-      message("The old behavior for hinjac >= 0 has been deprecated. Please ",
+      warning("The old behavior for hinjac >= 0 has been deprecated. Please ",
               "restate the inequality to be <=0. The ability to use the old ",
               "behavior will be removed in a future release.")
       .hinjac <- match.fun(hinjac)

R/ccsaq.R

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

R/cobyla.R

@@ -105,7 +105,7 @@ cobyla <- function(x0, fn, lower = NULL, upper = NULL, hin = NULL,
 
   if (!is.null(hin)) {
     if (deprecatedBehavior) {
-      message("The old behavior for hin >= 0 has been deprecated. Please ",
+      warning("The old behavior for hin >= 0 has been deprecated. Please ",
               "restate the inequality to be <=0. The ability to use the old ",
               "behavior will be removed in a future release.")
       .hin <- match.fun(hin)

R/global.R

@@ -197,7 +197,7 @@ isres <- function(x0, fn, lower, upper, hin = NULL, heq = NULL, maxeval = 10000,
 
   if (!is.null(hin)) {
     if (deprecatedBehavior) {
-      message("The old behavior for hin >= 0 has been deprecated. Please ",
+      warning("The old behavior for hin >= 0 has been deprecated. Please ",
               "restate the inequality to be <=0. The ability to use the old ",
               "behavior will be removed in a future release.")
       .hin <- match.fun(hin)

R/mma.R

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

R/slsqp.R

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

inst/tinytest/test-wrapper-auglag.R

@@ -20,8 +20,8 @@ depMess <- paste("The old behavior for hin >= 0 has been deprecated. Please",
 # Taken from example
 x0 <- c(1, 1)
 fn <- function(x) (x[1L] - 2) ^ 2 + (x[2L] - 1) ^ 2
-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
+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
 gr <- function(x) nl.grad(x, fn)
 hinjac <- function(x) nl.jacobian(x, hin)
 heqjac <- function(x) nl.jacobian(x, heq)
@@ -176,10 +176,10 @@ expect_identical(augTest$convergence, augControl$status)
 expect_identical(augTest$message, augControl$message)
 
 # Test deprecated message
-expect_message(auglag(x0, fn, hin = hin2), depMess)
+expect_warning(auglag(x0, fn, hin = hin2), depMess)
 
 # Test old behavior still works
-augTest <- suppressMessages(auglag(x0, fn, hin = hin2, hinjac = hinjac2,
+augTest <- suppressWarnings(auglag(x0, fn, hin = hin2, hinjac = hinjac2,
                                    heq = heq, localsolver = "MMA"))
 
 expect_identical(augTest$par, augControl$solution)

inst/tinytest/test-wrapper-ccsaq.R

@@ -127,10 +127,10 @@ expect_identical(ccsaqTest$convergence, ccsaqControlC$status)
 expect_identical(ccsaqTest$message, ccsaqControlC$message)
 
 # Test deprecated behavior message
-expect_message(ccsaq(x0.hs100, fn.hs100, hin = hin2.hs100), depMess)
+expect_warning(ccsaq(x0.hs100, fn.hs100, hin = hin2.hs100), depMess)
 
 # Test deprecated behavior
-ccsaqTest <- suppressMessages(ccsaq(x0.hs100, fn.hs100, gr = gr.hs100,
+ccsaqTest <- suppressWarnings(ccsaq(x0.hs100, fn.hs100, gr = gr.hs100,
                                     hin = hin2.hs100, hinjac = hinjac2.hs100,
                                     control = ctl))
 

inst/tinytest/test-wrapper-cobyla.R

@@ -69,10 +69,10 @@ expect_identical(cobylaTest$convergence, cobylaControl$status)
 expect_identical(cobylaTest$message, cobylaControl$message)
 
 # Test deprecated message
-expect_message(cobyla(x0.hs100, fn.hs100, hin = hin2.hs100), depMess)
+expect_warning(cobyla(x0.hs100, fn.hs100, hin = hin2.hs100), depMess)
 
 # Test deprecated behavior
-cobylaTest <- suppressMessages(cobyla(x0.hs100, fn.hs100, hin = hin2.hs100,
+cobylaTest <- suppressWarnings(cobyla(x0.hs100, fn.hs100, hin = hin2.hs100,
                                       control = ctl))
 
 expect_identical(cobylaTest$par, cobylaControl$solution)

inst/tinytest/test-wrapper-global.R

@@ -186,11 +186,11 @@ expect_identical(stogoTest$convergence, stogoControl$status)
 expect_identical(stogoTest$message, stogoControl$message)
 
 # Test deprecated message
-expect_message(isres(x0, rbf, lower = lb, upper = ub, hin = hin2,
+expect_warning(isres(x0, rbf, lower = lb, upper = ub, hin = hin2,
                      maxeval = 2e4L), depMess)
 
 # Test deprecated behavior
-isresTest <- suppressMessages(isres(x0, rbf, lb, ub, hin = hin2,
+isresTest <- suppressWarnings(isres(x0, rbf, lb, ub, hin = hin2,
                                     maxeval = 2e4L))
 
 expect_equal(isresTest$par, isresControl$solution, tolerance = 1e-4)

inst/tinytest/test-wrapper-mma.R

@@ -104,10 +104,10 @@ expect_identical(mmaTest$convergence, mmaControl$status)
 expect_identical(mmaTest$message, mmaControl$message)
 
 # Test deprecated message
-expect_message(mma(x0.hs100, fn.hs100, hin = hin.hs100), depMess)
+expect_warning(mma(x0.hs100, fn.hs100, hin = hin.hs100), depMess)
 
 # Test deprecated behavior
-mmaTest <- suppressMessages(mma(x0.hs100, fn.hs100, gr = gr.hs100,
+mmaTest <- suppressWarnings(mma(x0.hs100, fn.hs100, gr = gr.hs100,
                                 hin = hin2.hs100, hinjac = hinjac2.hs100,
                                 control = ctl))
 

inst/tinytest/test-wrapper-slsqp.R

@@ -19,47 +19,44 @@ depMess <- paste("The old behavior for hin >= 0 has been deprecated. Please",
                  "restate the inequality to be <=0. The ability to use the old",
                  "behavior will be removed in a future release.")
 
-## Functions for SLSQP
+# Taken from example
 x0.hs100 <- c(1, 2, 0, 4, 0, 1, 1)
-fn.hs100 <- function(x) {
-  (x[1L] - 10) ^ 2 + 5 * (x[2L] - 12) ^ 2 + x[3L] ^ 4 + 3 * (x[4L] - 11) ^ 2 +
-    10 * x[5L] ^ 6 + 7 * x[6L] ^ 2 + x[7L] ^ 4 - 4 * x[6L] * x[7L] -
-    10 * x[6L] - 8 * x[7L]
+fn.hs100 <- function(x) {(x[1] - 10) ^ 2 + 5 * (x[2] - 12) ^ 2 + x[3] ^ 4 +
+    3 * (x[4] - 11) ^ 2 + 10 * x[5] ^ 6 + 7 * x[6] ^ 2 +
+    x[7] ^ 4 - 4 * x[6] * x[7] - 10 * x[6] - 8 * x[7]}
+
+hin.hs100 <- function(x) {c(
+  2 * x[1] ^ 2 + 3 * x[2] ^ 4 + x[3] + 4 * x[4] ^ 2 + 5 * x[5] - 127,
+  7 * x[1] + 3 * x[2] + 10 * x[3] ^ 2 + x[4] - x[5] - 282,
+  23 * x[1] + x[2] ^ 2 + 6 * x[6] ^ 2 - 8 * x[7] - 196,
+  4 * x[1] ^ 2 + x[2] ^ 2 - 3 * x[1] * x[2] + 2 * x[3] ^ 2 + 5 * x[6] -
+    11 * x[7])
 }
 
 gr.hs100 <- function(x) {
-  c(2 * x[1L] -  20,
-    10 * x[2L] - 120,
-    4 * x[3L] ^ 3,
-    6 * x[4L] - 66,
-    60 * x[5L] ^ 5,
-    14 * x[6L] - 4 * x[7L] - 10,
-    4 * x[7L] ^ 3 - 4 * x[6L] - 8)
-}
-
-gr <- function(x) nl.grad(x, fn.hs100)
-
-hin.hs100 <- function(x) {
-  h <- double(4L)
-  h[1L] <- 127 - 2 * x[1L] ^ 2 - 3 * x[2L] ^ 4 - x[3L] - 4 * x[4L] ^ 2 - 5 *
-    x[5L]
-  h[2L] <- 282 - 7 * x[1L] - 3 * x[2L] - 10 * x[3L] ^ 2 - x[4L] + x[5L]
-  h[3L] <- 196 - 23 * x[1L] - x[2L] ^ 2 - 6 * x[6L] ^ 2 + 8 * x[7L]
-  h[4L] <- -4 * x[1L] ^ 2 - x[2L] ^ 2 + 3 * x[1L] * x[2L] - 2 * x[3L] ^ 2 -
-    5 * x[6L] + 11 * x[7L]
-  return(h)
+  c( 2 * x[1] - 20,
+     10 * x[2] - 120,
+     4 * x[3] ^ 3,
+     6 * x[4] - 66,
+     60 * x[5] ^ 5,
+     14 * x[6] - 4 * x[7] - 10,
+     4 * x[7] ^ 3 - 4 * x[6] - 8)
 }
 
 hinjac.hs100 <- function(x) {
-  matrix(c(4 * x[1L], 12 * x[2L] ^ 3, 1, 8 * x[4L], 5, 0, 0, 7, 3, 20 * x[3L],
-           1, -1, 0, 0, 23, 2 * x[2L], 0, 0, 0, 12 * x[6L], -8,
-           8 * x[1L] - 3 * x[2L], 2 * x[2L] - 3 * x[1L], 4 * x[3L], 0, 0, 5,
-           -11), 4L, 7L, byrow = TRUE)
+  matrix(c(4 * x[1], 12 * x[2] ^ 3, 1, 8 * x[4], 5, 0, 0,
+           7, 3, 20 * x[3], 1, -1, 0, 0,
+           23, 2 * x[2], 0, 0, 0, 12 * x[6], -8,
+           8 * x[1] - 3 * x[2], 2 * x[2] - 3 * x[1], 4 * x[3], 0, 0, 5, -11),
+         nrow = 4, byrow = TRUE)
 }
 
-hin2.hs100 <- function(x) -hin.hs100(x)                 # Needed for nloptr call
-hinjac2.hs100 <- function(x) -hinjac.hs100(x)           # Needed for nloptr call
-hinjac2b.hs100 <- function(x) nl.jacobian(x, hin2.hs100)# Needed for nloptr call
+hin2.hs100 <- function(x) -hin.hs100(x)           # Needed to test old behavior
+hinjac2.hs100 <- function(x) -hinjac.hs100(x)     # Needed to test old behavior
+
+gr.hs100.computed <- function(x) nl.grad(x, fn.hs100)
+hinjac.hs100.computed <- function(x) nl.jacobian(x, hin.hs100)
+hinjac2.hs100.computed <- function(x) nl.jacobian(x, hin2.hs100)
 
 # Test printout if nl.info passed. The word "Call:" should be in output if
 # passed and not if not passed.
@@ -69,13 +66,14 @@ expect_stdout(slsqp(x0.hs100, fn = fn.hs100, nl.info = TRUE),
 expect_silent(slsqp(x0.hs100, fn = fn.hs100))
 
 # No passed gradient or Inequality Jacobians
-slsqpTest <- suppressMessages(slsqp(x0.hs100, fn.hs100, hin = hin.hs100))
+slsqpTest <- slsqp(x0.hs100, fn.hs100, hin = hin.hs100,
+                   deprecatedBehavior = FALSE)
 
 slsqpControl <- nloptr(x0 = x0.hs100,
                        eval_f = fn.hs100,
-                       eval_grad_f = gr,
-                       eval_g_ineq = hin2.hs100,
-                       eval_jac_g_ineq = hinjac2b.hs100,
+                       eval_grad_f = gr.hs100.computed,
+                       eval_g_ineq = hin.hs100,
+                       eval_jac_g_ineq = hinjac.hs100.computed,
                        opts = list(algorithm = "NLOPT_LD_SLSQP",
                                    xtol_rel = 1e-6, maxeval = 1000L))
 
@@ -86,15 +84,15 @@ expect_identical(slsqpTest$convergence, slsqpControl$status)
 expect_identical(slsqpTest$message, slsqpControl$message)
 
 # Passed gradient or Inequality Jacobians
-slsqpTest <- suppressMessages(slsqp(x0.hs100, fn = fn.hs100, gr = gr.hs100,
-                                    hin = hin.hs100, hinjac = hinjac.hs100))
+slsqpTest <- slsqp(x0.hs100, fn = fn.hs100, gr = gr.hs100, hin = hin.hs100,
+                   hinjac = hinjac.hs100, deprecatedBehavior = FALSE)
 
 # Going to be reused below in new behavior test.
 slsqpControlhinjac <- nloptr(x0 = x0.hs100,
                              eval_f = fn.hs100,
                              eval_grad_f = gr.hs100,
-                             eval_g_ineq = hin2.hs100,
-                             eval_jac_g_ineq = hinjac2.hs100,
+                             eval_g_ineq = hin.hs100,
+                             eval_jac_g_ineq = hinjac.hs100,
                              opts = list(algorithm = "NLOPT_LD_SLSQP",
                                          xtol_rel = 1e-6, maxeval = 1000L))
 
@@ -105,13 +103,14 @@ expect_identical(slsqpTest$convergence, slsqpControlhinjac$status)
 expect_identical(slsqpTest$message, slsqpControlhinjac$message)
 
 # Not passing equality Jacobian
-slsqpTest <- suppressMessages(slsqp(x0.hs100, fn = fn.hs100, heq = hin.hs100))
+slsqpTest <- slsqp(x0.hs100, fn = fn.hs100, heq = hin.hs100,
+                   deprecatedBehavior = FALSE)
 
 slsqpControl <- nloptr(x0 = x0.hs100,
                        eval_f = fn.hs100,
-                       eval_grad_f = gr.hs100,
-                       eval_g_eq = hin2.hs100,
-                       eval_jac_g_eq = hinjac2b.hs100,
+                       eval_grad_f = gr.hs100.computed,
+                       eval_g_eq = hin.hs100,
+                       eval_jac_g_eq = hinjac.hs100.computed,
                        opts = list(algorithm = "NLOPT_LD_SLSQP",
                                    xtol_rel = 1e-6, maxeval = 1000L))
 
@@ -122,14 +121,14 @@ expect_identical(slsqpTest$convergence, slsqpControl$status)
 expect_identical(slsqpTest$message, slsqpControl$message)
 
 # Passing equality Jacobian
-slsqpTest <- suppressMessages(slsqp(x0.hs100, fn = fn.hs100, heq = hin.hs100,
-                                    heqjac = hinjac.hs100))
+slsqpTest <- slsqp(x0.hs100, fn = fn.hs100, gr = gr.hs100, heq = hin.hs100,
+                   heqjac = hinjac.hs100, deprecatedBehavior = FALSE)
 
 slsqpControl <- nloptr(x0 = x0.hs100,
                        eval_f = fn.hs100,
                        eval_grad_f = gr.hs100,
-                       eval_g_eq = hin2.hs100,
-                       eval_jac_g_eq = hinjac2.hs100,
+                       eval_g_eq = hin.hs100,
+                       eval_jac_g_eq = hinjac.hs100,
                        opts = list(algorithm = "NLOPT_LD_SLSQP",
                                    xtol_rel = 1e-6, maxeval = 1000L))
 
@@ -139,17 +138,12 @@ expect_identical(slsqpTest$iter, slsqpControl$iterations)
 expect_identical(slsqpTest$convergence, slsqpControl$status)
 expect_identical(slsqpTest$message, slsqpControl$message)
 
-# Test deprecated behavor message; remove when old behavior made defucnt.
-expect_message(slsqp(x0.hs100, fn = fn.hs100, hin = hin.hs100), depMess)
+# Test deprecated message
+expect_warning(slsqp(x0.hs100, fn = fn.hs100, hin = hin2.hs100), depMess)
 
-# Test new behavior. Adjust tests above when old behavior made defucnt.
-hinx <- function(x) -hin.hs100(x)
-hinjacx <- function(x) -hinjac.hs100(x)
-expect_silent(slsqp(x0.hs100, fn = fn.hs100, hin = hinx, hinjac = hinjacx,
-                    deprecatedBehavior = FALSE))
-
-slsqpTest <- slsqp(x0.hs100, fn = fn.hs100, hin = hinx, hinjac = hinjacx,
-                   deprecatedBehavior = FALSE)
+# Test deprecated behavior Adjust tests above when old behavior made defunct.
+slsqpTest <- suppressWarnings(slsqp(x0.hs100, fn = fn.hs100, gr = gr.hs100,
+                                    hin = hin2.hs100, hinjac = hinjac2.hs100))
 
 expect_identical(slsqpTest$par, slsqpControlhinjac$solution)
 expect_identical(slsqpTest$value, slsqpControlhinjac$objective)