Using checkmate for input validation, drop whole package import of rlang, input validation doc.

Author: kylesnap

DESCRIPTION

@@ -9,6 +9,7 @@ License: GPL (>= 3)
 URL: https://kylesnap.github.io/ernest/
 BugReports: https://github.com/kylesnap/ernest/issues/
 Imports: 
+    checkmate,
     cli,
     generics,
     ggplot2,
@@ -19,14 +20,14 @@ Imports:
     R6,
     rlang (>= 1.1.0),
     tibble,
-    tidyselect,
     utils,
     vctrs
 Suggests: 
     ggdist,
     knitr,
     LaplacesDemon,
     rmarkdown,
+    tidyselect,
     testthat (>= 3.0.0),
     vdiffr,
     xml2

NAMESPACE

@@ -43,7 +43,6 @@ export(nested_sampling)
 export(rwmh_cube)
 export(unif_cube)
 export(visualize)
-import(rlang)
 importFrom(R6,R6Class)
 importFrom(cli,cli_abort)
 importFrom(cli,cli_progress_bar)
@@ -70,11 +69,28 @@ importFrom(lifecycle,deprecated)
 importFrom(posterior,as_draws)
 importFrom(posterior,as_draws_matrix)
 importFrom(posterior,as_draws_rvars)
-importFrom(rlang,"%@%")
-importFrom(rlang,"%@%<-")
 importFrom(rlang,"%|%")
 importFrom(rlang,"%||%")
+importFrom(rlang,.data)
+importFrom(rlang,arg_match)
+importFrom(rlang,arg_match0)
+importFrom(rlang,as_function)
+importFrom(rlang,call2)
+importFrom(rlang,caller_arg)
+importFrom(rlang,caller_env)
+importFrom(rlang,check_dots_empty)
+importFrom(rlang,check_dots_used)
+importFrom(rlang,expr)
+importFrom(rlang,exprs)
+importFrom(rlang,inject)
 importFrom(rlang,is_double)
+importFrom(rlang,is_empty)
+importFrom(rlang,is_scalar_double)
+importFrom(rlang,is_scalar_integerish)
+importFrom(rlang,is_scalar_logical)
+importFrom(rlang,list2)
+importFrom(rlang,new_function)
+importFrom(rlang,pairlist2)
 importFrom(rlang,try_fetch)
 importFrom(tibble,tibble)
 importFrom(utils,head)

R/as_draws.R

@@ -3,16 +3,16 @@
 #' Try to transform an [ernest_run-class] to a format supported by the
 #' [posterior][posterior::posterior-package] package.
 #'
-#' @param x An `ernest_run` object.
-#' @inheritParams rlang::args_dots_empty
-#' @param units Character string specifying the scale of the returned points.
-#' One of `"original"` or `"unit_cube"`, case sensitive.
-#' - `"original"`: Points are expressed on the scale of the prior space.
-#' - `"unit_cube"`: Points are expressed on the scale of the (0-1)-unit
+#' @param x (ernest_run) An `ernest_run` object.
+#' @param units (case-sensitive string) The scale in which to return the
+#' sampled points:
+#' * `"original"`: Points are expressed on the scale of the prior space.
+#' * `"unit_cube"`: Points are expressed on the scale of the (0-1)-unit
 #' hypercube.
-#' @param radial Whether to return an additional column `.radial`, containing
-#' the radial coordinate (i.e., the squared sum of squares) for each sampled
-#' point.
+#' @param radial (logical) Whether to return an additional column `.radial`,
+#' containing the radial coordinate (i.e., the squared sum of squares) for
+#' each sampled point.
+#' @inheritParams rlang::args_dots_empty
 #'
 #' @returns
 #' A [draws][posterior::as_draws()] object, containing the posterior samples
@@ -87,27 +87,21 @@ as_draws_rvars.ernest_run <- function(
 
 #' Convert samples to a weighted draws matrix
 #'
-#' @param x An object containing sample data, with `samples`, `samples_unit`,
-#'   `log_weight`, and `log_evidence` components.
-#' @param ... Currently unused. For future extensibility.
-#' @param units Character string specifying the units for conversion.
-#' Must be one of `"original"` or `"unit_cube"`.
-#' @param radial Logical. If `TRUE`, appends a `.radial` column with the 
-#' Euclidean norm of each sample.
+#' @inheritParams as_draws_matrix
 #' @param error_call Environment to use for error reporting.
-#' 
-#' @srrstats {G2.3, G2.3a} Using `arg_match` to validate character input. 
+#'
+#' @srrstats {G2.3, G2.3a} Using `arg_match` to validate character input.
 #'
 #' @return A weighted draws matrix of class `draws_matrix`.
 #' @noRd
-as_draws_matrix_ <- function(x, ..., units, radial, error_call = caller_env()) {
-  check_dots_empty(call = error_call)
+as_draws_matrix_ <- function(x, ..., units, radial, call = caller_env()) {
+  check_dots_empty(call = call)
   units <- arg_match0(
     units,
     values = c("original", "unit_cube"),
-    error_call = error_call
+    error_call = call
   )
-  check_bool(radial, error_call = error_call)
+  radial <- as_scalar_logical(radial, call = call)
 
   points <- if (units == "original") x$samples else x$samples_unit
   if (radial) {

R/calculate.R

@@ -1,11 +1,11 @@
 #' Estimate Evidence using a Nested Sampling Run
 #'
-#' @param x An `ernest_run` object.
+#' @param x (ernest_run) An `ernest_run` object.
 #' @inheritParams rlang::args_dots_empty
-#' @param ndraws A positive integer or a boolean. If `FALSE`, the log volumes
-#' will be derived from their expected values. If not `FALSE`, the log volumes
-#' will be simulated using `ndraws` samples from each volume's
-#' joint distribution.
+#' @param ndraws (positive integer or zero, optional) The number of log volume
+#' sequences to simulate. If equal to zero, no simulations will be made, and a
+#' one draw vector of log volumes are produced from the estimates contained in
+#' `x`. If `NULL`, `getOption("posterior.rvar_ndraws")` is used (default 4000).
 #'
 #' @returns A tibble, containing `run$n_iter + run$n_points` rows and the
 #' following columns:
@@ -52,12 +52,12 @@
 #'
 #' @method calculate ernest_run
 #' @export
-calculate.ernest_run <- function(x, ..., ndraws = FALSE) {
+calculate.ernest_run <- function(x, ..., ndraws = NULL) {
   check_dots_empty()
-  if (is.logical(ndraws)) {
-    ndraws <- as.integer(ndraws)
-  }
-  ndraws <- check_integer(ndraws, min = 0)
+  ndraws <- as_scalar_count(
+    ndraws %||% getOption("posterior.rvar_ndraws", 4000L),
+    positive = FALSE
+  )
 
   if (ndraws == 0) {
     return(tibble::new_tibble(

R/compile.R

@@ -3,37 +3,41 @@
 #' Create a new set of live points/particles for a new nested sampling run, or
 #' check the current state of the live points before continuing a previous run.
 #'
-#' @param object An object of class `ernest_sampler`.
+#' @param object (ernest_sampler) An object of class `ernest_sampler`.
 #' @inheritParams rlang::args_dots_empty
-#' @param seed Either a single value, interpretted as an integer, or `NA` or
-#' `NULL`.
-#' * If an integer or NULL, `seed` is passed to [set.seed()] to set the state
-#' of the random number generator. `NULL` reinitializes the generator as if
+#' @param seed (integer or NA, optional) Specification for the random number
+#' generator.
+#' * integer: Passed to [set.seed()].
+#' * `NULL`: Passed to [set.seed()], which reinitializes the generator as if
 #' no seed has yet been set.
-#' * If `NA`, the random number generator is set with the seed stored in the
-#' `ernest_run` object bound to `object`. If this object does not exist (i.e.,
-#' if not prior runs have been performed), the current state of the generator
-#' is recorded and stored for future objects.
-#' @param clear A logical value indicating whether to reload `object` before
-#' creating new live points. If `TRUE`, former results from the sampler are
-#' removed from the object. If `FALSE`, the sampler will not drop prior results,
-#' and continue using live points from the last sampling iteration performed.
+#' * `NA`: Make no changes to the current seed if set. If `compile` has been
+#' called on `object` before, then `NA` will ensure that the seed remain
+#' identical between runs.
+#' @param clear (boolean) Whether to reset the sampler before compiling.
+#' * `TRUE`: Previous results stored in `object` are removed, and live points
+#' are generated and validated.
+#' * `FALSE`: Previous results stored in `object` are retained, and live points
+#' are validated.
 #'
 #' @details
 #' The `compile` function prepares an `ernest_sampler` object for nested
 #' sampling by ensuring that its set of live points is valid and ready for use.
-#' In addition to constructing the live point set for new runs, the live points
-#' are validated for a number of conditions:
+#' In addition to constructing the live point set for new runs or when
+#' `clear = FALSE`, compile also ensures that:
 #'
-#' * Ensures that the points are each represented within the unit hypercube.
-#' * Ensures that the wrapped likelihood function `ernest_likelihood` has a
-#' valid return value for each point (finite double or `-Inf`).
-#' * Ensures that the likelihood isn't at a plateau, warning you if there are
-#' duplicate likelihood values.
+#' * The live points are each represented within the unit hypercube.
+#' * The wrapped likelihood function `ernest_likelihood` has a valid return
+#' value for each point (either a finite double or `-Inf`).
+#' * The live points don't represent a perfect plateau (i.e., all points share
+#' the same likelihood). You are warned if more than 25% of the points
+#' share the same likelihood value.
 #'
-#' If `compile` fails these validation steps, the function will fail and the
-#' set of live points will be removed from `object` with an informative error
-#' message encouraging you to run the sampler from scratch with `clear = TRUE`.
+#' If `compile` fails these validation steps, the set of live points will be
+#' removed from `object`, preventing you from calling [generate()] on a
+#' malformed sampler.
+#'
+#' Random number generation can be seeded either through the `seed` argument,
+#' or by calling [set.seed()] before running `compile` or `generate`.
 #'
 #' @returns `object`, invisibly.
 #' @examples
@@ -67,7 +71,7 @@ compile.ernest_sampler <- function(object, ..., seed = NA, clear = FALSE) {
 #' @return A list containing `unit`, `point`, and `log_lik` matrices/vectors.
 #' @noRd
 create_live <- function(lrps, n_points, call = caller_env()) {
-  rlang::try_fetch(
+  try_fetch(
     lrps$propose_uniform(criteria = rep(-1e300, n_points)),
     error = function(cnd) {
       cli::cli_abort(
@@ -100,64 +104,59 @@ create_live <- function(lrps, n_points, call = caller_env()) {
 #' NULL.
 #' @noRd
 check_live <- function(unit, log_lik, n_points, n_var, call = caller_env()) {
-  # Check live point matrix.
-  if (!is.numeric(unit) || !is.matrix(unit)) {
-    stop_input_type(unit, "a numeric matrix", call = call)
-  }
-  if (ncol(unit) != n_var || nrow(unit) != n_points) {
-    cli::cli_abort(
-      c(
-        "Live points matrix must have dim. {n_points} x {n_var}.",
-        "x" = "Points are currently {nrow(unit)} x {ncol(unit)}."
-      ),
-      call = call
-    )
-  }
-  if (!all(is.finite(unit))) {
-    cli::cli_abort(
-      "Live points matrix must only contain finite values.",
-      call = call
-    )
+  # Check live point matrix using checkmate.
+  msg <- checkmate::check_matrix(
+    unit,
+    mode = "numeric",
+    nrows = n_points,
+    ncols = n_var,
+    any.missing = FALSE,
+    all.missing = FALSE
+  )
+  if (!isTRUE(msg)) {
+    format_checkmate(msg, "unit", call = call)
   }
-  if (any(unit < 0 | unit > 1)) {
-    cli::cli_abort(
-      "Live points matrix must only contain values between 0 and 1.",
-      call = call
-    )
+  msg <- checkmate::check_numeric(
+    unit,
+    lower = 0,
+    upper = 1,
+    any.missing = FALSE,
+    all.missing = FALSE,
+    finite = TRUE
+  )
+  if (!isTRUE(msg)) {
+    format_checkmate(msg, "unit", call = call)
   }
 
-  if (!is_double(log_lik, n = n_points)) {
-    cli::cli_abort(
-      c(
-        "`log_lik` must be a double vector of length {n_points}",
-        "!" = "You provided {obj_type_friendly(log_lik)}."
-      ),
-      call = call
-    )
+  msg <- checkmate::check_numeric(
+    log_lik,
+    len = n_points,
+    any.missing = FALSE,
+    all.missing = FALSE
+  )
+  if (!isTRUE(msg)) {
+    format_checkmate(msg, "log_lik", call = call)
   }
   if (any(!is.finite(log_lik) & log_lik != -Inf)) {
-    n_nonfinite <- sum(!is.finite(log_lik) & log_lik != -Inf)
-    cli::cli_abort(
-      c(
-        "Live points' log-likelihoods must be finite or -Inf.",
-        "x" = "Found {n_nonfinite} non-finite values."
-      ),
+    nonfinite <- unique(log_lik[!is.finite(log_lik) & log_lik != -Inf])
+    cli_abort(
+      "`{log_lik}` must contain only finite values or -Inf, not {nonfinite}.",
       call = call
     )
   }
 
   n_unique <- vctrs::vec_unique_count(log_lik)
   if (n_unique == 1L) {
-    cli::cli_abort(
+    cli_abort(
       c(
         "Log likelihoods of the live points must not be a plateau.",
-        "x" = "Log likelihood of all {n_points} points = {log_lik[1]}."
+        "!" = "Log likelihood of all {n_points} points = {log_lik[1]}."
       ),
       call = call
     )
   }
   if (n_unique < (n_points * 0.75)) {
-    cli::cli_warn(
+    cli_warn(
       c(
         "Potential likelihood plateau; proceed with caution.",
         "!" = "{n_unique} unique likelihoods across {n_points} live points."

R/ernest-package.R

@@ -2,14 +2,9 @@
 "_PACKAGE"
 
 ## usethis namespace: start
-#' @import rlang
 #' @importFrom generics generate
 #' @importFrom glue glue
 #' @importFrom lifecycle deprecated
-#' @importFrom rlang %@%
-#' @importFrom rlang %@%<-
-#' @importFrom rlang %|%
-#' @importFrom rlang %||%
 #' @importFrom tibble tibble
 #' @importFrom utils head
 #' @importFrom utils tail