diff --git a/NAMESPACE b/NAMESPACE index 26b27b5d..b6decc51 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -36,7 +36,9 @@ export(cmdstanr_example) export(draws_to_csv) export(eng_cmdstan) export(install_cmdstan) +export(parse_cmdstan_args) export(print_example_program) +export(print_stan_file) export(read_cmdstan_csv) export(rebuild_cmdstan) export(register_knitr_engine) diff --git a/R/example.R b/R/example.R index 085ac791..17255818 100644 --- a/R/example.R +++ b/R/example.R @@ -84,104 +84,3 @@ print_example_program <- code <- readLines(system.file(paste0(example, ".stan"), package = "cmdstanr")) cat(code, sep = "\n") } - - - -# including write_stan_file in example.R since it will be mostly used -# in examples - -#' Write Stan code to a file -#' -#' Convenience function for writing Stan code to a (possibly -#' [temporary][base::tempfile]) file with a `.stan` extension. By default, the -#' file name is chosen deterministically based on a [hash][rlang::hash()] -#' of the Stan code, and the file is not overwritten if it already has correct -#' contents. This means that calling this function multiple times with the same -#' Stan code will reuse the compiled model. This also however means that the -#' function is potentially not thread-safe. Using `hash_salt = Sys.getpid()` -#' should ensure thread-safety in the rare cases when it is needed. -#' -#' @export -#' @param code (character vector) The Stan code to write to the file. This can -#' be a character vector of length one (a string) containing the entire Stan -#' program or a character vector with each element containing one line of the -#' Stan program. -#' @param dir (string) An optional path to the directory where the file will be -#' written. If omitted, a global option `cmdstanr_write_stan_file_dir` is -#' used. If the global options is not set, [temporary directory][base::tempdir] -#' is used. -#' @param basename (string) If `dir` is specified, optionally the basename to -#' use for the file created. If not specified a file name is generated -#' from [hashing][rlang::hash()] the code. -#' @param force_overwrite (logical) If set to `TRUE` the file will always be -#' overwritten and thus the resulting model will always be recompiled. -#' @param hash_salt (string) Text to add to the model code prior to hashing to -#' determine the file name if `basename` is not set. -#' @return The path to the file. -#' -#' @examples -#' # stan program as a single string -#' stan_program <- " -#' data { -#' int N; -#' array[N] int y; -#' } -#' parameters { -#' real theta; -#' } -#' model { -#' y ~ bernoulli(theta); -#' } -#' " -#' -#' f <- write_stan_file(stan_program) -#' print(f) -#' -#' lines <- readLines(f) -#' print(lines) -#' cat(lines, sep = "\n") -#' -#' # stan program as character vector of lines -#' f2 <- write_stan_file(lines) -#' identical(readLines(f), readLines(f2)) -#' -write_stan_file <- function(code, - dir = getOption("cmdstanr_write_stan_file_dir", tempdir()), - basename = NULL, - force_overwrite = FALSE, - hash_salt = "") { - dir <- absolute_path(dir) - if (!dir.exists(dir)) { - dir.create(dir, recursive = TRUE) - } - collapsed_code <- paste0(code, collapse = "\n") - - if (!is.null(basename)) { - if (!endsWith(basename, ".stan")) { - basename <- paste0(basename, ".stan") - } - file <- file.path(dir, basename) - } else { - require_suggested_package("rlang") - hash <- rlang::hash(paste0(hash_salt, collapsed_code)) - file <- file.path(dir, paste0("model_", hash, ".stan")) - } - overwrite <- TRUE - # Do not overwrite file if it has the correct contents (to avoid recompilation) - if (!force_overwrite && file.exists(file)) { - tryCatch({ - file_contents <- paste0(readLines(file), collapse = "\n") - if (gsub("\r|\n", "\n", file_contents) == gsub("\r|\n", "\n", collapsed_code)) { - overwrite <- FALSE - } - }, - error = function(e) { - warning("Error when checking old file contents", e) - }) - } - - if (overwrite) { - cat(code, file = file, sep = "\n") - } - file -} diff --git a/R/file.R b/R/file.R new file mode 100644 index 00000000..631536cf --- /dev/null +++ b/R/file.R @@ -0,0 +1,168 @@ +#' Write Stan code to a file +#' +#' Convenience function for writing Stan code to a (possibly +#' [temporary][base::tempfile]) file with a `.stan` extension. By default, the +#' file name is chosen deterministically based on a [hash][rlang::hash()] +#' of the Stan code, and the file is not overwritten if it already has correct +#' contents. This means that calling this function multiple times with the same +#' Stan code will reuse the compiled model. This also however means that the +#' function is potentially not thread-safe. Using `hash_salt = Sys.getpid()` +#' should ensure thread-safety in the rare cases when it is needed. +#' +#' @export +#' @param code (character vector) The Stan code to write to the file. This can +#' be a character vector of length one (a string) containing the entire Stan +#' program or a character vector with each element containing one line of the +#' Stan program. +#' @param dir (string) An optional path to the directory where the file will be +#' written. If omitted, a global option `cmdstanr_write_stan_file_dir` is +#' used. If the global options is not set, [temporary directory][base::tempdir] +#' is used. +#' @param basename (string) If `dir` is specified, optionally the basename to +#' use for the file created. If not specified a file name is generated +#' from [hashing][rlang::hash()] the code. +#' @param force_overwrite (logical) If set to `TRUE` the file will always be +#' overwritten and thus the resulting model will always be recompiled. +#' @param hash_salt (string) Text to add to the model code prior to hashing to +#' determine the file name if `basename` is not set. +#' @return The path to the file. +#' +#' @examples +#' # stan program as a single string +#' stan_program <- " +#' data { +#' int N; +#' array[N] int y; +#' } +#' parameters { +#' real theta; +#' } +#' model { +#' y ~ bernoulli(theta); +#' } +#' " +#' +#' f <- write_stan_file(stan_program) +#' print(f) +#' +#' lines <- readLines(f) +#' print(lines) +#' cat(lines, sep = "\n") +#' +#' # stan program as character vector of lines +#' f2 <- write_stan_file(lines) +#' identical(readLines(f), readLines(f2)) +#' +write_stan_file <- function(code, + dir = getOption("cmdstanr_write_stan_file_dir", tempdir()), + basename = NULL, + force_overwrite = FALSE, + hash_salt = "") { + dir <- absolute_path(dir) + if (!dir.exists(dir)) { + dir.create(dir, recursive = TRUE) + } + collapsed_code <- paste0(code, collapse = "\n") + + if (!is.null(basename)) { + if (!endsWith(basename, ".stan")) { + basename <- paste0(basename, ".stan") + } + file <- file.path(dir, basename) + } else { + require_suggested_package("rlang") + hash <- rlang::hash(paste0(hash_salt, collapsed_code)) + file <- file.path(dir, paste0("model_", hash, ".stan")) + } + overwrite <- TRUE + # Do not overwrite file if it has the correct contents (to avoid recompilation) + if (!force_overwrite && file.exists(file)) { + tryCatch({ + file_contents <- paste0(readLines(file), collapse = "\n") + if (gsub("\r|\n", "\n", file_contents) == gsub("\r|\n", "\n", collapsed_code)) { + overwrite <- FALSE + } + }, + error = function(e) { + warning("Error when checking old file contents", e) + }) + } + + if (overwrite) { + cat(code, file = file, sep = "\n") + } + file +} + + +#' Print a Stan file with syntax highlighting in Quarto +#' +#' Prints the contents of a Stan file, optionally with syntax highlighting +#' when used in a Quarto or R Markdown document. When called inside a +#' [knitr][knitr::knitr-package] code chunk with the chunk option +#' `output: asis` (or `results: asis` in R Markdown), the output is a +#' fenced Stan code block that Quarto renders with syntax highlighting. +#' When called interactively or without `output: asis`, the code is +#' printed as plain text via [writeLines()]. +#' +#' @export +#' @param file (string) Path to a `.stan` file. +#' @param fold (logical) Whether to wrap the output in an HTML +#' `
` block so that the code is collapsed (folded) by +#' default. Only has an effect when rendering with `output: asis`. +#' Defaults to `FALSE`. +#' @param summary (string) The summary text shown in the fold toggle +#' when `fold = TRUE`. Defaults to `"Stan model code"`. +#' @return The file path (invisibly). +#' +#' @section Quarto usage: +#' Use in a Quarto code chunk with `output: asis` to get syntax +#' highlighting: +#' +#' ```` +#' ```{r} +#' #| output: asis +#' print_stan_file("path/to/model.stan") +#' ``` +#' ```` +#' +#' To make the code block collapsible: +#' +#' ```` +#' ```{r} +#' #| output: asis +#' print_stan_file("path/to/model.stan", fold = TRUE) +#' ``` +#' ```` +#' +#' @examples +#' stan_file <- write_stan_file(" +#' parameters { +#' real y; +#' } +#' model { +#' y ~ std_normal(); +#' } +#' ") +#' +#' # Prints plain code at the console +#' print_stan_file(stan_file) +#' +print_stan_file <- function(file, fold = FALSE, summary = "Stan model code") { + code <- readLines(file) + if (isTRUE(getOption("knitr.in.progress")) & + identical(knitr::opts_current$get("results"), "asis")) { + if (fold) { + cat("
", summary, "\n\n", sep = "") + } + cat("```stan\n") + cat(code, sep = "\n") + cat("\n```\n") + if (fold) { + cat("\n
\n") + } + } else { + writeLines(code) + } + invisible(file) +} diff --git a/_pkgdown.yml b/_pkgdown.yml index 123d2191..af774887 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -95,6 +95,7 @@ reference: - read_cmdstan_csv - write_stan_json - write_stan_file + - print_stan_file - draws_to_csv - as_mcmc.list - as_draws.CmdStanMCMC diff --git a/man/cmdstanr-package.Rd b/man/cmdstanr-package.Rd index c2ccbb1d..e6479f57 100644 --- a/man/cmdstanr-package.Rd +++ b/man/cmdstanr-package.Rd @@ -34,22 +34,22 @@ algorithms, and writing results to output files. \subsection{Advantages of RStan}{ \itemize{ \item Allows other developers to distribute R packages with \emph{pre-compiled} -Stan programs (like \strong{rstanarm}) on CRAN. (Note: As of 2023, this can -mostly be achieved with CmdStanR as well. See \href{https://mc-stan.org/cmdstanr/articles/cmdstanr-internals.html#developing-using-cmdstanr}{Developing using CmdStanR}.) -\item Avoids use of R6 classes, which may result in more familiar syntax for -many R users. +Stan programs (like \strong{rstanarm}) on CRAN. (Note: As of 2023, this +can mostly be achieved with CmdStanR as well. See \href{https://mc-stan.org/cmdstanr/articles/cmdstanr-internals.html#developing-using-cmdstanr}{Developing using CmdStanR}.) +\item Avoids use of R6 classes, which may result in more familiar syntax +for many R users. \item CRAN binaries available for Mac and Windows. } } \subsection{Advantages of CmdStanR}{ \itemize{ -\item Compatible with latest versions of Stan. Keeping up with Stan releases -is complicated for RStan, often requiring non-trivial changes to the -\strong{rstan} package and new CRAN releases of both \strong{rstan} and -\strong{StanHeaders}. With CmdStanR the latest improvements in Stan will be -available from R immediately after updating CmdStan using -\code{cmdstanr::install_cmdstan()}. +\item Compatible with latest versions of Stan. Keeping up with Stan +releases is complicated for RStan, often requiring non-trivial +changes to the \strong{rstan} package and new CRAN releases of both +\strong{rstan} and \strong{StanHeaders}. With CmdStanR the latest improvements +in Stan will be available from R immediately after updating CmdStan +using \code{cmdstanr::install_cmdstan()}. \item Running Stan via external processes results in fewer unexpected crashes, especially in RStudio. \item Less memory overhead. diff --git a/man/print_stan_file.Rd b/man/print_stan_file.Rd new file mode 100644 index 00000000..03ce30f8 --- /dev/null +++ b/man/print_stan_file.Rd @@ -0,0 +1,65 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/file.R +\name{print_stan_file} +\alias{print_stan_file} +\title{Print a Stan file with syntax highlighting in Quarto} +\usage{ +print_stan_file(file, fold = FALSE, summary = "Stan model code") +} +\arguments{ +\item{file}{(string) Path to a \code{.stan} file.} + +\item{fold}{(logical) Whether to wrap the output in an HTML +\verb{
} block so that the code is collapsed (folded) by +default. Only has an effect when rendering with \code{output: asis}. +Defaults to \code{FALSE}.} + +\item{summary}{(string) The summary text shown in the fold toggle +when \code{fold = TRUE}. Defaults to \code{"Stan model code"}.} +} +\value{ +The file path (invisibly). +} +\description{ +Prints the contents of a Stan file, optionally with syntax highlighting +when used in a Quarto or R Markdown document. When called inside a +\link[knitr:knitr-package]{knitr} code chunk with the chunk option +\code{output: asis} (or \code{results: asis} in R Markdown), the output is a +fenced Stan code block that Quarto renders with syntax highlighting. +When called interactively or without \code{output: asis}, the code is +printed as plain text via \code{\link[=writeLines]{writeLines()}}. +} +\section{Quarto usage}{ + +Use in a Quarto code chunk with \code{output: asis} to get syntax +highlighting: + +\if{html}{\out{
}}\preformatted{```\{r\} +#| output: asis +print_stan_file("path/to/model.stan") +``` +}\if{html}{\out{
}} + +To make the code block collapsible: + +\if{html}{\out{
}}\preformatted{```\{r\} +#| output: asis +print_stan_file("path/to/model.stan", fold = TRUE) +``` +}\if{html}{\out{
}} +} + +\examples{ +stan_file <- write_stan_file(" +parameters { + real y; +} +model { + y ~ std_normal(); +} +") + +# Prints plain code at the console +print_stan_file(stan_file) + +} diff --git a/man/write_stan_file.Rd b/man/write_stan_file.Rd index d172cf70..134b7172 100644 --- a/man/write_stan_file.Rd +++ b/man/write_stan_file.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/example.R +% Please edit documentation in R/file.R \name{write_stan_file} \alias{write_stan_file} \title{Write Stan code to a file} diff --git a/tests/testthat/test-print-stan-file.R b/tests/testthat/test-print-stan-file.R new file mode 100644 index 00000000..2870e697 --- /dev/null +++ b/tests/testthat/test-print-stan-file.R @@ -0,0 +1,82 @@ +stan_code <- " +parameters { + real y; +} +model { + y ~ std_normal(); +} +" +stan_file <- write_stan_file(stan_code) +stan_lines <- readLines(stan_file) + +test_that("print_stan_file() prints plain code outside of knitr", { + out <- capture.output(print_stan_file(stan_file)) + expect_identical(out, stan_lines) +}) + +test_that("print_stan_file() returns file path invisibly", { + out <- withr::with_output_sink(tempfile(), print_stan_file(stan_file)) + expect_identical(out, stan_file) +}) + +test_that("print_stan_file() outputs fenced code block in knitr with results='asis'", { + withr::local_options(knitr.in.progress = TRUE) + local_mocked_bindings( + opts_current = list(get = function(x) if (x == "results") "asis"), + .package = "knitr" + ) + out <- paste(capture.output(print_stan_file(stan_file)), collapse = "\n") + expect_match(out, "^```stan\n") + expect_match(out, "\n```$") + expect_match(out, paste(stan_lines, collapse = "\n"), fixed = TRUE) +}) + +test_that("print_stan_file() wraps in
when fold=TRUE", { + withr::local_options(knitr.in.progress = TRUE) + local_mocked_bindings( + opts_current = list(get = function(x) if (x == "results") "asis"), + .package = "knitr" + ) + out <- capture.output(print_stan_file(stan_file, fold = TRUE)) + expect_match(out[1], "
Stan model code") + expect_match(out[length(out)], "
") +}) + +test_that("print_stan_file() uses custom summary text", { + withr::local_options(knitr.in.progress = TRUE) + local_mocked_bindings( + opts_current = list(get = function(x) if (x == "results") "asis"), + .package = "knitr" + ) + out <- capture.output( + print_stan_file(stan_file, fold = TRUE, summary = "My Stan Code") + ) + expect_match(out[1], "
My Stan Code") +}) + +test_that("print_stan_file() does not fold when fold=FALSE in knitr", { + withr::local_options(knitr.in.progress = TRUE) + local_mocked_bindings( + opts_current = list(get = function(x) if (x == "results") "asis"), + .package = "knitr" + ) + out <- capture.output(print_stan_file(stan_file, fold = FALSE)) + expect_no_match(paste(out, collapse = "\n"), "
", fixed = TRUE) + expect_no_match(paste(out, collapse = "\n"), "
", fixed = TRUE) +}) + +test_that("print_stan_file() falls back to plain text without results='asis'", { + withr::local_options(knitr.in.progress = TRUE) + local_mocked_bindings( + opts_current = list(get = function(x) NULL), + .package = "knitr" + ) + out <- capture.output(print_stan_file(stan_file)) + expect_identical(out, stan_lines) +}) + +test_that("print_stan_file() falls back to plain text without knitr.in.progress", { + withr::local_options(knitr.in.progress = FALSE) + out <- capture.output(print_stan_file(stan_file)) + expect_identical(out, stan_lines) +})