verbose mode and replace regexpr

NEWS.md

@@ -8,6 +8,10 @@
 
 * Added informative messages on compile errors caused by precompiled headers (PCH). (#384)
 
+* Added the `cmdstanr_verbose` option for verbose mode. Intended for
+troubleshooting, debugging and development. See end of *How does CmdStanR work?*
+vignette for details. (#392)
+
 * New `loo()` method for CmdStanMCMC objects. Requires computing pointwise
 log-likelihood in Stan program. (#366)
 

R/install.R

@@ -347,8 +347,8 @@ build_cmdstan <- function(dir,
     run_cmd,
     args = c(translation_args, paste0("-j", cores), "build"),
     wd = dir,
-    echo_cmd = FALSE,
-    echo = !quiet,
+    echo_cmd = is_verbose_mode(),
+    echo = !quiet || is_verbose_mode(),
     spinner = quiet,
     error_on_status = FALSE,
     stderr_line_callback = function(x,p) { if (quiet) message(x) },
@@ -394,8 +394,8 @@ clean_cmdstan <- function(dir = cmdstan_path(),
     make_cmd(),
     args = c("clean-all"),
     wd = dir,
-    echo_cmd = FALSE,
-    echo = !quiet,
+    echo_cmd = is_verbose_mode(),
+    echo = !quiet || is_verbose_mode(),
     spinner = quiet,
     error_on_status = FALSE,
     stderr_line_callback = function(x,p) { if (quiet) message(x) }
@@ -408,8 +408,8 @@ build_example <- function(dir, cores, quiet, timeout) {
     make_cmd(),
     args = c(paste0("-j", cores), cmdstan_ext("examples/bernoulli/bernoulli")),
     wd = dir,
-    echo_cmd = FALSE,
-    echo = !quiet,
+    echo_cmd = is_verbose_mode(),
+    echo = !quiet || is_verbose_mode(),
     spinner = quiet,
     error_on_status = FALSE,
     stderr_line_callback = function(x,p) { if (quiet) message(x) },
@@ -464,7 +464,9 @@ install_mingw32_make <- function(quiet = FALSE) {
     "pacman",
     args = c("-Syu", "mingw-w64-x86_64-make","--noconfirm"),
     wd = rtools_usr_bin,
-    error_on_status = TRUE
+    error_on_status = TRUE,
+    echo_cmd = is_verbose_mode(),
+    echo = is_verbose_mode()
   )
   write('PATH="${RTOOLS40_HOME}\\usr\\bin;${RTOOLS40_HOME}\\mingw64\\bin;${PATH}"', file = "~/.Renviron", append = TRUE)
   Sys.setenv(PATH = paste0(Sys.getenv("RTOOLS40_HOME"), "\\usr\\bin;", Sys.getenv("RTOOLS40_HOME"), "\\mingw64\\bin;", Sys.getenv("PATH")))
@@ -484,7 +486,7 @@ check_rtools40_windows_toolchain <- function(fix = FALSE, quiet = FALSE) {
   }
   # If RTools is installed in a path with spaces or brackets
   # we error as this path is not valid
-  if (regexpr("\\(|)| ", rtools_path) > 0) {
+  if (grepl("\\(|)| ", rtools_path)) {
     stop(
       "\nRTools 4.0 is installed in a path with spaces or brackets, which is not supported.",
       "\nPlease reinstall RTools 4.0 to a valid path, restart R, and then run check_cmdstan_toolchain().",

R/model.R

@@ -454,7 +454,7 @@ compile_method <- function(quiet = TRUE,
   if (cmdstan_version() >= "2.21" && os_is_windows()) {
     path_to_TBB <- file.path(cmdstan_path(), "stan", "lib", "stan_math", "lib", "tbb")
     current_path <- Sys.getenv("PATH")
-    if (regexpr("path_to_TBB", current_path, perl = TRUE) <= 0) {
+    if (!grepl(path_to_TBB, current_path, perl = TRUE)) {
       Sys.setenv(PATH = paste0(path_to_TBB, ";", Sys.getenv("PATH")))
     }
   }
@@ -500,12 +500,13 @@ compile_method <- function(quiet = TRUE,
              cpp_options_to_compile_flags(cpp_options),
              stancflags_val),
     wd = cmdstan_path(),
-    echo = !quiet,
+    echo = !quiet || is_verbose_mode(),
+    echo_cmd = is_verbose_mode(),
     spinner = quiet && interactive(),
     stderr_line_callback = function(x,p) {
       if (!startsWith(x, paste0(make_cmd(), ": *** No rule to make target"))) message(x)
-      if (regexpr("PCH file uses an older PCH format that is no longer supported", x, fixed = TRUE) > 0
-          || regexpr("PCH file built from a different branch", x, fixed = TRUE) > 0) {
+      if (grepl("PCH file uses an older PCH format that is no longer supported", x, fixed = TRUE)
+          || grepl("PCH file built from a different branch", x, fixed = TRUE)) {
         warning("Cmdstan encountered an issue with an outdated precompiled header (PCH). Run rebuild_cmdstan() to rebuild the PCH files.\n",
         "If the issue persists please open a bug report.")
       }
@@ -648,7 +649,8 @@ check_syntax_method <- function(pedantic = FALSE,
     command = stanc_cmd(),
     args = c(self$stan_file(), stanc_built_options, stancflags_val),
     wd = cmdstan_path(),
-    echo = FALSE,
+    echo = is_verbose_mode(),
+    echo_cmd = is_verbose_mode(),
     spinner = quiet && interactive(),
     stdout_line_callback = function(x,p) {
       if (!quiet) cat(x)

R/read_csv.R

@@ -422,15 +422,15 @@ read_csv_metadata <- function(csv_file) {
       }
     } else {
       parse_key_val <- TRUE
-      if (regexpr("# Diagonal elements of inverse mass matrix:", line, perl = TRUE) > 0
-          || regexpr("# Elements of inverse mass matrix:", line, perl = TRUE) > 0) {
+      if (grepl("# Diagonal elements of inverse mass matrix:", line, perl = TRUE)
+          || grepl("# Elements of inverse mass matrix:", line, perl = TRUE)) {
         inv_metric_next <- TRUE
         parse_key_val <- FALSE
       } else if (inv_metric_next) {
         inv_metric_split <- strsplit(gsub("# ", "", line), ",")
         if ((length(inv_metric_split) == 0) ||
             ((length(inv_metric_split) == 1) && identical(inv_metric_split[[1]], character(0))) ||
-            regexpr("[a-zA-z]", line, perl = TRUE) > 0 ||
+            grepl("[a-zA-z]", line, perl = TRUE) ||
             inv_metric_split == "#") {
           parsing_done <- TRUE
           parse_key_val <- TRUE

R/run.R

@@ -175,6 +175,7 @@ CmdStanRun <- R6::R6Class(
         args = c(self$output_files(include_failed = FALSE), flags),
         wd = cmdstan_path(),
         echo = TRUE,
+        echo_cmd = is_verbose_mode(),
         error_on_status = TRUE
       )
     },
@@ -237,7 +238,7 @@ CmdStanRun <- R6::R6Class(
   if (cmdstan_version() >= "2.21" && os_is_windows()) {
     path_to_TBB <- file.path(cmdstan_path(), "stan", "lib", "stan_math", "lib", "tbb")
     current_path <- Sys.getenv("PATH")
-    if (regexpr("path_to_TBB", current_path, perl = TRUE) <= 0) {
+    if (!grepl(path_to_TBB, current_path, perl = TRUE)) {
       Sys.setenv(PATH = paste0(path_to_TBB, ";", Sys.getenv("PATH")))
     }
   }
@@ -320,7 +321,7 @@ CmdStanRun$set("private", name = "run_sample_", value = .run_sample)
   if (cmdstan_version() >= "2.21" && os_is_windows()) {
     path_to_TBB <- file.path(cmdstan_path(), "stan", "lib", "stan_math", "lib", "tbb")
     current_path <- Sys.getenv("PATH")
-    if (regexpr("path_to_TBB", current_path, perl = TRUE) <= 0) {
+    if (!grepl(path_to_TBB, current_path, perl = TRUE)) {
       Sys.setenv(PATH = paste0(path_to_TBB, ";", Sys.getenv("PATH")))
     }
   }
@@ -386,7 +387,7 @@ CmdStanRun$set("private", name = "run_generate_quantities_", value = .run_genera
   if (cmdstan_version() >= "2.21" && os_is_windows()) {
     path_to_TBB <- file.path(cmdstan_path(), "stan", "lib", "stan_math", "lib", "tbb")
     current_path <- Sys.getenv("PATH")
-    if (regexpr("path_to_TBB", current_path, perl = TRUE) <= 0) {
+    if (!grepl(path_to_TBB, current_path, perl = TRUE)) {
       Sys.setenv(PATH = paste0(path_to_TBB, ";", Sys.getenv("PATH")))
     }
   }
@@ -516,7 +517,8 @@ CmdStanProcs <- R6::R6Class(
         args = args,
         wd = wd,
         stdout = "|",
-        stderr = "|"
+        stderr = "|",
+        echo_cmd = is_verbose_mode()
       )
       invisible(self)
     },
@@ -624,9 +626,9 @@ CmdStanProcs <- R6::R6Class(
     },
     is_error_message = function(line) {
       startsWith(line, "Exception:") ||
-      (regexpr("either mistyped or misplaced.", line, perl = TRUE) > 0) ||
-      (regexpr("A method must be specified!", line, perl = TRUE) > 0) ||
-      (regexpr("is not a valid value for", line, perl = TRUE) > 0)
+      (grepl("either mistyped or misplaced.", line, perl = TRUE)) ||
+      (grepl("A method must be specified!", line, perl = TRUE)) ||
+      (grepl("is not a valid value for", line, perl = TRUE))
     },
     process_error_output = function(err_out, id) {
       if (length(err_out)) {
@@ -645,18 +647,18 @@ CmdStanProcs <- R6::R6Class(
       for (line in out) {
         private$proc_output_[[id]] <- c(private$proc_output_[[id]], line)
         if (nzchar(line)) {
-          if (regexpr("Optimization terminated with error", line, perl = TRUE) > 0) {
+          if (grepl("Optimization terminated with error", line, perl = TRUE)) {
             self$set_proc_state(id, new_state = 3.5)
           }
-          if (regexpr("Optimization terminated normally", line, perl = TRUE) > 0) {
+          if (grepl("Optimization terminated normally", line, perl = TRUE)) {
             self$set_proc_state(id, new_state = 4)
           }
-          if (self$proc_state(id) == 2 && regexpr("refresh = ", line, perl = TRUE) > 0) {
+          if (self$proc_state(id) == 2 && grepl("refresh = ", line, perl = TRUE)) {
             self$set_proc_state(id, new_state = 2.5)
           }
           if (private$proc_state_[[id]] == 3.5) {
             message(line)
-          } else if (private$show_stdout_messages_ && private$proc_state_[[id]] >= 3) {        
+          } else if ((private$show_stdout_messages_ && private$proc_state_[[id]] >= 3) || is_verbose_mode()) {        
             cat(line, collapse = "\n")
           }
         } else {
@@ -732,50 +734,50 @@ CmdStanMCMCProcs <- R6::R6Class(
           # (Note: state 2 is only used because rejection in cmdstan is printed
           # to stdout not stderr and we want to avoid printing the intial chain metadata)
           next_state <- state
-          if (state < 3 && regexpr("refresh =", line, perl = TRUE) > 0) {
+          if (state < 3 && grepl("refresh =", line, perl = TRUE)) {
             state <- 1.5
             next_state <- 1.5
           }
-          if (state <= 3 && regexpr("Rejecting initial value:", line, perl = TRUE) > 0) {
+          if (state <= 3 && grepl("Rejecting initial value:", line, perl = TRUE)) {
             state <- 2
             next_state <- 2
           }
-          if (state < 3 && regexpr("Iteration:", line, perl = TRUE) > 0) {
+          if (state < 3 && grepl("Iteration:", line, perl = TRUE)) {
             state <- 3 # 3 =  warmup
             next_state <- 3
           }
-          if (state < 3 && regexpr("Elapsed Time:", line, perl = TRUE) > 0) {
+          if (state < 3 && grepl("Elapsed Time:", line, perl = TRUE)) {
             state <- 5 # 5 = end of samp+ling
             next_state <- 5
           }
           if (private$proc_state_[[id]] == 3 &&
-              regexpr("(Sampling)", line, perl = TRUE) > 0) {
+              grepl("(Sampling)", line, perl = TRUE)) {
             next_state <- 4 # 4 = sampling
           }
-          if (regexpr("\\[100%\\]", line, perl = TRUE) > 0) {
+          if (grepl("\\[100%\\]", line, perl = TRUE)) {
             next_state <- 5 # writing csv and finishing
           }
-          if (regexpr("seconds (Total)", line, fixed = TRUE) > 0) {
+          if (grepl("seconds (Total)", line, fixed = TRUE)) {
             private$proc_total_time_[[id]] <- as.double(trimws(sub("seconds (Total)", "", line, fixed = TRUE)))
             next_state <- 5
             state <- 5
           }
-          if (regexpr("seconds (Sampling)", line, fixed = TRUE) > 0) {
+          if (grepl("seconds (Sampling)", line, fixed = TRUE)) {
             private$proc_section_time_[id, "sampling"] <- as.double(trimws(sub("seconds (Sampling)", "", line, fixed = TRUE)))
             next_state <- 5
             state <- 5
           }
-          if (regexpr("seconds (Warm-up)", line, fixed = TRUE) > 0) {
+          if (grepl("seconds (Warm-up)", line, fixed = TRUE)) {
             private$proc_section_time_[id, "warmup"] <- as.double(trimws(sub("Elapsed Time: ", "", sub("seconds (Warm-up)", "", line, fixed = TRUE), fixed = TRUE)))
             next_state <- 5
             state <- 5
           }
-          if (regexpr("Gradient evaluation took",line, fixed = TRUE) > 0
-              || regexpr("leapfrog steps per transition would take",line, fixed = TRUE) > 0
-              || regexpr("Adjust your expectations accordingly!",line, fixed = TRUE) > 0) {
+          if (grepl("Gradient evaluation took",line, fixed = TRUE)
+              || grepl("leapfrog steps per transition would take",line, fixed = TRUE)
+              || grepl("Adjust your expectations accordingly!",line, fixed = TRUE)) {
             ignore_line <- TRUE
           }
-          if (state > 1.5 && state < 5 && !ignore_line) {
+          if ((state > 1.5 && state < 5 && !ignore_line) || is_verbose_mode()) {
             if (state == 2) {
               message("Chain ", id, " ", line)
             } else {
@@ -873,7 +875,7 @@ CmdStanGQProcs <- R6::R6Class(
       for (line in out) {
         private$proc_output_[[id]] <- c(private$proc_output_[[id]], line)
         if (nzchar(line)) {
-          if (self$proc_state(id) == 1 && regexpr("refresh = ", line, perl = TRUE) > 0) {
+          if (self$proc_state(id) == 1 && grepl("refresh = ", line, perl = TRUE)) {
             self$set_proc_state(id, new_state = 1.5)
           } else if (self$proc_state(id) >= 2) {
             cat("Chain", id, line, "\n")

R/utils.R

@@ -14,6 +14,10 @@ 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.

tests/testthat/test-fit-mcmc.R

@@ -179,17 +179,17 @@ test_that("time() method works after mcmc", {
     warmup_time <- NULL
     total_time <- NULL
     for (l in readLines(fit_mcmc_0$output_files()[j])) {
-      if (regexpr("seconds (Sampling)", l, fixed = TRUE) > 0) {
+      if (grepl("seconds (Sampling)", l, fixed = TRUE)) {
         l <- sub("seconds (Sampling)", "", l, fixed = TRUE)
         l <- trimws(sub("#", "", l, fixed = TRUE))
         sampling_time <- as.double(l)
       }
-      if (regexpr("seconds (Warm-up)", l, fixed = TRUE) > 0) {
+      if (grepl("seconds (Warm-up)", l, fixed = TRUE)) {
         l <- sub("seconds (Warm-up)", "", l, fixed = TRUE)
         l <- trimws(sub("#  Elapsed Time: ", "", l, fixed = TRUE))
         warmup_time <- as.double(l)
       }
-      if (regexpr("seconds (Total)", l, fixed = TRUE) > 0) {
+      if (grepl("seconds (Total)", l, fixed = TRUE)) {
         l <- sub("seconds (Total)", "", l, fixed = TRUE)
         l <- trimws(sub("#", "", l, fixed = TRUE))
         total_time <- as.double(l)

vignettes/cmdstanr-internals.Rmd

@@ -405,4 +405,31 @@ fit <- readRDS(temp_rds_file)
 fit$summary()
 ```
 
+## Developing using CmdStanR
 
+CmdStanR can of course be used for developing other packages that require compiling
+and running Stan models as well as using new or custom Stan features available
+through CmdStan.
+
+### Troubleshooting and debugging
+
+When developing or testing new features it might be useful to have more
+information on how CmdStan is called internally and to see more information
+printed when compiling or running models. This can be enabled for an entire R
+session by setting the option `"cmdstanr_verbose"` to `TRUE`.
+
+```{r verbose-mode}
+options("cmdstanr_verbose"=TRUE)
+
+mod <- cmdstan_model(stan_file, force_recompile = TRUE)
+fit <- mod$sample(
+  data = data_list,
+  chains = 1,
+  iter_warmup = 100,
+  iter_sampling = 100
+)
+```
+
+```{r include=FALSE}
+options("cmdstanr_verbose" = FALSE)
+```