Merge pull request #413 from stan-dev/utils-cleanup

Utils cleanup

Author: jgabry

.github/workflows/Test-coverage.yaml

@@ -47,7 +47,7 @@ jobs:
 
       - name: Install dependencies
         run: |
-          install.packages(c("posterior", "cmdstanr", "remotes"),repos = c("https://mc-stan.org/r-packages/", getOption("repos")))
+          install.packages(c("posterior", "cmdstanr", "remotes"),repos = c("https://mc-stan.org/r-packages/", getOption("repos")), dependencies = TRUE)
           cmdstanr::install_cmdstan(cores = 2, overwrite = TRUE, release_url = "https://github.com/stan-dev/cmdstan/releases/download/v2.25.0/cmdstan-2.25.0.tar.gz")
           remotes::install_deps(dependencies = TRUE)
           remotes::install_cran("covr")
@@ -95,7 +95,7 @@ jobs:
 
       - name: Install dependencies
         run: |
-          install.packages(c("posterior", "cmdstanr", "remotes"),repos = c("https://mc-stan.org/r-packages/", getOption("repos")))
+          install.packages(c("posterior", "cmdstanr", "remotes"),repos = c("https://mc-stan.org/r-packages/", getOption("repos")), dependencies = TRUE)
           cmdstanr::install_cmdstan(cores = 2, overwrite = TRUE, release_url = "https://github.com/stan-dev/cmdstan/releases/download/v2.25.0/cmdstan-2.25.0.tar.gz")
           remotes::install_deps(dependencies = TRUE)
           remotes::install_cran("covr")

R/fit.R

@@ -861,9 +861,7 @@ CmdStanMCMC <- R6::R6Class(
 #' }
 #'
 loo <- function(variables = "log_lik", r_eff = TRUE, ...) {
-  if (!requireNamespace("loo", quietly = TRUE)) {
-    stop("Please install the loo package to use this method.", call. = FALSE)
-  }
+  suggest_package("loo")
   LLarray <- self$draws(variables)
   if (is.logical(r_eff)) {
     if (isTRUE(r_eff)) {

R/knitr.R

@@ -39,9 +39,7 @@
 #' * [knitr's built-in Stan language engine](https://bookdown.org/yihui/rmarkdown/language-engines.html#stan)
 #'
 register_knitr_engine <- function(override = TRUE) {
-  if (!requireNamespace("knitr", quietly = TRUE)) {
-    stop("Please install the knitr package.", call. = FALSE)
-  }
+  suggest_package("knitr")
   if (override) {
     knitr::knit_engines$set(stan = eng_cmdstan)
   } else {
@@ -64,6 +62,7 @@ register_knitr_engine <- function(override = TRUE) {
 #' }
 #' @export
 eng_cmdstan <- function(options) {
+  suggest_package("knitr")
   output_var <- options$output.var
   if (!is.character(output_var) || length(output_var) != 1L) {
     stop(

R/run.R

@@ -225,6 +225,20 @@ CmdStanRun <- R6::R6Class(
 
 
 # run helpers -------------------------------------------------
+check_target_exe <- function(exe) {
+  exe_path <- file.path(cmdstan_path(), exe)
+  if (!file.exists(exe_path)) {
+    run_log <- processx::run(
+      command = make_cmd(),
+      args = exe,
+      wd = cmdstan_path(),
+      echo_cmd = TRUE,
+      echo = TRUE,
+      error_on_status = TRUE
+    )
+  }
+}
+
 .run_sample <- function(mpi_cmd = NULL, mpi_args = NULL) {
   procs <- self$procs
   on.exit(procs$cleanup(), add = TRUE)
@@ -257,11 +271,11 @@ CmdStanRun <- R6::R6Class(
         if (is.null(mpi_n_process)) {
           start_msg <- paste0("Running MCMC with ", procs$num_procs(), " chains using MPI")
         } else {
-          start_msg <- paste0("Running MCMC with ", procs$num_procs(), " chains using MPI with ", mpi_n_process, " processes")          
-        }        
+          start_msg <- paste0("Running MCMC with ", procs$num_procs(), " chains using MPI with ", mpi_n_process, " processes")
+        }
       } else {
         start_msg <- paste0("Running MCMC with ", procs$num_procs(), " sequential chains")
-      }      
+      }
     } else {
       start_msg <- paste0("Running MCMC with ", procs$num_procs(), " chains, at most ", procs$parallel_procs(), " in parallel")
     }
@@ -436,8 +450,8 @@ CmdStanRun$set("private", name = "run_generate_quantities_", value = .run_genera
 CmdStanRun$set("private", name = "run_optimize_", value = .run_other)
 CmdStanRun$set("private", name = "run_variational_", value = .run_other)
 
-# CmdStanProcs ------------------------------------------------------------
 
+# CmdStanProcs ------------------------------------------------------------
 # System processes for model fitting
 CmdStanProcs <- R6::R6Class(
   classname = "CmdStanProcs",
@@ -658,15 +672,15 @@ CmdStanProcs <- R6::R6Class(
           }
           if (private$proc_state_[[id]] == 3.5) {
             message(line)
-          } else if ((private$show_stdout_messages_ && private$proc_state_[[id]] >= 3) || is_verbose_mode()) {        
+          } else if ((private$show_stdout_messages_ && private$proc_state_[[id]] >= 3) || is_verbose_mode()) {
             cat(line, collapse = "\n")
           }
         } else {
           # after the metadata is printed and we found a blank line
           # this represents the start of fitting
           if (self$proc_state(id) == 2.5) {
               self$set_proc_state(id, new_state = 3)
-          } 
+          }
         }
       }
       invisible(self)
@@ -686,7 +700,7 @@ CmdStanProcs <- R6::R6Class(
         ret <- c(ret, self$get_proc(id)$get_exit_status())
       }
       ret
-    }    
+    }
   ),
   private = list(
     processes_ = NULL, # will be list of processx::process objects
@@ -885,7 +899,7 @@ CmdStanGQProcs <- R6::R6Class(
           # this represents the start of fitting
           if (self$proc_state(id) == 1.5) {
               self$set_proc_state(id, new_state = 2)
-          } 
+          }
         }
       }
       invisible(self)

R/utils.R

@@ -1,50 +1,46 @@
 # misc --------------------------------------------------------------------
 
-#' Check for Windows
-#' @return `TRUE` if OS is Windows, `FALSE` if not.
-#' @noRd
+suggest_package <- function(pkg) {
+  if (!requireNamespace(pkg, quietly = TRUE)) {
+    stop("Please install the ", pkg, " package to use this function.",
+         call. = FALSE)
+  }
+}
+
+is_verbose_mode <- function() {
+  getOption("cmdstanr_verbose", default = FALSE)
+}
+
+# Famous helper for switching on `NULL` or zero length
+`%||%` <- function(x, y) {
+  if (is.null(x) || length(x) == 0) y else x
+}
+
+
+# checks for OS and hardware ----------------------------------------------
+
 os_is_windows <- function() {
   isTRUE(.Platform$OS.type == "windows")
 }
 
-#' Check for macOS
-#' @return `TRUE` if OS is macOS, `FALSE` if not.
-#' @noRd
 os_is_macos <- function() {
   isTRUE(Sys.info()[["sysname"]] == "Darwin")
 }
 
-is_verbose_mode <- function() {
-  getOption("cmdstanr_verbose", default = FALSE)
-}
-
-#' Check if running R in Rosetta 2 translation environment, which is an
-#' Intel-to-ARM translation layer.
-#' @return `TRUE` if it is running rosetta2, `FALSE` if not.
-#' @noRd
+# Check if running R in Rosetta 2 translation environment, which is an
+# Intel-to-ARM translation layer.
 is_rosetta2 <- function() {
   rosetta2 <- FALSE
   if (os_is_macos()) {
     rosetta2_check <- processx::run("/usr/sbin/sysctl",
-                                       args = c("-n", "sysctl.proc_translated"),
-                                       error_on_status = FALSE)
+                                    args = c("-n", "sysctl.proc_translated"),
+                                    error_on_status = FALSE)
     rosetta2 <- rosetta2_check$stdout == "1\n"
   }
   rosetta2
 }
 
-#' Famous helper for switching on `NULL` or zero length
-#' @noRd
-#' @param x,y Any \R objects.
-#' @return `x` if not `NULL` or length zero, otherwise `y` regardless of whether
-#'   `y` is `NULL`.
-`%||%` <- function(x, y) {
-  if (is.null(x) || length(x) == 0) y else x
-}
-
-#' Returns the type of make command to use to compile
-#' @return Returns "mingw32-make" if using cmdstan 2.21+ and running Windows
-#' @noRd
+# Returns the type of make command to use to compile depending on the OS
 make_cmd <- function() {
   # Cmdstan 2.21 introduced TBB that requires mingw32-make on Windows
   ver <- .cmdstanr$VERSION
@@ -55,9 +51,7 @@ make_cmd <- function() {
   }
 }
 
-#' Returns the stanc exe path
-#' @return Returns "bin/stanc.exe" if running Windows, "bin/stanc" otherwise
-#' @noRd
+# Returns the stanc exe path depending on the OS
 stanc_cmd <- function() {
   if (os_is_windows()) {
     "bin/stanc.exe"
@@ -66,20 +60,6 @@ stanc_cmd <- function() {
   }
 }
 
-check_target_exe <- function(exe) {
-  exe_path <- file.path(cmdstan_path(), exe)
-  if (!file.exists(exe_path)) {
-    run_log <- processx::run(
-      command = make_cmd(),
-      args = exe,
-      wd = cmdstan_path(),
-      echo_cmd = TRUE,
-      echo = TRUE,
-      error_on_status = TRUE
-    )
-  }
-}
-
 
 # paths and extensions ----------------------------------------------------
 

tests/testthat/test-knitr.R

@@ -1,7 +1,6 @@
 context("knitr engine")
 
 test_that("eng_cmdstan throws correct errors", {
-  skip_on_cran()
   skip_if_not_installed("knitr")
   expect_error(eng_cmdstan(list(output.var = 1)), "must be a character string")
   expect_error(eng_cmdstan(list(output.var = c("A", "B"))), "must be a character string")
@@ -23,7 +22,6 @@ test_that("eng_cmdstan works", {
 })
 
 test_that("register_knitr_engine works with and without override", {
-  skip_on_cran()
   skip_if_not_installed("knitr")
 
   knitr::knit_engines$delete(keys = "stan")