Add a quiet argument to init_model_methods() and expose_functions()

NEWS.md

@@ -184,6 +184,9 @@ computation, which can be very slow. Set `r_eff = TRUE` for the previous
 behavior. (#1091)
 * `$log_prob()`, `$grad_log_prob()`, and other model methods are now faster
 after initialization. (#1274)
+* `fit$init_model_methods()` and `$expose_functions()` gain a `quiet` argument
+that suppresses the messages printed while the methods or functions compile.
+(#914)
 * `install_cmdstan()` now offers to copy the `make/local` flags of the
 current installation into the new one before building it, so the new CmdStan is
 built with the same flags. In an interactive session it shows the previous

R/expose.R

@@ -106,8 +106,8 @@ drop_stale_standalone_functions <- function(env) {
   invisible(TRUE)
 }
 
-expose_model_methods <- function(env, verbose = FALSE) {
-  if (rlang::is_interactive()) {
+expose_model_methods <- function(env, verbose = FALSE, quiet = FALSE) {
+  if (!quiet && rlang::is_interactive()) {
     message("Compiling additional model methods...")
   }
   code <- c(env$hpp_code_,
@@ -282,7 +282,8 @@ compile_functions <- function(env, verbose = FALSE, global = FALSE) {
   invisible(NULL)
 }
 
-expose_stan_functions <- function(function_env, global = FALSE, verbose = FALSE) {
+expose_stan_functions <- function(function_env, global = FALSE,
+                                   verbose = FALSE, quiet = FALSE) {
   if (os_is_wsl()) {
     stop("Standalone functions are not currently available with ",
           "WSL CmdStan and will not be compiled",
@@ -301,9 +302,13 @@ expose_stan_functions <- function(function_env, global = FALSE, verbose = FALSE)
   drop_stale_standalone_functions(function_env)
   if (function_env$compiled) {
     if (!global) {
-      message("Functions already compiled, nothing to do!")
+      if (!quiet) {
+        message("Functions already compiled, nothing to do!")
+      }
     } else {
-      message("Functions already compiled, copying to global environment")
+      if (!quiet) {
+        message("Functions already compiled, copying to global environment")
+      }
       # Create reference to global environment, avoids NOTE about assigning to global
       pos <- 1
       envir <- as.environment(pos)
@@ -312,7 +317,7 @@ expose_stan_functions <- function(function_env, global = FALSE, verbose = FALSE)
       })
     }
   } else {
-    if (rlang::is_interactive()) {
+    if (!quiet && rlang::is_interactive()) {
       message("Compiling standalone functions...")
     }
     compile_functions(function_env, verbose, global)

R/fit.R

@@ -81,8 +81,9 @@ CmdStanFit <- R6::R6Class(
       }
       invisible(self)
     },
-    expose_functions = function(global = FALSE, verbose = FALSE) {
-      expose_stan_functions(self$functions, global, verbose)
+    expose_functions = function(global = FALSE, verbose = FALSE,
+                                 quiet = FALSE) {
+      expose_stan_functions(self$functions, global, verbose, quiet)
       invisible(NULL)
     }
   ),
@@ -379,6 +380,9 @@ CmdStanFit$set("public", name = "init", value = init)
 #'
 #' @param seed (integer) The random seed to use when initializing the model.
 #' @param verbose (logical) Whether to show verbose logging during compilation.
+#' @param quiet (logical) Should the message announcing the compilation be
+#'   suppressed? The default is `FALSE`. Compiler output is controlled by
+#'   `verbose`.
 #'
 #' @return `NULL`, invisibly.
 #'
@@ -391,7 +395,7 @@ CmdStanFit$set("public", name = "init", value = init)
 #'   [unconstrain_variables()], [unconstrain_draws()], [variable_skeleton()],
 #'   [hessian()]
 #'
-init_model_methods <- function(seed = 1, verbose = FALSE) {
+init_model_methods <- function(seed = 1, verbose = FALSE, quiet = FALSE) {
   if (model_methods_are_live(private$model_methods_env_)) {
     return(invisible(NULL))
   }
@@ -408,7 +412,7 @@ init_model_methods <- function(seed = 1, verbose = FALSE) {
   }
   if (is.null(private$model_methods_env_$model_ptr)) {
     require_suggested_package("Rcpp")
-    expose_model_methods(private$model_methods_env_, verbose)
+    expose_model_methods(private$model_methods_env_, verbose, quiet)
   }
   if (!model_methods_are_live(private$model_methods_env_)) {
     initialize_model_pointer(private$model_methods_env_, self$data_file(), seed)

R/model.R

@@ -2099,6 +2099,9 @@ CmdStanModel$set("public", name = "diagnose", value = diagnose)
 #'   available via the `functions` field of the R6 object.
 #' @param verbose (logical) Should detailed information about generated code be
 #'   printed to the console? Defaults to `FALSE`.
+#' @param quiet (logical) Should the messages saying the functions are being
+#'   compiled, or are already compiled, be suppressed? The default is `FALSE`.
+#'   Compiler output is controlled by `verbose`.
 #' @return `NULL`, invisibly.
 #' @template seealso-docs
 #' @examples
@@ -2128,9 +2131,10 @@ CmdStanModel$set("public", name = "diagnose", value = diagnose)
 #' }
 #'
 #'
-expose_functions = function(global = FALSE, verbose = FALSE) {
+expose_functions = function(global = FALSE, verbose = FALSE, quiet = FALSE) {
   private$assert_current()
-  expose_stan_functions(private$standalone_functions(), global, verbose)
+  expose_stan_functions(private$standalone_functions(), global, verbose,
+                         quiet)
   invisible(NULL)
 }
 CmdStanModel$set("public", name = "expose_functions", value = expose_functions)

tests/testthat/test-model-expose-functions.R

@@ -527,3 +527,17 @@ test_that("Functions with SUNDIALS/KINSOL methods link correctly", {
   mod <- cmdstan_model(write_stan_file(modcode), force_recompile=TRUE)
   expect_no_error(mod$expose_functions())
 })
+
+test_that("expose_functions(quiet = TRUE) suppresses the messages", {
+  rlang::local_interactive(TRUE)
+  local_mocked_bindings(compile_functions = function(...) invisible(NULL))
+  env <- new.env()
+  env$hpp_code <- "// [[stan::function]]"
+  env$compiled <- FALSE
+  expect_message(expose_stan_functions(env), "Compiling standalone functions")
+  expect_no_message(expose_stan_functions(env, quiet = TRUE))
+  env$compiled <- TRUE
+  env$fun_names <- "f"
+  expect_message(expose_stan_functions(env), "already compiled")
+  expect_no_message(expose_stan_functions(env, quiet = TRUE))
+})

tests/testthat/test-model-methods.R

@@ -386,3 +386,13 @@ test_that("model methods refuse a fit from an executable alone", {
     "created from an executable alone", fixed = TRUE
   )
 })
+
+test_that("init_model_methods(quiet = TRUE) suppresses the message", {
+  rlang::local_interactive(TRUE)
+  local_mocked_bindings(rcpp_source_stan = function(...) invisible(NULL))
+  env <- new.env()
+  env$hpp_code_ <- "// no code"
+  expect_message(expose_model_methods(env),
+                 "Compiling additional model methods")
+  expect_no_message(expose_model_methods(env, quiet = TRUE))
+})