diff --git a/NEWS.md b/NEWS.md index 0d9abd591..b12c14fe1 100644 --- a/NEWS.md +++ b/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) diff --git a/R/install.R b/R/install.R index 8db35a700..fcdb36d14 100644 --- a/R/install.R +++ b/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().", diff --git a/R/model.R b/R/model.R index 85eb29e54..929e38cfb 100644 --- a/R/model.R +++ b/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) diff --git a/R/read_csv.R b/R/read_csv.R index 546312ff9..3c279891d 100644 --- a/R/read_csv.R +++ b/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 diff --git a/R/run.R b/R/run.R index 86606e4fe..12fb1e660 100644 --- a/R/run.R +++ b/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") diff --git a/R/utils.R b/R/utils.R index 5a28b7c24..b6ba45ae2 100644 --- a/R/utils.R +++ b/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. diff --git a/tests/testthat/test-fit-mcmc.R b/tests/testthat/test-fit-mcmc.R index 2aeb288c9..e9e64e1ee 100644 --- a/tests/testthat/test-fit-mcmc.R +++ b/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) diff --git a/vignettes/cmdstanr-internals.Rmd b/vignettes/cmdstanr-internals.Rmd index bffc375c4..807f039b6 100644 --- a/vignettes/cmdstanr-internals.Rmd +++ b/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) +```