Merge branch 'master' into wsl-cmdstan-internal

.github/workflows/R-CMD-check-wsl.yaml

@@ -37,11 +37,11 @@ jobs:
 
       - uses: actions/checkout@v3
 
-      - uses: r-lib/actions/[email protected].6
+      - uses: r-lib/actions/[email protected].8
         with:
           r-version: 'release'
           rtools-version: '42'
-      - uses: r-lib/actions/[email protected].6
+      - uses: r-lib/actions/[email protected].8
 
       - name: Query dependencies
         run: |

.github/workflows/R-CMD-check.yaml

@@ -56,11 +56,11 @@ jobs:
           sudo apt-get install -y libcurl4-openssl-dev || true
           sudo apt-get install -y openmpi-bin openmpi-common libopenmpi-dev || true
 
-      - uses: r-lib/actions/[email protected].6
+      - uses: r-lib/actions/[email protected].8
         with:
           r-version: ${{ matrix.config.r }}
           rtools-version: ${{ matrix.config.rtools }}
-      - uses: r-lib/actions/[email protected].6
+      - uses: r-lib/actions/[email protected].8
 
       - name: Query dependencies
         run: |

.github/workflows/Test-coverage.yaml

@@ -34,8 +34,8 @@ jobs:
         if: "!startsWith(github.ref, 'refs/tags/') && github.ref != 'refs/heads/master'"
       - uses: actions/checkout@v3
 
-      - uses: r-lib/actions/[email protected].6
-      - uses: r-lib/actions/[email protected].6
+      - uses: r-lib/actions/[email protected].8
+      - uses: r-lib/actions/[email protected].8
 
       - name: Install Ubuntu dependencies
         run: |
@@ -85,12 +85,12 @@ jobs:
     steps:
       - uses: actions/checkout@v3
 
-      - uses: r-lib/actions/[email protected].6
+      - uses: r-lib/actions/[email protected].8
         with:
           r-version: 'release'
           rtools-version: '42'
 
-      - uses: r-lib/actions/[email protected].6
+      - uses: r-lib/actions/[email protected].8
 
       - name: Query dependencies
         run: |

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

@@ -40,12 +40,12 @@ jobs:
           sudo apt-get install -y libcurl4-openssl-dev || true
           sudo apt-get install -y openmpi-bin openmpi-common libopenmpi-dev || true
 
-      - uses: r-lib/actions/[email protected].6
+      - uses: r-lib/actions/[email protected].8
         with:
           r-version: ${{ matrix.config.r }}
           rtools-version: ${{ matrix.config.rtools }}
 
-      - uses: r-lib/actions/[email protected].6
+      - uses: r-lib/actions/[email protected].8
 
       - name: Query dependencies
         run: |

DESCRIPTION

@@ -15,7 +15,7 @@ Authors@R:
            email = "[email protected]", comment = c(ORCID = "0000-0003-1878-3253")),
       person(given = "Jacob", family = "Socolar", role = "ctb"),
       person(given = "Andrew", family = "Johnson", role = "ctb",
-            comment = c(ORCID = "0000-0001-7000-8065 ")))
+            comment = c(ORCID = "0000-0001-7000-8065")))
 Description: A lightweight interface to 'Stan' <https://mc-stan.org>.
     The 'CmdStanR' interface is an alternative to 'RStan' that calls the command
     line interface for compilation and running algorithms instead of interfacing
@@ -27,7 +27,7 @@ URL: https://mc-stan.org/cmdstanr/, https://discourse.mc-stan.org
 BugReports: https://github.com/stan-dev/cmdstanr/issues
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.2.0
+RoxygenNote: 7.2.1
 Roxygen: list(markdown = TRUE, r6 = FALSE)
 SystemRequirements: CmdStan (https://mc-stan.org/users/interfaces/cmdstan)
 Depends:
@@ -46,5 +46,8 @@ Suggests:
     loo (>= 2.0.0),
     rlang (>= 0.4.7),
     rmarkdown,
-    testthat (>= 2.1.0)
+    testthat (>= 2.1.0),
+    Rcpp,
+    RcppEigen,
+    decor
 VignetteBuilder: knitr

R/args.R

@@ -26,6 +26,8 @@ CmdStanArgs <- R6::R6Class(
     initialize = function(model_name,
                           stan_file = NULL,
                           stan_code = NULL,
+                          model_methods_env = NULL,
+                          standalone_env = NULL,
                           exe_file,
                           proc_ids,
                           method_args,
@@ -43,6 +45,8 @@ CmdStanArgs <- R6::R6Class(
       self$model_name <- model_name
       self$stan_code <- stan_code
       self$exe_file <- exe_file
+      self$model_methods_env <- model_methods_env
+      self$standalone_env <- standalone_env
       self$proc_ids <- proc_ids
       self$data_file <- data_file
       self$seed <- seed
@@ -52,12 +56,15 @@ CmdStanArgs <- R6::R6Class(
       self$method <- self$method_args$method
       self$save_latent_dynamics <- save_latent_dynamics
       self$using_tempdir <- is.null(output_dir)
+      self$model_variables <- model_variables
       if (os_is_wsl()) {
         # Want to ensure that any files under WSL are written to a tempdir within
         # WSL to avoid IO performance issues
         self$output_dir <- ifelse(is.null(output_dir),
                                   file.path(wsl_dir_prefix(), wsl_tempdir()),
                                   wsl_safe_path(output_dir))
+      } else (getRversion() < "3.5.0") {
+        self$output_dir <- output_dir %||% tempdir()
       } else {
         if (getRversion() < "3.5.0") {
           self$output_dir <- output_dir %||% tempdir()

R/fit.R

@@ -9,9 +9,16 @@ CmdStanFit <- R6::R6Class(
   classname = "CmdStanFit",
   public = list(
     runset = NULL,
+    functions = NULL,
     initialize = function(runset) {
       checkmate::assert_r6(runset, classes = "CmdStanRun")
       self$runset <- runset
+      private$model_methods_env_ <- runset$model_methods_env()
+      self$functions <- runset$standalone_env()
+
+      if (!is.null(private$model_methods_env_$model_ptr)) {
+        initialize_model_pointer(private$model_methods_env_, self$data_file(), 0)
+      }
       # Need to update the output directory path to one that can be accessed
       # from Windows, for the post-processing of results
       self$runset$args$output_dir <- wsl_safe_path(self$runset$args$output_dir,
@@ -61,13 +68,18 @@ CmdStanFit <- R6::R6Class(
             "rows (change via 'max_rows' argument or 'cmdstanr_max_rows' option)\n")
       }
       invisible(self)
+    },
+    expose_functions = function(global = FALSE, verbose = FALSE) {
+      expose_functions(self$functions, global, verbose)
+      invisible(NULL)
     }
   ),
   private = list(
     draws_ = NULL,
     metadata_ = NULL,
     init_ = NULL,
-    profiles_ = NULL
+    profiles_ = NULL,
+    model_methods_env_ = NULL
   )
 )
 
@@ -276,6 +288,222 @@ init <- function() {
 }
 CmdStanFit$set("public", name = "init", value = init)
 
+#' Compile additional methods for accessing the model log-probability function
+#' and parameter constraining and unconstraining. This requires the `Rcpp` package.
+#'
+#' @name fit-method-init_model_methods
+#' @aliases init_model_methods
+#' @description The `$init_model_methods()` compiles and initializes the
+#' `log_prob`, `grad_log_prob`, `constrain_pars`, and `unconstrain_pars` functions.
+#'
+#' @param seed (integer) The random seed to use when initializing the model.
+#' @param verbose (boolean) Whether to show verbose logging during compilation.
+#' @param hessian (boolean) Whether to expose the (experimental) hessian method.
+#'
+#' @examples
+#' \dontrun{
+#' fit_mcmc <- cmdstanr_example("logistic", method = "sample")
+#' fit_mcmc$init_model_methods()
+#' }
+#'
+init_model_methods <- function(seed = 0, verbose = FALSE, hessian = FALSE) {
+  require_suggested_package("Rcpp")
+  require_suggested_package("RcppEigen")
+  if (length(private$model_methods_env_$hpp_code_) == 0) {
+    stop("Model methods cannot be used with a pre-compiled Stan executable, ",
+          "the model must be compiled again", call. = FALSE)
+  }
+  if (hessian) {
+    message("The hessian method relies on higher-order autodiff ",
+            "which is still experimental. Please report any compilation ",
+            "errors that you encounter")
+  }
+  message("Compiling additional model methods...")
+  if (is.null(private$model_methods_env_$model_ptr)) {
+    expose_model_methods(private$model_methods_env_, verbose, hessian)
+  }
+  initialize_model_pointer(private$model_methods_env_, self$data_file(), seed)
+  invisible(NULL)
+}
+CmdStanFit$set("public", name = "init_model_methods", value = init_model_methods)
+
+#' Calculate the log-probability given a provided vector of unconstrained parameters.
+#'
+#' @name fit-method-log_prob
+#' @aliases log_prob
+#' @description The `$log_prob()` method provides access to the Stan model's `log_prob` function
+#'
+#' @param upars (numeric) A vector of unconstrained parameters to be passed to `log_prob`
+#' @param jacobian_adjustment (bool) Whether to include the log-density adjustments from
+#' un/constraining variables
+#'
+#' @examples
+#' \dontrun{
+#' fit_mcmc <- cmdstanr_example("logistic", method = "sample")
+#' fit_mcmc$log_prob(upars = c(0.5, 1.2, 1.1, 2.2, 1.1))
+#' }
+#'
+log_prob <- function(upars, jacobian_adjustment = TRUE) {
+  if (is.null(private$model_methods_env_$model_ptr)) {
+    stop("The method has not been compiled, please call `init_model_methods()` first",
+        call. = FALSE)
+  }
+  if (length(upars) != private$model_methods_env_$num_upars_) {
+    stop("Model has ", private$model_methods_env_$num_upars_, " unconstrained parameter(s), but ",
+          length(upars), " were provided!", call. = FALSE)
+  }
+  private$model_methods_env_$log_prob(private$model_methods_env_$model_ptr_, upars, jacobian_adjustment)
+}
+CmdStanFit$set("public", name = "log_prob", value = log_prob)
+
+#' Calculate the log-probability and the gradient w.r.t. each input for a
+#' given vector of unconstrained parameters
+#'
+#' @name fit-method-grad_log_prob
+#' @aliases grad_log_prob
+#' @description The `$grad_log_prob()` method provides access to the
+#' Stan model's `log_prob` function and its derivative
+#'
+#' @param upars (numeric) A vector of unconstrained parameters to be passed
+#' to `grad_log_prob`
+#' @param jacobian_adjustment (bool) Whether to include the log-density adjustments from
+#' un/constraining variables
+#'
+#' @examples
+#' \dontrun{
+#' fit_mcmc <- cmdstanr_example("logistic", method = "sample")
+#' fit_mcmc$grad_log_prob(upars = c(0.5, 1.2, 1.1, 2.2, 1.1))
+#' }
+#'
+grad_log_prob <- function(upars, jacobian_adjustment = TRUE) {
+  if (is.null(private$model_methods_env_$model_ptr)) {
+    stop("The method has not been compiled, please call `init_model_methods()` first",
+        call. = FALSE)
+  }
+  if (length(upars) != private$model_methods_env_$num_upars_) {
+    stop("Model has ", private$model_methods_env_$num_upars_, " unconstrained parameter(s), but ",
+          length(upars), " were provided!", call. = FALSE)
+  }
+  private$model_methods_env_$grad_log_prob(private$model_methods_env_$model_ptr_, upars, jacobian_adjustment)
+}
+CmdStanFit$set("public", name = "grad_log_prob", value = grad_log_prob)
+
+#' Calculate the log-probability , the gradient w.r.t. each input, and the hessian
+#' for a given vector of unconstrained parameters
+#'
+#' @name fit-method-hessian
+#' @aliases hessian
+#' @description The `$hessian()` method provides access to the
+#' Stan model's `log_prob`, its derivative, and its hessian
+#'
+#' @param upars (numeric) A vector of unconstrained parameters to be passed
+#' to `hessian`
+#'
+#' @examples
+#' \dontrun{
+#' fit_mcmc <- cmdstanr_example("logistic", method = "sample")
+#' fit_mcmc$hessian(upars = c(0.5, 1.2, 1.1, 2.2, 1.1))
+#' }
+#'
+hessian <- function(upars) {
+  if (is.null(private$model_methods_env_$model_ptr)) {
+    stop("The method has not been compiled, please call `init_model_methods()` first",
+        call. = FALSE)
+  }
+  if (length(upars) != private$model_methods_env_$num_upars_) {
+    stop("Model has ", private$model_methods_env_$num_upars_, " unconstrained parameter(s), but ",
+          length(upars), " were provided!", call. = FALSE)
+  }
+  private$model_methods_env_$hessian(private$model_methods_env_$model_ptr_, upars)
+}
+CmdStanFit$set("public", name = "hessian", value = hessian)
+
+#' Transform a set of parameter values to the unconstrained scale
+#'
+#' @name fit-method-unconstrain_pars
+#' @aliases unconstrain_pars
+#' @description The `$unconstrain_pars()` method transforms input parameters to
+#' the unconstrained scale
+#'
+#' @param pars (list) A list of parameter values to transform, in the same format as
+#' provided to the `init` argument of the `$sample()` method
+#'
+#' @examples
+#' \dontrun{
+#' fit_mcmc <- cmdstanr_example("logistic", method = "sample")
+#' fit_mcmc$unconstrain_pars(list(alpha = 0.5, beta = c(0.7, 1.1, 0.2)))
+#' }
+#'
+unconstrain_pars <- function(pars) {
+  if (is.null(private$model_methods_env_$model_ptr)) {
+    stop("The method has not been compiled, please call `init_model_methods()` first",
+        call. = FALSE)
+  }
+  model_par_names <- names(self$runset$args$model_variables$parameters)
+  prov_par_names <- names(pars)
+
+  model_pars_not_prov <- which(!(model_par_names %in% prov_par_names))
+  if (length(model_pars_not_prov) > 0) {
+    stop("Model parameter(s): ", paste(model_par_names[model_pars_not_prov], collapse = ","),
+         " not provided!", call. = FALSE)
+  }
+
+  # Ignore extraneous parameters
+  model_pars_only <- pars[model_par_names]
+
+  stan_pars <- process_init_list(list(pars), num_procs = 1, self$runset$args$model_variables)
+  private$model_methods_env_$unconstrain_pars(private$model_methods_env_$model_ptr_, stan_pars)
+}
+CmdStanFit$set("public", name = "unconstrain_pars", value = unconstrain_pars)
+
+#' Transform a set of unconstrained parameter values to the constrained scale
+#'
+#' @name fit-method-constrain_pars
+#' @aliases constrain_pars
+#' @description The `$constrain_pars()` method transforms input parameters to
+#' the constrained scale
+#'
+#' @param upars (numeric) A vector of unconstrained parameters to constrain
+#' @param transformed_parameters (boolean) Whether to return transformed parameters
+#'  implied by newly-constrained parameters (defaults to TRUE)
+#' @param generated_quantities (boolean) Whether to return generated quantities
+#'  implied by newly-constrained parameters (defaults to TRUE)
+#' @param skeleton_only (boolean) Whether to return only the "skeleton" needed by the
+#'  utils::relist function (defaults to FALSE)
+#'
+#' @examples
+#' \dontrun{
+#' fit_mcmc <- cmdstanr_example("logistic", method = "sample")
+#' fit_mcmc$constrain_pars(upars = c(0.5, 1.2, 1.1, 2.2, 1.1))
+#' }
+#'
+constrain_pars <- function(upars, transformed_parameters = TRUE, generated_quantities = TRUE,
+                            skeleton_only = FALSE) {
+  if (is.null(private$model_methods_env_$model_ptr)) {
+    stop("The method has not been compiled, please call `init_model_methods()` first",
+        call. = FALSE)
+  }
+
+  skeleton <- create_skeleton(private$model_methods_env_$param_metadata_,
+                              self$runset$args$model_variables,
+                              transformed_parameters,
+                              generated_quantities)
+  if (skeleton_only) {
+    return(skeleton)
+  }
+
+  if (length(upars) != private$model_methods_env_$num_upars_) {
+    stop("Model has ", private$model_methods_env_$num_upars_, " unconstrained parameter(s), but ",
+          length(upars), " were provided!", call. = FALSE)
+  }
+  cpars <- private$model_methods_env_$constrain_pars(
+    private$model_methods_env_$model_ptr_,
+    private$model_methods_env_$model_rng_,
+    upars, transformed_parameters, generated_quantities)
+  utils::relist(cpars, skeleton)
+}
+CmdStanFit$set("public", name = "constrain_pars", value = constrain_pars)
+
 #' Extract log probability (target)
 #'
 #' @name fit-method-lp