Merge branch 'master' into fix_opencl_vignette

Author: jgabry

.github/workflows/cmdstan-tarball-check.yaml

@@ -19,7 +19,7 @@ jobs:
     name: ${{ matrix.config.os }} (${{ matrix.config.r }})
 
     strategy:
-      fail-fast: true
+      fail-fast: false
       matrix:
         config:
           - {os: macOS-latest, r: 'release'}

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: cmdstanr
 Title: R Interface to 'CmdStan'
-Version: 0.4.0.9000
+Version: 0.4.0.9001
 Date: 2021-04-15
 Authors@R: 
     c(person(given = "Jonah", family = "Gabry", role = c("aut", "cre"),
@@ -36,7 +36,7 @@ Imports:
     R6 (>= 2.4.0)
 Suggests: 
     bayesplot,
-    knitr,
+    knitr (>= 1.37),
     loo (>= 2.0.0),
     rlang (>= 0.4.7),
     rmarkdown,

NAMESPACE

@@ -15,6 +15,7 @@ export(cmdstan_model)
 export(cmdstan_path)
 export(cmdstan_version)
 export(cmdstanr_example)
+export(draws_to_csv)
 export(eng_cmdstan)
 export(install_cmdstan)
 export(num_threads)

R/csv.R

@@ -179,6 +179,7 @@ read_cmdstan_csv <- function(files,
   if (length(uniq_seed) == 1) {
     metadata$seed <- uniq_seed
   }
+  metadata$time <- time
   if (metadata$method == "diagnose") {
     gradients <- metadata$gradients
     metadata$gradients <- NULL

R/data.R

@@ -204,27 +204,77 @@ any_zero_dims <- function(data) {
   any(has_zero_dims)
 }
 
-#' Write posterior draws objects to csv files
-#' @noRd
-#' @param draws A `draws_array` from posterior pkg
-#' @param sampler_diagnostics Either `NULL` or a `draws_array` of sampler diagnostics
+#' Write posterior draws objects to CSV files suitable for running standalone generated
+#' quantities with CmdStan.
+#'
+#' @export
+#' @param draws A `posterior::draws_*` object.
+#' @param sampler_diagnostics Either `NULL` or a `posterior::draws_*` object
+#'  of sampler diagnostics.
+#' @param dir (string) An optional path to the directory where the CSV files will be
+#'   written. If not set, [temporary directory][base::tempdir] is used.
+#' @param basename (string) If `dir` is specified, `basename`` is used for naming
+#' the output CSV files. If not specified, the file names are randomly generated.
+#'
 #' @return Paths to CSV files (one per chain).
 #'
-draws_to_csv <- function(draws, sampler_diagnostics = NULL) {
+#' @details
+#' `draws_to_csv()` generates a CSV suitable for running standalone generated
+#' quantities with CmdStan. The CSV file contains a single comment `#num_samples`,
+#' which equals the number of iterations in the supplied draws object.
+#'
+#' The comment is followed by the column names. The first column is the `lp__` value,
+#' followed by sampler diagnostics and finnaly other variables of the draws object.
+#' #' If the draws object does not contain the `lp__` or sampler diagnostics variables,
+#' columns with zeros are created in order to conform with the requirements of the
+#' standalone generated quantities method of CmdStan.
+#'
+#' The column names line is finally followed by the values of the draws in the same
+#' order as the column names.
+#'
+#' @examples
+#' \dontrun{
+#' draws <- posterior::example_draws()
+#'
+#' draws_csv_files <- draws_to_csv(draws)
+#' print(draws_csv_files)
+#'
+#' # draws_csv_files <- draws_to_csv(draws,
+#' #                                 sampler_diagnostic = sampler_diagnostics,
+#' #                                 dir = "~/my_folder",
+#' #                                 basename = "my-samples")
+#' }
+#'
+draws_to_csv <- function(draws,
+                         sampler_diagnostics = NULL,
+                         dir = tempdir(),
+                         basename = "fittedParams") {
+  sampler_diagnostics_names <- c(
+    "accept_stat__", "stepsize__", "treedepth__",
+    "n_leapfrog__", "divergent__", "energy__"
+  )
   n <- posterior::niterations(draws)
   n_chains <- posterior::nchains(draws)
+  draws_variables <- posterior::variables(draws)
+  sampler_diagnostics_variables <- posterior::variables(sampler_diagnostics)
+
+  # create dummy sampler diagnostics due to CmdStan requirement for all columns in GQ if needed
   zeros <- rep(0, n * n_chains) # filler for creating dummy sampler diagnostics and lp__ if necessary
   if (is.null(sampler_diagnostics)) {
-    # create dummy sampler diagnostics due to CmdStan requirement for all columns in GQ
-    sampler_diagnostics <- posterior::draws_array(
-      accept_stat__ = zeros,
-      stepsize__ = zeros,
-      treedepth__ = zeros,
-      n_leapfrog__ = zeros,
-      divergent__ = zeros,
-      energy__ = zeros,
-      .nchains = n_chains
-    )
+    missing_sampler_diagnostics <- sampler_diagnostics_names[!(sampler_diagnostics_names %in% draws_variables)]
+
+  } else {
+    missing_sampler_diagnostics <- sampler_diagnostics_names[!(sampler_diagnostics_names %in% draws_variables)]
+    missing_sampler_diagnostics <- missing_sampler_diagnostics[!(missing_sampler_diagnostics %in% sampler_diagnostics_variables)]
+  }
+  if (length(missing_sampler_diagnostics) > 0) {
+    additional_sampler_diagnostics <- list()
+    for (name in missing_sampler_diagnostics) {
+      additional_sampler_diagnostics[[name]] <- zeros
+    }
+    additional_sampler_diagnostics[[".nchains"]] <- n_chains
+    additional_sampler_diagnostics <- do.call(posterior::draws_array, additional_sampler_diagnostics)
+    sampler_diagnostics <- posterior::bind_draws(sampler_diagnostics, additional_sampler_diagnostics)
   }
 
   # the columns must be in order "lp__, sampler_diagnostics, parameters"
@@ -236,26 +286,31 @@ draws_to_csv <- function(draws, sampler_diagnostics = NULL) {
   }
   all_variables <- c(
     "lp__",
-    posterior::variables(sampler_diagnostics),
-    draws_variables[!(draws_variables %in% c("lp__", "lp_approx__"))]
+    sampler_diagnostics_names,
+    draws_variables[!(draws_variables %in% c("lp__", "lp_approx__", sampler_diagnostics_names))]
   )
   draws <- posterior::subset_draws(
     posterior::bind_draws(draws, sampler_diagnostics, lp__, along = "variable"),
     variable = all_variables
   )
 
   chains <- posterior::chain_ids(draws)
-  paths <- generate_file_names(basename = "fittedParams", ids = chains)
-  paths <- file.path(tempdir(), paths)
+  paths <- generate_file_names(basename = basename, ids = chains)
+  paths <- file.path(dir, paths)
   chain <- 1
   for (path in paths) {
     write(
       paste0("# num_samples = ", n, "\n", paste0(unrepair_variable_names(all_variables), collapse = ",")),
       file = path,
       append = FALSE
     )
+    data <- posterior::as_draws_df(posterior::subset_draws(draws, chain = chain))
+    class(data) <- "data.frame"
+    data$.chain <- NULL
+    data$.iteration <- NULL
+    data$.draw <- NULL
     data.table::fwrite(
-      posterior::as_draws_df(posterior::subset_draws(draws, chain = chain)),
+      data,
       sep = ",",
       file = path,
       col.names = FALSE,

R/model.R

@@ -587,7 +587,9 @@ compile <- function(quiet = TRUE,
     stop("An error occured during compilation! See the message above for more information.",
          call. = FALSE)
   }
-
+  if (file.exists(exe)) {
+    file.remove(exe)
+  }
   file.copy(tmp_exe, exe, overwrite = TRUE)
   private$exe_file_ <- exe
   private$cpp_options_ <- cpp_options
@@ -1311,6 +1313,13 @@ CmdStanModel$set("public", name = "variational", value = variational)
 #'  VB) object returned by CmdStanR's [`$draws()`][fit-method-draws] method.
 #'  * A character vector of paths to CmdStan CSV output files.
 #'
+#' NOTE: if you plan on making many calls to `$generate_quantities()` then the
+#' most efficient option is to pass the paths of the CmdStan CSV output files
+#' (this avoids CmdStanR having to rewrite the draws contained in the fitted
+#' model object to CSV each time). If you no longer have the CSV files you can
+#' use [draws_to_csv()] once to write them and then pass the resulting file
+#' paths to `$generate_quantities()` as many times as needed.
+#'
 #' @return A [`CmdStanGQ`] object.
 #'
 #' @template seealso-docs
@@ -1534,7 +1543,7 @@ cpp_options_to_compile_flags <- function(cpp_options) {
   for (i in seq_along(cpp_options)) {
     option_name <- names(cpp_options)[i]
     if (is.null(option_name) || !nzchar(option_name)) {
-      cpp_built_options <- c(cpp_built_options, toupper(cpp_options[[i]]))
+      cpp_built_options <- c(cpp_built_options, cpp_options[[i]])
     } else {
       cpp_built_options <- c(cpp_built_options, paste0(toupper(option_name), "=", cpp_options[[i]]))
     }

_pkgdown.yml

@@ -107,6 +107,7 @@ reference:
       - read_cmdstan_csv
       - write_stan_json
       - write_stan_file
+      - draws_to_csv
   - title: "Using CmdStanR with knitr and R Markdown"
     contents:
       - register_knitr_engine

inst/logistic.stan

@@ -1,7 +1,7 @@
 data {
   int<lower=0> N;
   int<lower=0> K;
-  int<lower=0,upper=1> y[N];
+  array[N] int<lower=0, upper=1> y;
   matrix[N, K] X;
 }
 parameters {
@@ -15,5 +15,7 @@ model {
 }
 generated quantities {
   vector[N] log_lik;
-  for (n in 1:N) log_lik[n] = bernoulli_logit_lpmf(y[n] | alpha + X[n] * beta);
+  for (n in 1 : N) {
+    log_lik[n] = bernoulli_logit_lpmf(y[n] | alpha + X[n] * beta);
+  }
 }

man/draws_to_csv.Rd

@@ -1,11 +1,11 @@
 data {
   int<lower=0> N;
-  int<lower=0,upper=1> y[N];
+  array[N] int<lower=0, upper=1> y;
 }
 parameters {
-  real<lower=0,upper=1> theta;
+  real<lower=0, upper=1> theta;
 }
 model {
-  theta ~ beta(1,1);  // uniform prior on interval 0,1
+  theta ~ beta(1, 1); // uniform prior on interval 0,1
   y ~ bernoulli(theta);
 }

man/model-method-generate-quantities.Rd

@@ -1,11 +1,11 @@
 data {
   int<lower=0> N;
-  int<lower=0,upper=1> y[N];
+  array[N] int<lower=0, upper=1> y;
 }
 parameters {
-  real<lower=0,upper=1> theta;
+  real<lower=0, upper=1> theta;
 }
 model {
-  theta ~ beta(1,1);  // uniform prior on interval 0,1
+  theta ~ beta(1, 1); // uniform prior on interval 0,1
   y ~ bernoulli(theta);
 }

tests/testthat/answers/model-code-output.rds

@@ -1,9 +1,10 @@
 transformed data {
   int<lower=0> N = 10;
-  real<lower=0,upper=1> theta = 0.35;
+  real<lower=0, upper=1> theta = 0.35;
 }
 generated quantities {
-  int y_sim[N];
-  for (n in 1:N)
+  array[N] int y_sim;
+  for (n in 1 : N) {
     y_sim[n] = bernoulli_rng(theta);
+  }
 }

tests/testthat/answers/model-print-output.stan

@@ -3,13 +3,14 @@ functions {
 }
 data {
   int<lower=0> N;
-  int<lower=0,upper=1> y[N];
+  array[N] int<lower=0, upper=1> y;
 }
 parameters {
-  real<lower=0,upper=1> theta;
+  real<lower=0, upper=1> theta;
 }
 model {
-  theta ~ beta(divide_real_by_two(2.0),1);
-  for (n in 1:N)
+  theta ~ beta(divide_real_by_two(2.0), 1);
+  for (n in 1 : N) {
     y[n] ~ bernoulli(theta);
+  }
 }

tests/testthat/resources/stan/bernoulli.stan

@@ -1,15 +1,17 @@
 data {
   int<lower=0> N;
-  int<lower=0,upper=1> y[N];
+  array[N] int<lower=0, upper=1> y;
 }
 parameters {
-  real<lower=0,upper=1> theta;
+  real<lower=0, upper=1> theta;
 }
 model {
-  theta ~ beta(1,1);  // uniform prior on interval 0,1
+  theta ~ beta(1, 1); // uniform prior on interval 0,1
   y ~ bernoulli(theta);
 }
 generated quantities {
   vector[N] log_lik;
-  for (n in 1:N) log_lik[n] = bernoulli_lpmf(y | theta);
+  for (n in 1 : N) {
+    log_lik[n] = bernoulli_lpmf(y | theta);
+  }
 }