Merge pull request #1204 from stan-dev/gq-compatibility

Gq compatibility

Author: jgabry

NEWS.md

@@ -8,11 +8,17 @@ to be consistent with other methods.
 keywords (@VisruthSK, #1154)
 * `save_cmdstan_config` and `save_metric` default to `FALSE` but can be 
 set to `TRUE` for an entire R session via new global options. (#1159)
-* `save_metric_files()` now gives an informative error when metric files were not created and keeps saved metric files after the fitted model is garbage-collected. (#1021)
+* `save_metric_files()` now gives an informative error when metric files were 
+not created and keeps saved metric files after the fitted model is garbage-collected. (#1021)
 * `cmdstan_model()` no longer fails when `MAKEFLAGS` enables directory-printing 
 output while reading `STANCFLAGS` from `make`. (#1163)
-* `cmdstan_model()` now retains include paths when initialized with both a Stan file and a precompiled executable, fixing model introspection for programs that use `#include` (#1094).
-* `$generate_quantities()` now reports per-process execution times with CmdStan 2.39 or newer, and `read_cmdstan_csv()` returns these times from standalone generated quantities CSV files. (#1168)
+* `cmdstan_model()` now retains include paths when initialized with both a Stan file 
+and a precompiled executable (#1094).
+* `$generate_quantities()` now also accepts `CmdStanMLE`, `CmdStanLaplace`, 
+and `CmdStanPathfinder` fitted model objects as `fitted_params`. (#1203)
+* `$generate_quantities()` now reports per-process execution times with 
+CmdStan 2.39 or newer, and `read_cmdstan_csv()` returns these times from 
+standalone generated quantities CSV files. (#1168)
 * `laplace()` no longer overwrites the internally generated optimizer CSV when
 `mode = NULL` and `output_basename` is supplied. The internally generated
 optimizer CSV now uses the filename `<output_basename>-mode-1.csv`.

R/data.R

@@ -333,7 +333,8 @@ draws_to_csv <- function(draws,
 #'
 #' @noRd
 #' @param fitted_params Paths to CSV files produced by CmdStan sampling,
-#'  a CmdStanMCMC or CmdStanVB object, a draws_array or draws_matrix.
+#'  a CmdStanMCMC, CmdStanMLE, CmdStanLaplace, CmdStanVB, or CmdStanPathfinder
+#'  object, a draws_array or draws_matrix.
 #' @return Paths to CSV files containing parameter values.
 #'
 process_fitted_params <- function(fitted_params) {
@@ -353,7 +354,10 @@ process_fitted_params <- function(fitted_params) {
       fitted_params$sampler_diagnostics()
     )
     paths <- draws_to_csv(draws, sampler_diagnostics)
-  } else if (checkmate::test_r6(fitted_params, "CmdStanVB")) {
+  } else if (checkmate::test_r6(fitted_params, "CmdStanMLE") ||
+             checkmate::test_r6(fitted_params, "CmdStanLaplace") ||
+             checkmate::test_r6(fitted_params, "CmdStanVB") ||
+             checkmate::test_r6(fitted_params, "CmdStanPathfinder")) {
     draws <- tryCatch(
       fitted_params$draws(),
       error = function(cond) {
@@ -368,7 +372,8 @@ process_fitted_params <- function(fitted_params) {
   } else {
     stop(
       "'fitted_params' must be a list of paths to CSV files, ",
-      "a CmdStanMCMC/CmdStanVB object, ",
+      "a CmdStanMCMC, CmdStanMLE, CmdStanLaplace, CmdStanVB, or ",
+      "CmdStanPathfinder object, ",
       "a posterior::draws_array or a posterior::draws_matrix.", call. = FALSE)
   }
   paths

R/model.R

@@ -1998,11 +1998,17 @@ CmdStanModel$set("public", name = "pathfinder", value = pathfinder)
 #' @inheritParams model-method-sample
 #' @param fitted_params (multiple options) The parameter draws to use. One of
 #'   the following:
-#'  * A [CmdStanMCMC] or [CmdStanVB] fitted model object.
-#'  * A [posterior::draws_array] (for MCMC) or [posterior::draws_matrix] (for
-#'  VB) object returned by CmdStanR's [`$draws()`][fit-method-draws] method.
+#'  * A [CmdStanMCMC], [CmdStanMLE], [CmdStanLaplace], [CmdStanVB], or
+#'  [CmdStanPathfinder] fitted model object.
+#'  * A [posterior::draws_array] or [posterior::draws_matrix] object returned by
+#'  CmdStanR's [`$draws()`][fit-method-draws] method.
 #'  * A character vector of paths to CmdStan CSV output files.
 #'
+#' For a [CmdStanMLE] object, optimization supplies one point estimate, so
+#' generated quantities that use RNG functions produce only one simulation.
+#' For [CmdStanLaplace], [CmdStanVB], and [CmdStanPathfinder] objects, generated
+#' quantities are evaluated once per approximate draw.
+#'
 #' 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

man/model-method-generate-quantities.Rd

@@ -66,7 +66,11 @@ test_that("process_fitted_params() works with basic input types", {
 })
 
 test_that("process_fitted_params() errors with bad args", {
-  error_msg <- "'fitted_params' must be a list of paths to CSV files, a CmdStanMCMC/CmdStanVB object, a posterior::draws_array or a posterior::draws_matrix."
+  error_msg <- paste0(
+    "'fitted_params' must be a list of paths to CSV files, a CmdStanMCMC, ",
+    "CmdStanMLE, CmdStanLaplace, CmdStanVB, or CmdStanPathfinder object, ",
+    "a posterior::draws_array or a posterior::draws_matrix."
+  )
   expect_error(
     process_fitted_params(5),
     error_msg
@@ -75,10 +79,6 @@ test_that("process_fitted_params() errors with bad args", {
     process_fitted_params(NULL),
     error_msg
   )
-  expect_error(
-    process_fitted_params(fit_optimize),
-    error_msg
-  )
 
   # WSL Tempdir not cleaned up with R gc
   if (!os_is_wsl()) {
@@ -106,6 +106,16 @@ test_that("process_fitted_params() errors with bad args", {
   }
 })
 
+test_that("process_fitted_params() works with CmdStanMLE", {
+  file <- process_fitted_params(fit_optimize)
+  fit_params <- data.table::fread(file, skip = "lp__")
+  expect_equal(nrow(fit_params), 1)
+  expect_equal(
+    fit_params$theta,
+    as.numeric(fit_optimize$draws(variables = "theta"))
+  )
+})
+
 test_that("process_fitted_params() works if output_files in fit do not exist", {
   fit_ref <- testing_fit("bernoulli", method = "sample", seed = 123)
   fit_tmp <- testing_fit("bernoulli", method = "sample", seed = 123)

tests/testthat/test-data.R

@@ -25,6 +25,11 @@ test_that("generate_quantities() method runs when all arguments specified validl
   expect_gq_output(fit1 <- do.call(mod_gq$generate_quantities, ok_arg_values))
   expect_s3_class(fit1, "CmdStanGQ")
 
+  # check run times are recorded and valid
+  run_times <- fit1$time()
+  expect_equal(run_times$chains$chain_id, seq_along(fit1$output_files()))
+  expect_gte(min(run_times$chains$total), 0)
+
   # leaving all at default (except 'data')
   expect_gq_output(fit2 <- mod_gq$generate_quantities(fitted_params = fit, data = data_list))
   expect_s3_class(fit2, "CmdStanGQ")
@@ -74,22 +79,99 @@ test_that("generate_quantities works with draws_array", {
   )
 })
 
-test_that("generate_quantities works with VB and draws_matrix", {
-  fit <- testing_fit("bernoulli", method = "variational", seed = 123)
+test_that("generate_quantities works with CmdStanMLE", {
+  fit_mle <- testing_fit(
+    "bernoulli",
+    method = "optimize",
+    seed = 123,
+    refresh = 0
+  )
+  expect_gq_output(
+    fit_gq_mle <- mod_gq$generate_quantities(
+      data = data_list,
+      fitted_params = fit_mle,
+      seed = 123
+    )
+  )
+  expect_s3_class(fit_gq_mle, "CmdStanGQ")
+  expect_equal(posterior::ndraws(fit_gq_mle$draws()), 1)
+})
+
+test_that("generate_quantities works with CmdStanLaplace", {
+  fit_laplace <- testing_fit(
+    "bernoulli",
+    method = "laplace",
+    seed = 123,
+    refresh = 0,
+    draws = 10
+  )
   expect_gq_output(
-    fit_gq <- mod_gq$generate_quantities(data = data_list, fitted_params = fit)
+    fit_gq_laplace <- mod_gq$generate_quantities(
+      data = data_list,
+      fitted_params = fit_laplace,
+      seed = 123
+    )
   )
-  run_times <- fit_gq$time()
-  expect_equal(run_times$chains$chain_id, 1)
-  expect_gte(run_times$chains$total, 0)
+  expect_s3_class(fit_gq_laplace, "CmdStanGQ")
+  expect_equal(
+    posterior::ndraws(fit_gq_laplace$draws()),
+    posterior::ndraws(fit_laplace$draws())
+  )
+})
+
+test_that("generate_quantities works with CmdStanVB and draws_matrix", {
+  fit_vb <- testing_fit("bernoulli", method = "variational", seed = 123)
   expect_gq_output(
-    mod_gq$generate_quantities(data = data_list, fitted_params = fit$draws())
+    fit_gq_vb <- mod_gq$generate_quantities(
+      data = data_list,
+      fitted_params = fit_vb,
+      seed = 123
+    )
+  )
+  expect_s3_class(fit_gq_vb, "CmdStanGQ")
+  expect_equal(
+    posterior::ndraws(fit_gq_vb$draws()),
+    posterior::ndraws(fit_vb$draws())
+  )
+  expect_gq_output(
+    mod_gq$generate_quantities(data = data_list, fitted_params = fit_vb$draws())
+  )
+})
+
+test_that("generate_quantities works with CmdStanPathfinder", {
+  fit_pathfinder <- testing_fit(
+    "bernoulli",
+    method = "pathfinder",
+    seed = 123,
+    refresh = 0,
+    num_paths = 1,
+    single_path_draws = 20,
+    draws = 10,
+    num_elbo_draws = 10
+  )
+  expect_gq_output(
+    fit_gq_pathfinder <- mod_gq$generate_quantities(
+      data = data_list,
+      fitted_params = fit_pathfinder,
+      seed = 123
+    )
+  )
+  expect_s3_class(fit_gq_pathfinder, "CmdStanGQ")
+  expect_equal(
+    posterior::ndraws(fit_gq_pathfinder$draws()),
+    posterior::ndraws(fit_pathfinder$draws())
   )
 })
 
 test_that("generate_quantities() warns if threads specified but not enabled", {
   expect_warning(
-    expect_gq_output(fit_gq <- mod_gq$generate_quantities(data = data_list, fitted_params = fit, threads_per_chain = 4)),
+    expect_gq_output(
+      fit_gq <- mod_gq$generate_quantities(
+        data = data_list,
+        fitted_params = fit,
+        threads_per_chain = 4
+      )
+    ),
     "'threads_per_chain' will have no effect"
   )
 })