Merge pull request #137 from aadler/master

Replacing testthat with tinytest (Issue #136)

.Rbuildignore

@@ -13,3 +13,4 @@ TODO
 ^src/nlopt/
 ^windows$
 ^CRAN-SUBMISSION$
+^.lintr$

.gitignore

@@ -14,4 +14,6 @@ inst/doc
 config.log
 config.status
 src/Makevars
+src/*.dll
 windows
+.lintr

DESCRIPTION

@@ -1,11 +1,14 @@
 Package: nloptr
 Type: Package
 Title: R Interface to NLopt
-Version: 2.0.3.9000
+Version: 2.0.3.9100
 Authors@R: c(person("Jelmer", "Ypma", role = "aut",
                     email = "uctpjyy@ucl.ac.uk"),
              person(c("Steven", "G."), "Johnson", role = "aut",
                     comment = "author of the NLopt C library"),
+             person("Aymeric", "Stamm", role = c("ctb", "cre"),
+                    email = "aymeric.stamm@math.cnrs.fr",
+                    comment = c(ORCID = "0000-0002-8725-3654")),
              person(c("Hans", "W."), "Borchers", role = "ctb",
                     email = "hwborchers@googlemail.com"),
              person("Dirk", "Eddelbuettel", role = "ctb",
@@ -18,10 +21,7 @@ Authors@R: c(person("Jelmer", "Ypma", role = "aut",
              person("Avraham", "Adler", role = "ctb", 
                     email = "Avraham.Adler@gmail.com",
                     comment = c(ORCID = "0000-0002-3039-0703")),
-             person("Xiongtao", "Dai", role = "ctb"), 
-             person("Aymeric", "Stamm", role = c("ctb", "cre"), 
-                    email = "aymeric.stamm@math.cnrs.fr", 
-                    comment = c(ORCID = "0000-0002-8725-3654")),
+             person("Xiongtao", "Dai", role = "ctb"),
              person("Jeroen", "Ooms", role = "ctb",
                     email = "jeroen@berkeley.edu"))
 Description: 
@@ -34,7 +34,7 @@ Description:
     requires 'CMake'. On Linux and 'macOS', if a suitable system build of 
     NLopt (2.7.0 or later) is found, it is used; otherwise, it is built 
     from included sources via 'CMake'. On Windows, NLopt is obtained through 
-    'rwinlib' for 'R <= 4.1.x' or grabbed from the 'Rtools42 toolchain' for 
+    'rwinlib' for 'R <= 4.1.x' or grabbed from the appropriate toolchain for
     'R >= 4.2.0'.
 License: LGPL (>= 3)
 SystemRequirements: cmake (>= 3.2.0) which is used only on Linux or macOS 
@@ -43,14 +43,7 @@ Biarch: true
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.2.3
-LinkingTo: testthat
-Suggests: 
-    knitr,
-    rmarkdown,
-    xml2,
-    testthat (>= 3.0.0),
-    covr
+Suggests:  knitr, rmarkdown, covr, tinytest
 VignetteBuilder: knitr
-Config/testthat/edition: 3
 URL: https://astamm.github.io/nloptr/index.html, https://github.com/astamm/nloptr
 BugReports: https://github.com/astamm/nloptr/issues

NEWS.md

@@ -1,8 +1,18 @@
+# nloptr 2.0.3.9100
+
+* Replaced the unit testing framework of `testthat` with `tinytest` (See 
+[Issue #136](https://github.com/astamm/nloptr/issues/136)).
+* Brought coverage of `is.nloptr` to 100%. The only file not completely covered
+by unit tests is `nloptr.c`. The uncovered calls are error messages which get
+trapped by tests in R before the call gets to C.
+* Linted package for code correctness and consistency.
+* Updated vignette, DESCRIPTION, and NEWS.
+
 # nloptr 2.0.3.9000
 
-This is a patch version update from [Avraham Adler](https://github.com/aadler)
-which should make the code safer, more efficient, and easier to follow. Please
-see commit logs for [#128](https://github.com/astamm/nloptr/pull/128),
+This is a patch version update which should make the code safer, more efficient,
+and easier to follow. Please see commit logs for
+[#128](https://github.com/astamm/nloptr/pull/128),
 [#129](https://github.com/astamm/nloptr/pull/129),
 [#131](https://github.com/astamm/nloptr/pull/131), 
 [#132](https://github.com/astamm/nloptr/pull/132),

R/auglag.R

@@ -9,7 +9,7 @@
 #
 # Changelog:
 #   2017-09-26: Fixed bug, BOBYQA is allowed as local solver
-#               (thanks to Leo Belzile).
+#         (thanks to Leo Belzile).
 #   2023-02-08: Tweaks for efficiency and readability (Avraham Adler)
 
 #' Augmented Lagrangian Algorithm
@@ -63,9 +63,9 @@
 #'   \item{global_solver}{the global NLOPT solver used.}
 #'   \item{local_solver}{the local NLOPT solver used, LBFGS or COBYLA.}
 #'   \item{convergence}{integer code indicating successful completion
-#'     (> 0) or a possible error number (< 0).}
+#'   (> 0) or a possible error number (< 0).}
 #'   \item{message}{character string produced by NLopt and giving additional
-#'      information.}
+#'    information.}
 #'
 #' @export
 #'
@@ -90,31 +90,31 @@
 #'
 #' x0 <- c(1, 1)
 #' fn <- function(x) (x[1]-2)^2 + (x[2]-1)^2
-#' hin <- function(x) -0.25*x[1]^2 - x[2]^2 + 1    # hin >= 0
-#' heq <- function(x) x[1] - 2*x[2] + 1            # heq == 0
+#' hin <- function(x) -0.25*x[1]^2 - x[2]^2 + 1  # hin >= 0
+#' heq <- function(x) x[1] - 2*x[2] + 1      # heq == 0
 #' gr <- function(x) nl.grad(x, fn)
 #' hinjac <- function(x) nl.jacobian(x, hin)
 #' heqjac <- function(x) nl.jacobian(x, heq)
 #'
 #' auglag(x0, fn, gr = NULL, hin = hin, heq = heq) # with COBYLA
-#' # $par:     0.8228761 0.9114382
+#' # $par:   0.8228761 0.9114382
 #' # $value:   1.393464
-#' # $iter:    1001
+#' # $iter:  1001
 #'
 #' auglag(x0, fn, gr = NULL, hin = hin, heq = heq, localsolver = "SLSQP")
-#' # $par:     0.8228757 0.9114378
+#' # $par:   0.8228757 0.9114378
 #' # $value:   1.393465
-#' # $iter     173
+#' # $iter   173
 #'
 #' ##  Example from the alabama::auglag help page
 #' fn <- function(x) (x[1] + 3*x[2] + x[3])^2 + 4 * (x[1] - x[2])^2
 #' heq <- function(x) x[1] + x[2] + x[3] - 1
 #' hin <- function(x) c(6*x[2] + 4*x[3] - x[1]^3 - 3, x[1], x[2], x[3])
 #'
 #' auglag(runif(3), fn, hin = hin, heq = heq, localsolver="lbfgs")
-#' # $par:     2.380000e-09 1.086082e-14 1.000000e+00
+#' # $par:   2.380000e-09 1.086082e-14 1.000000e+00
 #' # $value:   1
-#' # $iter:    289
+#' # $iter:  289
 #'
 #' ##  Powell problem from the Rsolnp::solnp help page
 #' x0 <- c(-2, 2, 2, -1, -1)
@@ -127,92 +127,91 @@
 #' auglag(x0, fn1, heq = eqn1, localsolver = "mma")
 #' # $par: -3.988458e-10 -1.654201e-08 -3.752028e-10  8.904445e-10  8.926336e-10
 #' # $value:   1
-#' # $iter:    1001
+#' # $iter:  1001
 #'
 auglag <- function(x0, fn, gr = NULL, lower = NULL, upper = NULL, hin = NULL,
                    hinjac = NULL, heq = NULL, heqjac = NULL,
-                   localsolver = "COBYLA", localtol = 1e-6,
-                   ineq2local = FALSE, nl.info = FALSE, control = list(), ...) {
+                   localsolver = "COBYLA", localtol = 1e-6, ineq2local = FALSE,
+                   nl.info = FALSE, control = list(), ...) {
+  if (ineq2local) {
+    # gsolver <- "NLOPT_LN_AUGLAG_EQ"
+    stop("Inequalities to local solver: feature not yet implemented.")
+  }
 
-    if (ineq2local) {
-        # gsolver <- "NLOPT_LN_AUGLAG_EQ"
-        stop("Inequalities to local solver: feature not yet implemented.")
-    }
-
-    localsolver <- toupper(localsolver)
-    if (localsolver %in% c("COBYLA", "BOBYQA")) {   # derivative-free
-        dfree <- TRUE
-        gsolver <- "NLOPT_LN_AUGLAG"
-        lsolver <- paste0("NLOPT_LN_", localsolver)
-    } else if (localsolver %in% c("LBFGS", "MMA", "SLSQP")) { # with derivatives
-        dfree <- FALSE
-        gsolver <- "NLOPT_LD_AUGLAG"
-        lsolver <- paste0("NLOPT_LD_", localsolver)
-    } else {
-        stop("Only local solvers allowed: BOBYQA, COBYLA, LBFGS, MMA, SLSQP.")
-    }
-
-    # Function and gradient, if needed
-    .fn <- match.fun(fn)
-    fn  <- function(x) .fn(x, ...)
+  localsolver <- toupper(localsolver)
+  if (localsolver %in% c("COBYLA", "BOBYQA")) {   # derivative-free
+    dfree <- TRUE
+    gsolver <- "NLOPT_LN_AUGLAG"
+    lsolver <- paste0("NLOPT_LN_", localsolver)
+  } else if (localsolver %in% c("LBFGS", "MMA", "SLSQP")) { # with derivatives
+    dfree <- FALSE
+    gsolver <- "NLOPT_LD_AUGLAG"
+    lsolver <- paste0("NLOPT_LD_", localsolver)
+  } else {
+    stop("Only local solvers allowed: BOBYQA, COBYLA, LBFGS, MMA, SLSQP.")
+  }
 
-    if (!dfree && is.null(gr)) {gr <- function(x) nl.grad(x, fn)}
+  # Function and gradient, if needed
+  .fn <- match.fun(fn)
+  fn  <- function(x) .fn(x, ...)
 
-    # Global and local options
-    opts <- nl.opts(control)
-    opts$algorithm <- gsolver
-    local_opts <- list(algorithm = lsolver,
-                        xtol_rel = localtol,
-                        eval_grad_f = if (!dfree) gr else NULL)
-    opts$local_opts <- local_opts
+  if (!dfree && is.null(gr)) {gr <- function(x) nl.grad(x, fn)}
 
-    # Inequality constraints
-    if (!is.null(hin)) {
-        if (getOption("nloptr.show.inequality.warning")) {
-            message("For consistency with the rest of the package the ",
-                    "inequality sign may be switched from >= to <= in a ",
-                    "future nloptr version.")
-        }
+  # Global and local options
+  opts <- nl.opts(control)
+  opts$algorithm <- gsolver
+  local_opts <- list(algorithm = lsolver,
+                     xtol_rel = localtol,
+                     eval_grad_f = if (!dfree) gr else NULL)
+  opts$local_opts <- local_opts
 
-        .hin <- match.fun(hin)
-        hin <- function(x) -.hin(x)   # change  hin >= 0  to  hin <= 0 !
-    }
-    if (!dfree) {
-        if (is.null(hinjac)) {
-            hinjac <- function(x) nl.jacobian(x, hin)
-        } else {
-            .hinjac <- match.fun(hinjac)
-            hinjac <- function(x) -.hinjac(x)
-        }
+  # Inequality constraints
+  if (!is.null(hin)) {
+    if (getOption("nloptr.show.inequality.warning")) {
+      message("For consistency with the rest of the package the ",
+              "inequality sign may be switched from >= to <= in a ",
+              "future nloptr version.")
     }
 
-    # Equality constraints
-    if (!is.null(heq)) {
-        .heq <- match.fun(heq)
-        heq <- function(x) .heq(x)
+    .hin <- match.fun(hin)
+    hin <- function(x) -.hin(x)   # change  hin >= 0  to  hin <= 0 !
+  }
+  if (!dfree) {
+    if (is.null(hinjac)) {
+      hinjac <- function(x) nl.jacobian(x, hin)
+    } else {
+      .hinjac <- match.fun(hinjac)
+      hinjac <- function(x) -.hinjac(x)
     }
-    if (!dfree) {
-        if (is.null(heqjac)) {
-            heqjac <- function(x) nl.jacobian(x, heq)
-        } else {
-            .heqjac <- match.fun(heqjac)
-            heqjac <- function(x) .heqjac(x)
-        }
+  }
+
+  # Equality constraints
+  if (!is.null(heq)) {
+    .heq <- match.fun(heq)
+    heq <- function(x) .heq(x)
+  }
+  if (!dfree) {
+    if (is.null(heqjac)) {
+      heqjac <- function(x) nl.jacobian(x, heq)
+    } else {
+      .heqjac <- match.fun(heqjac)
+      heqjac <- function(x) .heqjac(x)
     }
+  }
 
-    S0 <- nloptr(x0,
-                 eval_f = fn,
-                 eval_grad_f = gr,
-                 lb = lower,
-                 ub = upper,
-                 eval_g_ineq = hin,
-                 eval_jac_g_ineq = hinjac,
-                 eval_g_eq = heq,
-                 eval_jac_g_eq = heqjac,
-                 opts = opts)
+  S0 <- nloptr(x0,
+               eval_f = fn,
+               eval_grad_f = gr,
+               lb = lower,
+               ub = upper,
+               eval_g_ineq = hin,
+               eval_jac_g_ineq = hinjac,
+               eval_g_eq = heq,
+               eval_jac_g_eq = heqjac,
+               opts = opts)
 
-    if (nl.info) print(S0)
-    list(par = S0$solution, value = S0$objective, iter = S0$iterations,
-         global_solver = gsolver, local_solver = lsolver,
-         convergence = S0$status, message = S0$message)
+  if (nl.info) print(S0)
+  list(par = S0$solution, value = S0$objective, iter = S0$iterations,
+       global_solver = gsolver, local_solver = lsolver, convergence = S0$status,
+       message = S0$message)
 }