From 4b9bc370cb85492356c37c33e702d0340aecafac Mon Sep 17 00:00:00 2001 From: jgabry Date: Tue, 25 Jul 2023 11:57:07 -0600 Subject: [PATCH 01/16] document expose_functions method * rename internal function `expose_stan_functions` (method name still `expose_functions`). Not having identical names makes it easier to document the exposed one in the way we've been doing for other methods. * add doc page for `expose_functions` method --- R/model.R | 52 ++++++++++++++++++++++++++++++++++++++++++++++------ R/utils.R | 2 +- 2 files changed, 47 insertions(+), 7 deletions(-) diff --git a/R/model.R b/R/model.R index e95c13759..2ddaaff79 100644 --- a/R/model.R +++ b/R/model.R @@ -188,6 +188,7 @@ cmdstan_model <- function(stan_file = NULL, exe_file = NULL, compile = TRUE, ... #' [`$exe_file()`][model-method-compile] | Return the file path to the compiled executable. | #' [`$hpp_file()`][model-method-compile] | Return the file path to the `.hpp` file containing the generated C++ code. | #' [`$save_hpp_file()`][model-method-compile] | Save the `.hpp` file containing the generated C++ code. | +#' [`$expose_functions()`][model-method-expose_functions] | Expose Stan functions for use in R. | #' #' ## Model fitting #' @@ -325,10 +326,6 @@ CmdStanModel <- R6::R6Class( "- ", new_hpp_loc) private$hpp_file_ <- new_hpp_loc invisible(private$hpp_file_) - }, - expose_functions = function(global = FALSE, verbose = FALSE) { - expose_functions(self$functions, global, verbose) - invisible(NULL) } ) ) @@ -394,7 +391,10 @@ CmdStanModel <- R6::R6Class( #' (`log_prob()`, `grad_log_prob()`, `constrain_pars()`, `unconstrain_pars()`) #' @param compile_hessian_method (logical) Should the (experimental) `hessian()` method be #' be compiled with the model methods? -#' @param compile_standalone (logical) Should functions in the Stan model be compiled for used in R? +#' @param compile_standalone (logical) Should functions in the Stan model be +#' compiled for use in R? If `TRUE` the functions will be available via the +#' `functions` field in the compiled model object. +#' #' @param threads Deprecated and will be removed in a future release. Please #' turn on threading via `cpp_options = list(stan_threads = TRUE)` instead. #' @@ -584,7 +584,7 @@ compile <- function(quiet = TRUE, self$functions$hpp_code <- get_standalone_hpp(temp_stan_file, stancflags_standalone) self$functions$external <- !is.null(user_header) if (compile_standalone) { - expose_functions(self$functions, !quiet) + expose_stan_functions(self$functions, !quiet) } stancflags_val <- paste0("STANCFLAGS += ", stancflags_val, paste0(" ", stancflags_combined, collapse = " ")) withr::with_path( @@ -1749,6 +1749,46 @@ diagnose <- function(data = NULL, } CmdStanModel$set("public", name = "diagnose", value = diagnose) +#' Expose Stan functions to R +#' +#' @name model-method-expose_functions +#' @aliases expose_functions +#' @family CmdStanModel methods +#' +#' @description The `$expose_functions()` method of a [`CmdStanModel`] object +#' will compile the functions in the Stan program's `functions` block and +#' expose them for use in \R. This can also be specified via the +#' `compile_standalone` argument to the [`$compile()`][model-method-compile] +#' method. +#' @param global (logical) Should the functions be added to the Global +#' Environment? The default is `FALSE`, in which case the functions are +#' available via the `functions` field of the [CmdStanModel] object. +#' @param verbose (logical) Should detailed information about generated code be +#' printed to the console? Defaults to `FALSE`. +#' @template seealso-docs +#' @examples +#' \dontrun{ +#' stan_file <- write_stan_file( +#' " +#' functions { +#' real a_plus_b(real a, real b) { +#' return a + b; +#' } +#' } +#' " +#' ) +#' mod <- cmdstan_model(stan_file) +#' mod$expose_functions() +#' mod$functions$a_plus_b(1, 2) +#' } +#' +#' +expose_functions = function(global = FALSE, verbose = FALSE) { + expose_stan_functions(self$functions, global, verbose) + invisible(NULL) +} +CmdStanModel$set("public", name = "expose_functions", value = expose_functions) + # internal ---------------------------------------------------------------- diff --git a/R/utils.R b/R/utils.R index 3eef2590d..937d48021 100644 --- a/R/utils.R +++ b/R/utils.R @@ -907,7 +907,7 @@ compile_functions <- function(env, verbose = FALSE, global = FALSE) { invisible(NULL) } -expose_functions <- function(function_env, global = FALSE, verbose = FALSE) { +expose_stan_functions <- function(function_env, global = FALSE, verbose = FALSE) { if (os_is_wsl()) { stop("Standalone functions are not currently available with ", "WSL CmdStan and will not be compiled", From 711b5799a8335dd232091043575905c730b0b87a Mon Sep 17 00:00:00 2001 From: jgabry Date: Tue, 25 Jul 2023 14:04:54 -0600 Subject: [PATCH 02/16] add to doc for new methods --- DESCRIPTION | 4 +-- R/fit.R | 98 ++++++++++++++++++++++++++++++++++++++++++++++++----- R/model.R | 28 ++++++++++++--- 3 files changed, 115 insertions(+), 15 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 46a5814db..b656d0d98 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: cmdstanr Title: R Interface to 'CmdStan' -Version: 0.5.3 -Date: 2022-04-24 +Version: 0.6.0 +Date: 2023-07-25 Authors@R: c(person(given = "Jonah", family = "Gabry", role = c("aut", "cre"), email = "jsg2201@columbia.edu"), diff --git a/R/fit.R b/R/fit.R index 0bffa1cc5..a8afd2376 100644 --- a/R/fit.R +++ b/R/fit.R @@ -82,7 +82,7 @@ CmdStanFit <- R6::R6Class( invisible(self) }, expose_functions = function(global = FALSE, verbose = FALSE) { - expose_functions(self$functions, global, verbose) + expose_stan_functions(self$functions, global, verbose) invisible(NULL) } ), @@ -301,12 +301,18 @@ 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. +#' and parameter constraining and unconstraining. #' #' @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_variables`, and `unconstrain_variables` functions. +#' +#' @description The `$init_model_methods()` method compiles and initializes the +#' `log_prob`, `grad_log_prob`, `constrain_variables`, `unconstrain_variables` +#' and `unconstrain_draws` functions. These are then available as methods of +#' the fitted model object. This requires the `Rcpp` package. +#' +#' Note: there may be many compiler warnings emitted during compilation but +#' these can be ignored so long as they are warnings and not errors. #' #' @param seed (integer) The random seed to use when initializing the model. #' @param verbose (boolean) Whether to show verbose logging during compilation. @@ -317,6 +323,9 @@ CmdStanFit$set("public", name = "init", value = init) #' fit_mcmc <- cmdstanr_example("logistic", method = "sample") #' fit_mcmc$init_model_methods() #' } +#' @seealso [log_prob()], [grad_log_prob()], [constrain_variables()], +#' [unconstrain_variables()], [unconstrain_draws()], [variable_skeleton()], +#' [hessian()] #' init_model_methods <- function(seed = 0, verbose = FALSE, hessian = FALSE) { if (os_is_wsl()) { @@ -358,9 +367,13 @@ CmdStanFit$set("public", name = "init_model_methods", value = init_model_methods #' \dontrun{ #' fit_mcmc <- cmdstanr_example("logistic", method = "sample") #' fit_mcmc$init_model_methods() -#' fit_mcmc$log_prob(unconstrained_variables = c(0.5, 1.2, 1.1, 2.2, 1.1)) +#' fit_mcmc$log_prob(unconstrained_variables = c(0.5, 1.2, 1.1, 2.2)) #' } #' +#' @seealso [log_prob()], [grad_log_prob()], [constrain_variables()], +#' [unconstrain_variables()], [unconstrain_draws()], [variable_skeleton()], +#' [hessian()] +#' log_prob <- function(unconstrained_variables, 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", @@ -392,9 +405,13 @@ CmdStanFit$set("public", name = "log_prob", value = log_prob) #' \dontrun{ #' fit_mcmc <- cmdstanr_example("logistic", method = "sample") #' fit_mcmc$init_model_methods() -#' fit_mcmc$grad_log_prob(unconstrained_variables = c(0.5, 1.2, 1.1, 2.2, 1.1)) +#' fit_mcmc$grad_log_prob(unconstrained_variables = c(0.5, 1.2, 1.1, 2.2)) #' } #' +#' @seealso [log_prob()], [grad_log_prob()], [constrain_variables()], +#' [unconstrain_variables()], [unconstrain_draws()], [variable_skeleton()], +#' [hessian()] +#' grad_log_prob <- function(unconstrained_variables, 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", @@ -425,10 +442,14 @@ CmdStanFit$set("public", name = "grad_log_prob", value = grad_log_prob) #' @examples #' \dontrun{ #' fit_mcmc <- cmdstanr_example("logistic", method = "sample") -#' fit_mcmc$init_model_methods() -#' fit_mcmc$hessian(unconstrained_variables = c(0.5, 1.2, 1.1, 2.2, 1.1)) +#' fit_mcmc$init_model_methods(hessian = TRUE) +#' fit_mcmc$hessian(unconstrained_variables = c(0.5, 1.2, 1.1, 2.2)) #' } #' +#' @seealso [log_prob()], [grad_log_prob()], [constrain_variables()], +#' [unconstrain_variables()], [unconstrain_draws()], [variable_skeleton()], +#' [hessian()] +#' hessian <- function(unconstrained_variables, 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", @@ -460,6 +481,10 @@ CmdStanFit$set("public", name = "hessian", value = hessian) #' fit_mcmc$unconstrain_variables(list(alpha = 0.5, beta = c(0.7, 1.1, 0.2))) #' } #' +#' @seealso [log_prob()], [grad_log_prob()], [constrain_variables()], +#' [unconstrain_variables()], [unconstrain_draws()], [variable_skeleton()], +#' [hessian()] +#' unconstrain_variables <- function(variables) { if (is.null(private$model_methods_env_$model_ptr)) { stop("The method has not been compiled, please call `init_model_methods()` first", @@ -521,6 +546,10 @@ CmdStanFit$set("public", name = "unconstrain_variables", value = unconstrain_var #' unconstrained_draws <- fit_mcmc$unconstrain_draws(draws = fit_mcmc$draws()) #' } #' +#' @seealso [log_prob()], [grad_log_prob()], [constrain_variables()], +#' [unconstrain_variables()], [unconstrain_draws()], [variable_skeleton()], +#' [hessian()] +#' unconstrain_draws <- function(files = NULL, draws = NULL) { if (!is.null(files) || !is.null(draws)) { if (!is.null(files) && !is.null(draws)) { @@ -565,6 +594,7 @@ unconstrain_draws <- function(files = NULL, draws = NULL) { self$unconstrain_variables(variables = par_list) }) }) + unconstrained } CmdStanFit$set("public", name = "unconstrain_draws", value = unconstrain_draws) @@ -587,6 +617,10 @@ CmdStanFit$set("public", name = "unconstrain_draws", value = unconstrain_draws) #' fit_mcmc$variable_skeleton() #' } #' +#' @seealso [log_prob()], [grad_log_prob()], [constrain_variables()], +#' [unconstrain_variables()], [unconstrain_draws()], [variable_skeleton()], +#' [hessian()] +#' variable_skeleton <- function(transformed_parameters = TRUE, generated_quantities = TRUE) { if (is.null(private$model_methods_env_$model_ptr)) { stop("The method has not been compiled, please call `init_model_methods()` first", @@ -617,9 +651,13 @@ CmdStanFit$set("public", name = "variable_skeleton", value = variable_skeleton) #' \dontrun{ #' fit_mcmc <- cmdstanr_example("logistic", method = "sample") #' fit_mcmc$init_model_methods() -#' fit_mcmc$constrain_variables(unconstrained_variables = c(0.5, 1.2, 1.1, 2.2, 1.1)) +#' fit_mcmc$constrain_variables(unconstrained_variables = c(0.5, 1.2, 1.1, 2.2)) #' } #' +#' @seealso [log_prob()], [grad_log_prob()], [constrain_variables()], +#' [unconstrain_variables()], [unconstrain_draws()], [variable_skeleton()], +#' [hessian()] +#' constrain_variables <- function(unconstrained_variables, transformed_parameters = TRUE, generated_quantities = TRUE) { if (is.null(private$model_methods_env_$model_ptr)) { @@ -1233,6 +1271,20 @@ CmdStanFit$set("public", name = "code", value = code) #' [`$time()`][fit-method-time] | Report total and chain-specific run times. | #' [`$return_codes()`][fit-method-return_codes] | Return the return codes from the CmdStan runs. | #' +#' ## Expose Stan functions and additional methods to R +#' +#' |**Method**|**Description**| +#' |:----------|:---------------| +#' [`$expose_functions()`][fit-method-expose_functions] | Expose Stan functions for use in R. | +#' [`$init_model_methods()`][fit-method-init_model_methods] | Expose methods for log-probability, gradients, parameter constraining and unconstraining. | +#' [`$log_prob()`][fit-method-log_prob] | Calculate log-prob. | +#' [`$grad_log_prob()`][fit-method-grad_log_prob] | Calculate log-prob and gradient. | +#' [`$hessian()`][fit-method-hessian] | Calculate log-prob, gradient, and hessian. | +#' [`$constrain_variables()`][fit-method-constrain_variables] | Transform a set of unconstrained parameter values to the constrained scale. | +#' [`$unconstrain_variables()`][fit-method-unconstrain_variables] | Transform a set of parameter values to the unconstrained scale. | +#' [`$unconstrain_draws()`][fit-method-unconstrain_draws] | Transform all parameter draws to the unconstrained scale. | +#' [`$variable_skeleton()`][fit-method-variable_skeleton] | Helper function to re-structure a vector of constrained parameter values. | +#' CmdStanMCMC <- R6::R6Class( classname = "CmdStanMCMC", inherit = CmdStanFit, @@ -1718,6 +1770,20 @@ CmdStanMCMC$set("public", name = "num_chains", value = num_chains) #' [`$output()`][fit-method-output] | Pretty print the output that was printed to the console. | #' [`$return_codes()`][fit-method-return_codes] | Return the return codes from the CmdStan runs. | #' +#' ## Expose Stan functions and additional methods to R +#' +#' |**Method**|**Description**| +#' |:----------|:---------------| +#' [`$expose_functions()`][fit-method-expose_functions] | Expose Stan functions for use in R. | +#' [`$init_model_methods()`][fit-method-init_model_methods] | Expose methods for log-probability, gradients, parameter constraining and unconstraining. | +#' [`$log_prob()`][fit-method-log_prob] | Calculate log-prob. | +#' [`$grad_log_prob()`][fit-method-grad_log_prob] | Calculate log-prob and gradient. | +#' [`$hessian()`][fit-method-hessian] | Calculate log-prob, gradient, and hessian. | +#' [`$constrain_variables()`][fit-method-constrain_variables] | Transform a set of unconstrained parameter values to the constrained scale. | +#' [`$unconstrain_variables()`][fit-method-unconstrain_variables] | Transform a set of parameter values to the unconstrained scale. | +#' [`$unconstrain_draws()`][fit-method-unconstrain_draws] | Transform all parameter draws to the unconstrained scale. | +#' [`$variable_skeleton()`][fit-method-variable_skeleton] | Helper function to re-structure a vector of constrained parameter values. | +#' CmdStanMLE <- R6::R6Class( classname = "CmdStanMLE", inherit = CmdStanFit, @@ -1821,6 +1887,20 @@ CmdStanMLE$set("public", name = "mle", value = mle) #' [`$output()`][fit-method-output] | Pretty print the output that was printed to the console. | #' [`$return_codes()`][fit-method-return_codes] | Return the return codes from the CmdStan runs. | #' +#' ## Expose Stan functions and additional methods to R +#' +#' |**Method**|**Description**| +#' |:----------|:---------------| +#' [`$expose_functions()`][fit-method-expose_functions] | Expose Stan functions for use in R. | +#' [`$init_model_methods()`][fit-method-init_model_methods] | Expose methods for log-probability, gradients, parameter constraining and unconstraining. | +#' [`$log_prob()`][fit-method-log_prob] | Calculate log-prob. | +#' [`$grad_log_prob()`][fit-method-grad_log_prob] | Calculate log-prob and gradient. | +#' [`$hessian()`][fit-method-hessian] | Calculate log-prob, gradient, and hessian. | +#' [`$constrain_variables()`][fit-method-constrain_variables] | Transform a set of unconstrained parameter values to the constrained scale. | +#' [`$unconstrain_variables()`][fit-method-unconstrain_variables] | Transform a set of parameter values to the unconstrained scale. | +#' [`$unconstrain_draws()`][fit-method-unconstrain_draws] | Transform all parameter draws to the unconstrained scale. | +#' [`$variable_skeleton()`][fit-method-variable_skeleton] | Helper function to re-structure a vector of constrained parameter values. | +#' CmdStanVB <- R6::R6Class( classname = "CmdStanVB", inherit = CmdStanFit, diff --git a/R/model.R b/R/model.R index 2ddaaff79..f32f7e424 100644 --- a/R/model.R +++ b/R/model.R @@ -388,12 +388,15 @@ CmdStanModel <- R6::R6Class( #' not modified since last compiled. The default is `FALSE`. Can also be set #' via a global `cmdstanr_force_recompile` option. #' @param compile_model_methods (logical) Compile additional model methods -#' (`log_prob()`, `grad_log_prob()`, `constrain_pars()`, `unconstrain_pars()`) +#' (`log_prob()`, `grad_log_prob()`, `constrain_variables()`, +#' `unconstrain_variables()`). #' @param compile_hessian_method (logical) Should the (experimental) `hessian()` method be #' be compiled with the model methods? #' @param compile_standalone (logical) Should functions in the Stan model be #' compiled for use in R? If `TRUE` the functions will be available via the -#' `functions` field in the compiled model object. +#' `functions` field in the compiled model object. This can also be done after +#' compilation using the +#' [`$expose_functions()`][model-method-expose_functions] method. #' #' @param threads Deprecated and will be removed in a future release. Please #' turn on threading via `cpp_options = list(stan_threads = TRUE)` instead. @@ -1752,7 +1755,7 @@ CmdStanModel$set("public", name = "diagnose", value = diagnose) #' Expose Stan functions to R #' #' @name model-method-expose_functions -#' @aliases expose_functions +#' @aliases expose_functions fit-method-expose_functions #' @family CmdStanModel methods #' #' @description The `$expose_functions()` method of a [`CmdStanModel`] object @@ -1760,9 +1763,16 @@ CmdStanModel$set("public", name = "diagnose", value = diagnose) #' expose them for use in \R. This can also be specified via the #' `compile_standalone` argument to the [`$compile()`][model-method-compile] #' method. +#' +#' This method is also available for fitted model objects ([`CmdStanMCMC`], [`CmdStanVB`], etc.). +#' See **Examples**. +#' +#' Note: there may be many compiler warnings emitted during compilation but +#' these can be ignored so long as they are warnings and not errors. +#' #' @param global (logical) Should the functions be added to the Global #' Environment? The default is `FALSE`, in which case the functions are -#' available via the `functions` field of the [CmdStanModel] object. +#' available via the `functions` field of the R6 object. #' @param verbose (logical) Should detailed information about generated code be #' printed to the console? Defaults to `FALSE`. #' @template seealso-docs @@ -1775,11 +1785,21 @@ CmdStanModel$set("public", name = "diagnose", value = diagnose) #' return a + b; #' } #' } +#' parameters { +#' real x; +#' } +#' model { +#' x ~ std_normal(); +#' } #' " #' ) #' mod <- cmdstan_model(stan_file) #' mod$expose_functions() #' mod$functions$a_plus_b(1, 2) +#' +#' fit <- mod$sample(refresh = 0) +#' fit$expose_functions() # already compiled because of above but this would compile them otherwise +#' fit$functions$a_plus_b(1, 2) #' } #' #' From 88097c644a9871af161ec55379425245cdfc34be Mon Sep 17 00:00:00 2001 From: jgabry Date: Tue, 25 Jul 2023 14:08:19 -0600 Subject: [PATCH 03/16] generate rd files for new doc --- man/CmdStanMCMC.Rd | 15 +++++ man/CmdStanMLE.Rd | 15 +++++ man/CmdStanModel.Rd | 1 + man/CmdStanVB.Rd | 15 +++++ man/fit-method-constrain_variables.Rd | 7 ++- man/fit-method-grad_log_prob.Rd | 7 ++- man/fit-method-hessian.Rd | 9 ++- man/fit-method-init_model_methods.Rd | 17 +++-- man/fit-method-log_prob.Rd | 7 ++- man/fit-method-unconstrain_draws.Rd | 5 ++ man/fit-method-unconstrain_variables.Rd | 5 ++ man/fit-method-variable_skeleton.Rd | 5 ++ man/model-method-check_syntax.Rd | 1 + man/model-method-compile.Rd | 10 ++- man/model-method-diagnose.Rd | 1 + man/model-method-expose_functions.Rd | 83 +++++++++++++++++++++++++ man/model-method-format.Rd | 1 + man/model-method-generate-quantities.Rd | 1 + man/model-method-optimize.Rd | 1 + man/model-method-sample.Rd | 1 + man/model-method-sample_mpi.Rd | 1 + man/model-method-variables.Rd | 1 + man/model-method-variational.Rd | 1 + 23 files changed, 199 insertions(+), 11 deletions(-) create mode 100644 man/model-method-expose_functions.Rd diff --git a/man/CmdStanMCMC.Rd b/man/CmdStanMCMC.Rd index 98b7f4374..218ee49c3 100644 --- a/man/CmdStanMCMC.Rd +++ b/man/CmdStanMCMC.Rd @@ -55,6 +55,21 @@ methods, all of which have their own (linked) documentation pages. \code{\link[=fit-method-return_codes]{$return_codes()}} \tab Return the return codes from the CmdStan runs. \cr } +} + +\subsection{Expose Stan functions and additional methods to R}{\tabular{ll}{ + \strong{Method} \tab \strong{Description} \cr + \code{\link[=fit-method-expose_functions]{$expose_functions()}} \tab Expose Stan functions for use in R. \cr + \code{\link[=fit-method-init_model_methods]{$init_model_methods()}} \tab Expose methods for log-probability, gradients, parameter constraining and unconstraining. \cr + \code{\link[=fit-method-log_prob]{$log_prob()}} \tab Calculate log-prob. \cr + \code{\link[=fit-method-grad_log_prob]{$grad_log_prob()}} \tab Calculate log-prob and gradient. \cr + \code{\link[=fit-method-hessian]{$hessian()}} \tab Calculate log-prob, gradient, and hessian. \cr + \code{\link[=fit-method-constrain_variables]{$constrain_variables()}} \tab Transform a set of unconstrained parameter values to the constrained scale. \cr + \code{\link[=fit-method-unconstrain_variables]{$unconstrain_variables()}} \tab Transform a set of parameter values to the unconstrained scale. \cr + \code{\link[=fit-method-unconstrain_draws]{$unconstrain_draws()}} \tab Transform all parameter draws to the unconstrained scale. \cr + \code{\link[=fit-method-variable_skeleton]{$variable_skeleton()}} \tab Helper function to re-structure a vector of constrained parameter values. \cr +} + } } diff --git a/man/CmdStanMLE.Rd b/man/CmdStanMLE.Rd index c5044acc7..01acae4d9 100644 --- a/man/CmdStanMLE.Rd +++ b/man/CmdStanMLE.Rd @@ -45,6 +45,21 @@ all of which have their own (linked) documentation pages. \code{\link[=fit-method-return_codes]{$return_codes()}} \tab Return the return codes from the CmdStan runs. \cr } +} + +\subsection{Expose Stan functions and additional methods to R}{\tabular{ll}{ + \strong{Method} \tab \strong{Description} \cr + \code{\link[=fit-method-expose_functions]{$expose_functions()}} \tab Expose Stan functions for use in R. \cr + \code{\link[=fit-method-init_model_methods]{$init_model_methods()}} \tab Expose methods for log-probability, gradients, parameter constraining and unconstraining. \cr + \code{\link[=fit-method-log_prob]{$log_prob()}} \tab Calculate log-prob. \cr + \code{\link[=fit-method-grad_log_prob]{$grad_log_prob()}} \tab Calculate log-prob and gradient. \cr + \code{\link[=fit-method-hessian]{$hessian()}} \tab Calculate log-prob, gradient, and hessian. \cr + \code{\link[=fit-method-constrain_variables]{$constrain_variables()}} \tab Transform a set of unconstrained parameter values to the constrained scale. \cr + \code{\link[=fit-method-unconstrain_variables]{$unconstrain_variables()}} \tab Transform a set of parameter values to the unconstrained scale. \cr + \code{\link[=fit-method-unconstrain_draws]{$unconstrain_draws()}} \tab Transform all parameter draws to the unconstrained scale. \cr + \code{\link[=fit-method-variable_skeleton]{$variable_skeleton()}} \tab Helper function to re-structure a vector of constrained parameter values. \cr +} + } } diff --git a/man/CmdStanModel.Rd b/man/CmdStanModel.Rd index fbe191f82..94ec10d61 100644 --- a/man/CmdStanModel.Rd +++ b/man/CmdStanModel.Rd @@ -29,6 +29,7 @@ methods, many of which have their own (linked) documentation pages: \code{\link[=model-method-compile]{$exe_file()}} \tab Return the file path to the compiled executable. \cr \code{\link[=model-method-compile]{$hpp_file()}} \tab Return the file path to the \code{.hpp} file containing the generated C++ code. \cr \code{\link[=model-method-compile]{$save_hpp_file()}} \tab Save the \code{.hpp} file containing the generated C++ code. \cr + \code{\link[=model-method-expose_functions]{$expose_functions()}} \tab Expose Stan functions for use in R. \cr } } diff --git a/man/CmdStanVB.Rd b/man/CmdStanVB.Rd index b11a361f4..4b4d53ada 100644 --- a/man/CmdStanVB.Rd +++ b/man/CmdStanVB.Rd @@ -48,6 +48,21 @@ all of which have their own (linked) documentation pages. \code{\link[=fit-method-return_codes]{$return_codes()}} \tab Return the return codes from the CmdStan runs. \cr } +} + +\subsection{Expose Stan functions and additional methods to R}{\tabular{ll}{ + \strong{Method} \tab \strong{Description} \cr + \code{\link[=fit-method-expose_functions]{$expose_functions()}} \tab Expose Stan functions for use in R. \cr + \code{\link[=fit-method-init_model_methods]{$init_model_methods()}} \tab Expose methods for log-probability, gradients, parameter constraining and unconstraining. \cr + \code{\link[=fit-method-log_prob]{$log_prob()}} \tab Calculate log-prob. \cr + \code{\link[=fit-method-grad_log_prob]{$grad_log_prob()}} \tab Calculate log-prob and gradient. \cr + \code{\link[=fit-method-hessian]{$hessian()}} \tab Calculate log-prob, gradient, and hessian. \cr + \code{\link[=fit-method-constrain_variables]{$constrain_variables()}} \tab Transform a set of unconstrained parameter values to the constrained scale. \cr + \code{\link[=fit-method-unconstrain_variables]{$unconstrain_variables()}} \tab Transform a set of parameter values to the unconstrained scale. \cr + \code{\link[=fit-method-unconstrain_draws]{$unconstrain_draws()}} \tab Transform all parameter draws to the unconstrained scale. \cr + \code{\link[=fit-method-variable_skeleton]{$variable_skeleton()}} \tab Helper function to re-structure a vector of constrained parameter values. \cr +} + } } diff --git a/man/fit-method-constrain_variables.Rd b/man/fit-method-constrain_variables.Rd index 31cdbe9db..cf3e8c2ee 100644 --- a/man/fit-method-constrain_variables.Rd +++ b/man/fit-method-constrain_variables.Rd @@ -28,7 +28,12 @@ the constrained scale \dontrun{ fit_mcmc <- cmdstanr_example("logistic", method = "sample") fit_mcmc$init_model_methods() -fit_mcmc$constrain_variables(unconstrained_variables = c(0.5, 1.2, 1.1, 2.2, 1.1)) +fit_mcmc$constrain_variables(unconstrained_variables = c(0.5, 1.2, 1.1, 2.2)) } } +\seealso{ +\code{\link[=log_prob]{log_prob()}}, \code{\link[=grad_log_prob]{grad_log_prob()}}, \code{\link[=constrain_variables]{constrain_variables()}}, +\code{\link[=unconstrain_variables]{unconstrain_variables()}}, \code{\link[=unconstrain_draws]{unconstrain_draws()}}, \code{\link[=variable_skeleton]{variable_skeleton()}}, +\code{\link[=hessian]{hessian()}} +} diff --git a/man/fit-method-grad_log_prob.Rd b/man/fit-method-grad_log_prob.Rd index e0a58d487..f7c8819f8 100644 --- a/man/fit-method-grad_log_prob.Rd +++ b/man/fit-method-grad_log_prob.Rd @@ -23,7 +23,12 @@ Stan model's \code{log_prob} function and its derivative \dontrun{ fit_mcmc <- cmdstanr_example("logistic", method = "sample") fit_mcmc$init_model_methods() -fit_mcmc$grad_log_prob(unconstrained_variables = c(0.5, 1.2, 1.1, 2.2, 1.1)) +fit_mcmc$grad_log_prob(unconstrained_variables = c(0.5, 1.2, 1.1, 2.2)) } } +\seealso{ +\code{\link[=log_prob]{log_prob()}}, \code{\link[=grad_log_prob]{grad_log_prob()}}, \code{\link[=constrain_variables]{constrain_variables()}}, +\code{\link[=unconstrain_variables]{unconstrain_variables()}}, \code{\link[=unconstrain_draws]{unconstrain_draws()}}, \code{\link[=variable_skeleton]{variable_skeleton()}}, +\code{\link[=hessian]{hessian()}} +} diff --git a/man/fit-method-hessian.Rd b/man/fit-method-hessian.Rd index 3674e926b..0fb4bb0f9 100644 --- a/man/fit-method-hessian.Rd +++ b/man/fit-method-hessian.Rd @@ -22,8 +22,13 @@ Stan model's \code{log_prob}, its derivative, and its hessian \examples{ \dontrun{ fit_mcmc <- cmdstanr_example("logistic", method = "sample") -fit_mcmc$init_model_methods() -fit_mcmc$hessian(unconstrained_variables = c(0.5, 1.2, 1.1, 2.2, 1.1)) +fit_mcmc$init_model_methods(hessian = TRUE) +fit_mcmc$hessian(unconstrained_variables = c(0.5, 1.2, 1.1, 2.2)) } } +\seealso{ +\code{\link[=log_prob]{log_prob()}}, \code{\link[=grad_log_prob]{grad_log_prob()}}, \code{\link[=constrain_variables]{constrain_variables()}}, +\code{\link[=unconstrain_variables]{unconstrain_variables()}}, \code{\link[=unconstrain_draws]{unconstrain_draws()}}, \code{\link[=variable_skeleton]{variable_skeleton()}}, +\code{\link[=hessian]{hessian()}} +} diff --git a/man/fit-method-init_model_methods.Rd b/man/fit-method-init_model_methods.Rd index 6561b0cde..165e804a6 100644 --- a/man/fit-method-init_model_methods.Rd +++ b/man/fit-method-init_model_methods.Rd @@ -4,7 +4,7 @@ \alias{fit-method-init_model_methods} \alias{init_model_methods} \title{Compile additional methods for accessing the model log-probability function -and parameter constraining and unconstraining. This requires the \code{Rcpp} package.} +and parameter constraining and unconstraining.} \usage{ init_model_methods(seed = 0, verbose = FALSE, hessian = FALSE) } @@ -16,13 +16,22 @@ init_model_methods(seed = 0, verbose = FALSE, hessian = FALSE) \item{hessian}{(boolean) Whether to expose the (experimental) hessian method.} } \description{ -The \verb{$init_model_methods()} compiles and initializes the -\code{log_prob}, \code{grad_log_prob}, \code{constrain_variables}, and \code{unconstrain_variables} functions. +The \verb{$init_model_methods()} method compiles and initializes the +\code{log_prob}, \code{grad_log_prob}, \code{constrain_variables}, \code{unconstrain_variables} +and \code{unconstrain_draws} functions. These are then available as methods of +the fitted model object. This requires the \code{Rcpp} package. + +Note: there may be many compiler warnings emitted during compilation but +these can be ignored so long as they are warnings and not errors. } \examples{ \dontrun{ fit_mcmc <- cmdstanr_example("logistic", method = "sample") fit_mcmc$init_model_methods() } - +} +\seealso{ +\code{\link[=log_prob]{log_prob()}}, \code{\link[=grad_log_prob]{grad_log_prob()}}, \code{\link[=constrain_variables]{constrain_variables()}}, +\code{\link[=unconstrain_variables]{unconstrain_variables()}}, \code{\link[=unconstrain_draws]{unconstrain_draws()}}, \code{\link[=variable_skeleton]{variable_skeleton()}}, +\code{\link[=hessian]{hessian()}} } diff --git a/man/fit-method-log_prob.Rd b/man/fit-method-log_prob.Rd index cbdbb93a0..c35e48431 100644 --- a/man/fit-method-log_prob.Rd +++ b/man/fit-method-log_prob.Rd @@ -20,7 +20,12 @@ The \verb{$log_prob()} method provides access to the Stan model's \code{log_prob \dontrun{ fit_mcmc <- cmdstanr_example("logistic", method = "sample") fit_mcmc$init_model_methods() -fit_mcmc$log_prob(unconstrained_variables = c(0.5, 1.2, 1.1, 2.2, 1.1)) +fit_mcmc$log_prob(unconstrained_variables = c(0.5, 1.2, 1.1, 2.2)) } } +\seealso{ +\code{\link[=log_prob]{log_prob()}}, \code{\link[=grad_log_prob]{grad_log_prob()}}, \code{\link[=constrain_variables]{constrain_variables()}}, +\code{\link[=unconstrain_variables]{unconstrain_variables()}}, \code{\link[=unconstrain_draws]{unconstrain_draws()}}, \code{\link[=variable_skeleton]{variable_skeleton()}}, +\code{\link[=hessian]{hessian()}} +} diff --git a/man/fit-method-unconstrain_draws.Rd b/man/fit-method-unconstrain_draws.Rd index 947e47fe2..6764ecb53 100644 --- a/man/fit-method-unconstrain_draws.Rd +++ b/man/fit-method-unconstrain_draws.Rd @@ -36,3 +36,8 @@ unconstrained_draws <- fit_mcmc$unconstrain_draws(draws = fit_mcmc$draws()) } } +\seealso{ +\code{\link[=log_prob]{log_prob()}}, \code{\link[=grad_log_prob]{grad_log_prob()}}, \code{\link[=constrain_variables]{constrain_variables()}}, +\code{\link[=unconstrain_variables]{unconstrain_variables()}}, \code{\link[=unconstrain_draws]{unconstrain_draws()}}, \code{\link[=variable_skeleton]{variable_skeleton()}}, +\code{\link[=hessian]{hessian()}} +} diff --git a/man/fit-method-unconstrain_variables.Rd b/man/fit-method-unconstrain_variables.Rd index 472c1488f..04bfc78e4 100644 --- a/man/fit-method-unconstrain_variables.Rd +++ b/man/fit-method-unconstrain_variables.Rd @@ -23,3 +23,8 @@ fit_mcmc$unconstrain_variables(list(alpha = 0.5, beta = c(0.7, 1.1, 0.2))) } } +\seealso{ +\code{\link[=log_prob]{log_prob()}}, \code{\link[=grad_log_prob]{grad_log_prob()}}, \code{\link[=constrain_variables]{constrain_variables()}}, +\code{\link[=unconstrain_variables]{unconstrain_variables()}}, \code{\link[=unconstrain_draws]{unconstrain_draws()}}, \code{\link[=variable_skeleton]{variable_skeleton()}}, +\code{\link[=hessian]{hessian()}} +} diff --git a/man/fit-method-variable_skeleton.Rd b/man/fit-method-variable_skeleton.Rd index 859dab332..2116d0ad2 100644 --- a/man/fit-method-variable_skeleton.Rd +++ b/man/fit-method-variable_skeleton.Rd @@ -26,3 +26,8 @@ fit_mcmc$variable_skeleton() } } +\seealso{ +\code{\link[=log_prob]{log_prob()}}, \code{\link[=grad_log_prob]{grad_log_prob()}}, \code{\link[=constrain_variables]{constrain_variables()}}, +\code{\link[=unconstrain_variables]{unconstrain_variables()}}, \code{\link[=unconstrain_draws]{unconstrain_draws()}}, \code{\link[=variable_skeleton]{variable_skeleton()}}, +\code{\link[=hessian]{hessian()}} +} diff --git a/man/model-method-check_syntax.Rd b/man/model-method-check_syntax.Rd index 885061116..9193a684d 100644 --- a/man/model-method-check_syntax.Rd +++ b/man/model-method-check_syntax.Rd @@ -80,6 +80,7 @@ The Stan and CmdStan documentation: Other CmdStanModel methods: \code{\link{model-method-compile}}, \code{\link{model-method-diagnose}}, +\code{\link{model-method-expose_functions}}, \code{\link{model-method-format}}, \code{\link{model-method-generate-quantities}}, \code{\link{model-method-optimize}}, diff --git a/man/model-method-compile.Rd b/man/model-method-compile.Rd index 9ff75f473..b4d7b35f8 100644 --- a/man/model-method-compile.Rd +++ b/man/model-method-compile.Rd @@ -60,12 +60,17 @@ not modified since last compiled. The default is \code{FALSE}. Can also be set via a global \code{cmdstanr_force_recompile} option.} \item{compile_model_methods}{(logical) Compile additional model methods -(\code{log_prob()}, \code{grad_log_prob()}, \code{constrain_pars()}, \code{unconstrain_pars()})} +(\code{log_prob()}, \code{grad_log_prob()}, \code{constrain_variables()}, +\code{unconstrain_variables()}).} \item{compile_hessian_method}{(logical) Should the (experimental) \code{hessian()} method be be compiled with the model methods?} -\item{compile_standalone}{(logical) Should functions in the Stan model be compiled for used in R?} +\item{compile_standalone}{(logical) Should functions in the Stan model be +compiled for use in R? If \code{TRUE} the functions will be available via the +\code{functions} field in the compiled model object. This can also be done after +compilation using the +\code{\link[=model-method-expose_functions]{$expose_functions()}} method.} \item{threads}{Deprecated and will be removed in a future release. Please turn on threading via \code{cpp_options = list(stan_threads = TRUE)} instead.} @@ -142,6 +147,7 @@ The Stan and CmdStan documentation: Other CmdStanModel methods: \code{\link{model-method-check_syntax}}, \code{\link{model-method-diagnose}}, +\code{\link{model-method-expose_functions}}, \code{\link{model-method-format}}, \code{\link{model-method-generate-quantities}}, \code{\link{model-method-optimize}}, diff --git a/man/model-method-diagnose.Rd b/man/model-method-diagnose.Rd index 371b71619..7f9cde7d4 100644 --- a/man/model-method-diagnose.Rd +++ b/man/model-method-diagnose.Rd @@ -122,6 +122,7 @@ The Stan and CmdStan documentation: Other CmdStanModel methods: \code{\link{model-method-check_syntax}}, \code{\link{model-method-compile}}, +\code{\link{model-method-expose_functions}}, \code{\link{model-method-format}}, \code{\link{model-method-generate-quantities}}, \code{\link{model-method-optimize}}, diff --git a/man/model-method-expose_functions.Rd b/man/model-method-expose_functions.Rd new file mode 100644 index 000000000..c01aa3c1a --- /dev/null +++ b/man/model-method-expose_functions.Rd @@ -0,0 +1,83 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model.R +\name{model-method-expose_functions} +\alias{model-method-expose_functions} +\alias{expose_functions} +\alias{fit-method-expose_functions} +\title{Expose Stan functions to R} +\usage{ +expose_functions(global = FALSE, verbose = FALSE) +} +\arguments{ +\item{global}{(logical) Should the functions be added to the Global +Environment? The default is \code{FALSE}, in which case the functions are +available via the \code{functions} field of the R6 object.} + +\item{verbose}{(logical) Should detailed information about generated code be +printed to the console? Defaults to \code{FALSE}.} +} +\description{ +The \verb{$expose_functions()} method of a \code{\link{CmdStanModel}} object +will compile the functions in the Stan program's \code{functions} block and +expose them for use in \R. This can also be specified via the +\code{compile_standalone} argument to the \code{\link[=model-method-compile]{$compile()}} +method. + +This method is also available for fitted model objects (\code{\link{CmdStanMCMC}}, \code{\link{CmdStanVB}}, etc.). +See \strong{Examples}. + +Note: there may be many compiler warnings emitted during compilation but +these can be ignored so long as they are warnings and not errors. +} +\examples{ +\dontrun{ +stan_file <- write_stan_file( + " + functions { + real a_plus_b(real a, real b) { + return a + b; + } + } + parameters { + real x; + } + model { + x ~ std_normal(); + } + " +) +mod <- cmdstan_model(stan_file) +mod$expose_functions() +mod$functions$a_plus_b(1, 2) + +fit <- mod$sample(refresh = 0) +fit$expose_functions() # already compiled because of above but this would compile them otherwise +fit$functions$a_plus_b(1, 2) +} + + +} +\seealso{ +The CmdStanR website +(\href{https://mc-stan.org/cmdstanr/}{mc-stan.org/cmdstanr}) for online +documentation and tutorials. + +The Stan and CmdStan documentation: +\itemize{ +\item Stan documentation: \href{https://mc-stan.org/users/documentation/}{mc-stan.org/users/documentation} +\item CmdStan User’s Guide: \href{https://mc-stan.org/docs/cmdstan-guide/}{mc-stan.org/docs/cmdstan-guide} +} + +Other CmdStanModel methods: +\code{\link{model-method-check_syntax}}, +\code{\link{model-method-compile}}, +\code{\link{model-method-diagnose}}, +\code{\link{model-method-format}}, +\code{\link{model-method-generate-quantities}}, +\code{\link{model-method-optimize}}, +\code{\link{model-method-sample_mpi}}, +\code{\link{model-method-sample}}, +\code{\link{model-method-variables}}, +\code{\link{model-method-variational}} +} +\concept{CmdStanModel methods} diff --git a/man/model-method-format.Rd b/man/model-method-format.Rd index 777e7da01..1d7ed11bd 100644 --- a/man/model-method-format.Rd +++ b/man/model-method-format.Rd @@ -79,6 +79,7 @@ Other CmdStanModel methods: \code{\link{model-method-check_syntax}}, \code{\link{model-method-compile}}, \code{\link{model-method-diagnose}}, +\code{\link{model-method-expose_functions}}, \code{\link{model-method-generate-quantities}}, \code{\link{model-method-optimize}}, \code{\link{model-method-sample_mpi}}, diff --git a/man/model-method-generate-quantities.Rd b/man/model-method-generate-quantities.Rd index da75ac5f3..5a80bb736 100644 --- a/man/model-method-generate-quantities.Rd +++ b/man/model-method-generate-quantities.Rd @@ -172,6 +172,7 @@ Other CmdStanModel methods: \code{\link{model-method-check_syntax}}, \code{\link{model-method-compile}}, \code{\link{model-method-diagnose}}, +\code{\link{model-method-expose_functions}}, \code{\link{model-method-format}}, \code{\link{model-method-optimize}}, \code{\link{model-method-sample_mpi}}, diff --git a/man/model-method-optimize.Rd b/man/model-method-optimize.Rd index a8735e7fe..42f81d07a 100644 --- a/man/model-method-optimize.Rd +++ b/man/model-method-optimize.Rd @@ -300,6 +300,7 @@ Other CmdStanModel methods: \code{\link{model-method-check_syntax}}, \code{\link{model-method-compile}}, \code{\link{model-method-diagnose}}, +\code{\link{model-method-expose_functions}}, \code{\link{model-method-format}}, \code{\link{model-method-generate-quantities}}, \code{\link{model-method-sample_mpi}}, diff --git a/man/model-method-sample.Rd b/man/model-method-sample.Rd index 2c6b693db..e0955abb4 100644 --- a/man/model-method-sample.Rd +++ b/man/model-method-sample.Rd @@ -412,6 +412,7 @@ Other CmdStanModel methods: \code{\link{model-method-check_syntax}}, \code{\link{model-method-compile}}, \code{\link{model-method-diagnose}}, +\code{\link{model-method-expose_functions}}, \code{\link{model-method-format}}, \code{\link{model-method-generate-quantities}}, \code{\link{model-method-optimize}}, diff --git a/man/model-method-sample_mpi.Rd b/man/model-method-sample_mpi.Rd index a99b96952..89981273f 100644 --- a/man/model-method-sample_mpi.Rd +++ b/man/model-method-sample_mpi.Rd @@ -311,6 +311,7 @@ Other CmdStanModel methods: \code{\link{model-method-check_syntax}}, \code{\link{model-method-compile}}, \code{\link{model-method-diagnose}}, +\code{\link{model-method-expose_functions}}, \code{\link{model-method-format}}, \code{\link{model-method-generate-quantities}}, \code{\link{model-method-optimize}}, diff --git a/man/model-method-variables.Rd b/man/model-method-variables.Rd index f2fb296f5..aa609ddda 100644 --- a/man/model-method-variables.Rd +++ b/man/model-method-variables.Rd @@ -40,6 +40,7 @@ Other CmdStanModel methods: \code{\link{model-method-check_syntax}}, \code{\link{model-method-compile}}, \code{\link{model-method-diagnose}}, +\code{\link{model-method-expose_functions}}, \code{\link{model-method-format}}, \code{\link{model-method-generate-quantities}}, \code{\link{model-method-optimize}}, diff --git a/man/model-method-variational.Rd b/man/model-method-variational.Rd index a64a5a232..21c92fe24 100644 --- a/man/model-method-variational.Rd +++ b/man/model-method-variational.Rd @@ -304,6 +304,7 @@ Other CmdStanModel methods: \code{\link{model-method-check_syntax}}, \code{\link{model-method-compile}}, \code{\link{model-method-diagnose}}, +\code{\link{model-method-expose_functions}}, \code{\link{model-method-format}}, \code{\link{model-method-generate-quantities}}, \code{\link{model-method-optimize}}, From a1e3790041b82ca883d0e07d2ab114c1a88a7af6 Mon Sep 17 00:00:00 2001 From: jgabry Date: Tue, 25 Jul 2023 14:23:20 -0600 Subject: [PATCH 04/16] update NEWS --- NEWS.md | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/NEWS.md b/NEWS.md index 495c4d477..aaf69021e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,37 @@ +# cmdstanr 0.6.0 + +### Major new features + +* New `expose_functions()` method to expose Stan functions to R by @andrjohns in #702. See `?expose_functions`. +* New methods for accessing log_prob, grad_log_prob, hessian, un/constrain variables by @andrjohns in #701. See `?init_model_methods`. + +## Other changes + +* mod$variables works w includes in precompile state (fix #680) by @MKyhos in #682 +* Update broken link for Stan OpenCL support page by @erictleung in #686 +* Add newline to check syntax output by @rok-cesnovar in #689 +* Allow exposing functions without sampling by @andrjohns in #705 +* Expose skeleton by @andrjohns in #706 +* WSL - Run cmdstan and models under WSL filesystem by @andrjohns in #696 +* Bugfix - Deep copy method/function environments by @andrjohns in #709 +* Add option for including jacobian adjustments in hessian method by @andrjohns in #710 +* WSL Optimisations and Bugfixes for CI by @andrjohns in #711 +* add stancflags from make/local by @rok-cesnovar in #690 +* Update co-authors by @andrjohns in #715 +* Update model methods parameter naming and extract skeleton function by @andrjohns in #724 +* Add method for unconstraining all parameter draws by @andrjohns in #729 +* Improve efficiency of variable matching by @sbfnk in #736 +* Add verbosity to download output and errors by @andrjohns in #745 +* Update handling of show_messages, add show_exceptions by @andrjohns in #746 +* Rtools43 support by @andrjohns in #755 +* Add stanc M1 make patch, suppress boost warnings by @andrjohns in #756 +* more examples of summary method by @gravesti in #751 +* Fix model$format and model$check_syntax for compiled models with include-paths by @adrian-lison in #775 +* Generalise RTools config/support by @andrjohns in #777 +* New posterior vignette by @gravesti in #719 +* Add moment-matching support to $loo() method by @andrjohns in #778 +* replace \ with function by @jsocolar in #789 + # cmdstanr 0.5.3 ### New features From ceabf488b0e38570400cc65f7449bb06e7c429f5 Mon Sep 17 00:00:00 2001 From: jgabry Date: Tue, 25 Jul 2023 14:23:31 -0600 Subject: [PATCH 05/16] add new vignette to _pkgdown.yml --- _pkgdown.yml | 1 + vignettes/posterior.Rmd | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/_pkgdown.yml b/_pkgdown.yml index 2f99caefa..70db6a30b 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -70,6 +70,7 @@ articles: and using CmdStanR in R Markdown documents. contents: - cmdstanr-internals + - posterior - r-markdown - deprecations - profiling diff --git a/vignettes/posterior.Rmd b/vignettes/posterior.Rmd index 3d246a6f1..fca84be29 100644 --- a/vignettes/posterior.Rmd +++ b/vignettes/posterior.Rmd @@ -81,4 +81,4 @@ fit$summary(variables = NULL, "Strictly Positive" = strict_pos) # fit$print(variables = NULL, "Strictly Positive" = strict_pos) ``` -For more information, see [posterior::summarise_draws()], which is is called by `$summary()`. +For more information, see [posterior::summarise_draws()], which is called by `$summary()`. From 18dfd3cd204952c3366698c1f16260863e900ab2 Mon Sep 17 00:00:00 2001 From: jgabry Date: Tue, 25 Jul 2023 14:27:39 -0600 Subject: [PATCH 06/16] minor doc fixes --- R/fit.R | 35 +++++++++++++------------ man/fit-method-constrain_variables.Rd | 9 ++++--- man/fit-method-grad_log_prob.Rd | 8 +++--- man/fit-method-hessian.Rd | 14 +++++----- man/fit-method-unconstrain_variables.Rd | 4 +-- 5 files changed, 36 insertions(+), 34 deletions(-) diff --git a/R/fit.R b/R/fit.R index a8afd2376..f9dd4d8d2 100644 --- a/R/fit.R +++ b/R/fit.R @@ -396,10 +396,10 @@ CmdStanFit$set("public", name = "log_prob", value = log_prob) #' @description The `$grad_log_prob()` method provides access to the #' Stan model's `log_prob` function and its derivative #' -#' @param unconstrained_variables (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 +#' @param unconstrained_variables (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{ @@ -434,16 +434,16 @@ CmdStanFit$set("public", name = "grad_log_prob", value = grad_log_prob) #' @description The `$hessian()` method provides access to the #' Stan model's `log_prob`, its derivative, and its hessian #' -#' @param unconstrained_variables (numeric) A vector of unconstrained parameters to be passed -#' to `hessian` -#' @param jacobian_adjustment (bool) Whether to include the log-density adjustments from -#' un/constraining variables +#' @param unconstrained_variables (numeric) A vector of unconstrained parameters +#' to be passed to `hessian`. +#' @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$init_model_methods(hessian = TRUE) -#' fit_mcmc$hessian(unconstrained_variables = c(0.5, 1.2, 1.1, 2.2)) +#' # fit_mcmc <- cmdstanr_example("logistic", method = "sample") +#' # fit_mcmc$init_model_methods(hessian = TRUE) +#' # fit_mcmc$hessian(unconstrained_variables = c(0.5, 1.2, 1.1, 2.2)) #' } #' #' @seealso [log_prob()], [grad_log_prob()], [constrain_variables()], @@ -471,8 +471,8 @@ CmdStanFit$set("public", name = "hessian", value = hessian) #' @description The `$unconstrain_variables()` method transforms input parameters to #' the unconstrained scale #' -#' @param variables (list) A list of parameter values to transform, in the same format as -#' provided to the `init` argument of the `$sample()` method +#' @param variables (list) A list of parameter values to transform, in the same +#' format as provided to the `init` argument of the `$sample()` method. #' #' @examples #' \dontrun{ @@ -641,11 +641,12 @@ CmdStanFit$set("public", name = "variable_skeleton", value = variable_skeleton) #' @description The `$constrain_variables()` method transforms input parameters to #' the constrained scale #' -#' @param unconstrained_variables (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 unconstrained_variables (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) +#' implied by newly-constrained parameters (defaults to TRUE). #' #' @examples #' \dontrun{ diff --git a/man/fit-method-constrain_variables.Rd b/man/fit-method-constrain_variables.Rd index cf3e8c2ee..78c5b8098 100644 --- a/man/fit-method-constrain_variables.Rd +++ b/man/fit-method-constrain_variables.Rd @@ -12,13 +12,14 @@ constrain_variables( ) } \arguments{ -\item{unconstrained_variables}{(numeric) A vector of unconstrained parameters to constrain} +\item{unconstrained_variables}{(numeric) A vector of unconstrained parameters +to constrain.} -\item{transformed_parameters}{(boolean) Whether to return transformed parameters -implied by newly-constrained parameters (defaults to TRUE)} +\item{transformed_parameters}{(boolean) Whether to return transformed +parameters implied by newly-constrained parameters (defaults to TRUE).} \item{generated_quantities}{(boolean) Whether to return generated quantities -implied by newly-constrained parameters (defaults to TRUE)} +implied by newly-constrained parameters (defaults to TRUE).} } \description{ The \verb{$constrain_variables()} method transforms input parameters to diff --git a/man/fit-method-grad_log_prob.Rd b/man/fit-method-grad_log_prob.Rd index f7c8819f8..ef42d6c3d 100644 --- a/man/fit-method-grad_log_prob.Rd +++ b/man/fit-method-grad_log_prob.Rd @@ -9,11 +9,11 @@ given vector of unconstrained parameters} grad_log_prob(unconstrained_variables, jacobian_adjustment = TRUE) } \arguments{ -\item{unconstrained_variables}{(numeric) A vector of unconstrained parameters to be passed -to \code{grad_log_prob}} +\item{unconstrained_variables}{(numeric) A vector of unconstrained parameters +to be passed to \code{grad_log_prob}.} -\item{jacobian_adjustment}{(bool) Whether to include the log-density adjustments from -un/constraining variables} +\item{jacobian_adjustment}{(bool) Whether to include the log-density +adjustments from un/constraining variables.} } \description{ The \verb{$grad_log_prob()} method provides access to the diff --git a/man/fit-method-hessian.Rd b/man/fit-method-hessian.Rd index 0fb4bb0f9..fe384c9d9 100644 --- a/man/fit-method-hessian.Rd +++ b/man/fit-method-hessian.Rd @@ -9,11 +9,11 @@ for a given vector of unconstrained parameters} hessian(unconstrained_variables, jacobian_adjustment = TRUE) } \arguments{ -\item{unconstrained_variables}{(numeric) A vector of unconstrained parameters to be passed -to \code{hessian}} +\item{unconstrained_variables}{(numeric) A vector of unconstrained parameters +to be passed to \code{hessian}.} -\item{jacobian_adjustment}{(bool) Whether to include the log-density adjustments from -un/constraining variables} +\item{jacobian_adjustment}{(bool) Whether to include the log-density +adjustments from un/constraining variables.} } \description{ The \verb{$hessian()} method provides access to the @@ -21,9 +21,9 @@ Stan model's \code{log_prob}, its derivative, and its hessian } \examples{ \dontrun{ -fit_mcmc <- cmdstanr_example("logistic", method = "sample") -fit_mcmc$init_model_methods(hessian = TRUE) -fit_mcmc$hessian(unconstrained_variables = c(0.5, 1.2, 1.1, 2.2)) +# fit_mcmc <- cmdstanr_example("logistic", method = "sample") +# fit_mcmc$init_model_methods(hessian = TRUE) +# fit_mcmc$hessian(unconstrained_variables = c(0.5, 1.2, 1.1, 2.2)) } } diff --git a/man/fit-method-unconstrain_variables.Rd b/man/fit-method-unconstrain_variables.Rd index 04bfc78e4..69c6e308e 100644 --- a/man/fit-method-unconstrain_variables.Rd +++ b/man/fit-method-unconstrain_variables.Rd @@ -8,8 +8,8 @@ unconstrain_variables(variables) } \arguments{ -\item{variables}{(list) A list of parameter values to transform, in the same format as -provided to the \code{init} argument of the \verb{$sample()} method} +\item{variables}{(list) A list of parameter values to transform, in the same +format as provided to the \code{init} argument of the \verb{$sample()} method.} } \description{ The \verb{$unconstrain_variables()} method transforms input parameters to From f7d72611d21aa18581deb73c0b37fb7fff21b05d Mon Sep 17 00:00:00 2001 From: jgabry Date: Tue, 25 Jul 2023 14:32:31 -0600 Subject: [PATCH 07/16] avoid pkgdown error about missing topics --- R/csv.R | 2 +- R/example.R | 2 +- R/utils.R | 2 +- _pkgdown.yml | 2 ++ man/read_sample_csv.Rd | 1 + man/stan_threads.Rd | 1 + man/write_stan_tempfile.Rd | 1 + 7 files changed, 8 insertions(+), 3 deletions(-) diff --git a/R/csv.R b/R/csv.R index 9ab528e1f..5d3824428 100644 --- a/R/csv.R +++ b/R/csv.R @@ -422,7 +422,7 @@ read_cmdstan_csv <- function(files, #' Read CmdStan CSV files from sampling into \R #' #' Deprecated. Use [read_cmdstan_csv()] instead. -#' +#' @keywords internal #' @export #' @param files,variables,sampler_diagnostics Deprecated. Use #' [read_cmdstan_csv()] instead. diff --git a/R/example.R b/R/example.R index 388c555ef..755f33703 100644 --- a/R/example.R +++ b/R/example.R @@ -188,7 +188,7 @@ write_stan_file <- function(code, #' Write Stan code to a temporary file #' #' This function is deprecated. Please use [write_stan_file()] instead. -#' +#' @keywords internal #' @export #' @inheritParams write_stan_file write_stan_tempfile <- function(code, dir = tempdir()) { diff --git a/R/utils.R b/R/utils.R index 937d48021..7e732c0a5 100644 --- a/R/utils.R +++ b/R/utils.R @@ -235,7 +235,7 @@ generate_file_names <- #' Set or get the number of threads used to execute Stan models #' #' DEPRECATED. Please use the `threads_per_chain` argument when fitting the model. -#' +#' @keywords internal #' @name stan_threads NULL diff --git a/_pkgdown.yml b/_pkgdown.yml index 70db6a30b..1dea923a9 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -111,6 +111,8 @@ reference: - write_stan_json - write_stan_file - draws_to_csv + - as.mcmc.list + - as_draws.CmdStanMCMC - title: "Using CmdStanR with knitr and R Markdown" contents: - register_knitr_engine diff --git a/man/read_sample_csv.Rd b/man/read_sample_csv.Rd index 76bb5463c..4c7661ae7 100644 --- a/man/read_sample_csv.Rd +++ b/man/read_sample_csv.Rd @@ -13,3 +13,4 @@ read_sample_csv(files, variables = NULL, sampler_diagnostics = NULL) \description{ Deprecated. Use \code{\link[=read_cmdstan_csv]{read_cmdstan_csv()}} instead. } +\keyword{internal} diff --git a/man/stan_threads.Rd b/man/stan_threads.Rd index e79e882ff..e8cf8470d 100644 --- a/man/stan_threads.Rd +++ b/man/stan_threads.Rd @@ -19,3 +19,4 @@ The value of the environment variable \code{STAN_NUM_THREADS}. \description{ DEPRECATED. Please use the \code{threads_per_chain} argument when fitting the model. } +\keyword{internal} diff --git a/man/write_stan_tempfile.Rd b/man/write_stan_tempfile.Rd index be3073ffa..e663302fe 100644 --- a/man/write_stan_tempfile.Rd +++ b/man/write_stan_tempfile.Rd @@ -20,3 +20,4 @@ is used.} \description{ This function is deprecated. Please use \code{\link[=write_stan_file]{write_stan_file()}} instead. } +\keyword{internal} From 87159463f4463a0d0eb2cb1085a0765fc8053d4c Mon Sep 17 00:00:00 2001 From: jgabry Date: Tue, 25 Jul 2023 15:17:38 -0600 Subject: [PATCH 08/16] Update _pkgdown.yml --- _pkgdown.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/_pkgdown.yml b/_pkgdown.yml index 1dea923a9..ca5375be8 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -111,7 +111,7 @@ reference: - write_stan_json - write_stan_file - draws_to_csv - - as.mcmc.list + - as_mcmc.list - as_draws.CmdStanMCMC - title: "Using CmdStanR with knitr and R Markdown" contents: From 3303838e3651ad479494eb6fc923e5a7f294f6b7 Mon Sep 17 00:00:00 2001 From: jgabry Date: Tue, 25 Jul 2023 15:19:35 -0600 Subject: [PATCH 09/16] minor vignette fixes * now need to use underscore in file name for including the knitr settings (to avoid it being treated as its own vignette) * fix array syntax in a few cases --- .../opencl-files/bernoulli_logit_glm.stan | 2 +- vignettes/articles-online-only/opencl.Rmd | 2 +- .../children/{settings-knitr.Rmd => _settings-knitr.Rmd} | 0 vignettes/children/comparison-with-rstan.md | 8 ++------ vignettes/cmdstanr-internals.Rmd | 6 +++--- vignettes/cmdstanr.Rmd | 2 +- vignettes/deprecations.Rmd | 2 +- vignettes/posterior.Rmd | 4 ++-- vignettes/profiling.Rmd | 2 +- 9 files changed, 12 insertions(+), 16 deletions(-) rename vignettes/children/{settings-knitr.Rmd => _settings-knitr.Rmd} (100%) diff --git a/vignettes/articles-online-only/opencl-files/bernoulli_logit_glm.stan b/vignettes/articles-online-only/opencl-files/bernoulli_logit_glm.stan index 133521db4..3d5514364 100644 --- a/vignettes/articles-online-only/opencl-files/bernoulli_logit_glm.stan +++ b/vignettes/articles-online-only/opencl-files/bernoulli_logit_glm.stan @@ -2,7 +2,7 @@ data { int k; int n; matrix[n, k] X; - int y[n]; + array[n] int y; } parameters { vector[k] beta; diff --git a/vignettes/articles-online-only/opencl.Rmd b/vignettes/articles-online-only/opencl.Rmd index bdf35bf77..bc8599efd 100644 --- a/vignettes/articles-online-only/opencl.Rmd +++ b/vignettes/articles-online-only/opencl.Rmd @@ -13,7 +13,7 @@ vignette: > %\VignetteEncoding{UTF-8} --- -```{r child="../children/settings-knitr.Rmd"} +```{r child="../children/_settings-knitr.Rmd"} ``` ## Introduction diff --git a/vignettes/children/settings-knitr.Rmd b/vignettes/children/_settings-knitr.Rmd similarity index 100% rename from vignettes/children/settings-knitr.Rmd rename to vignettes/children/_settings-knitr.Rmd diff --git a/vignettes/children/comparison-with-rstan.md b/vignettes/children/comparison-with-rstan.md index 65233450b..314266c82 100644 --- a/vignettes/children/comparison-with-rstan.md +++ b/vignettes/children/comparison-with-rstan.md @@ -9,15 +9,11 @@ results to output files. ### Advantages of RStan -* Advanced features. We are working on making these available outside of RStan -but currently they are only available to R users via RStan: - - `rstan::log_prob()` - - `rstan::grad_log_prob()` - - `rstan::expose_stan_functions()` - * Allows other developers to distribute R packages with _pre-compiled_ Stan programs (like **rstanarm**) on CRAN. +* Avoids use of R6 classes, which may result in more familiar syntax for many R users. + ### Advantages of CmdStanR * Compatible with latest versions of Stan. Keeping up with Stan releases is diff --git a/vignettes/cmdstanr-internals.Rmd b/vignettes/cmdstanr-internals.Rmd index 93c656f31..164b80085 100644 --- a/vignettes/cmdstanr-internals.Rmd +++ b/vignettes/cmdstanr-internals.Rmd @@ -13,7 +13,7 @@ vignette: > %\VignetteEncoding{UTF-8} --- -```{r child="children/settings-knitr.Rmd"} +```{r child="children/_settings-knitr.Rmd"} ``` ## Introduction @@ -127,7 +127,7 @@ is missing a lower bound and a prior for a parameter. stan_file_pedantic <- write_stan_file(" data { int N; - int y[N]; + array[N] int y; } parameters { // should have but omitting to demonstrate pedantic mode @@ -461,7 +461,7 @@ the save file. rm(fit); gc() fit <- readRDS(temp_rds_file) -fit$summary() +fit$print() ``` ## Developing using CmdStanR diff --git a/vignettes/cmdstanr.Rmd b/vignettes/cmdstanr.Rmd index 9350ea541..31f35bce3 100644 --- a/vignettes/cmdstanr.Rmd +++ b/vignettes/cmdstanr.Rmd @@ -13,7 +13,7 @@ vignette: > %\VignetteEncoding{UTF-8} --- -```{r child="children/settings-knitr.Rmd"} +```{r child="children/_settings-knitr.Rmd"} ``` ## Introduction diff --git a/vignettes/deprecations.Rmd b/vignettes/deprecations.Rmd index 6fb1b6e8a..920aebed6 100644 --- a/vignettes/deprecations.Rmd +++ b/vignettes/deprecations.Rmd @@ -13,7 +13,7 @@ vignette: > %\VignetteEncoding{UTF-8} --- -```{r child="children/settings-knitr.Rmd"} +```{r child="children/_settings-knitr.Rmd"} ``` ## Introduction diff --git a/vignettes/posterior.Rmd b/vignettes/posterior.Rmd index fca84be29..e1f9e30e8 100644 --- a/vignettes/posterior.Rmd +++ b/vignettes/posterior.Rmd @@ -12,7 +12,7 @@ vignette: > %\VignetteEncoding{UTF-8} --- -```{r child="children/settings-knitr.Rmd"} +```{r child="children/_settings-knitr.Rmd"} ``` ## Summary @@ -81,4 +81,4 @@ fit$summary(variables = NULL, "Strictly Positive" = strict_pos) # fit$print(variables = NULL, "Strictly Positive" = strict_pos) ``` -For more information, see [posterior::summarise_draws()], which is called by `$summary()`. +For more information, see `posterior::summarise_draws()`, which is called by `$summary()`. diff --git a/vignettes/profiling.Rmd b/vignettes/profiling.Rmd index 59323bb1a..1f9eb0dc5 100644 --- a/vignettes/profiling.Rmd +++ b/vignettes/profiling.Rmd @@ -13,7 +13,7 @@ vignette: > %\VignetteEncoding{UTF-8} --- -```{r child="children/settings-knitr.Rmd"} +```{r child="children/_settings-knitr.Rmd"} ``` ## Introduction From 1dffad3791a319b4d4ddd6c25dd9efc20451055f Mon Sep 17 00:00:00 2001 From: jgabry Date: Tue, 25 Jul 2023 15:38:14 -0600 Subject: [PATCH 10/16] Update NEWS.md --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index aaf69021e..863988233 100644 --- a/NEWS.md +++ b/NEWS.md @@ -5,7 +5,7 @@ * New `expose_functions()` method to expose Stan functions to R by @andrjohns in #702. See `?expose_functions`. * New methods for accessing log_prob, grad_log_prob, hessian, un/constrain variables by @andrjohns in #701. See `?init_model_methods`. -## Other changes +### Other changes * mod$variables works w includes in precompile state (fix #680) by @MKyhos in #682 * Update broken link for Stan OpenCL support page by @erictleung in #686 From 0af482832c6e1f6898e78bb4cffa4107a9bc90c0 Mon Sep 17 00:00:00 2001 From: jgabry Date: Tue, 25 Jul 2023 19:08:16 -0600 Subject: [PATCH 11/16] temporary work around pkgdown formatting issue with posterior draws_summary the hack of using print.data.frame in chunks with echo=FALSE is used because the pillar formatting of posterior draws_summary objects isn't playing nicely with pkgdown::build_articles(). --- vignettes/children/comparison-with-rstan.md | 2 - vignettes/cmdstanr.Rmd | 52 +++++++++++--- vignettes/posterior.Rmd | 75 ++++++++++++++++++--- 3 files changed, 107 insertions(+), 22 deletions(-) diff --git a/vignettes/children/comparison-with-rstan.md b/vignettes/children/comparison-with-rstan.md index 314266c82..ed1628f1b 100644 --- a/vignettes/children/comparison-with-rstan.md +++ b/vignettes/children/comparison-with-rstan.md @@ -22,8 +22,6 @@ package and new CRAN releases of both **rstan** and **StanHeaders**. With CmdStanR the latest improvements in Stan will be available from R immediately after updating CmdStan using `cmdstanr::install_cmdstan()`. -* Fewer installation issues (e.g., no need to mess with Makevars files). - * Running Stan via external processes results in fewer unexpected crashes, especially in RStudio. diff --git a/vignettes/cmdstanr.Rmd b/vignettes/cmdstanr.Rmd index 31f35bce3..dcd24d15a 100644 --- a/vignettes/cmdstanr.Rmd +++ b/vignettes/cmdstanr.Rmd @@ -18,11 +18,11 @@ vignette: > ## Introduction -CmdStanR is a lightweight interface to [Stan](https://mc-stan.org/) for R users -(see [CmdStanPy](https://github.com/stan-dev/cmdstanpy) for Python) that -provides an alternative to the traditional [RStan](https://mc-stan.org/rstan/) -interface. See the [*Comparison with RStan*](#comparison-with-rstan) section -later in this vignette for more details on how the two interfaces differ. +CmdStanR (Command Stan R) is a lightweight interface to +[Stan](https://mc-stan.org/) for R users that provides an alternative to the +traditional [RStan](https://mc-stan.org/rstan/) interface. See the [*Comparison +with RStan*](#comparison-with-rstan) section later in this vignette for more +details on how the two interfaces differ. **CmdStanR is not on CRAN yet**, but the beta release can be installed by running the following command in R. @@ -38,7 +38,6 @@ later in examples. ```{r library, message=FALSE} library(cmdstanr) -check_cmdstan_toolchain(fix = TRUE, quiet = TRUE) library(posterior) library(bayesplot) color_scheme_set("brightblue") @@ -188,7 +187,7 @@ first argument specifies the variables to summarize and any arguments after that are passed on to `posterior::summarise_draws()` to specify which summaries to compute, whether to use multiple cores, etc. -```{r summary} +```{r summary, eval=FALSE} fit$summary() fit$summary(variables = c("theta", "lp__"), "mean", "sd") @@ -203,6 +202,24 @@ fit$summary( ) ``` +```{r, echo=FALSE} +# NOTE: the hack of using print.data.frame in chunks with echo=FALSE +# is used because the pillar formatting of posterior draws_summary objects +# isn't playing nicely with pkgdown::build_articles(). +options(digits = 2) +print.data.frame(fit$summary()) + +print.data.frame(fit$summary(variables = c("theta", "lp__"), "mean", "sd")) + +print.data.frame(fit$summary("theta", pr_lt_half = ~ mean(. <= 0.5))) + +print.data.frame(fit$summary( + variables = NULL, + posterior::default_summary_measures(), + extra_quantiles = ~posterior::quantile2(., probs = c(.0275, .975)) +)) +``` + #### CmdStan's stansummary utility CmdStan itself provides a `stansummary` utility that can be called using the @@ -334,11 +351,20 @@ the `$sample()` method demonstrated above. We can find the (penalized) maximum likelihood estimate (MLE) using [`$optimize()`](https://mc-stan.org/cmdstanr/reference/model-method-optimize.html). -```{r optimize} +```{r optimize, eval=FALSE} fit_mle <- mod$optimize(data = data_list, seed = 123) fit_mle$summary() # includes lp__ (log prob calculated by Stan program) fit_mle$mle("theta") ``` +```{r, echo=FALSE} +# NOTE: the hack of using print.data.frame in chunks with echo=FALSE +# is used because the pillar formatting of posterior draws_summary objects +# isn't playing nicely with pkgdown::build_articles(). +options(digits = 2) +fit_mle <- mod$optimize(data = data_list, seed = 123) +print.data.frame(fit_mle$summary()) # includes lp__ (log prob calculated by Stan program) +fit_mle$mle("theta") +``` Here's a plot comparing the penalized MLE to the posterior distribution of `theta`. @@ -354,10 +380,18 @@ We can run Stan's experimental variational Bayes algorithm (ADVI) using the [`$variational()`](https://mc-stan.org/cmdstanr/reference/model-method-variational.html) method. -```{r variational} +```{r variational, eval=FALSE} fit_vb <- mod$variational(data = data_list, seed = 123, output_samples = 4000) fit_vb$summary("theta") ``` +```{r, echo=FALSE} +# NOTE: the hack of using print.data.frame in chunks with echo=FALSE +# is used because the pillar formatting of posterior draws_summary objects +# isn't playing nicely with pkgdown::build_articles(). +options(digits = 2) +fit_vb <- mod$variational(data = data_list, seed = 123, output_samples = 4000) +print.data.frame(fit_vb$summary("theta")) +``` The `$draws()` method can be used to access the approximate posterior draws. Let's extract the draws, make the same plot we made after MCMC, and compare the diff --git a/vignettes/posterior.Rmd b/vignettes/posterior.Rmd index e1f9e30e8..f9d339dc4 100644 --- a/vignettes/posterior.Rmd +++ b/vignettes/posterior.Rmd @@ -15,14 +15,28 @@ vignette: > ```{r child="children/_settings-knitr.Rmd"} ``` + +```{r, include=FALSE} +options(digits=2) +``` + ## Summary We can easily customise the summary statistics reported by `$summary()` and `$print()`. -```{r} +```{r eval=FALSE} fit <- cmdstanr::cmdstanr_example("schools", method = "sample") fit$summary() ``` +```{r echo=FALSE} +fit <- cmdstanr::cmdstanr_example("schools", method = "sample") +print.data.frame(fit$summary()) +``` By default all variables are summaries with the follow functions: ```{r} @@ -30,23 +44,33 @@ posterior::default_summary_measures() ``` To change the variables summarised, we use the variables argument -```{r} +```{r eval=FALSE} fit$summary(variables = c("mu", "tau")) ``` +```{r echo=FALSE} +print.data.frame(fit$summary(variables = c("mu", "tau"))) +``` We can additionally change which functions are used -```{r} +```{r eval=FALSE} fit$summary(variables = c("mu", "tau"), mean, sd) ``` +```{r echo=FALSE} +print.data.frame(fit$summary(variables = c("mu", "tau"), mean, sd)) +``` To summarise all variables with non-default functions, it is necessary to set explicitly set the variables argument, either to `NULL` or the full vector of variable names. -```{r} +```{r eval=FALSE} fit$metadata()$model_params fit$summary(variables = NULL, "mean", "median") ``` +```{r echo=FALSE} +fit$metadata()$model_params +print.data.frame(fit$summary(variables = NULL, "mean", "median")) +``` Summary functions can be specified by character string, function, or using a formula (or anything else supported by [rlang::as_function]). If these arguments are named, those names will be used in the tibble output. If the summary results are named they will take precedence. -```{r} +```{r eval=FALSE} my_sd <- function(x) c(My_SD = sd(x)) fit$summary( c("mu", "tau"), @@ -57,28 +81,57 @@ fit$summary( Minimum = function(x) min(x) ) ``` +```{r echo=FALSE} +my_sd <- function(x) c(My_SD = sd(x)) +print.data.frame(fit$summary( + c("mu", "tau"), + MEAN = mean, + "median", + my_sd, + ~quantile(.x, probs = c(0.1, 0.9)), + Minimum = function(x) min(x) +)) +``` + Arguments to all summary functions can also be specified with `.args`. -```{r} +```{r eval=FALSE} fit$summary(c("mu", "tau"), quantile, .args = list(probs = c(0.025, .05, .95, .975))) ``` +```{r echo=FALSE} +print.data.frame(fit$summary(c("mu", "tau"), quantile, .args = list(probs = c(0.025, .05, .95, .975)))) +``` The summary functions are applied to the array of sample values, with dimension `iter_sampling`x`chains`. -```{r} +```{r eval=FALSE} fit$summary(variables = NULL, dim, colMeans) ``` +```{r echo=FALSE} +print.data.frame(fit$summary(variables = NULL, dim, colMeans)) +``` -For this reason users may have unexpected results if they use [stats::var()] directly, as it will return a covariance matrix. An alternative is the [distributional::variance] function. -```{r} -fit$summary(c("mu", "tau"), distributional::variance, ~var(as.vector(.x))) + +For this reason users may have unexpected results if they use `stats::var()` directly, as it will return a covariance matrix. An alternative is the `distributional::variance()` function, +which can also be accessed via `posterior::variance()`. +```{r eval=FALSE} +fit$summary(c("mu", "tau"), posterior::variance, ~var(as.vector(.x))) ``` +```{r echo=FALSE} +print.data.frame(fit$summary(c("mu", "tau"), posterior::variance, ~var(as.vector(.x)))) +``` + Summary functions need not be numeric, but these won't work with `$print()`. -```{r} +```{r eval=FALSE} strict_pos <- function(x) if (all(x > 0)) "yes" else "no" fit$summary(variables = NULL, "Strictly Positive" = strict_pos) # fit$print(variables = NULL, "Strictly Positive" = strict_pos) ``` +```{r echo=FALSE} +strict_pos <- function(x) if (all(x > 0)) "yes" else "no" +print.data.frame(fit$summary(variables = NULL, "Strictly Positive" = strict_pos)) +# fit$print(variables = NULL, "Strictly Positive" = strict_pos) +``` For more information, see `posterior::summarise_draws()`, which is called by `$summary()`. From 907d0e83deaa5af49cff40e0c0f98232ae1e8e40 Mon Sep 17 00:00:00 2001 From: jgabry Date: Tue, 25 Jul 2023 19:09:49 -0600 Subject: [PATCH 12/16] Update posterior.Rmd --- vignettes/posterior.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/posterior.Rmd b/vignettes/posterior.Rmd index f9d339dc4..465391d8b 100644 --- a/vignettes/posterior.Rmd +++ b/vignettes/posterior.Rmd @@ -19,7 +19,7 @@ vignette: > NOTE: the hack below of using print.data.frame in chunks with echo=FALSE is used because the pillar formatting of posterior draws_summary objects isn't playing nicely with pkgdown::build_articles(). When that is fixed -using options(digits=2) won't be necessary anymore. +using options(digits=2) also won't be necessary anymore. --> ```{r, include=FALSE} options(digits=2) From 71f85cc619b19a02efb41b10fe9a2fd0e3129590 Mon Sep 17 00:00:00 2001 From: jgabry Date: Tue, 25 Jul 2023 19:12:14 -0600 Subject: [PATCH 13/16] website for v0.6.0 --- docs/404.html | 160 +- docs/LICENSE-text.html | 139 +- docs/LICENSE.html | 148 +- .../articles/articles-online-only/opencl.html | 227 +-- docs/articles/cmdstanr-internals.html | 896 ++++++----- docs/articles/cmdstanr.html | 705 +++++---- .../cmdstanr_files/figure-html/plot-mle-1.png | Bin 37984 -> 41641 bytes .../figure-html/plot-variational-1-1.png | Bin 38005 -> 41428 bytes .../figure-html/plot-variational-2-1.png | Bin 37488 -> 41075 bytes .../cmdstanr_files/figure-html/plots-1.png | Bin 37827 -> 41578 bytes docs/articles/deprecations.html | 199 ++- docs/articles/index.html | 173 +-- docs/articles/posterior.html | 309 ++++ .../header-attrs-2.18/header-attrs.js | 12 + docs/articles/profiling.html | 325 ++-- docs/articles/r-markdown.html | 260 ++-- docs/authors.html | 230 ++- docs/index.html | 153 +- docs/news/index.html | 527 +++---- docs/pkgdown.css | 83 +- docs/pkgdown.js | 4 +- docs/pkgdown.yml | 12 +- docs/pull_request_template.html | 175 +-- docs/reference/CmdStanDiagnose.html | 218 +-- docs/reference/CmdStanGQ.html | 436 +++--- docs/reference/CmdStanMCMC.html | 242 +-- docs/reference/CmdStanMLE.html | 233 +-- docs/reference/CmdStanModel-1.png | Bin 12494 -> 15795 bytes docs/reference/CmdStanModel-2.png | Bin 12652 -> 16009 bytes docs/reference/CmdStanModel.html | 906 ++++++------ docs/reference/CmdStanVB.html | 237 +-- docs/reference/Rplot002.png | Bin 4617 -> 6854 bytes docs/reference/as_draws.CmdStanMCMC.html | 435 +++--- docs/reference/as_mcmc.list.html | 184 +-- .../cmdstan_default_install_path.html | 174 +-- docs/reference/cmdstan_default_path.html | 179 +-- docs/reference/cmdstan_model-1.png | Bin 12494 -> 15795 bytes docs/reference/cmdstan_model-2.png | Bin 12652 -> 16009 bytes docs/reference/cmdstan_model.html | 909 ++++++------ docs/reference/cmdstanr-package-1.png | Bin 12494 -> 15795 bytes docs/reference/cmdstanr-package-2.png | Bin 12652 -> 16009 bytes docs/reference/cmdstanr-package.html | 911 ++++++------ docs/reference/cmdstanr_example.html | 571 ++++--- docs/reference/draws_to_csv.html | 252 ++-- docs/reference/eng_cmdstan.html | 179 +-- .../reference/fit-method-cmdstan_summary.html | 485 +++--- docs/reference/fit-method-code.html | 263 ++-- .../fit-method-constrain_variables.html | 179 +++ .../fit-method-diagnostic_summary.html | 264 ++-- docs/reference/fit-method-draws-1.png | Bin 61243 -> 72272 bytes docs/reference/fit-method-draws-2.png | Bin 614623 -> 671367 bytes docs/reference/fit-method-draws.html | 534 +++---- docs/reference/fit-method-grad_log_prob.html | 173 +++ docs/reference/fit-method-gradients.html | 192 +-- docs/reference/fit-method-hessian.html | 172 +++ docs/reference/fit-method-init.html | 234 ++- .../fit-method-init_model_methods.html | 180 +++ docs/reference/fit-method-inv_metric.html | 332 ++--- docs/reference/fit-method-log_prob.html | 167 +++ docs/reference/fit-method-loo.html | 257 ++-- docs/reference/fit-method-lp-1.png | Bin 82170 -> 86194 bytes docs/reference/fit-method-lp.html | 212 +-- docs/reference/fit-method-metadata.html | 422 +++--- docs/reference/fit-method-mle.html | 212 +-- docs/reference/fit-method-num_chains.html | 178 +-- docs/reference/fit-method-output.html | 539 +++---- docs/reference/fit-method-profiles.html | 338 ++--- docs/reference/fit-method-return_codes.html | 200 +-- .../fit-method-sampler_diagnostics.html | 288 ++-- docs/reference/fit-method-save_object.html | 230 +-- .../fit-method-save_output_files.html | 318 ++-- docs/reference/fit-method-summary.html | 380 +++-- docs/reference/fit-method-time.html | 223 +-- .../fit-method-unconstrain_draws.html | 185 +++ .../fit-method-unconstrain_variables.html | 165 +++ .../fit-method-variable_skeleton.html | 171 +++ docs/reference/index.html | 477 ++---- docs/reference/install_cmdstan.html | 365 ++--- docs/reference/model-method-check_syntax.html | 335 ++--- docs/reference/model-method-compile.html | 424 +++--- docs/reference/model-method-diagnose.html | 325 ++-- .../model-method-expose_functions.html | 231 +++ docs/reference/model-method-format.html | 325 ++-- .../model-method-generate-quantities.html | 510 +++---- docs/reference/model-method-optimize-1.png | Bin 12494 -> 15795 bytes docs/reference/model-method-optimize-2.png | Bin 12652 -> 16009 bytes docs/reference/model-method-optimize.html | 1131 +++++++------- docs/reference/model-method-sample-1.png | Bin 12494 -> 15795 bytes docs/reference/model-method-sample-2.png | Bin 12652 -> 16009 bytes docs/reference/model-method-sample.html | 1310 ++++++++--------- docs/reference/model-method-sample_mpi.html | 651 ++++---- docs/reference/model-method-variables.html | 283 ++-- docs/reference/model-method-variational-1.png | Bin 12494 -> 15795 bytes docs/reference/model-method-variational-2.png | Bin 12652 -> 16009 bytes docs/reference/model-method-variational.html | 1151 +++++++-------- docs/reference/read_cmdstan_csv.html | 566 +++---- docs/reference/read_sample_csv.html | 163 +- docs/reference/register_knitr_engine.html | 188 +-- docs/reference/set_cmdstan_path.html | 210 +-- docs/reference/stan_threads.html | 170 +-- docs/reference/write_stan_file.html | 318 ++-- docs/reference/write_stan_json.html | 282 ++-- docs/reference/write_stan_tempfile.html | 175 +-- 103 files changed, 12938 insertions(+), 14948 deletions(-) create mode 100644 docs/articles/posterior.html create mode 100644 docs/articles/posterior_files/header-attrs-2.18/header-attrs.js create mode 100644 docs/reference/fit-method-constrain_variables.html create mode 100644 docs/reference/fit-method-grad_log_prob.html create mode 100644 docs/reference/fit-method-hessian.html create mode 100644 docs/reference/fit-method-init_model_methods.html create mode 100644 docs/reference/fit-method-log_prob.html create mode 100644 docs/reference/fit-method-unconstrain_draws.html create mode 100644 docs/reference/fit-method-unconstrain_variables.html create mode 100644 docs/reference/fit-method-variable_skeleton.html create mode 100644 docs/reference/model-method-expose_functions.html diff --git a/docs/404.html b/docs/404.html index 0b36386a3..ced1d14e2 100644 --- a/docs/404.html +++ b/docs/404.html @@ -1,74 +1,34 @@ - - - - + + + + - Page not found (404) • cmdstanr - - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + - - - - - + + + - - -
+
+
-
- +
+ + - - diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html index 697b1bfa8..5ed5129d6 100644 --- a/docs/LICENSE-text.html +++ b/docs/LICENSE-text.html @@ -1,74 +1,12 @@ - - - - - - - -License • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -License • cmdstanr - - + + - - -
-
- -
- -
+
+
-
- +
- - + + diff --git a/docs/LICENSE.html b/docs/LICENSE.html index 21ed26a88..2dcbb7c1a 100644 --- a/docs/LICENSE.html +++ b/docs/LICENSE.html @@ -1,74 +1,12 @@ - - - - - - - -BSD 3-Clause License • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -BSD 3-Clause License • cmdstanr - - + + - - -
-
- -
- -
+
+
-
- +
- - + + diff --git a/docs/articles/articles-online-only/opencl.html b/docs/articles/articles-online-only/opencl.html index 98da606fa..274f8275e 100644 --- a/docs/articles/articles-online-only/opencl.html +++ b/docs/articles/articles-online-only/opencl.html @@ -26,6 +26,8 @@ + +
+
-
-

-Introduction

-

This vignette is intended to be read after the Getting started with CmdStanR vignette. Please read that first for important background. In this document we provide additional details about compiling models, passing in data, and how CmdStan output is saved and read back into R.

-

We will only use the $sample() method in examples, but all model fitting methods work in a similar way under the hood.

+
+

Introduction +

+

This vignette is intended to be read after the Getting +started with CmdStanR vignette. Please read that first for +important background. In this document we provide additional details +about compiling models, passing in data, and how CmdStan output is saved +and read back into R.

+

We will only use the $sample() method in examples, but +all model fitting methods work in a similar way under the hood.

-library(cmdstanr)
-check_cmdstan_toolchain(fix = TRUE, quiet = TRUE)
+library(cmdstanr) +check_cmdstan_toolchain(fix = TRUE, quiet = TRUE)
-
-

-Compilation

-
-

-Immediate compilation

-

The cmdstan_model() function creates a new CmdStanModel object. The CmdStanModel object stores the path to a Stan program as well as the path to a compiled executable.

+
+

Compilation +

+
+

Immediate compilation +

+

The cmdstan_model() function creates a new +CmdStanModel object. The CmdStanModel object +stores the path to a Stan program as well as the path to a compiled +executable.

-stan_file <- file.path(cmdstan_path(), "examples", "bernoulli", "bernoulli.stan")
-mod <- cmdstan_model(stan_file)
-mod$print()
+stan_file <- file.path(cmdstan_path(), "examples", "bernoulli", "bernoulli.stan") +mod <- cmdstan_model(stan_file) +mod$print()
data {
   int<lower=0> N;
-  array[N] int<lower=0,upper=1> y; // or int<lower=0,upper=1> y[N];
+  array[N] int<lower=0,upper=1> y;
 }
 parameters {
   real<lower=0,upper=1> theta;
@@ -171,209 +182,256 @@ 

y ~ bernoulli(theta); }

-mod$stan_file()
-
[1] "/Users/jgabry/.cmdstan/cmdstan-2.29.1/examples/bernoulli/bernoulli.stan"
+mod$stan_file()
+
[1] "/Users/jgabry/.cmdstan/cmdstan-2.32.2/examples/bernoulli/bernoulli.stan"
-mod$exe_file()
-
[1] "/Users/jgabry/.cmdstan/cmdstan-2.29.1/examples/bernoulli/bernoulli"
-

Subsequently, if you create a CmdStanModel object from the same Stan file then compilation will be skipped (assuming the file hasn’t changed).

+mod$exe_file()
+
[1] "/Users/jgabry/.cmdstan/cmdstan-2.32.2/examples/bernoulli/bernoulli"
+

Subsequently, if you create a CmdStanModel object from +the same Stan file then compilation will be skipped (assuming the file +hasn’t changed).

-mod <- cmdstan_model(stan_file)
-

Internally, cmdstan_model() first creates the CmdStanModel object from just the Stan file and then calls its $compile() method. Optional arguments to the $compile() method can be passed via ....

+mod <- cmdstan_model(stan_file)
+

Internally, cmdstan_model() first creates the +CmdStanModel object from just the Stan file and then calls +its $compile() +method. Optional arguments to the $compile() method can be +passed via ....

-mod <- cmdstan_model(
-  stan_file, 
-  force_recompile = TRUE, 
-  include_paths = "paths/to/directories/with/included/files", 
-  cpp_options = list(stan_threads = TRUE, STANC2 = TRUE)
-)
+mod <- cmdstan_model( + stan_file, + force_recompile = TRUE, + include_paths = "paths/to/directories/with/included/files", + cpp_options = list(stan_threads = TRUE, STANC2 = TRUE) +)
-
-

-Delayed compilation

-

It is also possible to delay compilation when creating the CmdStanModel object by specifying compile=FALSE and then later calling the $compile() method directly.

+
+

Delayed compilation +

+

It is also possible to delay compilation when creating the +CmdStanModel object by specifying +compile=FALSE and then later calling the +$compile() method directly.

-unlink(mod$exe_file())
-mod <- cmdstan_model(stan_file, compile = FALSE)
-mod$exe_file() # not yet created
-
character(0)
+unlink(mod$exe_file()) +mod <- cmdstan_model(stan_file, compile = FALSE) +mod$exe_file() # not yet created
+
character(0)
-mod$compile()
-mod$exe_file()
-
[1] "/Users/jgabry/.cmdstan/cmdstan-2.29.1/examples/bernoulli/bernoulli"
+mod$compile() +mod$exe_file()
+
[1] "/Users/jgabry/.cmdstan/cmdstan-2.32.2/examples/bernoulli/bernoulli"
-
-

-Pedantic check

-

If you are using CmdStan version 2.24 or later and CmdStanR version 0.2.1 or later, you can run a pedantic check for your model. CmdStanR will always check that your Stan program does not contain any invalid syntax but with pedantic mode enabled the check will also warn you about other potential issues in your model, for example:

+
+

Pedantic check +

+

If you are using CmdStan version 2.24 or later and CmdStanR version +0.2.1 or later, you can run a pedantic check for your model. CmdStanR +will always check that your Stan program does not contain any invalid +syntax but with pedantic mode enabled the check will also warn you about +other potential issues in your model, for example:

    -
  • Distribution usages issues: distribution arguments do not match the distribution specification, or some specific distribution is used in an inadvisable way.
  • -
  • Unused parameter: a parameter is defined but does not contribute to target.
  • -
  • Large or small constant in a distribution: very large or very small constants are used as distribution arguments.
  • -
  • Control flow depends on a parameter: branching control flow (like if/else) depends on a parameter value.
  • -
  • Parameter has multiple twiddles: a parameter is on the left-hand side of multiple twiddles (i.e., multiple ~ symbols).
  • -
  • Parameter has zero or multiple priors: a parameter has zero or more than one prior distribution.
  • -
  • Variable is used before assignment: a variable is used before being assigned a value.
  • -
  • Strict or nonsensical parameter bounds: a parameter is given questionable bounds.
  • +
  • Distribution usages issues: distribution arguments do not match the +distribution specification, or some specific distribution is used in an +inadvisable way.
  • +
  • Unused parameter: a parameter is defined but does not contribute to +target.
  • +
  • Large or small constant in a distribution: very large or very small +constants are used as distribution arguments.
  • +
  • Control flow depends on a parameter: branching control flow (like +if/else) depends on a parameter value.
  • +
  • Parameter has multiple twiddles: a parameter is on the left-hand +side of multiple twiddles (i.e., multiple ~ symbols).
  • +
  • Parameter has zero or multiple priors: a parameter has zero or more +than one prior distribution.
  • +
  • Variable is used before assignment: a variable is used before being +assigned a value.
  • +
  • Strict or nonsensical parameter bounds: a parameter is given +questionable bounds.
-

For the latest information on the checks performed in pedantic mode see the Pedantic mode chapter in the Stan Reference Manual.

-

Pedantic mode is available when compiling the model or when using the separate $check_syntax() method of a CmdStanModel object. Internally this corresponds to setting the stanc (Stan transpiler) option warn-pedantic. Here we demonstrate pedantic mode with a Stan program that is syntactically correct but is missing a lower bound and a prior for a parameter.

+

For the latest information on the checks performed in pedantic mode +see the Pedantic +mode chapter in the Stan Reference Manual.

+

Pedantic mode is available when compiling the model or when using the +separate $check_syntax() method of a +CmdStanModel object. Internally this corresponds to setting +the stanc (Stan transpiler) option +warn-pedantic. Here we demonstrate pedantic mode with a +Stan program that is syntactically correct but is missing a lower bound +and a prior for a parameter.

-stan_file_pedantic <- write_stan_file("
-data {
-  int N;
-  int y[N];
-}
-parameters {
-  // should have <lower=0> but omitting to demonstrate pedantic mode
-  real lambda;
-}
-model {
-  y ~ poisson(lambda);
-}
-")
-

To turn on pedantic mode at compile time you can set pedantic=TRUE in the call to cmdstan_model() (or when calling the $compile() method directly if using the delayed compilation approach described above).

-
mod_pedantic <- cmdstan_model(stan_file_pedantic, pedantic = TRUE)
-Warning in '/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMNhFrl/model-dfb56281c2c0.stan', line 4, column 2: Declaration
-    of arrays by placing brackets after a variable name is deprecated and
-    will be removed in Stan 2.32.0. Instead use the array keyword before the
-    type. This can be changed automatically using the auto-format flag to
-    stanc
-Warning in '/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMNhFrl/model-dfb56281c2c0.stan', line 11, column 14: A
-    poisson distribution is given parameter lambda as a rate parameter
-    (argument 1), but lambda was not constrained to be strictly positive.
-Warning: The parameter lambda has no priors.
-

To turn on pedantic mode separately from compilation use the pedantic argument to the $check_syntax() method.

-
mod_pedantic$check_syntax(pedantic = TRUE) 
-Warning in '/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMNhFrl/model_74b584fd23ea8c78eceda86d1d425fe8.stan', line 4, column 2: Declaration
-    of arrays by placing brackets after a variable name is deprecated and
-    will be removed in Stan 2.32.0. Instead use the array keyword before the
-    type. This can be changed automatically using the auto-format flag to
-    stanc
-Warning in '/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMNhFrl/model_74b584fd23ea8c78eceda86d1d425fe8.stan', line 11, column 14: A
-    poisson distribution is given parameter lambda as a rate parameter
-    (argument 1), but lambda was not constrained to be strictly positive.
-Warning: The parameter lambda has no priors.
-Stan program is syntactically correct
-

Using pedantic=TRUE via the $check_syntax() method also has the advantage that it can be used even if the model hasn’t been compiled yet. This can be helpful because the pedantic and syntax checks themselves are much faster than compilation.

-
file.remove(mod_pedantic$exe_file()) # delete compiled executable
-[1] TRUE
-rm(mod_pedantic)
-
-mod_pedantic <- cmdstan_model(stan_file_pedantic, compile = FALSE)
-mod_pedantic$check_syntax(pedantic = TRUE)
-Warning in '/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMNhFrl/model_74b584fd23ea8c78eceda86d1d425fe8.stan', line 4, column 2: Declaration
-    of arrays by placing brackets after a variable name is deprecated and
-    will be removed in Stan 2.32.0. Instead use the array keyword before the
-    type. This can be changed automatically using the auto-format flag to
-    stanc
-Warning in '/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMNhFrl/model_74b584fd23ea8c78eceda86d1d425fe8.stan', line 11, column 14: A
-    poisson distribution is given parameter lambda as a rate parameter
-    (argument 1), but lambda was not constrained to be strictly positive.
-Warning: The parameter lambda has no priors.
-Stan program is syntactically correct
+stan_file_pedantic <- write_stan_file(" +data { + int N; + array[N] int y; +} +parameters { + // should have <lower=0> but omitting to demonstrate pedantic mode + real lambda; +} +model { + y ~ poisson(lambda); +} +")
+

To turn on pedantic mode at compile time you can set +pedantic=TRUE in the call to cmdstan_model() +(or when calling the $compile() method directly if using +the delayed compilation approach described above).

+
mod_pedantic <- cmdstan_model(stan_file_pedantic, pedantic = TRUE)
+Warning in '/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpOiRpoh/model-17ac4361020c.stan', line 11, column 14: A
+    poisson distribution is given parameter lambda as a rate parameter
+    (argument 1), but lambda was not constrained to be strictly positive.
+Warning: The parameter lambda has no priors. This means either no prior is
+    provided, or the prior(s) depend on data variables. In the later case,
+    this may be a false positive.
+

To turn on pedantic mode separately from compilation use the +pedantic argument to the $check_syntax() +method.

+
mod_pedantic$check_syntax(pedantic = TRUE)
+Warning in '/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpOiRpoh/model_febb1e69c7387a0e64cf13583e078104.stan', line 11, column 14: A
+    poisson distribution is given parameter lambda as a rate parameter
+    (argument 1), but lambda was not constrained to be strictly positive.
+Warning: The parameter lambda has no priors. This means either no prior is
+    provided, or the prior(s) depend on data variables. In the later case,
+    this may be a false positive.
+Stan program is syntactically correct
+

Using pedantic=TRUE via the $check_syntax() +method also has the advantage that it can be used even if the model +hasn’t been compiled yet. This can be helpful because the pedantic and +syntax checks themselves are much faster than compilation.

+
file.remove(mod_pedantic$exe_file()) # delete compiled executable
+[1] TRUE
+rm(mod_pedantic)
+
+mod_pedantic <- cmdstan_model(stan_file_pedantic, compile = FALSE)
+mod_pedantic$check_syntax(pedantic = TRUE)
+Warning in '/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpOiRpoh/model_febb1e69c7387a0e64cf13583e078104.stan', line 11, column 14: A
+    poisson distribution is given parameter lambda as a rate parameter
+    (argument 1), but lambda was not constrained to be strictly positive.
+Warning: The parameter lambda has no priors. This means either no prior is
+    provided, or the prior(s) depend on data variables. In the later case,
+    this may be a false positive.
+Stan program is syntactically correct
-
-

-Stan model variables

-

If using CmdStan 2.27 or newer, you can obtain the names, types and dimensions of the data, parameters, transformed parameters and generated quantities variables of a Stan model using the $variables() method of the CmdStanModel object.

+
+

Stan model variables +

+

If using CmdStan 2.27 or newer, you can obtain the names, types and +dimensions of the data, parameters, transformed parameters and generated +quantities variables of a Stan model using the $variables() +method of the CmdStanModel object.

-stan_file_variables <- write_stan_file("
-data {
-  int<lower=1> J;
-  vector<lower=0>[J] sigma;
-  vector[J] y;
-}
-parameters {
-  real mu;
-  real<lower=0> tau;
-  vector[J] theta_raw;
-}
-transformed parameters {
-  vector[J] theta = mu + tau * theta_raw;
-}
-model {
-  target += normal_lpdf(tau | 0, 10);
-  target += normal_lpdf(mu | 0, 10);
-  target += normal_lpdf(theta_raw | 0, 1);
-  target += normal_lpdf(y | theta, sigma);
-}
-")
-mod_v <- cmdstan_model(stan_file_variables)
-variables <- mod_v$variables()
-

The $variables() method returns a list with data, parameters, transformed_parameters and generated_quantities elements, each corresponding to variables in their respective block of the program. Transformed data variables are not listed as they are not used in the model’s input or output.

+stan_file_variables <- write_stan_file(" +data { + int<lower=1> J; + vector<lower=0>[J] sigma; + vector[J] y; +} +parameters { + real mu; + real<lower=0> tau; + vector[J] theta_raw; +} +transformed parameters { + vector[J] theta = mu + tau * theta_raw; +} +model { + target += normal_lpdf(tau | 0, 10); + target += normal_lpdf(mu | 0, 10); + target += normal_lpdf(theta_raw | 0, 1); + target += normal_lpdf(y | theta, sigma); +} +") +mod_v <- cmdstan_model(stan_file_variables) +variables <- mod_v$variables()
+

The $variables() method returns a list with +data, parameters, +transformed_parameters and +generated_quantities elements, each corresponding to +variables in their respective block of the program. Transformed data +variables are not listed as they are not used in the model’s input or +output.

-names(variables)
+names(variables)
[1] "parameters"             "included_files"         "data"                  
 [4] "transformed_parameters" "generated_quantities"  
-names(variables$data)
+names(variables$data)
[1] "J"     "sigma" "y"    
-names(variables$parameters)
+names(variables$parameters)
[1] "mu"        "tau"       "theta_raw"
-names(variables$transformed_parameters)
+names(variables$transformed_parameters)
[1] "theta"
-names(variables$generated_quantities)
-
character(0)
-

Each variable is represented as a list containing the type information (currently limited to real or int) and the number of dimensions.

+names(variables$generated_quantities) +
character(0)
+

Each variable is represented as a list containing the type +information (currently limited to real or int) +and the number of dimensions.

-variables$data$J
+variables$data$J
$type
 [1] "int"
 
 $dimensions
 [1] 0
-variables$data$sigma
+variables$data$sigma
$type
 [1] "real"
 
 $dimensions
 [1] 1
-variables$parameters$tau
+variables$parameters$tau
$type
 [1] "real"
 
 $dimensions
 [1] 0
-variables$transformed_parameters$theta
+variables$transformed_parameters$theta
$type
 [1] "real"
 
 $dimensions
 [1] 1
-
-

-Executable location

-

By default, the executable is created in the same directory as the file containing the Stan program. You can also specify a different location with the dir argument.

+
+

Executable location +

+

By default, the executable is created in the same directory as the +file containing the Stan program. You can also specify a different +location with the dir argument.

-mod <- cmdstan_model(stan_file, dir = "path/to/directory/for/executable")
+mod <- cmdstan_model(stan_file, dir = "path/to/directory/for/executable")
-
-

-Processing data

-

There are three data formats that CmdStanR allows when fitting a model:

+
+

Processing data +

+

There are three data formats that CmdStanR allows when fitting a +model:

  • named list of R objects
  • JSON file
  • R dump file
-
-

-Named list of R objects

-

Like the RStan interface, CmdStanR accepts a named list of R objects where the names correspond to variables declared in the data block of the Stan program. In the Bernoulli model the data is N, the number of data points, and y an integer array of observations.

+
+

Named list of R objects +

+

Like the RStan interface, CmdStanR accepts a named list of R objects +where the names correspond to variables declared in the data block of +the Stan program. In the Bernoulli model the data is N, the +number of data points, and y an integer array of +observations.

-mod$print()
+mod$print()
data {
   int<lower=0> N;
-  array[N] int<lower=0,upper=1> y; // or int<lower=0,upper=1> y[N];
+  array[N] int<lower=0,upper=1> y;
 }
 parameters {
   real<lower=0,upper=1> theta;
@@ -383,92 +441,113 @@ 

y ~ bernoulli(theta); }

-# data block has 'N' and 'y'
-data_list <- list(N = 10, y = c(0,1,0,0,0,0,0,0,0,1))
-fit <- mod$sample(data = data_list)
-

Because CmdStan doesn’t accept lists of R objects, CmdStanR will first write the data to a temporary JSON file using write_stan_json(). This happens internally, but it is also possible to call write_stan_json() directly.

+# data block has 'N' and 'y' +data_list <- list(N = 10, y = c(0,1,0,0,0,0,0,0,0,1)) +fit <- mod$sample(data = data_list)
+

Because CmdStan doesn’t accept lists of R objects, CmdStanR will +first write the data to a temporary JSON file using +write_stan_json(). This happens internally, but it is also +possible to call write_stan_json() directly.

-data_list <- list(N = 10, y = c(0,1,0,0,0,0,0,0,0,1))
-json_file <- tempfile(fileext = ".json")
-write_stan_json(data_list, json_file)
-cat(readLines(json_file), sep = "\n")
+data_list <- list(N = 10, y = c(0,1,0,0,0,0,0,0,0,1)) +json_file <- tempfile(fileext = ".json") +write_stan_json(data_list, json_file) +cat(readLines(json_file), sep = "\n")
{
   "N": 10,
   "y": [0, 1, 0, 0, 0, 0, 0, 0, 0, 1]
 }
-
-

-JSON file

-

If you already have your data in a JSON file you can just pass that file directly to CmdStanR instead of using a list of R objects. For example, we could pass in the JSON file we created above using write_stan_json():

+
+

JSON file +

+

If you already have your data in a JSON file you can just pass that +file directly to CmdStanR instead of using a list of R objects. For +example, we could pass in the JSON file we created above using +write_stan_json():

-fit <- mod$sample(data = json_file)
+fit <- mod$sample(data = json_file)
-
-

-R dump file

-

Finally, it is also possible to use the R dump file format. This is not recommended because CmdStan can process JSON faster than R dump, but CmdStanR allows it because CmdStan will accept files created by rstan::stan_rdump():

+
+

R dump file +

+

Finally, it is also possible to use the R dump file format. This is +not recommended because CmdStan can process JSON faster than R +dump, but CmdStanR allows it because CmdStan will accept files created +by rstan::stan_rdump():

-rdump_file <- tempfile(fileext = ".data.R")
-rstan::stan_rdump(names(data_list), file = rdump_file, envir = list2env(data_list))
-cat(readLines(rdump_file), sep = "\n")
-fit <- mod$sample(data = rdump_file)
+rdump_file <- tempfile(fileext = ".data.R") +rstan::stan_rdump(names(data_list), file = rdump_file, envir = list2env(data_list)) +cat(readLines(rdump_file), sep = "\n") +fit <- mod$sample(data = rdump_file)
-
-

-Writing CmdStan output to CSV

-
-

-Default temporary files

+
+

Writing CmdStan output to CSV +

+
+

Default temporary files +

-data_list <- list(N = 10, y = c(0,1,0,0,0,0,0,0,0,1))
-fit <- mod$sample(data = data_list)
-

When fitting a model, the default behavior is to write the output from CmdStan to CSV files in a temporary directory.

+data_list <- list(N = 10, y = c(0,1,0,0,0,0,0,0,0,1)) +fit <- mod$sample(data = data_list)
+

When fitting a model, the default behavior is to write the output +from CmdStan to CSV files in a temporary directory.

-fit$output_files()
-
[1] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMNhFrl/bernoulli-202203181228-1-9912f0.csv"
-[2] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMNhFrl/bernoulli-202203181228-2-9912f0.csv"
-[3] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMNhFrl/bernoulli-202203181228-3-9912f0.csv"
-[4] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMNhFrl/bernoulli-202203181228-4-9912f0.csv"
-

These files will be lost if you end your R session or if you remove the fit object and force (or wait for) garbage collection.

+fit$output_files()
+
[1] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpOiRpoh/bernoulli-202307251455-1-48e885.csv"
+[2] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpOiRpoh/bernoulli-202307251455-2-48e885.csv"
+[3] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpOiRpoh/bernoulli-202307251455-3-48e885.csv"
+[4] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpOiRpoh/bernoulli-202307251455-4-48e885.csv"
+

These files will be lost if you end your R session or if you remove +the fit object and force (or wait for) garbage +collection.

-files <- fit$output_files()
-file.exists(files)
+files <- fit$output_files() +file.exists(files)
[1] TRUE TRUE TRUE TRUE
-rm(fit)
-gc()
-
          used (Mb) gc trigger (Mb) limit (Mb) max used  (Mb)
-Ncells 1135293 60.7    2208007  118         NA  2208007 118.0
-Vcells 2043878 15.6    8388608   64      32768  3361903  25.7
+rm(fit) +gc()
+
          used (Mb) gc trigger  (Mb) limit (Mb) max used  (Mb)
+Ncells 1260687 67.4    2431888 129.9         NA  2431888 129.9
+Vcells 2216221 17.0    8388608  64.0      32768  3504936  26.8
-file.exists(files)
+file.exists(files)
[1] FALSE FALSE FALSE FALSE
-
-

-Non-temporary files

-

To save these files to a non-temporary location there are two options. You can either specify the output_dir argument to mod$sample() or use fit$save_output_files() after fitting the model.

+
+

Non-temporary files +

+

To save these files to a non-temporary location there are two +options. You can either specify the output_dir argument to +mod$sample() or use fit$save_output_files() +after fitting the model.

-# see ?save_output_files for info on optional arguments
-fit$save_output_files(dir = "path/to/directory")
+# see ?save_output_files for info on optional arguments +fit$save_output_files(dir = "path/to/directory")
-fit <- mod$sample(
-  data = data_list, 
-  output_dir = "path/to/directory"
-)
+fit <- mod$sample( + data = data_list, + output_dir = "path/to/directory" +)
-
-

-Reading CmdStan output into R

-
-

-Lazy CSV reading

-

With the exception of some diagnostic information, the CSV files are not read into R until their contents are requested by calling a method that requires them (e.g., fit$draws(), fit$summary(), etc.). If we examine the structure of the fit object, notice how the Private slot draws_ is NULL, indicating that the CSV files haven’t yet been read into R.

+
+

Reading CmdStan output into R +

+
+

Lazy CSV reading +

+

With the exception of some diagnostic information, the CSV files are +not read into R until their contents are requested by calling a method +that requires them (e.g., fit$draws(), +fit$summary(), etc.). If we examine the structure of the +fit object, notice how the Private slot +draws_ is NULL, indicating that the CSV files +haven’t yet been read into R.

-str(fit)
+str(fit)
Classes 'CmdStanMCMC', 'CmdStanFit', 'R6' <CmdStanMCMC>
   Inherits from: <CmdStanFit>
   Public:
@@ -476,14 +555,21 @@ 

cmdstan_diagnose: function () cmdstan_summary: function (flags = NULL) code: function () + constrain_variables: function (unconstrained_variables, transformed_parameters = TRUE, data_file: function () diagnostic_summary: function (diagnostics = c("divergences", "treedepth", "ebfmi"), draws: function (variables = NULL, inc_warmup = FALSE, format = getOption("cmdstanr_draws_format", + expose_functions: function (global = FALSE, verbose = FALSE) + functions: environment + grad_log_prob: function (unconstrained_variables, jacobian_adjustment = TRUE) + hessian: function (unconstrained_variables, jacobian_adjustment = TRUE) init: function () + init_model_methods: function (seed = 0, verbose = FALSE, hessian = FALSE) initialize: function (runset) inv_metric: function (matrix = TRUE) latent_dynamics_files: function (include_failed = FALSE) - loo: function (variables = "log_lik", r_eff = TRUE, ...) + log_prob: function (unconstrained_variables, jacobian_adjustment = TRUE) + loo: function (variables = "log_lik", r_eff = TRUE, moment_match = FALSE, lp: function () metadata: function () num_chains: function () @@ -503,20 +589,26 @@

save_profile_files: function (dir = ".", basename = NULL, timestamp = TRUE, random = TRUE) summary: function (variables = NULL, ...) time: function () + unconstrain_draws: function (files = NULL, draws = NULL) + unconstrain_variables: function (variables) + variable_skeleton: function (transformed_parameters = TRUE, generated_quantities = TRUE) Private: draws_: NULL init_: NULL inv_metric_: list metadata_: list + model_methods_env_: environment profiles_: NULL read_csv_: function (variables = NULL, sampler_diagnostics = NULL, format = getOption("cmdstanr_draws_format", - sampler_diagnostics_: 1 2 2 1 2 1 1 2 1 1 1 1 2 2 1 2 1 1 2 1 2 1 1 1 1 2 1 1 ... + sampler_diagnostics_: 1 1 2 1 2 1 1 1 2 1 1 1 1 2 2 1 1 1 1 2 1 1 1 1 2 2 2 2 ... warmup_draws_: NULL warmup_sampler_diagnostics_: NULL

-

After we call a method that requires the draws then if we reexamine the structure of the object we will see that the draws_ slot in Private is no longer empty.

+

After we call a method that requires the draws then if we reexamine +the structure of the object we will see that the draws_ +slot in Private is no longer empty.

-draws <- fit$draws() # force CSVs to be read into R
-str(fit)
+draws <- fit$draws() # force CSVs to be read into R +str(fit)
Classes 'CmdStanMCMC', 'CmdStanFit', 'R6' <CmdStanMCMC>
   Inherits from: <CmdStanFit>
   Public:
@@ -524,14 +616,21 @@ 

cmdstan_diagnose: function () cmdstan_summary: function (flags = NULL) code: function () + constrain_variables: function (unconstrained_variables, transformed_parameters = TRUE, data_file: function () diagnostic_summary: function (diagnostics = c("divergences", "treedepth", "ebfmi"), draws: function (variables = NULL, inc_warmup = FALSE, format = getOption("cmdstanr_draws_format", + expose_functions: function (global = FALSE, verbose = FALSE) + functions: environment + grad_log_prob: function (unconstrained_variables, jacobian_adjustment = TRUE) + hessian: function (unconstrained_variables, jacobian_adjustment = TRUE) init: function () + init_model_methods: function (seed = 0, verbose = FALSE, hessian = FALSE) initialize: function (runset) inv_metric: function (matrix = TRUE) latent_dynamics_files: function (include_failed = FALSE) - loo: function (variables = "log_lik", r_eff = TRUE, ...) + log_prob: function (unconstrained_variables, jacobian_adjustment = TRUE) + loo: function (variables = "log_lik", r_eff = TRUE, moment_match = FALSE, lp: function () metadata: function () num_chains: function () @@ -551,33 +650,43 @@

save_profile_files: function (dir = ".", basename = NULL, timestamp = TRUE, random = TRUE) summary: function (variables = NULL, ...) time: function () + unconstrain_draws: function (files = NULL, draws = NULL) + unconstrain_variables: function (variables) + variable_skeleton: function (transformed_parameters = TRUE, generated_quantities = TRUE) Private: - draws_: -7.82818 -7.71698 -7.1161 -7.09583 -7.51485 -8.04188 -7. ... + draws_: -7.16701 -7.08773 -6.93018 -6.84097 -6.84713 -6.90778 -7 ... init_: NULL inv_metric_: list metadata_: list + model_methods_env_: environment profiles_: NULL read_csv_: function (variables = NULL, sampler_diagnostics = NULL, format = getOption("cmdstanr_draws_format", - sampler_diagnostics_: 1 2 2 1 2 1 1 2 1 1 1 1 2 2 1 2 1 1 2 1 2 1 1 1 1 2 1 1 ... + sampler_diagnostics_: 1 1 2 1 2 1 1 1 2 1 1 1 1 2 2 1 1 1 1 2 1 1 1 1 2 2 2 2 ... warmup_draws_: NULL warmup_sampler_diagnostics_: NULL

-

For models with many parameters, transformed parameters, or generated quantities, if only some are requested (e.g., by specifying the variables argument to fit$draws()) then CmdStanR will only read in the requested variables (unless they have already been read in).

+

For models with many parameters, transformed parameters, or generated +quantities, if only some are requested (e.g., by specifying the +variables argument to fit$draws()) then +CmdStanR will only read in the requested variables (unless they have +already been read in).

-
-

-read_cmdstan_csv()

-

Internally, the read_cmdstan_csv() function is used to read the CmdStan CSV files into R. This function is exposed to users, so you can also call it directly.

+
+

read_cmdstan_csv() +

+

Internally, the read_cmdstan_csv() function is used to +read the CmdStan CSV files into R. This function is exposed to users, so +you can also call it directly.

-# see ?read_cmdstan_csv for info on optional arguments controlling 
-# what information is read in
-csv_contents <- read_cmdstan_csv(fit$output_files())
-str(csv_contents)
+# see ?read_cmdstan_csv for info on optional arguments controlling +# what information is read in +csv_contents <- read_cmdstan_csv(fit$output_files()) +str(csv_contents)
List of 8
  $ metadata                       :List of 40
   ..$ stan_version_major  : num 2
-  ..$ stan_version_minor  : num 29
-  ..$ stan_version_patch  : num 1
-  ..$ start_datetime      : chr "2022-03-18 18:28:03 UTC"
+  ..$ stan_version_minor  : num 32
+  ..$ stan_version_patch  : num 2
+  ..$ start_datetime      : chr "2023-07-25 20:55:39 UTC"
   ..$ method              : chr "sample"
   ..$ save_warmup         : num 0
   ..$ thin                : num 1
@@ -594,14 +703,14 @@ 

..$ num_chains : num 1 ..$ id : num [1:4] 1 2 3 4 ..$ init : num [1:4] 2 2 2 2 - ..$ seed : num 1.13e+09 + ..$ seed : num 1.01e+09 ..$ refresh : num 100 ..$ sig_figs : num -1 - ..$ profile_file : chr "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMNhFrl/bernoulli-profile-202203181228-1-6c529e.csv" - ..$ stanc_version : chr "stanc3 v2.29.1" + ..$ profile_file : chr "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpOiRpoh/bernoulli-profile-202307251455-1-07c6cb.csv" + ..$ stanc_version : chr "stanc3 v2.32.2" ..$ sampler_diagnostics : chr [1:6] "accept_stat__" "stepsize__" "treedepth__" "n_leapfrog__" ... ..$ variables : chr [1:2] "lp__" "theta" - ..$ step_size_adaptation: num [1:4] 1.062 0.9 0.966 0.973 + ..$ step_size_adaptation: num [1:4] 0.938 0.853 0.941 0.842 ..$ model_name : chr "bernoulli_model" ..$ adapt_engaged : num 1 ..$ adapt_delta : num 0.8 @@ -612,9 +721,9 @@

..$ threads_per_chain : num 1 ..$ time :'data.frame': 4 obs. of 4 variables: .. ..$ chain_id: num [1:4] 1 2 3 4 - .. ..$ warmup : num [1:4] 0.004 0.005 0.005 0.004 - .. ..$ sampling: num [1:4] 0.012 0.013 0.018 0.014 - .. ..$ total : num [1:4] 0.016 0.018 0.023 0.018 + .. ..$ warmup : num [1:4] 0.004 0.004 0.004 0.004 + .. ..$ sampling: num [1:4] 0.012 0.011 0.011 0.012 + .. ..$ total : num [1:4] 0.016 0.015 0.015 0.016 ..$ stan_variable_sizes :List of 2 .. ..$ lp__ : num 1 .. ..$ theta: num 1 @@ -624,143 +733,178 @@

..$ total : int NA ..$ chains:'data.frame': 4 obs. of 4 variables: .. ..$ chain_id: num [1:4] 1 2 3 4 - .. ..$ warmup : num [1:4] 0.004 0.005 0.005 0.004 - .. ..$ sampling: num [1:4] 0.012 0.013 0.018 0.014 - .. ..$ total : num [1:4] 0.016 0.018 0.023 0.018 + .. ..$ warmup : num [1:4] 0.004 0.004 0.004 0.004 + .. ..$ sampling: num [1:4] 0.012 0.011 0.011 0.012 + .. ..$ total : num [1:4] 0.016 0.015 0.015 0.016 $ inv_metric :List of 4 - ..$ 1: num 0.532 - ..$ 2: num 0.497 - ..$ 3: num 0.514 - ..$ 4: num 0.539 + ..$ 1: num 0.491 + ..$ 2: num 0.494 + ..$ 3: num 0.449 + ..$ 4: num 0.511 $ step_size :List of 4 - ..$ 1: num 1.06 - ..$ 2: num 0.9 - ..$ 3: num 0.966 - ..$ 4: num 0.973 + ..$ 1: num 0.938 + ..$ 2: num 0.853 + ..$ 3: num 0.941 + ..$ 4: num 0.842 $ warmup_draws : NULL - $ post_warmup_draws : 'draws_array' num [1:1000, 1:4, 1:2] -7.83 -7.72 -7.12 -7.1 -7.51 ... + $ post_warmup_draws : 'draws_array' num [1:1000, 1:4, 1:2] -7.17 -7.09 -6.93 -6.84 -6.85 ... ..- attr(*, "dimnames")=List of 3 .. ..$ iteration: chr [1:1000] "1" "2" "3" "4" ... .. ..$ chain : chr [1:4] "1" "2" "3" "4" .. ..$ variable : chr [1:2] "lp__" "theta" $ warmup_sampler_diagnostics : NULL - $ post_warmup_sampler_diagnostics: 'draws_array' num [1:1000, 1:4, 1:6] 1 1 1 1 0.888 ... + $ post_warmup_sampler_diagnostics: 'draws_array' num [1:1000, 1:4, 1:6] 0.86 1 0.94 1 0.999 ... ..- attr(*, "dimnames")=List of 3 .. ..$ iteration: chr [1:1000] "1" "2" "3" "4" ... .. ..$ chain : chr [1:4] "1" "2" "3" "4" .. ..$ variable : chr [1:6] "accept_stat__" "stepsize__" "treedepth__" "n_leapfrog__" ...

-
-

-as_cmdstan_fit()

-

If you need to manually create fitted model objects from CmdStan CSV files use as_cmdstan_fit().

+
+

as_cmdstan_fit() +

+

If you need to manually create fitted model objects from CmdStan CSV +files use as_cmdstan_fit().

-fit2 <- as_cmdstan_fit(fit$output_files())
-

This is pointless in our case since we have the original fit object, but this function can be used to create fitted model objects (CmdStanMCMC, CmdStanMLE, etc.) from any CmdStan CSV files.

+fit2 <- as_cmdstan_fit(fit$output_files())
+

This is pointless in our case since we have the original +fit object, but this function can be used to create fitted +model objects (CmdStanMCMC, CmdStanMLE, etc.) +from any CmdStan CSV files.

-
-

-Saving and accessing advanced algorithm info (latent dynamics)

-

If save_latent_dynamics is set to TRUE when running the $sample() method then additional CSV files are created (one per chain) that provide access to quantities used under the hood by Stan’s implementation of dynamic Hamiltonian Monte Carlo.

-

CmdStanR does not yet provide a special method for processing these files but they can be read into R using R’s standard CSV reading functions.

+
+

Saving and accessing advanced algorithm info (latent dynamics) +

+

If save_latent_dynamics is set to TRUE when +running the $sample() method then additional CSV files are +created (one per chain) that provide access to quantities used under the +hood by Stan’s implementation of dynamic Hamiltonian Monte Carlo.

+

CmdStanR does not yet provide a special method for processing these +files but they can be read into R using R’s standard CSV reading +functions.

-fit <- mod$sample(data = data_list, save_latent_dynamics = TRUE)
+fit <- mod$sample(data = data_list, save_latent_dynamics = TRUE)
-fit$latent_dynamics_files()
-
[1] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMNhFrl/bernoulli-diagnostic-202203181228-1-263c4e.csv"
-[2] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMNhFrl/bernoulli-diagnostic-202203181228-2-263c4e.csv"
-[3] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMNhFrl/bernoulli-diagnostic-202203181228-3-263c4e.csv"
-[4] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMNhFrl/bernoulli-diagnostic-202203181228-4-263c4e.csv"
+fit$latent_dynamics_files()
+
[1] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpOiRpoh/bernoulli-diagnostic-202307251455-1-156ae3.csv"
+[2] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpOiRpoh/bernoulli-diagnostic-202307251455-2-156ae3.csv"
+[3] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpOiRpoh/bernoulli-diagnostic-202307251455-3-156ae3.csv"
+[4] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpOiRpoh/bernoulli-diagnostic-202307251455-4-156ae3.csv"
-# read one of the files in
-x <- utils::read.csv(fit$latent_dynamics_files()[1], comment.char = "#")
-head(x)
+# read one of the files in +x <- utils::read.csv(fit$latent_dynamics_files()[1], comment.char = "#") +head(x)
      lp__ accept_stat__ stepsize__ treedepth__ n_leapfrog__ divergent__
-1 -7.29215      0.999807   0.944718           2            3           0
-2 -6.81105      0.988812   0.944718           1            3           0
-3 -8.51410      0.694033   0.944718           1            3           0
-4 -7.89903      1.000000   0.944718           1            1           0
-5 -8.72776      0.925309   0.944718           1            1           0
-6 -6.87320      1.000000   0.944718           2            3           0
-  energy__    theta    p_theta   g_theta
-1  7.38144 -1.84247 -0.6346060 -1.358890
-2  7.27073 -1.34029  1.4398900 -0.510444
-3  9.26904 -2.53206 -1.8452700 -2.116310
-4  8.47008 -2.22096  1.6048800 -1.825390
-5  8.72848 -2.63117  0.0571749 -2.194090
-6  8.50747 -1.44232 -2.7149800 -0.705762
-

The column lp__ is also provided via fit$draws(), and the columns accept_stat__, stepsize__, treedepth__, n_leapfrog__, divergent__, and energy__ are also provided by fit$sampler_diagnostics(), but there are several columns unique to the latent dynamics file.

+1 -6.77840 0.964447 0.816376 2 3 0 +2 -6.74817 0.998632 0.816376 1 3 0 +3 -6.74817 0.828194 0.816376 1 3 0 +4 -6.75537 0.956585 0.816376 2 3 0 +5 -7.01137 0.961708 0.816376 2 3 0 +6 -6.77984 0.967943 0.816376 1 3 0 + energy__ theta p_theta g_theta +1 7.09195 -1.265290 -1.074960 -0.3592230 +2 6.78971 -1.087340 -0.391278 0.0254425 +3 7.76283 -1.087340 -1.933750 0.0254425 +4 7.08469 -1.018340 -1.101660 0.1842200 +5 7.09451 -0.631842 -0.553509 1.1651200 +6 7.23052 -1.269250 -1.288770 -0.3673810 +

The column lp__ is also provided via +fit$draws(), and the columns accept_stat__, +stepsize__, treedepth__, +n_leapfrog__, divergent__, and +energy__ are also provided by +fit$sampler_diagnostics(), but there are several columns +unique to the latent dynamics file.

-head(x[, c("theta", "p_theta", "g_theta")])
-
     theta    p_theta   g_theta
-1 -1.84247 -0.6346060 -1.358890
-2 -1.34029  1.4398900 -0.510444
-3 -2.53206 -1.8452700 -2.116310
-4 -2.22096  1.6048800 -1.825390
-5 -2.63117  0.0571749 -2.194090
-6 -1.44232 -2.7149800 -0.705762
-

Our model has a single parameter theta and the three columns above correspond to theta in the unconstrained space (theta on the constrained space is accessed via fit$draws()), the auxiliary momentum p_theta, and the gradient g_theta. In general, each of these three columns will exist for every parameter in the model.

+head(x[, c("theta", "p_theta", "g_theta")]) +
      theta   p_theta    g_theta
+1 -1.265290 -1.074960 -0.3592230
+2 -1.087340 -0.391278  0.0254425
+3 -1.087340 -1.933750  0.0254425
+4 -1.018340 -1.101660  0.1842200
+5 -0.631842 -0.553509  1.1651200
+6 -1.269250 -1.288770 -0.3673810
+

Our model has a single parameter theta and the three +columns above correspond to theta in the +unconstrained space (theta on the constrained +space is accessed via fit$draws()), the auxiliary momentum +p_theta, and the gradient g_theta. In general, +each of these three columns will exist for every parameter in +the model.

-
-

-Saving fitted model objects

-

As described above, the contents of the CSV files are only read into R when they are needed. This means that in order to save a fitted model object containing all of the posterior draws and sampler diagnostics you should either make sure to call fit$draws() and fit$sampler_diagnostics() before saving the object fit, or use the special $save_object() method provided by CmdStanR, which will ensure that everything has been read into R before saving the object using saveRDS().

+
+

Saving fitted model objects +

+

As described above, the contents of the CSV files are only read into +R when they are needed. This means that in order to save a fitted model +object containing all of the posterior draws and sampler +diagnostics you should either make sure to call fit$draws() +and fit$sampler_diagnostics() before saving the object +fit, or use the special $save_object() method +provided by CmdStanR, which will ensure that everything has been read +into R before saving the object using saveRDS().

-temp_rds_file <- tempfile(fileext = ".RDS") # temporary file just for demonstration
-fit$save_object(file = temp_rds_file)
-

We can check that this worked by removing fit and loading it back in from the save file.

+temp_rds_file <- tempfile(fileext = ".RDS") # temporary file just for demonstration +fit$save_object(file = temp_rds_file)
+

We can check that this worked by removing fit and +loading it back in from the save file.

-rm(fit); gc()
-
          used (Mb) gc trigger (Mb) limit (Mb) max used  (Mb)
-Ncells 1159655 62.0    2208007  118         NA  2208007 118.0
-Vcells 2197871 16.8    8388608   64      32768  3895933  29.8
+rm(fit); gc()
+
          used (Mb) gc trigger  (Mb) limit (Mb) max used  (Mb)
+Ncells 1286546 68.8    2431888 129.9         NA  2431888 129.9
+Vcells 2365428 18.1    8388608  64.0      32768  4130519  31.6
-fit <- readRDS(temp_rds_file)
-fit$summary()
-
# A tibble: 2 × 10
+fit <- readRDS(temp_rds_file)
+fit$summary()
+

[38;5;246m# A tibble: 2 × 10
[39m
   variable   mean median    sd   mad      q5    q95  rhat ess_bulk ess_tail
-  <chr>     <dbl>  <dbl> <dbl> <dbl>   <dbl>  <dbl> <dbl>    <dbl>    <dbl>
-1 lp__     -7.25  -6.97  0.732 0.309 -8.71   -6.75   1.00    2009.    1714.
-2 theta     0.250  0.235 0.118 0.118  0.0821  0.463  1.00    1445.    1640.
+ 
[3m
[38;5;246m<chr>
[39m
[23m 
[3m
[38;5;246m<num>
[39m
[23m 
[3m
[38;5;246m<num>
[39m
[23m 
[3m
[38;5;246m<num>
[39m
[23m 
[3m
[38;5;246m<num>
[39m
[23m 
[3m
[38;5;246m<num>
[39m
[23m 
[3m
[38;5;246m<num>
[39m
[23m 
[3m
[38;5;246m<num>
[39m
[23m 
[3m
[38;5;246m<num>
[39m
[23m 
[3m
[38;5;246m<num>
[39m
[23m +
[38;5;250m1
[39m lp__ -
[31m7
[39m
[31m.
[39m
[31m28
[39m -
[31m7
[39m
[31m.
[39m
[31m00
[39m 0.751 0.339 -
[31m8
[39m
[31m.
[39m
[31m81
[39m -
[31m6
[39m
[31m.
[39m
[31m75
[39m 1.00 
[4m1
[24m833. 
[4m2
[24m545. +
[38;5;250m2
[39m theta 0.253 0.239 0.121 0.125 0.080
[4m5
[24m 0.470 1.00 
[4m1
[24m594. 
[4m1
[24m821.
-
-

-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.

+
+

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.

-options("cmdstanr_verbose"=TRUE)
-
-mod <- cmdstan_model(stan_file, force_recompile = TRUE)
+options("cmdstanr_verbose"=TRUE) + +mod <- cmdstan_model(stan_file, force_recompile = TRUE)
Running make \
-  /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMNhFrl/model-dfb56119ce10 \
+  /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpOiRpoh/model-17ac47a020565 \
   "STANCFLAGS +=  --name='bernoulli_model'"
 
 --- Translating Stan model to C++ code ---
-bin/stanc --name='bernoulli_model' --o=/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMNhFrl/model-dfb56119ce10.hpp /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMNhFrl/model-dfb56119ce10.stan
+bin/stanc --name='bernoulli_model' --o=/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpOiRpoh/model-17ac47a020565.hpp /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpOiRpoh/model-17ac47a020565.stan
 
 --- Compiling, linking C++ code ---
-clang++ -std=c++1y -Wno-unknown-warning-option -Wno-tautological-compare -Wno-sign-compare -D_REENTRANT -Wno-ignored-attributes      -I stan/lib/stan_math/lib/tbb_2020.3/include    -O3 -I src -I stan/src -I lib/rapidjson_1.1.0/ -I lib/CLI11-1.9.1/ -I stan/lib/stan_math/ -I stan/lib/stan_math/lib/eigen_3.3.9 -I stan/lib/stan_math/lib/boost_1.75.0 -I stan/lib/stan_math/lib/sundials_6.0.0/include -I stan/lib/stan_math/lib/sundials_6.0.0/src/sundials    -DBOOST_DISABLE_ASSERTS          -c -include-pch stan/src/stan/model/model_header.hpp.gch -x c++ -o /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMNhFrl/model-dfb56119ce10.o /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMNhFrl/model-dfb56119ce10.hpp
-clang++ -std=c++1y -Wno-unknown-warning-option -Wno-tautological-compare -Wno-sign-compare -D_REENTRANT -Wno-ignored-attributes      -I stan/lib/stan_math/lib/tbb_2020.3/include    -O3 -I src -I stan/src -I lib/rapidjson_1.1.0/ -I lib/CLI11-1.9.1/ -I stan/lib/stan_math/ -I stan/lib/stan_math/lib/eigen_3.3.9 -I stan/lib/stan_math/lib/boost_1.75.0 -I stan/lib/stan_math/lib/sundials_6.0.0/include -I stan/lib/stan_math/lib/sundials_6.0.0/src/sundials    -DBOOST_DISABLE_ASSERTS                -Wl,-L,"/Users/jgabry/.cmdstan/cmdstan-2.29.1/stan/lib/stan_math/lib/tbb" -Wl,-rpath,"/Users/jgabry/.cmdstan/cmdstan-2.29.1/stan/lib/stan_math/lib/tbb"      /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMNhFrl/model-dfb56119ce10.o src/cmdstan/main.o        -Wl,-L,"/Users/jgabry/.cmdstan/cmdstan-2.29.1/stan/lib/stan_math/lib/tbb" -Wl,-rpath,"/Users/jgabry/.cmdstan/cmdstan-2.29.1/stan/lib/stan_math/lib/tbb"   stan/lib/stan_math/lib/sundials_6.0.0/lib/libsundials_nvecserial.a stan/lib/stan_math/lib/sundials_6.0.0/lib/libsundials_cvodes.a stan/lib/stan_math/lib/sundials_6.0.0/lib/libsundials_idas.a stan/lib/stan_math/lib/sundials_6.0.0/lib/libsundials_kinsol.a  stan/lib/stan_math/lib/tbb/libtbb.dylib stan/lib/stan_math/lib/tbb/libtbbmalloc.dylib stan/lib/stan_math/lib/tbb/libtbbmalloc_proxy.dylib -o /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMNhFrl/model-dfb56119ce10
-rm -f /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMNhFrl/model-dfb56119ce10.o
+clang++ -std=c++1y -Wno-unknown-warning-option -Wno-tautological-compare -Wno-sign-compare -D_REENTRANT -Wno-ignored-attributes -I stan/lib/stan_math/lib/tbb_2020.3/include -O3 -I src -I stan/src -I stan/lib/rapidjson_1.1.0/ -I lib/CLI11-1.9.1/ -I stan/lib/stan_math/ -I stan/lib/stan_math/lib/eigen_3.4.0 -I stan/lib/stan_math/lib/boost_1.78.0 -I stan/lib/stan_math/lib/sundials_6.1.1/include -I stan/lib/stan_math/lib/sundials_6.1.1/src/sundials -DBOOST_DISABLE_ASSERTS -c -include-pch stan/src/stan/model/model_header.hpp.gch -x c++ -o /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpOiRpoh/model-17ac47a020565.o /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpOiRpoh/model-17ac47a020565.hpp +clang++ -std=c++1y -Wno-unknown-warning-option -Wno-tautological-compare -Wno-sign-compare -D_REENTRANT -Wno-ignored-attributes -I stan/lib/stan_math/lib/tbb_2020.3/include -O3 -I src -I stan/src -I stan/lib/rapidjson_1.1.0/ -I lib/CLI11-1.9.1/ -I stan/lib/stan_math/ -I stan/lib/stan_math/lib/eigen_3.4.0 -I stan/lib/stan_math/lib/boost_1.78.0 -I stan/lib/stan_math/lib/sundials_6.1.1/include -I stan/lib/stan_math/lib/sundials_6.1.1/src/sundials -DBOOST_DISABLE_ASSERTS -Wl,-L,"/Users/jgabry/.cmdstan/cmdstan-2.32.2/stan/lib/stan_math/lib/tbb" -Wl,-rpath,"/Users/jgabry/.cmdstan/cmdstan-2.32.2/stan/lib/stan_math/lib/tbb" /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpOiRpoh/model-17ac47a020565.o src/cmdstan/main.o -Wl,-L,"/Users/jgabry/.cmdstan/cmdstan-2.32.2/stan/lib/stan_math/lib/tbb" -Wl,-rpath,"/Users/jgabry/.cmdstan/cmdstan-2.32.2/stan/lib/stan_math/lib/tbb" stan/lib/stan_math/lib/sundials_6.1.1/lib/libsundials_nvecserial.a stan/lib/stan_math/lib/sundials_6.1.1/lib/libsundials_cvodes.a stan/lib/stan_math/lib/sundials_6.1.1/lib/libsundials_idas.a stan/lib/stan_math/lib/sundials_6.1.1/lib/libsundials_kinsol.a stan/lib/stan_math/lib/tbb/libtbb.dylib stan/lib/stan_math/lib/tbb/libtbbmalloc.dylib stan/lib/stan_math/lib/tbb/libtbbmalloc_proxy.dylib -o /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpOiRpoh/model-17ac47a020565 +rm -f /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpOiRpoh/model-17ac47a020565.o
-fit <- mod$sample(
-  data = data_list,
-  chains = 1,
-  iter_warmup = 100,
-  iter_sampling = 100
-)
+fit <- mod$sample( + data = data_list, + chains = 1, + iter_warmup = 100, + iter_sampling = 100 +)
Running MCMC with 1 chain...
 
-Running ./bernoulli 'id=1' random 'seed=911816340' data \
-  'file=/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMNhFrl/standata-dfb528f42a87.json' \
+Running ./bernoulli 'id=1' random 'seed=1523483778' data \
+  'file=/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpOiRpoh/standata-17ac41edf7bd5.json' \
   output \
-  'file=/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMNhFrl/bernoulli-202203181228-1-036a9c.csv' \
-  'profile_file=/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMNhFrl/bernoulli-profile-202203181228-1-7b073f.csv' \
+  'file=/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpOiRpoh/bernoulli-202307251455-1-7b6962.csv' \
+  'profile_file=/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpOiRpoh/bernoulli-profile-202307251455-1-281032.csv' \
   'method=sample' 'num_samples=100' 'num_warmup=100' 'save_warmup=0' \
   'algorithm=hmc' 'engine=nuts' adapt 'engaged=1'
 Chain 1 method = sample (Default) 
@@ -790,16 +934,16 @@ 

Chain 1 num_chains = 1 (Default) Chain 1 id = 1 (Default) Chain 1 data -Chain 1 file = /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMNhFrl/standata-dfb528f42a87.json +Chain 1 file = /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpOiRpoh/standata-17ac41edf7bd5.json Chain 1 init = 2 (Default) Chain 1 random -Chain 1 seed = 911816340 +Chain 1 seed = 1523483778 Chain 1 output -Chain 1 file = /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMNhFrl/bernoulli-202203181228-1-036a9c.csv +Chain 1 file = /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpOiRpoh/bernoulli-202307251455-1-7b6962.csv Chain 1 diagnostic_file = (Default) Chain 1 refresh = 100 (Default) Chain 1 sig_figs = -1 (Default) -Chain 1 profile_file = /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMNhFrl/bernoulli-profile-202203181228-1-7b073f.csv +Chain 1 profile_file = /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpOiRpoh/bernoulli-profile-202307251455-1-281032.csv Chain 1 num_threads = 1 (Default) Chain 1 Gradient evaluation took 6e-06 seconds Chain 1 1000 transitions using 10 leapfrog steps per transition would take 0.06 seconds. @@ -834,11 +978,13 @@

-

Site built with pkgdown 1.6.1.

+

+

Site built with pkgdown 2.0.7.

@@ -847,5 +993,7 @@

+ + diff --git a/docs/articles/cmdstanr.html b/docs/articles/cmdstanr.html index 5c8946717..ac4bb8ffa 100644 --- a/docs/articles/cmdstanr.html +++ b/docs/articles/cmdstanr.html @@ -26,6 +26,8 @@ + +
+
-
-

-Introduction

-

CmdStanR is a lightweight interface to Stan for R users (see CmdStanPy for Python) that provides an alternative to the traditional RStan interface. See the Comparison with RStan section later in this vignette for more details on how the two interfaces differ.

-

CmdStanR is not on CRAN yet, but the beta release can be installed by running the following command in R.

+
+

Introduction +

+

CmdStanR (Command Stan R) is a lightweight interface to Stan for R users that provides an +alternative to the traditional RStan interface. See the Comparison with RStan section +later in this vignette for more details on how the two interfaces +differ.

+

CmdStanR is not on CRAN yet, but the beta release +can be installed by running the following command in R.

-# we recommend running this is a fresh R session or restarting your current session
-install.packages("cmdstanr", repos = c("https://mc-stan.org/r-packages/", getOption("repos")))
-

CmdStanR (the cmdstanr R package) can now be loaded like any other R package. We’ll also load the bayesplot and posterior packages to use later in examples.

+# we recommend running this is a fresh R session or restarting your current session +install.packages("cmdstanr", repos = c("https://mc-stan.org/r-packages/", getOption("repos")))

+

CmdStanR (the cmdstanr R package) can now be loaded +like any other R package. We’ll also load the bayesplot +and posterior packages to use later in examples.

-
-
-

-Installing CmdStan

-

CmdStanR requires a working installation of CmdStan, the shell interface to Stan. If you don’t have CmdStan installed then CmdStanR can install it for you, assuming you have a suitable C++ toolchain. The requirements are described in the CmdStan Guide:

+library(cmdstanr) +library(posterior) +library(bayesplot) +color_scheme_set("brightblue")
+ +
+

Installing CmdStan +

+

CmdStanR requires a working installation of CmdStan, +the shell interface to Stan. If you don’t have CmdStan installed then +CmdStanR can install it for you, assuming you have a suitable C++ +toolchain. The requirements are described in the CmdStan Guide:

-

To double check that your toolchain is set up properly you can call the check_cmdstan_toolchain() function:

+

To double check that your toolchain is set up properly you can call +the check_cmdstan_toolchain() function:

+check_cmdstan_toolchain()
The C++ toolchain required for CmdStan is setup properly!
-

If your toolchain is configured correctly then CmdStan can be installed by calling the install_cmdstan() function:

+

If your toolchain is configured correctly then CmdStan can be +installed by calling the install_cmdstan() +function:

-install_cmdstan(cores = 2)
-

Before CmdStanR can be used it needs to know where the CmdStan installation is located. When the package is loaded it tries to help automate this to avoid having to manually set the path every session:

+install_cmdstan(cores = 2) +

Before CmdStanR can be used it needs to know where the CmdStan +installation is located. When the package is loaded it tries to help +automate this to avoid having to manually set the path every +session:

    -
  1. If the environment variable "CMDSTAN" exists at load time then its value will be automatically set as the default path to CmdStan for the R session. This is useful if your CmdStan installation is not located in the default directory that would have been used by install_cmdstan() (see #2).

  2. -
  3. If no environment variable is found when loaded but any directory in the form ".cmdstan/cmdstan-[version]", for example ".cmdstan/cmdstan-2.23.0", exists in the user’s home directory (Sys.getenv("HOME"), not the current working directory) then the path to the CmdStan with the largest version number will be set as the path to CmdStan for the R session. This is the same as the default directory that install_cmdstan() uses to install the latest version of CmdStan, so if that’s how you installed CmdStan you shouldn’t need to manually set the path to CmdStan when loading CmdStanR.

  4. +
  5. If the environment variable "CMDSTAN" exists at load +time then its value will be automatically set as the default path to +CmdStan for the R session. This is useful if your CmdStan installation +is not located in the default directory that would have been used by +install_cmdstan() (see #2).

  6. +
  7. If no environment variable is found when loaded but any directory +in the form ".cmdstan/cmdstan-[version]", for example +".cmdstan/cmdstan-2.23.0", exists in the user’s home +directory (Sys.getenv("HOME"), not the current +working directory) then the path to the CmdStan with the largest version +number will be set as the path to CmdStan for the R session. This is the +same as the default directory that install_cmdstan() uses +to install the latest version of CmdStan, so if that’s how you installed +CmdStan you shouldn’t need to manually set the path to CmdStan when +loading CmdStanR.

-

If neither of these applies (or you want to subsequently change the path) you can use the set_cmdstan_path() function:

+

If neither of these applies (or you want to subsequently change the +path) you can use the set_cmdstan_path() function:

-set_cmdstan_path(PATH_TO_CMDSTAN)
-

To check the path to the CmdStan installation and the CmdStan version number you can use cmdstan_path() and cmdstan_version():

+set_cmdstan_path(PATH_TO_CMDSTAN) +

To check the path to the CmdStan installation and the CmdStan version +number you can use cmdstan_path() and +cmdstan_version():

-
[1] "/Users/jgabry/.cmdstan/cmdstan-2.29.1"
+cmdstan_path() +
[1] "/Users/jgabry/.cmdstan/cmdstan-2.32.2"
-
[1] "2.29.1"
- -
-

-Compiling a model

-

The cmdstan_model() function creates a new CmdStanModel object from a file containing a Stan program. Under the hood, CmdStan is called to translate a Stan program to C++ and create a compiled executable. Here we’ll use the example Stan program that comes with the CmdStan installation:

+cmdstan_version()
+
[1] "2.32.2"
+ +
+

Compiling a model +

+

The cmdstan_model() function creates a new CmdStanModel +object from a file containing a Stan program. Under the hood, CmdStan is +called to translate a Stan program to C++ and create a compiled +executable. Here we’ll use the example Stan program that comes with the +CmdStan installation:

-file <- file.path(cmdstan_path(), "examples", "bernoulli", "bernoulli.stan")
-mod <- cmdstan_model(file)
-

The object mod is an R6 reference object of class CmdStanModel and behaves similarly to R’s reference class objects and those in object oriented programming languages. Methods are accessed using the $ operator. This design choice allows for CmdStanR and CmdStanPy to provide a similar user experience and share many implementation details.

-

The Stan program can be printed using the $print() method:

+file <- file.path(cmdstan_path(), "examples", "bernoulli", "bernoulli.stan") +mod <- cmdstan_model(file)
+

The object mod is an R6 reference object of class CmdStanModel +and behaves similarly to R’s reference class objects and those in object +oriented programming languages. Methods are accessed using the +$ operator. This design choice allows for CmdStanR and CmdStanPy to provide a +similar user experience and share many implementation details.

+

The Stan program can be printed using the $print() +method:

-mod$print()
+mod$print()
data {
   int<lower=0> N;
-  array[N] int<lower=0,upper=1> y; // or int<lower=0,upper=1> y[N];
+  array[N] int<lower=0,upper=1> y;
 }
 parameters {
   real<lower=0,upper=1> theta;
@@ -207,26 +249,31 @@ 

theta ~ beta(1,1); // uniform prior on interval 0,1 y ~ bernoulli(theta); }

-

The path to the compiled executable is returned by the $exe_file() method:

+

The path to the compiled executable is returned by the +$exe_file() method:

-mod$exe_file()
-
[1] "/Users/jgabry/.cmdstan/cmdstan-2.29.1/examples/bernoulli/bernoulli"
- -
-

-Running MCMC

-

The $sample() method for CmdStanModel objects runs Stan’s default MCMC algorithm. The data argument accepts a named list of R objects (like for RStan) or a path to a data file compatible with CmdStan (JSON or R dump).

+mod$exe_file()
+
[1] "/Users/jgabry/.cmdstan/cmdstan-2.32.2/examples/bernoulli/bernoulli"
+ +
+

Running MCMC +

+

The $sample() +method for CmdStanModel +objects runs Stan’s default MCMC algorithm. The data +argument accepts a named list of R objects (like for RStan) or a path to +a data file compatible with CmdStan (JSON or R dump).

-# names correspond to the data block in the Stan program
-data_list <- list(N = 10, y = c(0,1,0,0,0,0,0,0,0,1))
-
-fit <- mod$sample(
-  data = data_list, 
-  seed = 123, 
-  chains = 4, 
-  parallel_chains = 4,
-  refresh = 500 # print update every 500 iters
-)
+# names correspond to the data block in the Stan program +data_list <- list(N = 10, y = c(0,1,0,0,0,0,0,0,0,1)) + +fit <- mod$sample( + data = data_list, + seed = 123, + chains = 4, + parallel_chains = 4, + refresh = 500 # print update every 500 iters +)
Running MCMC with 4 parallel chains...
 
 Chain 1 Iteration:    1 / 2000 [  0%]  (Warmup) 
@@ -260,79 +307,99 @@ 

All 4 chains finished successfully. Mean chain execution time: 0.0 seconds. -Total execution time: 0.3 seconds.

-

There are many more arguments that can be passed to the $sample() method. For details follow this link to its separate documentation page:

+Total execution time: 0.4 seconds.
+

There are many more arguments that can be passed to the +$sample() method. For details follow this link to its +separate documentation page:

-

The $sample() method creates R6 CmdStanMCMC objects, which have many associated methods. Below we will demonstrate some of the most important methods. For a full list, follow this link to the CmdStanMCMC documentation:

+

The $sample() method creates R6 CmdStanMCMC objects, +which have many associated methods. Below we will demonstrate some of +the most important methods. For a full list, follow this link to the +CmdStanMCMC documentation:

-
-

-Posterior summary statistics

-
-

-Summaries from the posterior package

-

The $summary() method calls summarise_draws() from the posterior package. The first argument specifies the variables to summarize and any arguments after that are passed on to posterior::summarise_draws() to specify which summaries to compute, whether to use multiple cores, etc.

+
+

Posterior summary statistics +

+
+

Summaries from the posterior package +

+

The $summary() +method calls summarise_draws() from the +posterior package. The first argument specifies the +variables to summarize and any arguments after that are passed on to +posterior::summarise_draws() to specify which summaries to +compute, whether to use multiple cores, etc.

-fit$summary()
-
# A tibble: 2 × 10
-  variable   mean median    sd   mad      q5    q95  rhat ess_bulk ess_tail
-  <chr>     <dbl>  <dbl> <dbl> <dbl>   <dbl>  <dbl> <dbl>    <dbl>    <dbl>
-1 lp__     -7.27  -7.00  0.709 0.344 -8.70   -6.75   1.00    1852.    2114.
-2 theta     0.247  0.232 0.119 0.123  0.0804  0.466  1.00    1611.    1678.
-
-fit$summary(variables = c("theta", "lp__"), "mean", "sd")
-
# A tibble: 2 × 3
-  variable   mean    sd
-  <chr>     <dbl> <dbl>
-1 theta     0.247 0.119
-2 lp__     -7.27  0.709
-
-# use a formula to summarize arbitrary functions, e.g. Pr(theta <= 0.5)
-fit$summary("theta", pr_lt_half = ~ mean(. <= 0.5))
-
# A tibble: 1 × 2
-  variable pr_lt_half
-  <chr>         <dbl>
-1 theta         0.969
-
-
-

-CmdStan’s stansummary utility

-

CmdStan itself provides a stansummary utility that can be called using the $cmdstan_summary() method. This method will print summaries but won’t return anything.

-
-
-
-

-Posterior draws

-
-

-Extracting draws

-

The $draws() method can be used to extract the posterior draws in formats provided by the posterior package. Here we demonstrate only the draws_array and draws_df formats, but the posterior package supports other useful formats as well.

-
-# default is a 3-D draws_array object from the posterior package
-# iterations x chains x variables
-draws_arr <- fit$draws() # or format="array"
-str(draws_arr)
+fit$summary() +fit$summary(variables = c("theta", "lp__"), "mean", "sd") + +# use a formula to summarize arbitrary functions, e.g. Pr(theta <= 0.5) +fit$summary("theta", pr_lt_half = ~ mean(. <= 0.5)) + +# summarise all variables with default and additional summary measures +fit$summary( + variables = NULL, + posterior::default_summary_measures(), + extra_quantiles = ~posterior::quantile2(., probs = c(.0275, .975)) +)
+
  variable  mean median   sd  mad    q5   q95 rhat ess_bulk ess_tail
+1     lp__ -7.27  -7.00 0.71 0.34 -8.70 -6.75    1     1852     2114
+2    theta  0.25   0.23 0.12 0.12  0.08  0.47    1     1611     1678
+
  variable  mean   sd
+1    theta  0.25 0.12
+2     lp__ -7.27 0.71
+
  variable pr_lt_half
+1    theta       0.97
+
  variable  mean median   sd  mad    q5   q95  q2.75 q97.5
+1     lp__ -7.27  -7.00 0.71 0.34 -8.70 -6.75 -9.165 -6.75
+2    theta  0.25   0.23 0.12 0.12  0.08  0.47  0.065  0.52
+
+
+

CmdStan’s stansummary utility +

+

CmdStan itself provides a stansummary utility that can +be called using the $cmdstan_summary() method. This method +will print summaries but won’t return anything.

+
+
+
+

Posterior draws +

+
+

Extracting draws +

+

The $draws() +method can be used to extract the posterior draws in formats provided by +the posterior +package. Here we demonstrate only the draws_array and +draws_df formats, but the posterior +package supports other useful formats as well.

+
+# default is a 3-D draws_array object from the posterior package
+# iterations x chains x variables
+draws_arr <- fit$draws() # or format="array"
+str(draws_arr)
 'draws_array' num [1:1000, 1:4, 1:2] -6.78 -6.9 -7.05 -6.85 -6.75 ...
  - attr(*, "dimnames")=List of 3
   ..$ iteration: chr [1:1000] "1" "2" "3" "4" ...
   ..$ chain    : chr [1:4] "1" "2" "3" "4"
   ..$ variable : chr [1:2] "lp__" "theta"
-
-# draws x variables data frame
-draws_df <- fit$draws(format = "df")
-str(draws_df)
+
+# draws x variables data frame
+draws_df <- fit$draws(format = "df")
+str(draws_df)
draws_df [4,000 × 5] (S3: draws_df/draws/tbl_df/tbl/data.frame)
  $ lp__      : num [1:4000] -6.78 -6.9 -7.05 -6.85 -6.75 ...
  $ theta     : num [1:4000] 0.284 0.186 0.162 0.196 0.252 ...
  $ .chain    : int [1:4000] 1 1 1 1 1 1 1 1 1 1 ...
  $ .iteration: int [1:4000] 1 2 3 4 5 6 7 8 9 10 ...
  $ .draw     : int [1:4000] 1 2 3 4 5 6 7 8 9 10 ...
-
-print(draws_df)
+
+print(draws_df)
# A draws_df: 1000 iterations, 4 chains, and 2 variables
    lp__ theta
 1  -6.8  0.28
@@ -347,41 +414,52 @@ 

10 -7.5 0.42 # ... with 3990 more draws # ... hidden reserved variables {'.chain', '.iteration', '.draw'}

-

To convert an existing draws object to a different format use the posterior::as_draws_*() functions.

-
-# this should be identical to draws_df created via draws(format = "df")
-draws_df_2 <- as_draws_df(draws_arr)
-identical(draws_df, draws_df_2)
+

To convert an existing draws object to a different format use the +posterior::as_draws_*() functions.

+
+# this should be identical to draws_df created via draws(format = "df")
+draws_df_2 <- as_draws_df(draws_arr)
+identical(draws_df, draws_df_2)
[1] TRUE
-

In general, converting to a different draws format in this way will be slower than just setting the appropriate format initially in the call to the $draws() method, but in most cases the speed difference will be minor.

-
-
-

-Plotting draws

-

Plotting posterior distributions is as easy as passing the object returned by the $draws() method directly to plotting functions in our bayesplot package.

-
-mcmc_hist(fit$draws("theta"))
+

In general, converting to a different draws format in this way will +be slower than just setting the appropriate format initially in the call +to the $draws() method, but in most cases the speed +difference will be minor.

+
+
+

Plotting draws +

+

Plotting posterior distributions is as easy as passing the object +returned by the $draws() method directly to plotting +functions in our bayesplot +package.

+
+mcmc_hist(fit$draws("theta"))

-
-

-Sampler diagnostics

-
-

-Extracting diagnostic values for each iteration and chain

-

The $sampler_diagnostics() method extracts the values of the sampler parameters (treedepth__, divergent__, etc.) in formats supported by the posterior package. The default is as a 3-D array (iteration x chain x variable).

-
-# this is a draws_array object from the posterior package
-str(fit$sampler_diagnostics())
+
+

Sampler diagnostics +

+
+

Extracting diagnostic values for each iteration and chain +

+

The $sampler_diagnostics() +method extracts the values of the sampler parameters +(treedepth__, divergent__, etc.) in formats +supported by the posterior package. The default is as a +3-D array (iteration x chain x variable).

+
+# this is a draws_array object from the posterior package
+str(fit$sampler_diagnostics())
 'draws_array' num [1:1000, 1:4, 1:6] 1 2 2 2 2 1 1 1 1 2 ...
  - attr(*, "dimnames")=List of 3
   ..$ iteration: chr [1:1000] "1" "2" "3" "4" ...
   ..$ chain    : chr [1:4] "1" "2" "3" "4"
   ..$ variable : chr [1:6] "treedepth__" "divergent__" "energy__" "accept_stat__" ...
-
-# this is a draws_df object from the posterior package
-str(fit$sampler_diagnostics(format = "df"))
+
+# this is a draws_df object from the posterior package
+str(fit$sampler_diagnostics(format = "df"))
draws_df [4,000 × 9] (S3: draws_df/draws/tbl_df/tbl/data.frame)
  $ treedepth__  : num [1:4000] 1 2 2 2 2 1 1 1 1 2 ...
  $ divergent__  : num [1:4000] 0 0 0 0 0 0 0 0 0 0 ...
@@ -393,12 +471,14 @@ 

$ .iteration : int [1:4000] 1 2 3 4 5 6 7 8 9 10 ... $ .draw : int [1:4000] 1 2 3 4 5 6 7 8 9 10 ...

-
-

-Sampler diagnostic warnings and summaries

-

The $diagnostic_summary() method will display any sampler diagnostic warnings and return a summary of diagnostics for each chain.

-
-fit$diagnostic_summary()
+
+

Sampler diagnostic warnings and summaries +

+

The $diagnostic_summary() method will display any +sampler diagnostic warnings and return a summary of diagnostics for each +chain.

+
+fit$diagnostic_summary()
$num_divergent
 [1] 0 0 0 0
 
@@ -406,93 +486,113 @@ 

[1] 0 0 0 0 $ebfmi -[1] 1.017555 1.250490 1.078559 1.237357

-

We see the number of divergences for each of the four chains, the number of times the maximum treedepth was hit for each chain, and the E-BFMI for each chain.

-

In this case there were no warnings, so in order to demonstrate the warning messages we’ll use one of the CmdStanR example models that suffers from divergences.

-
-fit_with_warning <- cmdstanr_example("schools")
-
Warning: 76 of 4000 (2.0%) transitions ended with a divergence.
+[1] 1.0 1.3 1.1 1.2
+

We see the number of divergences for each of the four chains, the +number of times the maximum treedepth was hit for each chain, and the +E-BFMI for each chain.

+

In this case there were no warnings, so in order to demonstrate the +warning messages we’ll use one of the CmdStanR example models that +suffers from divergences.

+
+fit_with_warning <- cmdstanr_example("schools")
+
Warning: 185 of 4000 (5.0%) transitions ended with a divergence.
 See https://mc-stan.org/misc/warnings for details.
-

After fitting there is a warning about divergences. We can also regenerate this warning message later using fit$diagnostic_summary().

-
-diagnostics <- fit_with_warning$diagnostic_summary()
-
Warning: 76 of 4000 (2.0%) transitions ended with a divergence.
+

After fitting there is a warning about divergences. We can also +regenerate this warning message later using +fit$diagnostic_summary().

+
+diagnostics <- fit_with_warning$diagnostic_summary()
+
Warning: 185 of 4000 (5.0%) transitions ended with a divergence.
 See https://mc-stan.org/misc/warnings for details.
-
-print(diagnostics)
+
+print(diagnostics)
$num_divergent
-[1] 22 19 33  2
+[1]   8 120  17  40
 
 $num_max_treedepth
 [1] 0 0 0 0
 
 $ebfmi
-[1] 0.3826859 0.3953390 0.2349030 0.2268031
-
-# number of divergences reported in warning is the sum of the per chain values
-sum(diagnostics$num_divergent) 
-
[1] 76
-
-
-

-CmdStan’s diagnose utility

-

CmdStan itself provides a diagnose utility that can be called using the $cmdstan_diagnose() method. This method will print warnings but won’t return anything.

-
-
-
-

-Create a stanfit object

-

If you have RStan installed then it is also possible to create a stanfit object from the csv output files written by CmdStan. This can be done by using rstan::read_stan_csv() in combination with the $output_files() method of the CmdStanMCMC object. This is only needed if you want to fit a model with CmdStanR but already have a lot of post-processing code that assumes a stanfit object. Otherwise we recommend using the post-processing functionality provided by CmdStanR itself.

+[1] 0.29 0.24 0.26 0.30
+
+# number of divergences reported in warning is the sum of the per chain values
+sum(diagnostics$num_divergent)
+
[1] 185
+
+
+

CmdStan’s diagnose utility +

+

CmdStan itself provides a diagnose utility that can be +called using the $cmdstan_diagnose() method. This method +will print warnings but won’t return anything.

+
+
+
+

Create a stanfit object +

+

If you have RStan installed then it is also possible to create a +stanfit object from the csv output files written by +CmdStan. This can be done by using rstan::read_stan_csv() +in combination with the $output_files() method of the +CmdStanMCMC object. This is only needed if you want to fit +a model with CmdStanR but already have a lot of post-processing code +that assumes a stanfit object. Otherwise we recommend using +the post-processing functionality provided by CmdStanR itself.

+
+stanfit <- rstan::read_stan_csv(fit$output_files())
+
+
+
+

Running optimization and variational inference +

+

CmdStanR also supports running Stan’s optimization algorithms and its +algorithms for variational approximation of full Bayesian inference. +These are run via the $optimize() and +$variational() methods, which are called in a similar way +to the $sample() method demonstrated above.

+
+

Optimization +

+

We can find the (penalized) maximum likelihood estimate (MLE) using +$optimize().

-stanfit <- rstan::read_stan_csv(fit$output_files())
-
-
-
-

-Running optimization and variational inference

-

CmdStanR also supports running Stan’s optimization algorithms and its algorithms for variational approximation of full Bayesian inference. These are run via the $optimize() and $variational() methods, which are called in a similar way to the $sample() method demonstrated above.

-
-

-Optimization

-

We can find the (penalized) maximum likelihood estimate (MLE) using $optimize().

-
-fit_mle <- mod$optimize(data = data_list, seed = 123) 
+fit_mle <- mod$optimize(data = data_list, seed = 123) +fit_mle$summary() # includes lp__ (log prob calculated by Stan program) +fit_mle$mle("theta")
Initial log joint probability = -9.51104 
     Iter      log prob        ||dx||      ||grad||       alpha      alpha0  # evals  Notes  
        6      -5.00402   0.000103557   2.55661e-07           1           1        9    
 Optimization terminated normally:  
   Convergence detected: relative gradient magnitude is below tolerance 
-Finished in  0.1 seconds.
-
-fit_mle$summary() # includes lp__ (log prob calculated by Stan program)
-
# A tibble: 2 × 2
-  variable estimate
-  <chr>       <dbl>
-1 lp__        -5.00
-2 theta        0.2 
-
-fit_mle$mle("theta") 
-
theta 
-  0.2 
-

Here’s a plot comparing the penalized MLE to the posterior distribution of theta.

-
-mcmc_hist(fit$draws("theta")) + 
-  vline_at(fit_mle$mle("theta"), size = 1.5)
+Finished in 0.2 seconds. +
  variable estimate
+1     lp__     -5.0
+2    theta      0.2
+
theta 
+  0.2 
+

Here’s a plot comparing the penalized MLE to the posterior +distribution of theta.

+
+mcmc_hist(fit$draws("theta")) +
+  vline_at(fit_mle$mle("theta"), size = 1.5)

-
-

-Variational Bayes

-

We can run Stan’s experimental variational Bayes algorithm (ADVI) using the $variational() method.

-
-fit_vb <- mod$variational(data = data_list, seed = 123, output_samples = 4000) 
+
+

Variational Bayes +

+

We can run Stan’s experimental variational Bayes algorithm (ADVI) +using the $variational() +method.

+
+fit_vb <- mod$variational(data = data_list, seed = 123, output_samples = 4000)
+fit_vb$summary("theta")
------------------------------------------------------------ 
 EXPERIMENTAL ALGORITHM: 
   This procedure has not been thoroughly tested and may be unstable 
   or buggy. The interface is subject to change. 
 ------------------------------------------------------------ 
-Gradient evaluation took 4e-06 seconds 
-1000 transitions using 10 leapfrog steps per transition would take 0.04 seconds. 
+Gradient evaluation took 6e-06 seconds 
+1000 transitions using 10 leapfrog steps per transition would take 0.06 seconds. 
 Adjust your expectations accordingly! 
 Begin eta adaptation. 
 Iteration:   1 / 250 [  0%]  (Adaptation) 
@@ -509,92 +609,115 @@ 

Drawing a sample of size 4000 from the approximate posterior... COMPLETED. Finished in 0.1 seconds.

-
-fit_vb$summary("theta")
-
# A tibble: 1 × 7
-  variable  mean median    sd   mad    q5   q95
-  <chr>    <dbl>  <dbl> <dbl> <dbl> <dbl> <dbl>
-1 theta    0.267  0.250 0.117 0.117 0.105 0.487
-

The $draws() method can be used to access the approximate posterior draws. Let’s extract the draws, make the same plot we made after MCMC, and compare the two. In this trivial example the distributions look quite similar, although the variational approximation slightly underestimates the posterior standard deviation.

-
-mcmc_hist(fit$draws("theta"), binwidth = 0.025)
+
  variable mean median   sd  mad  q5  q95
+1    theta 0.27   0.25 0.12 0.12 0.1 0.49
+

The $draws() method can be used to access the +approximate posterior draws. Let’s extract the draws, make the same plot +we made after MCMC, and compare the two. In this trivial example the +distributions look quite similar, although the variational approximation +slightly underestimates the posterior standard deviation.

+
+mcmc_hist(fit$draws("theta"), binwidth = 0.025)
Posterior from MCMC

Posterior from MCMC

-
-mcmc_hist(fit_vb$draws("theta"), binwidth = 0.025)
+
+mcmc_hist(fit_vb$draws("theta"), binwidth = 0.025)
Posterior from variational

Posterior from variational

-

For more details on the $optimize() and $variational() methods, follow these links to their documentation pages.

+

For more details on the $optimize() and +$variational() methods, follow these links to their +documentation pages.

-
-

-Saving fitted model objects

-

In order to save a fitted model object to disk and ensure that all of the contents are available when reading the object back into R, we recommend using the $save_object() method provided by CmdStanR. The reason for this is discussed in detail in the vignette How does CmdStanR work?, so here we just demonstrate how to use the method.

-
-fit$save_object(file = "fit.RDS")
-
-# can be read back in using readRDS
-fit2 <- readRDS("fit.RDS")
-
-
-

-Comparison with RStan

-
-

-Different ways of interfacing with Stan’s C++

-

The RStan interface (rstan package) is an in-memory interface to Stan and relies on R packages like Rcpp and inline to call C++ code from R. On the other hand, the CmdStanR interface does not directly call any C++ code from R, instead relying on the CmdStan interface behind the scenes for compilation, running algorithms, and writing results to output files.

-
-
-

-Advantages of RStan

-
    -
  • Advanced features. We are working on making these available outside of RStan but currently they are only available to R users via RStan: +
    +

    Saving fitted model objects +

    +

    In order to save a fitted model object to disk and ensure that all of +the contents are available when reading the object back into R, we +recommend using the $save_object() +method provided by CmdStanR. The reason for this is discussed in detail +in the vignette How +does CmdStanR work?, so here we just demonstrate how to use the +method.

    +
    +fit$save_object(file = "fit.RDS")
    +
    +# can be read back in using readRDS
    +fit2 <- readRDS("fit.RDS")
    +
    +
    +

    Comparison with RStan +

    +
    +

    Different ways of interfacing with Stan’s C++ +

    +

    The RStan interface (rstan package) is +an in-memory interface to Stan and relies on R packages like +Rcpp and inline to call C++ code from +R. On the other hand, the CmdStanR interface does not directly call any +C++ code from R, instead relying on the CmdStan interface behind the +scenes for compilation, running algorithms, and writing results to +output files.

    +
    +
  • -
  • Allows other developers to distribute R packages with pre-compiled Stan programs (like rstanarm) on CRAN.
  • +
  • Allows other developers to distribute R packages with +pre-compiled Stan programs (like rstanarm) on +CRAN.

  • +
  • Avoids use of R6 classes, which may result in more familiar +syntax for many R users.

-
-

-Advantages of CmdStanR

+
+

Advantages of CmdStanR +

    -
  • Compatible with latest versions of Stan. Keeping up with Stan releases is complicated for RStan, often requiring non-trivial changes to the rstan package and new CRAN releases of both rstan and StanHeaders. With CmdStanR the latest improvements in Stan will be available from R immediately after updating CmdStan using cmdstanr::install_cmdstan().

  • -
  • Fewer installation issues (e.g., no need to mess with Makevars files).

  • -
  • Running Stan via external processes results in fewer unexpected crashes, especially in RStudio.

  • +
  • Compatible with latest versions of Stan. Keeping up with Stan +releases is complicated for RStan, often requiring non-trivial changes +to the rstan package and new CRAN releases of both +rstan and StanHeaders. With CmdStanR +the latest improvements in Stan will be available from R immediately +after updating CmdStan using +cmdstanr::install_cmdstan().

  • +
  • Running Stan via external processes results in fewer unexpected +crashes, especially in RStudio.

  • Less memory overhead.

  • -
  • More permissive license. RStan uses the GPL-3 license while the license for CmdStanR is BSD-3, which is a bit more permissive and is the same license used for CmdStan and the Stan C++ source code.

  • +
  • More permissive license. RStan uses the GPL-3 license while the +license for CmdStanR is BSD-3, which is a bit more permissive and is the +same license used for CmdStan and the Stan C++ source code.

-
-

-Additional resources

-

There are additional vignettes available that discuss other aspects of using CmdStanR. These can be found online at the CmdStanR website:

+
+

Additional resources +

+

There are additional vignettes available that discuss other aspects +of using CmdStanR. These can be found online at the CmdStanR +website:

To ask a question please post on the Stan forums:

-

To report a bug, suggest a feature (including additions to these vignettes), or to start contributing to CmdStanR development (new contributors welcome!) please open an issue on GitHub:

+

To report a bug, suggest a feature (including additions to these +vignettes), or to start contributing to CmdStanR development (new +contributors welcome!) please open an issue on GitHub:

@@ -610,11 +733,13 @@

-

Site built with pkgdown 1.6.1.

+

+

Site built with pkgdown 2.0.7.

@@ -623,5 +748,7 @@

+ + diff --git a/docs/articles/cmdstanr_files/figure-html/plot-mle-1.png b/docs/articles/cmdstanr_files/figure-html/plot-mle-1.png index 1998cf9a6d4336390c48fd73053000863dd500de..ea9c074429a91760ed53dbd3b60bbe74b9aee4fd 100644 GIT binary patch literal 41641 zcmeFabyQSe_&16p3Wy4dh)An|NUD?)gNcZMii9-M-CfQX5S3I~QV~#6dT68(3F#g} zLSkqJ7#Qvzloam$M#kOx+Y)%co$J@Y!H|}vDn7@(fvzNIeYQwY%BLSn+kdho14rge zIMGyUUGSSLFO~1GT#WO;ly<(v8$Q1vhl^)6)#=60^(m3*T=ktQ?)Z1&=Nt2#(N39n zy7fvsoh7`}I2=wP4#F1#FPR4Pxe-T5{p>P-nark>Rz|$0k*z~8eI7?KH_z4d$h2Uo znv`80<%s#`IG!Ix%&|?uTEqxvYm2Y^-^!7ndoh=>}exBn9B7hBYM z>MvqCmtIzT%4l;}%)DHL51rP8I3QWIbgsA7UyIg!eS-z*J}`4aI##e$=5u)9%~fUA ztW)Lm0xy(8kD6Cj^J_6b04v~QI64459&>?E4v@T zL)=!^R;TyPztvFbx`UyNd+uH7h};&lU*;FI&g!z7S9UaonbxfpD-XARQ6A=zJBq<` zJm@smDV@bN#`#_Ph(nH%e5vrPfVjF~G^>=pYFgBXr(Dv@5SnTnhivOye67RsD?d?H z(6@S3sJAo>P6ItZ1^a5vB1|Jp5YH~o$<-e%zDo|WftS%}sLi)mmK$YFrk|&~Mb=VYJF#tjqFTKb?* z?gkuYw2v8>yn0aFaKPof2$cMst3j@<%fx()rK6}oM>4G3Y+9fH&@+2wdrrYq&|+g} za)f)qqw(n`(_g98$NN2W!qPL|jlM3a`Z@6INb;3Sr;iR6MP3}s8Of#m5pz5vP*p;v7kW)C(YaNv<^2iNGW3Cq-4ssTXoYRHOc ziizP|0@wIB2i$aUaKY69@c%6MkAnk=glyb7)D?Mfd*^lk*n=TPrEedVl6adY$-}SK zY2p0$(|G9nwTM{~t`$?>t7jy{%UGV* z$KCs7+Ir{bMfrHQ>Gx_Gy#BnX`|@8s{^`h;m>7d5D^4|q9*p= zZ^RI*id~c3d~)Q5P;bw{4=48&1+9=!FY?Uhv%4+?@bSCsgr5AjPt*8aR0sEIH4^Ut z%#P^g{XL|=-UlpKZMRl7`kteuHJ&{1h+rS_(;8bH-KSL;HPD*??WG(0G>wb&+DG#L zgGxPf?)SuIFL0do{8m*})pR~FA>n}omCVM3H)o@88lMCXwVC-yNkgNIWbLY`uCCUw zvO?Wg_NIZd#m2_U)XoyX5+D>56dHDR=;p#QB;q3p%mV^l=_9H}6|Sv*mS0<$t*chy z2wJvH66(!7bo%t^Z_ao`N*U9Gfyx1CX=$B?RTCs5cU1KB;`I#;3zC{wZ_fXS5>AGq z4#37CC}cNtH~R`|Vc{DFKQ8$5fBv>#XP*^A|wsV$jC@d zOPjq!IDX|uY#xM&MlhizFV^q#-FS|@rJR0&c<2O@^?isx)}HzaR@|Un_onet%Bx6| zr9rnwsD?Pd3Dt=mVu3A@5X0*b;$pY4I^`i=tXazpJ7>J6<%G&ET0M-mAl+#u9E1m8 zXcoWj!`LCXkjW~t`4$NnhE(|CWq6mHpc~0|4ejCUqV7k(-IW32G)VRg4+#y+6YmvG z<{Ffx-|5Hi59Mj=j?8O&?d=Y!z**At??>$I5yWyrz0|e>@6PXR^UuRD7U142Aq|YX zhWF=Tm(#>>Hzn_(y}^Oj{dtiP2IlRLz| zF$^JX;Ku)^yiIifw7g*(f4ty-SHp&>jvzUOu`Z*7D~PsDSqVXO7R)<3Eelg*^*Ha2 z!!T~(MFz<3Cg89miYk-Z?^k-(4%7DSS9R80~t3wYQvG{fM-p*K01Ll9yp7! zmEKHy@65F{^x~2nQ=O)jnc-jjWC~ye=3Ox!78L3Oix~NQ^Hu{Os4F&igX_>|Z&PhE z!*wJmIt5YUv^c^-whO5KfXV^LBmmDsiSnh*8#^yljsUPcCCheyZ{Wb~VWc&7itv~v z*o;s+EYAFJ9c+RtfcQ|foP+4A{m;opLt|#rjKe*|ltKjeuyY|lbq<<-V47EC zxZ}dq1cVGF%Es1AHHM5((6)vWLCB!WmQXyt%wg3i%@JHS1ba5|Q$!!;j+7^zGa{osPE-A@%h1(!vVdg(oxDud0k;sw^@T*nEXhPIjoF+bT+ja`13@PXzJ6 zkbyDC!0(;X=#Yw%6X>)jf7#e?>7E4vg(uHGYH!sDIYCszAIDHIm6*M^sxxp{@_RpA zy}BG!ltp0f6xW?^QMWdB?RlZtx7Hqd4##=Z(=vs^1!JbQXkOSfZilFweP|!Q61pGr z3Qa!?@3z#+fh(KR^a%kTjx(;KXone>xk@NOrQP&iVOd_w1LlS@ND0 zrRHIERS3%2*?DHXJxx$+EMFS+j5{|sS7uZYkfYG>aHVT?jJT;s%#%gFRAg?{V((XHnE{9SW|_h9aeXCW zE*UjQ_v{BHN5%ix{OspO9;qEE57UC#p^*8u$c5F_)rS0QCxY-`NSnk-M4^+0AKTcq z>(_Hk!zJ+5Nk^2NOtrLzn;no9-ZWZNw-6*SHzFEov#E!ry6H#uk*g?hn1DAg+% z69cVr^8XEcqBSD1iY*I~M#>Hn#YIrMd8)7A+BAfK^X!(nS9b%CPfKZE-x*AfFY ztknEsRl{}?2$(lWb)0a+&iaHo4mCXyZ6C$gRmvgF0=+Et+k`Xy~M<6(!P-8HgxHKC;@0hLJCxpNf4E_ipFi zjV|g#p9{lzvP=(>(E2>;{hI%{Mf#alfz!ipGEndCDCA$vj0?mIE{kRcFck@iyYKLX zlG5mB+2|{Z-r~DEfCYeOS&b0mxVFTL{Yy8O3cdeh{5lylo6Dy)NCp*fsE`T0voVeh zbfgvP)dVUJ$<97~0D{0@>C<8!R9=k@GpAk~kx}wu4$)@N@b-sH#8V`if}3g z#N2tcLy8gmM7;;t+QGq{FKsIAU+rLn9sMt<9dO(Rnt%o1ii_99t|FlFm!OL@6n(r^h2kDPay+`7t!ArLEJ$N`8LL1=iGH@dJumaRL4WYeHGFJJ{g=?)@sx1I}Kg7rOP z5+x`&Sipb3Ebi%UI{;Qs&>s_nQnQBOULw#>@;6;mitZN(SoN*5Wr;bp+2Y29kkkS8 zcXIwRCc7K@ZGGBzKyBw+OwB&2pA@ieDI3zg85B$!3_4N2BlPciWA8i!KBx4r;|+Ty z{wL~9QT)F6XIwi3^3R<%FzZiX{0AUA1@aF-cKFKy$UgwtA&~#?0*H!i#`38$Jm(wa z$4k;@Yir5K$Pm||wsl5a<3}Ngb6>s~WBA}Y7y&kx<^1j}pXHMWK+bSCYL=mnVbW>F zoc>0|Fsos*S2er7_kENAy1%JgCVOS6Y^jH&^5RsITD!xfM@Z8w8kfy$8Yu`@Lp$8B ztz(!<>iWo6cRAd^ciADLNX*n1)ohAcIpQJ$Z*6J0j|!MD2a6T@tYd*ic!vT&i6=I~ zartYt1zB59PD`1>O8`QuhrA?e5QLq>A)c$w%1na@%s~7w5{Xn2DAB?l zx)+H)fXYEh3~B2}angQCNqLmR!w8wZWIS9OWj)Sy-^V zCMd`z5ze12{Y$GZr|?00c8i80cHD0col4s|(Bpm1wrJ*VKO_RNZeH?@H6YBmwRIvLz*Qt9c_r%ZNs zb{bAjGoIbAiYW2Ty_fUBf{wpPxS)famzP&k=r9T7Dd=^$t-amG|Bz*Hq@>b%IYUqI zL9dd*P1lVIVC$)on^wCrB4fz|Q0bm0weveNtF3&sh#piK>5tOvED&sBBP;|YY(|%c zZTF_3LcMQ6QQ+hYqKzT!daOtca9kdLGl9JcGOe+QP_H9FiQBH%HZ<59gH58pWm9jC zXXgd{0iT9*WK6B|_U-e_-Y+Us`|P7=eFi>K&zHoEEd@XugwF{VlDW#~Od z$VPzQ#jd*Ovrp??PgJZMnR7PBUNn9PWHv^#70Sn|3(?LsSI!*$R$jhj!>*JNIBm_3 zj!80ccbYV!4p3g63mHl_u_2?|%uGR@;x1V0DNp?M$GWwpd*{aO=V+WVp5$c3$JWG0 z99|yh>(qjvgwXXzwoS+aq!AVhQX6%tC#15W{Fi&bnKp-vL@!oHU9o9$V2?hvqbF<7 z(;}(P#=NF7i<2;fT7h;dv7g|$b%#+>(f34TK^Gj2dK)Rc(=EbmO-Tz#TvJ% zqn%H2GJ&F=>BI|ACffOj^%^&<0ND1wDQ~lae_GyUqW=tg7i|9X<=sf~e<*yFFvN0m z!ipeuM0kVBYpr})4SmKYvM)rVJ?^>>E?N)E3D{$1%k&g$UH9N6-*cZAIrQ-87nnob zVx4Cq)~qK2(8!x}oyfibf-e4Ti1Ww1U`zmtCI8Fjg*`o@Z{(Lsyz(mIxKeA};J-EI)%JV6NaKw-xos)6o&eWrJb`|{vN=jxv#`f3K^L@cU>p_U=KB-~zk*qPCHuG!d8(uXdqYwf758RtLdGDb zP94(Ohx?d<L=8;Uy^Yg>}+`T+!t@utmn~ zLN9uNlC|;Tm3T1)0+7ZVY6myU*lnKbc;<0pry-W#sp?w^D!!fI-2)|dWeV7XS4wPV^t zy0R*~lsU=`Qy3_x?YNtt(y$9CE4AAhc71(2E#?cQgD05OcC zuFuij9Hd;8vB;(19(%)l@XyrJ@^rRAK0S$bL2Ev5@-SR1lY0V-%0+m%$B!%dY1N4f z8Z#*~Oa(&Xd&(=2c|en)KEJ1Y zVPV0)vlD?}-`ZN*jhaBBtpfj)0K&q;bZguQx^fTBFD}A6A{|aCDJeNJ8$&?`(72Ta=j$NMj)`@D()qr@~m#^{y0h@`G>22S5Sli0n#B|BO*F#q5_CUB_p*7r6&nljxy9(8Nnn5Oqh1=bua;e z&BXFO$%a|NeeQEg1<4eoiJ9MxH_Od-Kk2 zaD>^Mp2A1j^dz-!ypzRZ%zfRcw{WFOcd0QpWzrT&rReB^W-ZCK+2|U?g~vxqF`pUf zKgVnioelRc0vB1h=G#1jhGz4&+HHFp|9dP*_yke9m;T%ox(M@+t}^?8S2%2AEB)<< z$wls(ZRX|kfOgSapo%j?bVF8C;;^v9$4LExSy9zmeqNTry27K4UUxSJ4W@PPV(%SE z5;n2w-BbJ>#fZUfSZX82>-&ho1>nDnXycW=LtZJ^$Xn6*%4=J98#oC@P5T~%yuOC? zZHnDqO`Habo3{LLe!D!j=6dfUt+520lXV|P!Ve52FKh(6F0seFPJ*iIzbS7CllGsM zcbO>cpJ8u6$e$YjKVRO3B>&)R8-T1E$v?#26>k2Yf)q^EFF;yGrn;p?+Rw75y+Vb< zdTa$`uUDwO5!VsqxQ3UEbIcp{HkL~3KNR&Fr;H5VT4y1c!;tHCkR^wqk#nQo(GZf@?Rt|4$5lic&}`uR`q z6K$Q7n78K^l$|| z!cHP0B2m=r7ZR8a@d)*UrJ<;H>}G{uzkcz1XdQ+`qYphs1&Sa8e?re>W@W`6JHcQ) zS+I1s(D#SHhoPFH)xqjO%)lp0>&&N%y^-kI3oyHoP9CoHNd_rJqG6L|?n{JSx%ES) zy**Xm2SOW-y10h!MDi8n7UkRZ2LI0ck+9cBhmqav{$S%lFL4kdj7`4~zsq5=HoxH= zESF5I#zB81e3$zFaGn1^N!gj@CdD2^1VkMluuL0n=ajQ|VFpGE2o|k-{rbVs-TsD) z{}U|J4);VLH`(NlFh=_l5Uk2`>H8ck&IUDwY*g$H!nxH2J~#(Pl!|Y#b!QuOdoE-M zQ$;RV{N8_#?KDyhRx&V~y*B>qi~S^CM9huF9(Ec(#9{`S&T{kCPIs6NV0De!*({s9 z49sv~+U7iC)QzR_F@CGDLdRd;`p%R$J2t!fMC&sgZsXeLf8kFk0zy+%fy;hFhAm3+ zcd`$Tga{8-OiFLtEMW)=B89;rdRuD~_;g=5Y>F1cYKRl<^+?#2#33l7d>8huHG)d^ z-pOmTll8dkYT{4j+58s3u0TjkOAJn*Q>zfjZH{oq1#AVVY=w{Wz~&TpT;PHeCU~;{ zo!+6T%`RvQfy&m7i*3$y=fwday#oP}hjxXcKd)D^gDPF&Es}jyh66b9b9!yq-c~w8 zh~Kq2{mt=gT>P8zE`9ye@=nVHD|-J7dndyGkNPr9^*MFAP-IS#(aM71Qk5^I8(Lc- ztmN2UzW?wBtuW-Nsxf`%Noy0%i)dj?WK?2eNWkAfP^1rHLfX8gUKY!jw5Q*eJ6L(9 zVIk0Ktb^07G;kmGy|Qg$ae#(~^k?IkzT_!<)0`?=o%$5>ykn;=2b!+#CC}?}Ob=O*zLlD<3<}GXpgJuj9=?^iR~A zqWFFB&$xC9!4@FdLq2oY8}?ljcHYb3`S(JKYm_s&F(21 zgf6U>8L%F|PyV1MHS`7bV}A{)@Mc6%vTg7nqN{ctQD2jXa zv*=qIai@%!q|0nhbL@^SO{Fh3aPKzB)S{a<#g833MYjmX$5WuT?5Eerxz%(iM1Cx~ ztNS$qt>s;7m*^IKbX{cLJQbPt$eYV#?duu8_6J`Yv2v=~)e4Kn#D!`FBVa&qL@1PvvNo4{wGz`lpGT40Gj zAu;jKH!0wifjJ)aYuV&HydmKwxXA7UA=4DbR>PG{1x39R2>((exotUG%*it!SAuop zP7F^Ki;9Xy+nJr?NQQJDWC_Fn9wI~r*ZO{W*nsHK@QGV@yFCgvg|y>>)*qxx%{iR= zMEysHiut3zYja+zsHk`prZnFyK-M1OG-_pP+JCLt`{(}L;2xqX=x?*Xxfb#dV(YVgM)+2WrGYdy!LMuBGCoi4r@rI zx)i?5u$d!yOZjniBE`5!H#fJzrP*PJ+7`P+!xO*10%5n1@aHQK)3~+b&|pq_WA7~T ztxreIF-`rf@)fN9EcK|jC*LmG&TtHTO(M0hP#v@>c@{C z{tl_BDslF23gZF6Te_YyUZG{!A`O9}?KHbM{-+{g1 zXA_IJBjuLU*MpM{`OyZyKZmtL8|xB`15N+ycq1kpfcz8nPBV)9XIwi3^3R=iW@@(sa4}JAGgL!jtF{SdXkHeW@Rq{;L1&0aD=&7dYxLCWK_}sX$o}5XW@bCgu zOQM<6umD$Vu9L;6!XHc$>c+j$HFh`t*%n4^H^@rg=Pq{Pw(|1(#0EpiNu))T)a4ya zZnNs}Q$(m(Kq5aeaeI?nvEw1n0RmLckGP<{x#r9T+P?7Eo|gT-G!z1c)~zkIPf)Wt z>0?|cX{5)z_t2Wego^VG(=TnYo9%`N<0rTWAO4(`vHq3Ezr)%n18tuYj~wY<6%cR; zEgZ;nwyCpYpKp>`koXuUQzX9LTc)%UK&CdM1_m4X!KOIZFJL)fXsw>oWqZrihY`q> ze?BvFABNtI+c7GgwzKOprHe=b;qcmFcbfVnOJ~9HQQX< zkrsSDDI0j9OTIYE5h^H^V!#r#nyJXzS8$ou`%k4k_!Q8AdKSTsy@nJ=j!w2s$#!@p z$deT>*QVd0r{3tq0LV>m;M3{tw#ccV5>j)P`ewv|@A9XL|D$&ZAKLh+tq{YZE>14r zZiao%yxqfENQdoh{(VFx0z~z|G9+>zJs5x~>x`Y4-YNeLa{`@T=(^f&@ZUZbln&Gs zn#U@|Vn`>ekapMgJjK^IN%`|dq>{0m?}1g`t+s;1>I293iyZ5TF8Y*#Dy zfOn7_*=ONUNTnAvelTnH!FK1_X1YH3_u!1DxVNOf?QdWYb`h{NbHV#amFg==nrKOm4RM_Lpn*d{5 zkEle0TS?;DY)rC*pj@db22Lla^jEGoSSqI(pNh%YB>;)=LDmRuRzgwzxACwSl;bce>_M&`>I^4Pp z87TLRx9|`C#6CFbsb2ihXInSw!YV&2AF1}2KH?(c#ZZNo6}svje_tF!dWO$ZzcEv+ zWQLiT@wh}N@8v=qxq?TqrVCxUIXT5S7GvCJ^`mG!CY8$89uCq^Tn?;|tDdN><)tWj zeLI6wifo&;{~{e3S5RII$%xlHP##<~t+%>7PlpjmAl5z&L&oD+d-90Z=?b5^ICyvf zPNm#=-||q7w^W9{i0(-wvrN)acQW=QjZR%98DU}JAbuOuJNblUY!6l`4v`*c)z%vP zws?F#=xlS$+3l+TD6i5!GuW5W8qms8DdNlEx+pS9$}H`oQ612nphS8?`=e0k$HjoG zyy$Z-L1RzzZ7s?!^WmmmB8I-HnsjPdi?| zW;fj=CzDM>&L3W>SdA)4rlEM6){>r?`68hB6ufpm>ZaE4%XiK4aU-2hxg7djst!7> zR=;Jd@)B6O8-9nz4nLu_gD5H{SMVFz=)F|VU{9&-XwB7B6rH#wb^f;z)W-tvi@3cr z^uh87J(wOC(nz6Sjc{pr8XeEe{1hV<=kXg=J^`YUf1e|EhsOzFaPJ-`QY~&X&&o}c zEEeb%xNsdiuuA9WAu&Vm12c9&(w32r0;E>5dPcU7fAWI}HT>`G-O~AAE46xQ6f=B# zgu$xwp%tvQmWO@1d5uTVLx0kCR_JvWgV*R$#C6k0ug{-4yKZhHg}~a@5<_=UsVj6- zrSVk3FRvcHrty9Gd+DWz>o#2<2%c8HNxf_16FEr`2e(U$AN#pnO#^&U8TF&m@O6WV zBm$vA@Hzjk>@Ssp!_geSL{hLyfT5GVD{bN1Np|dL=IDK9P`T(Mh=DD0-03`fMY@e5 zFi7djv24EwR=jI`e_Df?1KW*_qPe{fNg)Rer_LJh$UfiOY@h@D$jg!V&^EB%HcoZG zQ3M94F53V0{;g5{*2_INAiC?zH%@JPWm~-VF#(eDu!@}8o1E<#;egZpsBta2nTQ4e;;X-Ic6|sDpzwis!cln;P4Bm1ynZfCT^V0#4mE3M= z7e#J)`HuN8tXqz1U+bi{ptMfw8-H|db$e-_raxwXy%(EqetH7`-qTV%d6AmT5)-t zcZ}#Z4giA6U;qlW*A>imdcDv)TscCkz)pSBcjrd01^CC`dRg6Ds&03>Uoqv9OG7Na zt>K#}ERH-RI=~~A=oWW<=ldIxfYu7436K3)P2-p%pfJ@rhqw?^%H`yW(!GDWVE2^Q zVTtw#0LY&fU!IAH2IWTz(Eq^SCnJj^1;sJxgxX;;Bq>SHmCvR3bG&y2KUrhbM8w5A7u=V|&~+UH;wKgjQgvr!rA zroAI>u15-8Y&rDmebTKBw%f%n6b@qNY!|vid@HPM*b(*)7q%Qq9{u|7cCmM8>wrvc zkPZg>;P5+aIn?9voxi7yz2l<=Wcp9t+w)+o0sOyJcfEAlyC-{Dnot}rX1>Lw@9QRv@8ri8798x4@@*J=N88vy3%Ew`qt3GVRyrB;u7VDchZS^KEQv_X~U{imRj2?Ji&OPq0@4wWmz><<$56Y&*(6cCA;}kUmiJ8j+ssAzMC-8-L z%@l=>T68TMMxj?Nt!1>^7k~MaY4<9PeJS>szL|&pu-rFb^VMAXf1%7fAr*(=F;94J z3qjw1@)YfnuRQat6_fL4WAuuh9G^KVCcig@;HEM@v}PCIIzPKhe}|b>UZ7PD3H(JT zeICP@NN%1HxDx#}|3u4cDZ1~9i_5hwAul*s1{-e$vJk0$eQO@_+6xC(4%~*Pw#WZ3 zIa!cu>m7R^m7f%N#(Yq(HUH@yJGvG)x9vMoy{}Keh=hzFOfBL7Q*3{44e=4c zDq2km(R}iB;&;s}e1xObEgx-Ez1k*?791YHnQ`xf0n-y8{*n~PDkLNGeWXIJypLey znM#)#a;p#iYCrXJn(nBP5v>B0E&s!mj@up4Te7X>#a5WYlvV4y*Tvf%XL6=6iqbLX zgBU!{aS@tz`YRH}fvH$hK(oWymk2UB@&$TBe_y zKYg^jaB$5nE?d`LAf5Blh$F7t@+vQ3a(4rqID{0fCiYrU&ErS$8UCEZeq(_+CIqw|NDjS!?hPaCAaJWTh26etV zWo5jCI7#)nDs=&q>V0*3U@R*t|NH~+4O0|}z?F-zfTWw`PmXcf&V2J{z8Y+t{Ajks z;Ob4@A-s$@F#!NWmB~eMu}1jrj;rtE4sfpy*WN4^7!2-JgfKbPeX%?ywf)5V_UAvvJ|{=cHzj^RE}9f-xKgmHM<*zd6pt1Q7hIPk9Md6f zX}WLsG-q_4{@`6wLlU0_@5R!(P!`950@8sadj8G5rw>?6gu~4%Ul)(P&)~Rht$$eB zRZeNq>GWFRF?RbVJ@p(TibvyFi*hfMUtM-x(=u>fGtyz3jxwKKlVc${3-{`C>NdZ{ ziy>*QGma=^>Au<(NUA?jv3B>g;nJH03cRw`q7S6gh+_D|GZk`@m<2~llKwVgD1xH^ zmfU?#7K*9rsOzP7HDO_Mx|+i=R8HX@on7kP%4VZRNuj(L9I!x?zeuitkdX{#cY~wYG1?GV-dF6uvN%ggL9Jm&M>g=85RJtlOtC$7{iW9wRF3 zdq$3Ws6|_+EeHT_J4ATeW!?lfaVpT-xe2M4$*utZ@&$aq_n8`#m$EkQ^2wK|M`x~T zK9H4{z7_t(U+;$d19sUYN}FO6&yEly1EZ3+5U=tO@L!yV4xbG zm^teB&H)lk`jVh>k;iz2s;e!m-SCt(4{VXIY88c0HZf1D;jW$+Kwsh*S68C->YTQq zE~Lo4iU_mN6Vla$w4P|9N!)o54w#^ z0ujJsQ0m%WA!(h){=5TdJ-a|+*q&|EK9m9RFlQz%bUWwWdUOW6HWnD(BEI*~KE;Ef zDcVTw!<}uwx?G*8gx)^Cx!5EH!d_C|rG2<_9)7wx>3yZMd~KF&@|i5(!v%6byvr&8 zKeWV-2%CYpn4PAUhEWfSOc=Cp6~hbdl5>|4Tm~t{eQ6Y z`j+pWV?CL*wY3~p$Sw}8+R!h$&2bzW-~7HzWOlv)Yf)Cvj3KmVo@EV16m}8r=zF24 ziaMLwAy+abYdRL?0)G9BW@**YrqAyaS!JMtZeOw#U*o_uPioICDjF_znbo-hggZq9 zS~D!4Hl^$YQoKlVucVEtVhns;{JO`P%jfj-=UY@8K8k3Z=m3kRLd%Eba*oiisvc)6 z=F)3%p)kt3ys}sUJuVu+^7)f~)2By$KDUk&tSx%4o$0qs6g{7;IF|VdOPFsl)mKi> zg5P94E~9861s_YweQi`9kd+I*k+rBfp#?>^PbFF9$FI;~2SNLgSo`NAn!7f@>Z$(1KV=D)1deA;Uvw1uQFY(cX@8QBzHl60W>`(RrmV=;;a? z8ZZ8tN@6E68PJ%IB`ih)j>Ybv2i|EUJknUxGoCIZYn=<6ysKoVW-xyScxwY2c7&tx z$;Vq2trTT*Ee#?bpeGBRcvt5dOTg}0G=D2LXjeK5ov)Y-w{J~WR$h_s1${|S2mD#@ zj=Weul7bG9HzYt{7P8!p+6)s!W5hyEvlXt)yc;s$wiLkbc2S9hh=mz@r^#Y|MPQh| z2VIUDAwdv$rk$`tIG{N6+rCUWt)ZOy3eZT=!}IXG?;3%Mr@7nJePOl?b$UNDd}*;u z>$J`gPfDoM>X@>dk;9n$tB#<{YQ@TH^U7{On@NjIpWqk1hFSHH_oE)So7D-p7cN#r zFk_RA85S_jTppBOQZ_>=&*N%$7rX2i2H-v$7(3sPO8;xz=##To+-MxFv8!meR$Lmo ztq@ey4s$;mN>n2p7MR2X=5noWK6A!_ojSs4QM_u0Kr6v9%VX~2R8&-b;OBS|y#s4R z&=q47%V#TeB%%sRL-ES1x+ZoUYn(G3&aXPLb*6f4*j>*E@Y(p|Cc#0?@iJrt3!oe0 zmZw?<9Ci-fITn2#ddbHwzmmMf7-s&McPL2helE6JL>mb4JX>g2;@JO+vABvcg0i0l zHFK^{DM>X12P{uFoHVem3}gjQ~}2ZrUH@9#>bbZUwn?h%*DC`!=8Eu5yZ>7&BV3745v>E zWNzoIas;nm{T(42T*X=4PGa~vKqXk-5in#gUxoe|j_8xETF^m1$=C5G{JhF0!7_2# zE7nOzRIYCc_@(1XUjyuRj(br;jSOAjhl#_x&gg)+8+XsceDbBDRX3O4;YnVz%WO;> zK@F99L=1*?U{9D()S;WrfDs;kpRrqq+c)=^US#s|`+KkdtrSXza#Qh!HFgvCbt8 zixGoE7kiyw*(hY?ubdaDI;cT`M`LfCO6D|TZfVJYZZ-sJZ!RCjE=hb8iF`CLoM$t8 zbEzf+#PJHjr!2ALyd+ts`UURNJbHve&_EO>fiVuFINTMbA{`;(CTtz@NG z_X_WM=+aMLkqNtr44KsK&buobc~3wrk`FzRHs2y2czhmhcRsm$k~R$N=EvH#=?bNw zz4gn&yoyr0mDfCaqwxufx!k46k6&3_#G*hH76p(!CYe8Z3YTj7`xZr_)9M6spCuq2 z3mm{ie@aEZQM1a+DhKQ*qQ1h8ab8MJUfx-PWj^{R$c7uv)%#uTig3a#eF6Ne6b^kg z3s*8)dQhen;lOR<$VCBAoy+8UAV5wX5`cx|T1}MZ^*72w*u#vA2~>YpzHyl02f#$C zcd&56z-Vmt8g`{t=qh&LNaWIdvXcOyiE!&hLgmGqZTe|7IT6p+D*#6TY~(82PnUfG zVGoH_iY)8f&O zK$QnywVGj-bQ+f68G*&hn>-*UQ5$`E7pj6KWMV8n0n_Mm3ZtW_9y_B)*9%@P_n->0 zUNv)JqqsAePTT7Dt92K?R@foS+Q(A9zvGIBUy!A&Ry>IflBFM*E4_<-D#*#Jl z8<9*}aCQ*OQoPencXlkJ3W{9_NZtvB(~16a#xG7 z7FU{;UcA1=0dFFnF5_F%J@-uxuY9=UUhIJCCUaaFpm7`U;$!P_L{C)Bt|M^`L@dHM zSyQYVB<3HJr4!}+^<~l?VQ%StN;G+4hJ!=3EOPtClVnA)&{}MV9k{7i9Lqn}$`md) zyBN*D>K!;3e{kP2E}pysiH3>$NA=R6U70gD0)bUH9G68iN~+>;HWIW2>F6; z#Bjwd7@%&yIU6=IGx#h_&qfC-9f??58NT%(C-B>^*a&J%5H1^%Cb8ZajrB%1YTJt- zd4MwI7-bIz^!Z7OS832_V~@hckpi1j3^(?!E-y8m`yuQ$X+O+Y#?>jRms26aYVxZb z8w{6zHZ0GNm6VYwhkk#NoY{^29p0jc_?#NW4uIjl>K<*5_nj!4d7fwsR^HhU>TD&FtarkX^s<8>XrR;-ZaGsft{ETXBy-ocFZQ{T%-~dlo zwDoir#6nF-e6I^rn%q7uTZRR>9761%^e_Q}7UttA6)zMm+oO>N7C>D1obEzV<;W2k z#|ijaACVL9Tn43a=*VM7C$IK2t%}%7Sfhy+l1%Co)chWV%a@b}c;JstzUZn~uAXJ? zWQ@7L2O=`HKH3{FPOk`_9&5G5EGKl9diIyaim!Lb6i@Xm)mmvjl&!>0-&^Q>`DCYI zF6+wV8pbH)hA)HI5hEvbX9+f-Qd7v@{}xDXzcO9nE0I<{YzSCww3|IPcp2iJy=)n1 zoa=N}2R)I+F3>cFf{#yv;1HI8!i=ZYE!ZaE0jvUSBjy1-aIJx|6(#pYJ4~Yt-UAy>MBFs^|6HCiOtNp`j;uW>J))KOzb9A zK^VWqJYi~^kJh8r?1fzsvAk{o4v(GC{zk7615)!8hBkNhf;L8Eu`6N8Yf|R7vz9$J z!|J*3Jnt&yzT*u8WKWom2sab}Tax&5WJ6a~|xBeoP0Dmyh(! ze^}VN3*x$^Lq8A{PGx?_BV2*i9>e~rOiwgqkGZx zKs1Q!6?aoaC*PL)GKhzs;RZzk&u~PiGl)h;m#<-Mody4+>WYV`PZ_gwIw?5IFTk?g=4L>_Dm_Mg&LKyC?G27Vd{ z3CE+hRxxGw0s!-A?qM=QEj8bM{=a-wPj0K30G2G>1rYZ3%87Y_NgIi06k0h55P_;3 zQJ&UTV+~?~{c6+4+nt#_^A=S47qDk3IOQVW3~1#|H-N_iiLr6L518ulw-W@fu&MIg zB`ia4jpScXRw=O9<*?Z2#+V{7T}smTPA^Gh!LDNwgjBNr*hgxwB23SYTmfepC$Qv5 zm$hC_Hg-W-S5fEeC$*F*flfF%b~o^s|H4P@-N5y`~%_AZ91`G0SO3dtt_We z$%so(`gY7O2`4#)Mij^e38%-BF{8Kq2Y`L8bP>gariJKalLcw-5&oJdBPtp{S2JlF1ZG&+S|G{8j} zGZR?V$J>d8)8FKKog|?^zC`})Lq4aTK&`2_XpOn@C^JL*K>i<0Wu+;^~l{fqoMuQ*+{=>xubh53w(?Srb+s#VzIq-aWxmQ%64>N zb=X(@`sZg=|7lLpOkj=G2$Dfvh(4QZ=N^TgMv8vx0?AQ;-!Cuq2pm|~ZxVk&LSVj0 zy+JgzD78_X&lNB~=y+;18(q>}Vl$3GRF`|iO;41g=wBl z0g|RAfq0%Nyn5jLJ?tN4K|Dsqgc!<&=3|oAmXqnkwLNBU3?!fynZvbpc?v;03|7YEgJsu!S^5L>;Tja7H0wrDf`8e zSqWMcD+B?hJ*7QLuVD-E9-FNN=`UQ(E?zye#cY|4kAG#kK^+_T?-fO&2laEf{D80;Q|hdi(@`mQmC&-)!z z$`EQ~XYw8EX$C(^3k0#VC2lu^ZtY9ZhQJ&a+8Gn%v)FX1u(cFWu=gLwrWDu! zg0&mkLa?)CIBPOvvtAqdKxKLES6`c&H!EMm>`)02l#<$Z%6>*?>~8fXdjp z_MV1@x0%FaXC-<%m1PwCH&xu^zUnT=va{hvxH7MPcbY+{B zRK7W10+8-32wA!HJv~ak%Xo4k`l!%rX2sZ_0#F`nO(r5?cz_Sc{NB5D&}fc@EteO z9{`mk0t7(k;$u8r4jG@Lir_qNQ{ir@^pj#8=$&v~&%g+>?7E5SudZfjk9B@ynptjRb zS^aSfTaNi{Z}lD!R@dN*iZyK<23y!t?^|?>NZ`~0sF#IPcl5SV+l`-~c3kXxJpjsa zsuLXB>-%1pU z!F|A5^~8!`^D9w+xgl1DcuHcStG^uSJJrTP#l)!ikuVkMbv{0x4!@u#C=xzU99S?H z?a0`v=32NqVN{}w8B~6Ol|j@z(a_g*D!z(Xb7-zwu&$|~apGSuhYVUCCUG9#TF1E; z1r|ni#z`-4dU2DO%Gdu6m3_3zEAk+}S`6|IKLx!CDyyS_xrnDiP5MixFsMRkyEjF* z7CaDoCNOddFn)>!P#hN}_!L%S?H4a%NQ4ALlhUaeF!wOgF(Bb`57II-cNxeqhzBY3l2Ekq5N@y4HmWGy`Z4QfDJvP zVg{R5@#%iA7a#IsZ6=!lQ_@vxZ-az6KVxsbx60Oiu6>})GH&9q04OsDrDdCHS;(t^ z(H>A@DhA|Lz9VswnxvU;B3<&%+vOlNF9O6W(#pMR{IxHl4O>A{R5VBCXFUR2M$5p$@d@Ji-7~b1={U_J9Q5g?U zf5Chg$w_QZ@Ed%@XjMdl8Afi4Z6c_4LJ_vOT?;ZMYTt>=sl4Y`^JZ(~@vkr>V(X43 z3F#!QciAIOP`7FnB6G%U#WE{~sce3}DJ!+IzZLnU|L78LW1cj9&y!64_8#yl)I8PE za!|YNkT=S=c$wB!Et+RDM#!G`(6N$x!#Z(b-@*PgtpY->4X+Z4d;>9A3c^yBI%4tb zzdmx<&W-%cgTFvut>gC{599_FScGecVb14tigIrnnxul|QFSLZ3ckraGhR?r^py-? zm6x_ZPkW7{($hMvab^aa`0E$0E)2Tac6*IwdQ)CY?Vko!wTx$ot)IJqC1A&qk5{(& zCCvJVFe1k(=T*7W(fRoT`d}f9G=&Xd^D`)NW!MR$RhHuIv@)Pt&6<_Ko0$@Z94oGf z*3^~iKc+BHBdgZG3d+^TfNm`d;|+Cm2s#b26w8(d(-xVjzigc=rHz6ZkbBCvZ7K!i zjK)Bl3w&NdAg8**>Ti9p5lP>posl=5g>W3qbug^>xBwu+cTl&VtH1T5i0`t!p)zAB z`6$TQ7P)*HRu3nEa7BKPD|}lo8DM4X^Tb)$rW>l?Pyq|TV^%>XHbFC~U>R$syWbM! zf(E6$Vo=~n`D#PK$6?TsexZ-L&fNmg&H@U%`!zJ~A{e;1odRkVo0Wj^*jWQMe<`W4 zxmha3XdC3TfFPRIpu z)dgN(`!Dn@lJTaX0`&sBCPDE;Cg=Sq5F&MdD~JYp2f!+Yk^)(1Jny z3;E2GvCibz=}aR8Yc<+>dW2&wiOiX5U`vDQ+{h1Ach<~%cX9#br%r+L%p_^bI0z(k z)J}DFJtWt!U%x~>RzT7zskAKjEOtdp^UXPJ9@W|M!I(h>VkbZccp0qT9$ zK}$F-H@=qb0k}hE6lB|`>NX#&?=7JKDl}!Y^j*xn>#NG^8U^1qAV-STzk0VhfqH%j zNd48Umw(0j9$uaHcKW}@1FF(C-JjoUe9l4{G*dGcG540%WKREg<>KEtplT3U z6mEF*VP^U~$z#3J;e~6q&#iF20qmWI*t|(wEh7bS&s0-*RaUa<2Jmjf9R|GhSGfU?7jbos3s}F1QYga#-0vhf)-coJ)cK`Ev z)lNIlZ%90R=peg%OyS(#w|{`0qB{>B0;f@P3eLcbCq|}7u?1N ztv^j(>eE}p4RE-~QXi{?=wbs}+xCO^+$^yaBA8 z4*&mi{(nm=x42sWQI~3)ZU6uMZl5tjUmrB8e|Vz1Tx8vfq}{W=m6w#XSVZsJ69XLj zf4FAzxmyXj-zxlS9xI*8>Nh;Tq}o3fxFW|^whX$t4OnM6q=6^DH(%t2H}@M3D6l3u z{Q!=Azt}jTg>pED}@ythyBiut5^&g;FuC2;QY(AVqn^XL3JEdS3yrvA^z zlXX9jotbHTSg~D3XdZA5=+oho-+*In!ft&slAtv!RZ+8^UU25uUB@c__-+I+CJm=m zFkf@+77GoL%%8LC^EvBwiQqX~<<3_Fv%J=|n)})7_a3_FE-!lySSdZ(DgXC{ySB|F zcF^nuv^+eq0+@YJR#IMZdjOhYoviNvZsVpI5&u8W|9|Ik@>jbb*S7E5y2Hlj`^zHR<6`~Dv_n_n*$17}C~WeVCGemHLb&u~t~qfW(R;aZoM`|GQ{@cxao`2WN% z;L4S2)d7Ft>9JX;!+0}j9RJaoxAU}KkHB5Ji`Td7x190@beMZ3j-0gQkW&A9y?T!m85Eq~{Y5@!6)dz~SkO~8McmNqMe1RRl zy(cYjEbn1i1>EGlp6T>TWIZr10sXcBbb`vg6d8COi6jR~C85A=Y2l4eLtxnt%@r3w z2V~?M^}#!a@ZbV72s<8FoSI7_<#!bQ4x+#oLui5}jx$s^z5rM1+?(BlYe(J!E}-AE zHq60shzd&;us(n9dkohyE;!j=nh7X~Br15H)D>fk87G?I=MCjflY>?f>dqueo|1 UpUDQC1!iFIboFyt=akR{0OJvwx&QzG literal 37984 zcmeIb1yodR*e(nR0-^$?(QLk;5?prpzul7k|lG)Os=NJt~y z>Cg<#ki)-61p)D#wf^s%^Tpy_>s@QR+56e|bH{aG&;7(aQ&pBbcI3f`cOx z5TK!FMyqjBGCVJn^L*W-=D4_*$1y^%PgXa-KkgjGm}FXaa|K&{y8OIyvM175T+4#$?v>$) zX|Iu9M^rD#^IR^S*S*YmTxU|akxhe{6~m>aqE27H4adL@+?;{0I9{>f(hQXpbxut) zmiM+T<)AlBCsI`9aG&-(X-^WVIyY#7gE>`}q4xm)^4d4zHltO)^#cxoWS#rDx3Q`+^EaD-_|8=uf|rYlffC?T2sT(wN)#l$dWrlx{NYmjW2 z9?R0MM=C*?eBhIPhjN!fI2>LN_>jRhesnuMP31AqEF;@A$ulROWx~-ze|qwx1)&iLj~Q?kBCuFhY?tIAQ=*0cBxB91tF-HbRoOiGW_KghwI=8k5f zPg64Icv>BxWp=S*?&)&wFy(zbFpAsMT(qs>QtW--%UmeGp*eERc*#<&4^bgkHVn9P zPL?xEcn*EZwb|&4f^D??5VD$ZM62VN(|OY~7TiwXI-4UM>NiUaM%vO0MufGGVhFts zK_VxB?O;Tp-fYdG7 z*N0g>BYlQpbsl_-KF9nItRA{;5td%%{k*9&DpyWxZ61zvI z`}_*kCTE)+#xkmp5Bi%&e##0P_x)P=W60=8>IDwUqsZcDwu#T92-@#)$FoArkT_`` z7eq>IZ(ug4y4+$-9N~vW)>*~S+S!*#`;!heteI6`d|*0MFpZNW8Rxom)0MTNjnXpvY5TuFZ+02b)Iq0rsrJCqd%_6_*Z;!q9gbq<`zf#>^GvC2KoETd zCtUyYhlxI~1>H-zc}_G@D!a^!PjvnSSuU$~wi*CLd_KiX@m03U5XY5a+IrEk)28rM zq{GOoBC#=bPyfAoAmixQse0_d@fXtm3amQ>o=-elYs15V_g)dW)WPO{Agf3(yn!d-xQRFEDEQFRH;8|G<`AAU@la{O=eB?i5=P z;G+`tlE3T@{w?_pm2shK5uH&odlc~-G7?Xb<)*r19cKC)dw@I8OF-L>79Nz_c(v;y zNmIJNu(RdNU&{K`*zifR-1-kwclIQi-;$+i1AIf_ibi&)>N36feIx@f!-Ggb!i9LLkYzS~7b$!EAtMDM^ZVoAg9KVe&ow#GFW z=w0%10wM^C#!nHK!gMWY)Lx~cHFoUvPpM2EGYHxI5nKU&pN!s^S-fe}W0T0* zv%5KH7?35yK3h;QN;4|=kA1ks0QF$dE4P+q-s_mfYj}8|cx+e%;`8WnAr*%p$U=+@ zdk$LkN(;xX$N)aUcs+WyoyAPv1Q0gu1auw|8zI)U#3yW<)dNTU6{}eQ)5*Hm!u(vR zA53 zpGdVUmK#C1#LeT zrgI8C7oW_MikhtyP#W}bLNp77y2oM-z`KZ`v>0F_7nipbKP{5R0o^3&_L<{sGL$R& z?22$zEp&`I3H6}rYCONw2%P}b=VX!oGB>n^n07Mwo2p(?m5~ z4a=Jwk$1ih{W1>J4(dlGpXbD%Z)NtSVB;ocqv)!_9{49FIJ24VO)PA5Z?CWX((vd_ zfMOv#1(o(F`nLxr6BBjobUpR@%Nu@bIa&eWl_8c*g1f}rcHU1cjCQuxOsi-2i4DL- zc>v_rOHpdtWw7l>8^Qp~Wd)4-?C%Mm0ptedT~q>MVjsz+Edg`1UVO*!Kdsa4P90fs zK%mV$2XJbdin=-^rH~KPa`km0X3jndLqz(wI$W;4%j7t_qqo@QS&JgfenqBb(X6d`P*1Rz~e&BEiBT} zZqQ7zSltz;d233j$C_B<*}ZO2OseF3=m0{9)x`bA7%58zYyUA%^o6q^|!Wv-N6G1@8_1- zMzPJ}K9%1Nl06qt1kJx1#RYsC=Nj|=q4?lIanG?mZEcwriUWix&bt%;(7bd%>hM1r zl?IxXz)>UKYH5!N80|m@<~%SbHjECU^B_6_lsEv}1F-#>Gyj*l(+bamZ7b=HYWL5~ zd|j%K;xx!x?_RF+nKnm*e1PGatrvK?!bPn4^vTwK5~L&03a2{NV4E^Nbd6gj&qjn42xj~9AR7)y8%?v!&!J~dMY8tj%A z+$qnFM&jk3*Da{g#m*%;hYo4{vIe{KQA2wXp}xD&UAlj@Soc0i?z=0&u+;Dr691G z?pd3;U6ra2_VQdQRk0a+WW2Jdwdu4R@>;u*WQQ&A&jDQaMVQ4_m+zBNlTJ(AV?!F9 zjx&hNr#otr6ReqaV+SdOssj$GQZ_8}Tg6Z$feR?EbfaVr9MSw`L1P)YXvqrp4%%uF zYg0oBKy{0gjpu*8BYgoX&?HqU#E`4<3{fo6araEfwn3zgaHRx=X6FKwcYJe)!1h2( zA_}i|c-s#0$e0e0w}W@Llyjh~1K&7^qhCI75DWh$VxgF2c2btLA-@xAa~i2oct}f_N%Q$#{r2wE~OLyA-)Sp{!$Um zt)!cw8;@@G7HWLR&Df`9QD6WEN;}VeLgYvn+%@0YM<<5>Wo>&M^!Kw_1nUjWoh9S{ zsJk5j=!&lp&CBf!w(G(In5DKPN!&Z*^_$MH18jx8)$00I=H8L#067x48SPTJlO%WF z-7@2Qpa=1{Gtd5mMP&mD$xd7SyF1uB&#y@LM;X<6@0l0){V=o>$gu|<-cq~tfrSrT z`XGk4k>mihcER-lN^b$>Pn0-FOIxF_p8*qnkcW5bv<=_*L|jb3y3g_+^=;;O=A;O1RlV&o zWXEA0vGmxfx9eXQi1E-AuRNb`XMSlgz;nUID%x@=b?K?@~^Jlht4JAC0yV(_KRX!)IrB6LA-arzv`aWH}usKHJPfZC2iUF!z z8`BN=TMSnc-+QjP!9BiKxLq_F^T$Jf0PDX-dW*)kWXdGg{d~LXzDIUN`bG4h+>gmj~@fKqdu=^&6=9p_Marp z7lUo&6!PbL`i8g@Z`%nv3}n07)a#G_h#E+h>)|@Rq0@y_iR+`=u)tWeAzMCF)(iF} z9R5RGBCZtYz%CJlh3ucbaiBp*mXDx=e3u3Oe5(#WMV|v%l9wG`xPn@UodQTn2fCvw!aGl*CX7U;r&i zjf{W#we!KW_YaD}H^BA37S8T{2HFCU3$0A~M>|{mLl%l(0&O!dN?^Ao?0pruqlu;G zwH(L(K`#`5+4GQQwAFsE0=vlq0KtS31^+<;x!8fWZ}w&WvBORg4?4Y@$zhFiVClac z?ZCbN4&47}Ok2J7%r&KWqtjp2R&K!6h3s;aLZ6L7*IdnSRoE|B->3mQahS5@gc#HG zc#d9OxpFAd3|NQtx2;|Qt2MN;RfoiLi;*f4%OgCCp|-lbCbS{$pGS7B=l}ik%ne{r z1;183k|Jxk%7LC+j+qLYZw>&A>b`Exs9Bc@}@{WU) zbC7cWgDK}=f7iiwy`Q=MV1L)a(CsG&{9g{;+VPuJckja0CUea>8tY%+dAH?u72lsj zpl$~NOi}_N_@{J=i$_ebv?N8lI*xS6%%2&6>tK3BUKhDemCcE9qqnJKG3%*OBqxL9 zn6BhMra_5nIDjJpOp!~wPVH!>aGjf5P|}XGaWa!fkxcy!_6R zfgp1lLcL0JXp?T{Ps;dS70N{Z%I!|48 z*6{!MLbM8?6}U%}(0-l5ClbUS>R@%Yb9+R&OSMo*zyp7Gdbw{2h2NQyA$fASP*_-i z?8LJ#L`Fi=1TyDMhz3=yTjH}{wOUwO!&ACT9xb310wPhSG+yy*B~K?rpRE&I*F0tqaM@qU6$aErW`bS(`&7F zI%0iVa_vtvZi~kj`rxrgCC^j4e{?$x?*ytP-{##vLhB{*_1uujheZFd*GG270sYzu z7K{BY@<00Hd>XZBGP`|E<79im$Up)sO9n|G*m&sS$A!22!I3U)G8AnZ%=-4fYppTl zc0Oxn-C6Q~U}h&Y2~pVjc+~PFpmtg_`UoCph-pVyOckAZ%nOs89z7Jb%^BUkG@^p8o@= zJpq3~B3RCy`x81lx&b|Meeu6nyE>BO#)Xw7u!Db!zH8OyZtBn1}(UOd!1iR3(S*L&5`A+sd z`@A*RzKuIBwkLn*b3RdAV)XY8%iUhVagOiO3ll$i%<0)@Prv`>4gQ+ZKWwRF{bHPV z3B0W+#)f3TL33`7@1L)6pvM6RrL&vd-#>BjdH@FnamLc`68ul3jWRM0^x{_V9DIC_ zg8uhvSEpO**n61Wt!svx3%b!19i7H~4X!t2O6r!Tt9c4Wz!accTYv~v1}qloG`WX< zoFZ>WObQp9p4P*wM%(=B2kXl)sYA6&}S7i8%Lb>1hGc za$~dpr)K7VM1eK_`R=abcEug|w^M2EBUs&n{O$nZ;5S4+8VR0ebb{-^33iVasCNqX1oBb^_J7`>5ZW@-iy+x zNR|w%rUzl8UFJ;XKJh+O^dYIQ!M$(3@o;+h4+0P>-2#v_x*>9oOXud? zWa%SPla46xor|Z5(He3v1~i5+)5`txy1g%UrN8q@wiN|!y2{08yK$228-ZqWO$L+Z z4@+c3A9z}~M52(`c52+A{IN0qQW3()?@u_CIb0A7n4=z;g7vELtrz6AzSqz7;B(d~iOw)w!$i~rW%qIfKs zdEeu6_-LVR7hk7DR(ahQ30O>hl`FQqgy0EVZo@==4<$OPC0zo}?bY5Ve)#O5F>x8M z{8%!Bj^@Ah5^ne=Nfi&Xo6bp`Kc)n{W!8LVAG*)y3H=~*=ORD-Igdsw|A5J=mlf`e`LaxFo}TF= zKF6)nfY+dxaEU=ue@*m5&k)xL(gW>eu2rVP`?;Ov@&nKxyO|4xZ<` z2Efl*BTL^ssLja71w|@kT8+KDo0XmBvV^M5AViCMPJWl;nWX(HZqbI~s+PLUSL2c; z^FZ1eNF9le$=CiWOaP}fi^T7b)SF{ndUe- zwHB^Hm}rWYe$hXQ2dMxygON@b_SYluIx*V5U~YAHQDqyl!KY@9q6-~FcO8xO6QHH_ z2$oP%4Vk7XYgy%l$CF;!z5V`e(9$tcV5&!$YT}xUMTa%%%^r9GIz=if7ZYu*S*{KE zO%iWW-QSf)Cr&;(pc}%G7x-U9zD$ML)6Z&HbZ+)#SIA9L-C|xItDICPPkij5!P8DQ z2(x3r%V7DFCALPA<4kEH7c8n3yf&9>6kktu>q*Q5&X{dx+* z)$>3ViOIr=0*dhJRGldz=I%uB#X$kz~xb0J9ILU-@dM+v;fMlp7U&`6#`@I!}I30tUeA7LAy`_;ywWUN94Dis% zkN3iLgKb0Oe}s89-D2;03d)c#G9|aHgq+M+NH5D{c=7_n7;#_hIUHW99SeT~t4V1Tl(cCfLj-xCzS}|pHvO@vcB8JTY0s92;BabWuvns+u&t#y?Sh$ zfbs1K%l4pT47``LtaXIXJIiIPLUU7P+UK34|4qQbV5?J|y}@An`!|*bT@VU6;B#W! zM%q!e_xk+1S_^ePFCW1zBNl}>pcPDL-9K1lXnr%&bv?EV_MVyp=HbAmNfRdAyeHyAk<1{U2&4j zIX}Qk?_#LL#qc_pGS7Q`&4rs$$+pMh8OF;j`XaR;moVyctOc|JHJ@h@&QAV!Su5V8 zNtHk5{%YlM*1Ak&=25^iD~(dH4p(2{bH}3-ZVBZ)WP|8Q0O{i8w9M0+lVwR9~kl7GpD=4K{|4a*={ zz7%o3{K-_h=k!Ar!N-S&&{odtQIUfD!Bc+e1DsdQ=F-B5npg!{GGop(btLmI_1fQN zrCInQ(BW&Pw)DPP(LYbC;*AbUia|J|qO3jZV)-Kk(+}HYVIy{R3~dkxBMvdgCE5Th z%Nm7^Sl8Jz*gMgD%Oob`RUi1&wTN!E_tGa9s@8@o*IMx4Xo;>yh+s}L{={VLM=R_{n@z3hj$VYw<@n(tHW8jl}hCmf(3i6W?> zDJcGSk9Qbh4{_POwXx_kc$-Wmw4(tWCWx;R7)C)4VcFHI(j1wfu(Ix7g*ET9c8Y>8 zefP5Z1bFe_WzYvJQ0~ZvQr~U#oM&v(yhfs?$wX^%__66$9ot%$X`aP+lIkipY*Fl} zQvWxmpc?wc1i9L5(ArdvDZ*vyjCR-01PtvZ2oxE7YPGStm`Uh0BGy+)?^+xm?V;s_ zJ>S@yHO;8ZcQSVugjTe+S+rF=f@W-$x!y#HHi{}#)buFSq~^wnc|afddjJE%`gTmU|^ z%0Xtl7$!16(Rjo7l0>zT#A@|V4KSa2n(nUg_~M%Q(rx9wS3(W%HE*1L3}n4Lf~Di4 z`5CmaX^qT>1;(T;_Mg-qMRm0{jRWU2Dcy%>kc+tcoTtsV-1te(`k zC?GITA>8BCBz5%tSypVB2wF%K;na9zq~e+6E9F)*LH%s-+EUR}^|Q#IyLk_vBXfJn z5FlPj)mS;Sv6MKtu|!DN_&gXWP(_#G1v3XKnQdpg-51dpfYkXa?-t(v#VF_n5@4QY zW&G)1KT`1%?eRI7fVz9A0<-G=nU^gSsHujg2Dbm5$gp?*vp=r>>e;8qP-PVr1IbI5 zRxE*d<-Pm#3YPLg9~NUa);1k2EG%5Q183J(OL+XSic`G;4Gj%VCU2e0rJF7&x>-W@ zZLdnCEUB)ZkY|}x|wbjd^ z{vUfTFIKn#><*xnY60-?sGw5IuL?2ncv&~ye0@)k`}c=e-xzpxn1q1OXDi9^V@K%H zB*3FR+*d+-7MkNF7gzYbHr4zm4E*@l%cjOVfFmBE_NUmIa=}X-rm5j!VXGa~IdGbx zrKX{<_cXG+&*nbZ7f1q>5MZa}C#Sg8GC6T9klhe zX1%r&-ep^~@leMm5Bc^ss#@@)%i4+jV8DkBALGTGkz!&GJ~27{tj&AGX%sWOv4$?1 ztKv+}e|wb<0eAqP3-Am=>~cM`O?G)M=G*mdPoWbiQ>Tx%*!lMI8_|kGF8*y5GVeBO z2OyXIJF1Oql!=!}WqOBSa;D@Op+)qlz|7LopYe=??cfSgo@WnFF52f|X0y9&*2au( zf}7%$EGfCQ7s}c}vPVZZ(~TT@v zAGzwidDa$G=~=)BG3zS?(+J!4u4k28#JV}P4py`CP&wVrlS9k%>Jr50l~0qb(uNWE zRf0AZbW2p_)L=FLHclfiTU{T6XHw7O!daAn7ZYI8i9asKiZ&>v1%W4xL&_d(jIm7^ zH+UJMQ9V?Y!BbxJJI53K3suxT*rPVu**! zf|*r$q3PFiQw@qR*7hCBiXl9Qr=@x_OsYZJdgZQM#ac!l@}J(1mE=xrbdd7$O!lc| zA=1p~fLRIX9Ff1py7+iPj2EXqs~6wP2`YW}u~=R|;gwBVP-@>R%ypW+S$k(I594*h z{(Lr4%1?E^n~eGI(rmC32FC1sAJY*OE}tC*$`_^l?bjNW7qJr-#Ue*wce?}ct@$FW zLpB}#TSn^j9@$QHW=*hmA+5`2MaO`xi!Brh;F67Ibrp$oQB9bMmDtdzC}oI{wOCpB z?4h-x+=cEm0;L!W(B&_p*dG94K0!UO97>0nw5^-*6!^Ix5PB`$P z%()tCdtoSfV2||&VXO8u!Sa!!XZ9OX?{p)y{H+5#J0gH)hB#Ec?ZsYB`7w21K=#M# zl-kagj~CbvRV$?C4TsSUx$7;2<3Qbsnk5J5L7bS|x*ts(Lni86ofO@9Y`fTBPHw`c z{e_3>1F0U!AtwrI`yu1W=_vg0U%bLToT)Nh+$Id3?PuVZP@|0V~yO zZXlT%PU6c7xqu$(=h*ZhjC3JR;;;Kp%@!6ei=-+0bjV?SfQ;>HE?wmknqX<(VTL-f zFG5lyEHxZ(gXoWVSt_{|RBsF4+u3KAIaG*g58C6RWg^#K2>89`(Ob=YGKA2l)j;SG zCY%GpQl5kFlE{%u_^0X4)F5i*rDZ z>As7DN~`rCN5%BIgih{qL+p&E#z|`A@@WPGa0M9MgVyT#TsHAF;K^qLPA(mwoLPLE z*xzB&hJX&PD#0R|wfdqR{q}mV=VuMNE-d8K;W1O^F!dFU4!TN3(vQ7SfxPB@gH^*g z_VaRcKm2p0SBCC2&KG}{&#mAm94}jjxVvMFd8yoQO)Z^>!PcGGVv5-+>X(Pl9~k4vhWD7P$gUdaG{{{p{U$q;4?;+!z4ehuc!p7!jA66*I^6j@{42n1CN>I%PT z?S3O4;^ilXBE(ddd~pEVYw8%Y#jNtS#i;zL&?kJIjA!^mT$2q(~Qa*HV?Uc+H5q6uxF~SI5&Vf#P3}s`nuj9-4S1giA^sQ z7}hcFVjU?o{SYoEMX6$q)jbn=!Xh1t|2hNAj&z_$k3;HqQqH}~mvU5XBRcdNi1{)T z?AaexJgTo|1;9szdzWpmNAYh4Enh*^hxBNAVl@DhzEh5(4p#}}UwJn=B4(spXra2{ ztPe1yTY84DAs2TBx+wReS``sO52fpaacHfxB(-&IBcZ<5x-m%U_Du{LV@ z*m&O9!#3beYpLEOtL(}wn~I-k&@=1l>RMw@Dc;tilS3Q6p5a*YS8=FL$W@g-$WI|I zOcd)LA}|DbmW~y_Q1B?ni9uczNX3-F006RZ*^>>>xeDp9Y-V9WG z`j9YFFM_12*L675lpgkpck*X`x=GY5IzV5tsc|b%>;z(C^!tmlA)^(9(!_jn;K!bo z!3^vgOcN@$#bq}vXYt!Sna@pT+m&P6=LgV^*FIIpIk59MM=u-RGX{y*gPi@V83N{> zRr40D8($qw#8!(`3860nx}fN9=L|hBjCl{b&(8so+j#6bLv2olYtg;2##kxXFBtO2 z3pP3W(SX0q;Ib`u6sP2BQATd>-IeIa9<(48pU*y%XEYE#_(s?tx#VC`ott&!D6AP9 zdM1c5o>{LA7w*&K*B`(_G9w-nJ)(~x(qghZZ$5;u@e+2xB7KYia3{I0KK7Tgh0GG7 zaYH97))myB1c$dKV+SR-@UpzTJ&sm^R}!t~-G&hlYZs~9O~JsWWt-Q}2#I#<=4@Ja zL*P#z zyih~mS#hV`RP~<-8JQTyS_)B|P(JnJjJ0hLqM4Me!efG&P_vV(ltDw7!MRzjtbp~D z78f>ltgz@f-B+|(bncF0vH0OR(UsZUl2^d)^8@xk9=FliTmxWRh zRNoQjrg$R;_1igE_tPfvx9C<*nDttvk?CH>AG1&QYG@+%U2B?aP1XUGG28)_4Nj_) z4ARcCjD^?VjRgGU>&b*gCX{r8NwMT~9*vTsq?AYgh#VMf+ci_BTdfXA}f#vru0me~0eC@N+p- zp@U!-`CO2|DF%u8ESux1*h#;b6Ie)uc0QdmRr3#Y*O+*hI^IWF619C za7#hu4CdwxSCkd@{KoTZhUbS|G71(N6{h`Yv~7ITL07edW|#fnfG=>@3ncSQ78Ryh zVF^?$MS@3(L>B@y4KEeGUBv$*MAmJtJb;GEwj;yD0Ku7V-V`S|I&x@5!hYSfvt{ZN z_|}w*ZzVR4Ze5P%8Zup%>;JJFR4i2i!NV}VoSGgh=Q**E>id~tG%iIH>p8*2Y=Fp} zx-{M&YQ)Ms)(MAFs>BDp3_Oj-DCX(k11s6_Ex7o6?GeQ**|#yv-K&1a7@8+wAFe2` z)iJq>@{WqiQcp=?=`^p-zz!<2FdrFel%-PAIeYwWR?+^xgg;|(^E@D z!Y}7ZDO-0_5moP5ffE8j$D``yGBzH)fUQK@Bn;-g9I5Detuppo&~WL~<*3i0^)FHQJDssktnAi^mi3hbKA1fc!*!;{b1Sz}+n{E?Qi=)fySIVc(pMgIXWx*`3K5?a6Zli94ps`H#UF1U5E6xzv zo~&8znf!$Ll;uOyaW2l*z@|j$9so03+IloM0jK37f~o~}eP5y(lvsGhu0k=5Xre<& zHKhcpAxB1*rrH5ew9QF06~m^XbE<1%-4qMMwc$mShZe#c9cm!w=qYA`&GX!Ri#}qm zOhS~8E_oPZ)Z26&YXgTx%NAYjm-7G-AVOARq0vk^U7!&K)^%*d7N1xeAY@%UPM3?47jy0!tSM}ywL zHM^-sB+MkHXjBnp_qnkU_8RZd87a~;@qR-~=JAo)7hXm+rTXdC5<4FEJEt}O>BEN)^<^GQ zW9<+xao^!bF?@|IfZp9ty%}A6@UboE%i10O+eH#pP49ToGApvMCgU0X6Z0yi6~SIi z7^BtX+fkq}kGl5Zgj~VEJ{sPWDhiNTYiC2LE^B8mELT<4f_eqQBg?1SLkgv*{SBH@_MDb`R ztK6MaT{fMWruD*I*j^?f$IsV-fSeJ;Rvnl+*ghD=k3 zT=XOsvGX5a$@pAIuil}-njel8;rc3^>{3{KDZ}-)Ye6YJ1s>?uZ%vaE2GbFH3#5M* z9{x9|{ruOdS2@KpcH`iXrr)@B`4(W1t!c6UW*5|dhA#UmlV4oZhpAS2Z<0#%Bza^01jH`wvQzK#Xu!Plp9 zE~H07+1%bqz!h>qxCuvqXx{I6wj*56Uh&FR22Yvu4CtTC__HF>&>!FPZ45yBze;Ny=>tl;7$HDy60|NtWZA_UXOr zuAx)u+~Btsyy~lSEp6A_v|+(9wB*QEHn^X|Y_~&=dl)@kmH{oYL+xgSoJ<~nm5^FW z;2f#i{db?jS35@3-@V9@b-M|JmDUGO_4y-HWmn{3q_TNpe@)u_?t=w~o$P|87ECsT znYl7No~q1yaCY;e)>&}ag0&jTw$mWV!*!*HF)_+1(`iK1p)CFLf40 zrN*pZhn-TRl)C{+iofRRRVS!Yxoq&PQG79`zIyO|h)iXd0`Zb&)245LTcnPW+toyQ zY~I}m+@uTe8+%6G97Jl1+D*`56exqhAxR1o(JG%9S}JCEqu%t`?1h!cJ~xk|5G^wS zmHO8zLH;)uH^r;2!8Ds}%gWay%nOC9#*#VetaZ%bevpXkkZWdCD&w}F{iK4%C>*E4 z{_)`e0?IH?8|B>iA9Lt;;+c;$+}Gu!9xKn&h&C%B8Z&#<3pS~knbXCT!i`O5yW7fF zUtT2SdS72Xq&r4_!Hs4th|pXIG1l1rqD`rCMcKJ4@+&rP{lNi>8qm(&eLhE=f;}Y{5>VOi5&fWRmp-d*kUv3s+N*Qr z+u1NPXTx7jkMbF`81;SN&d%y=wuZyW2{(0Na&jxxnylk#N+kt{0`;~v)`H#Tu(U`a zv5ijs_@9*|c?BO54i+1gfMxtBVjp`*MxG=g*=YQ(J{MdgFr8hG7!n`zQx{W8G&Ys5 zqFQ@C&a1HbX3Gcwi%$xu@qODCSLb)gi@9n=EyeF;AzRC@*;i}}hFrjcjEcbv6Wc$ATnx-szVOtS&LpI} zx&H7wlX1NX;ndV-)s?k;kt=R)ur`?+pe6`gRj68H=A_hV@cV_b%YQ2=mTs8<5b592*d1o`mz>XYA zmk?c_Z5-z~pZ1Q-ay8@oLfOYYPAeMZ;Ly8Sn4y$Jl@rXscWy*Yaa#uba!p2wimk01 zSiy?l;uZ8xfk#gthg2&m#Zxcnp?a29e9omL#=O7h5ytcMT!*B>!1fOm10`4h<3|!x zr?=aT#2OAHS}}m?>UDa^V5vQAA|!z^Df|#FnHmu6DOwel7YybZW(d`}_-CmYUn`Kl zjKM3;+vom8Kav)%969cTHfa+MtD8$qFDx|I5l$SDiRIS2H5pfL8#w=dBx|I}XP&@u zOM^hsoCnYbN(y&%d-kkBIr`}ID`8=R9P!q^-cQzrEgEVAsqZ}P3VqXy!X=9`#>8_j zChKgcS4O^Uyq^5G^g6V3+XuK%b3!GQ3MAf{gBublxXv}Y%qd&s+P+BIdnByt+d ztr|6%s7W@zyO|1B4hp_u(5)Sz%#-rzwtkyYICj2f3-GbK?W(Iks&C&SA#4BcR5KLb z+LfGQ*7@RPcaLK2Vpx4}9X~)blvu-k7kOpf6kwV+R`XYxjL%9KY;>sgl9_;D!ynot z z0AUTdp3<|qvA7`~D-Hha*w1Z3Ew#q$SFDN{t0-dLhnolbI>^F6G99OxTh=1krsAF~ zte`~h^m<7`Jghib8mY=w72b7IAnVxN3IusqB`&t=Y`i^t@gKwpm>n1koG(!GtsD?D z+Hh98Ik*AfFBvoQ2S4@I#)d(D^GiJ)J?5ekE*BZ*F~!5mg09^MBm4= z^~IbF{#u5Fv0+xOK-ABzt+TOz*G&p}-Na--PZ8VVbj51@CT!UF=G=-~^6@uaOWkiE zQu6cm$*oO8#*Iv-+7fsy7a0T>8%LZBJ*f+1BY0W0+vy=t#jQhYUE8D|TB_oFEhFfI>sYLg9SF~M=L`?AW@70+kmPEk&vWr5*9 z^C&t7n#PdmxO>isi@eXkZsFWWGfrXO26s(xGpOl zGigMC9cKS_y>Z5dv7uP!QMlyR9pIeFr^QTz(WWvth>@^jj6Upw5__SO@H(+t^5#%vp&~+)p@hsTqD-e02~p;mkae}DJ(U8}X;uXotbeumF8>}T)eEq_gNFX>@Y0s?})QdchB zARr*>ARyQoMZ63A{@I)wL0!x+&cn%E1NFUW6@z7E=Wl;>tJ~{V$Hn3Mg8c={jw5{~MQ!7g zjGwxi7qZY;qtRq}$sLb6AG9P2emUN2NPwX(Pu03hcwyx;N%PG`k}@IlaK>KB(hLHX zgOTJ@skI@`PCwGQ%y}~YDWRt>b|4>N8vA@CN8aJoYDy=wRgV}zGsk}o}jyzoh!u| z%|xFfYr_7h%16ccY{kr@#q2?vTQIi?E+dok&2{JA-g^3b?;` z^mt%D@1bKci~+2b3IDq-Tkc9&26h=t7F4p7bR)h;55l+Hi3-!Kssm= ze7z&;qIwIL@JWLQA|<6I2GVlF)DJyL^mv@_2qaMX&}!xFsz|XiNN`KMOZ(n#%rY^p zsYgsvB4`(@Yi!@-nVr`x`#hPX#10*QV3FtSIX)kI$6Z>a4T<<OK_D{2(6xZj=Vc@XWfc%)!Dm7eFc*QiK4NN3pX5D z%Wk4zf{ph}KdQ(bu1#PVo!4-*WbPtpaV^lsuB|JG@K?2*K43@b57AM?e6JhW-8vQAhO7-`6{%pqqTbulxuI-~>{a zE+{(g80(ZaH)waJof?pQftnDt91@JUB*h}da>#T4#gJnsJSnJ-8$K=z-$5xZafO2I z(S<9=nd_fY?jk;R3by~1KO^kEOF8GstG3xWaaK_i^%hy}cUG=n9-qi=A4txf&P2Cm z&=&=`BF)gr8HJPRMw?))R+si+Im?ee1Uq1a#1xG1yMJ6b`WMgKryu`_^Coz_*kuPI zj}?aJ?O`~)yKBd5W?WweFW)WhwEJ_w-z3~-WVD_n_(q9mV0ib$xxa}0_3n8Jifo6w z#w56B1ip(t`g@c=XG}*-+#v){C&V)!ifosCf4=gIK*T;m!U;M?^?QFX@b^f>9U{B& zumQds21DT3kxNUjY^J~RVS&W9}kM37uUzh#Z3t4G>0K4EeWq4XlZRFX>V`u85`rwcb<s=qRj&6}1-+w;kjC-3zqC{A9EcB<~mzvD4GC@Ux`%Kethjp8L`OIsUh zUS1x9pHD^K)L3hpAKL9=G#}#r{rf5T`A2WmUbS;5ir9U-)z2Z@;k^kLZdH7z%oyU3 zts=C;hYAP~{sD$s!!Wv{dA!unXgeKk&!Q!T9~eUQrtHV8TXh}L3skM#M^PLSmH*>n z?CO(@DGiVGz^mub@qNJ_JxRrD+P3tUwy6_8DRGBccy1&Kkax5SV&E;s!zlN?SCB3! zhqT!$3W=B%(YC(r3JQ+^dU<{**$kq7_`0qemuJ*sYQ!aK8pfMoEiz|1M14BP6kc)Z{>o^g7HFQlT>hX>k$j1wV#BU9`3vEq~P7!_386h zaeNpI^$oD>n=zLR?z{XXfH|R=+7NU8eu6RdZn4PWqzAa~Mzer9$<{Y<;5M{NR212g zF&VtL?>3xZv__h=IWyxJ_AUX!7%;>*orVSX-B2(mepwCVZ;Rc|7z$ZO-5h*Ee7Z>uK`11zNx>&eb0Zb#xBf_41ySD`oexaer4i?er+|LN_E-0>C zy0O@YY)Wlf{1%arII1H22eiu<0%%=5H0lq)Qvv3ZcZ`!umhS3uP2Ljo$KP zG6D^QImi(L_*P^|5y(mXYAbiocvu7{QB955^R?>s7gG)%D~z_}fvA&5LdgZTyC47rE{KV)PtERDez+Vf zq!i`Ej$SUOVj76o`K+o&(!;7>^szv{1gYa`y|!=7H#qa?9}M=729x~w>ZCU`Nl{wk zq4P@I6wXaobwmNp*7&CWSikPz0kUE4;^#uVgJ z0A2ryVpiqK7Wge?^nvW`)v4mi)dAksFcd0hi2aFM3knmGHYMQRd-KEPmWXX;9S_1V z6@JU=^;jE`N200iCO9cqc*t{*siNIaB$qOKNKlY}Ypl(v4_N%ERN?$Oiyv|EzRbU& zdgN2r+xB_6nu`a0a<%GBxAV7~8%Q+ojB8HUGOt(eF z(R+3j@nt+cH-aY(rU5pgGeux7heN5s2!}n5;1CW)N zn3z9lXlHkZ4;7QU|K#=VW&W?#U9M5i3Z+ADNi>Tho#uw0HS>n-b2xulTbHVuwk{kt z7Tcw!Ge>*H*bEjy#;4P7w>+6@clRDm{=C&gBKufs*ep>f#ZBHtic4R`5(>qp562dU zG;Wq$F*i5&9Q-b&U0OzGF}osnvonCCBh2ct!oHL+D|xG36S7HOUS1ytZ)(BF zsExI=1sJNy4%N=e#T=A%N3~%WXEWq>pI#nwL57X0l69Op9CAa5!nkn1kgyDzVOGfa zLnEb-kkI5#G|Thpi~{P2z%!J_u#k4d%JlRH#?vu}*fS!EySlnoiVH{#Lx*yYASj74 zGc#jh=vYal;nnc;$Yi3>=F_s>n1%87H)-ETo$c1J>@c*ZSBxc$aAdz=RQ~masMVDM z=fh2Ge}NgC17XnB(-m*Z3M><-bfAa%zUs^BwmJNhH4cCKibotE>m4<-2QGnnvGP7e zlc<&i?-I9P*TbnX!x=+%D9YGo5B?d&woQ#3k$?XEms*@S-c2{*z31W~LQ~4cilUVh z`GPf*s1=qX@xL5Ca6QGEI}j_HhdqEN=R_d=luO9F63f)Pa<`56^UE~HfoT)x$&yeQ z6Vh9Gr4$DFl^Y)@nN?Y8NVu_`MDPN_9k`h_=XM_g#1Yt$z!W#5(NBmnv4VWcY*x|Z z1An;}8g_rw<>$0t4DJ5<)X(|zYQVci+sm)xxm|Y^xSq#Vl{g58EJHW*Zn0bDlNda= zqhA2;LLD5q4eK`Tt=JrJ$(&Xa&uusdKwS=QNZy<8Y>Efb3Sh03+ZT7qgaDxoZYyhE z!(9Z}0ZRjnOw&60N1V7Zkt7giBxQ%=DSQy#0-=IYo*BV4O^pdBBW6x)8Gf6r=%AcuvugjH zYVoFkXJ_@?$g&=_+x&fsWFGI?(wbSL4I_pw{9{4ZQ=Rkf@lRuOj4mFzN^DlTo4faq zTrm2pt35ue$C7+zHFlMSBRbr%87!m8eH zBYhM0bRz-IMn3Jsa~qIeTtF10fCos6g#peAAF9A}8%_prmW(qFACNi$Aay$JyG6j8 zgaMC418&o(Uc(2Zvj9kE4UTTB#BX6C7r4!p5{?f@2LX@{RSMz>(g@W-;H#l~4o@|f z_$$a#YXfb<@!>33@XGrCQs9V2nxXSA2oRoxnA+z1Q_FlcMIn24-A_rQD``CGSz4M= zljrWxx)eZjVymcsiY>(&Xj6$~Gyx1vwOEZUq{1vFOq5RjFjZ!8K*y5jNN%&)pBh^% z1KyFL*-g^Vl#+hn;_S0}3qGfz{3BZw;g@P7z5|7LE2}8hNHRA5aH{{hwgt9Q#i=nt z9f##O?0;mpV>oYY>?n?#&6$}$=Up$-+ zob~ds9~vYfUvxDzJjW^5WqRuH-qOZK%ueOy9`dz$k41~cXXD?<#VVt=0!_3$VDhW` zjWj=*?2jx)@6#{5WaeIcs*C)b_S2x52P)^b3V{A3#cW>A?x4Zn@QpZ61mb4iqy6*EwdTT{F&-+ zo%>G^xdH;>$Ogd!;yAP%Jdp#I3+*Dpb8%}FBO93PjXwE3TPL(Brhaxt>sou;5j;xq z1}KG;kNBxAG(PpH%txK`k6|uI)K(c!&|4kU`kr1Zc(pY==(vZA7*XS_Wt?V8O~_yQ~}EKJYHXh@%-Z(2~;1GC!a7DaJV zw!4a_Xiv4AEm*>5508opZqh!zR<Sat zH3A5iSz)wh(GykYq3ky@&S$Rg$F2VcCxQN38(+nv|8qe9e^g((j8jD!{a*q7FMY*^ z2iLxXP#{i#iu$h%`KJ~=1p2?nD;7`EbOi)&kzF#1cSO=WZRGg3R2+z(0fZP_bX2Q=d%8?oqvA%uiSv~UvTnQ zj`uG(`F|)lK{U=?y|IyRz^}nnV&obzv)DPoJt`GZ`wV7UM`i?9Kk*cNd82N)r7+BOJs^srInS}x8YAkq|B%XFp>_f?q!#I^Yinyg+>J{ z>@_F+GmGbES8u(Tc^P(Clt)(A#N>yYbhX*bgoK3eZ3(ZV3@Gyk$&9}sR>qCQ6($pT zma}T@qQJtU26op0vm>MHRDew}Of{&yFmNto6mv`XL1XJ=;aI;MaCnV-zsbJ^c9n6-HK6RB>|&%@M% zm96&O?lC0W$~K^ga;N}197*SV@Gp1#6J&-jFovKR_?wmTv$Ka^4Xjvv(-a+CK76&B zRJI^F=C+u$--v{+u%$cluE&{CiF)?+tWHPc?nLV@`_(pZZQ4#{XIU({-Wb9M9FpjqA##0{e4Ggpv$z1IW>-?o6o z@7kK0l5gLxYgX<~EG#M#vzN_}?J6xT-JLl6ijbbg+PzRft$044K6d!q`uN@V;j=C} zI{A(WCObrr^}$GCr_+t)qs_=bcl}z$4-*u|Y@kv=8)~*186NK0*Vh;1cjr7pm=G*; zmrP7dD1N}yMD|+8@j?ylXscxl+ltxQ*^*r8xQIBpC<%^F?fU<^gEvE!|FQ*K)h9D` zOZ)f!R(?Nl`L_YVqt!v)pApl%v0zl3QQUueSkJ=IjmHlw<`yg&5x-ep2aV;@UmE^3 zhi?XL|C+-$d9j}5{M+WSS&@cl@T?iEfd;Y_ zfh;E6(enYY62fEsP90CLIR)27(JX7A$pOs>iQv zuxZ-`5m?J0I~pIfl@D7YHVj$Ky-*y&*>v?a^h z@-`d+=z@90Gvj9GunuUDDaxVSRJpCvjD`cc5aNxLxY_wn%v+fS$@@Q5%!o!s=eCv> zVjb7%%j^TL$`#+ge{TrDo}v7G7QlztE|6J68<2+;bS(te!pH2aTz*?ZE`_nS9K+G0 zw?8y=@PnPsgP0I8M*qCxdGvb?4UJbz)=ctG;A2HXrZx>mp|ED1c7+Wj=Xbvt$W zrD=Vq@UM7tYPV7u?No+Hp-mzk$V*WLF0`O+TYrA3+up&!p>$+~H958`%L*mxs6|GR zjVvxNujzkve?_!oV{H6{Khvngq1iggRsjU{h}2zI}k3hez6s zC&c|G=0JZOq0`6lvpo00Xgl6_h4KswSjiU14o^tvUWdgzV>qPsyx`}GI03?vFj=Cr zFt%_lwBY?rZ*T9KqyV+X1GqY@Ir!Q1nu)sIb=fSK0BY5-AXRu!y#yN!`qv{(02BFT zzNndaFKEp_ujSXw9cej_8!F(8_rPi{ES?#Uxr+jGcRSO33b(mm0)1VQ@Qf32y@ zAEedbc|5Dk!~lkf-v!}8xMkp~=BqU;aFb1O0qh;#(HMaHt~|5{s4!%7Gh5w;-^W2O z8&kA;z_veb!0-rIzit+=qr=loKnNH@s3?sGTHU~$mTx8NI z3EHTy_M6^$o4?pksLYgTA_Z$D*7N~8Vba(f;_GZ;?dAA;_WjNNjlQOFBFy~cvaJ0=JF6HADcS;R&^h<;71d@EIu+!xte_k1&E_&quKRFIE97uG8HjU5}3SigW< z0hV^Xv%ursnSpngj!f>_{?c#BMhgIGSv8!+yE7<9^Y{(BP$6nh}LfXNnI zZ-2D?rQZ(mDzr!SpP0AE^q-i2>&9;@`De|WLHy5%{lBti-HiUhxvj>G;3mQ}tCUWy zI=-!9cF`H7bzc=;U5rWSLT4QN1yRwv0Q&4zXxf?*MG&vnV7o{?7L7(D5;NXi#+0L6 zL`XX1Xfu9?B0FH00oFdDM-Kj$7Et9!$5MoI1c$EPq8-l9etJw#_BZN)fCz>Li!58a z(TnNU_g!HZ_p!3v{u1RTM)=C*;?C>8x_;%~z;8`fp0wQ+iU+M>0A7gpTqoONL0j}E z#Sv=NHHwD)reHfBp9BXzX%|yuY{`SR!qgLxVe+`|V*iuVla)@|V9mA*|3nZhw|+bMbgS-cKJjnT+l>xL<^NYnC%jk8%*{Q# z>;8rHr-%9)Z&1BjGfv zYHCg%(M#HG=(zf`6EB!}kM0vQ`!u_DhH^LQ0aYCxx$_)c{`qM^(8gn)Xs~!5!B6Az zYJCs4{-oKOCDE=ZY(eMvF6B*4_kUUZX<4GBvwFw{S+*F!83%R`gC=Z#VookD*}{k8 zO?C0~9JEv9(o3Q{@{^9CTHoW@&_fCJxby9Ky9Ix@!doG*Zdao?Tin)t?My|#IzJ0PzvtoIWzrCW*#&Kax%}Yr2G02s7@7}HF z_V^M7icUlyd%Cjs_cJUolXAnjTdh@l|ADb z<>&ld6JN_e$tF-Q`)|sVNUICXcw_4 zy$R=uN!QxG{_4pHhu_C+j*|g zq&NPAe?nK0;OdXCu6I|MY0n4$3by1~!OYHI$lJRGu?P>drS$lO@r)j&3F1HPf2_l0 zJU8>0=J@aP9N^Fy?=>e~^LA__a731{%dnz>ZE}>Mv!%5j=j6Gck zsu{Nx%Nitg6}ekQ-Ob%5lzj5cKO1&1cO)Epzvm|#qv>Jvq3Yy@=q+*RraBNHf@uA% zt(I7nFW~0-J1@X>k>{QFafg-a+VGNsfiP7fJVK!dLYbGpLyr67#!i53K~^`Z@f2E} ziGezaw~G9p{#H%_iyr_C)F|{;`s)~vpJE*W%+mh9b>fKqTsq>^i8;jqN~I+URrO1) zvQIlNZV}9eCLv4#7gWSg^%<_#QpJ=Qrm@`8yfBZ8-=A~u_7tdj5WN%IczN4};^ksu zbUZKn3DT!y#Cl;SKT;igUQpyV#d6&GhRY-Y>2@(h7Hm+}ZPM!$p zJ3Avgo&%nMoL%;Ad3@_<5$uo_?6|&vyA5n847{Y%Y~z3axKO+RjFj}z-r*ZMd3-*)m}vz;lF`QM+^g?nB>nc$ z(b4TJ`07M>gSqYu1J(UtKPe?D(#(qp(6+ov-B;m9e&nqAyD8H+f&1|K6CL`y4+plG zsNKvjuwORuE(*2rH4as|&TsaXbE^g^%IO+ZeC|Ny1GUS3vp+}dORwJpI1S;=)2C&Z zVmQ;i&o@aF?|z?QlO*|Gc9v(REyGNF)uhRAtmOkU$wG2+a$Rd{Yhq6me{xNYVEoP7 zT9ZGvbPo|zTnQ`&yPGe*n~BQT|MawywXF{oJ8h*%hEP86NUGv`%vm>)6TXXDg|1E< z%1RN${Y1T=7ZyK$|MG&PG}nIgUBeaK5>FC-_H&-GSF;6Xk9aOp7xeBQ@9gYcqIIuU zXSqy-R6D~$o8;;8I8^4{7Ts@9(;bLc(rd{bxwe-=a_Q5vahoZ1nXjtE>G5!z5|O5F zqXkMD>IJXi;kH679d0kx+ndF?s3urY$rkNw+YcJt@Ia@JGxkJ2d#Joohu$JGF!Z}5 zc)bjpLc1yZAMZD)FbXu@PF=MrPf5v5FqX76nBveX75^;qgg;UB8;x>OVzpzgUe3)p zUoEjkMlGpz@ITE02K%r}MQf|HDBk(OC%)-a&LBp+o+qk!7-}YeUQ}2!oOx;AgT3aK zv`obDvzsXW9o#|`W_6vj5qG_N2W)`wsWlI){vUzHyMW?58V@MqjHIek*ncYLhDi|bQPo{r_KCYQrNEJsZc@`}v>ZA$?#F2v>PWc$ZYu@vTbZ+MYFxP0 zDEbpjBD?vZ>hvauA<`I=V5N4Yb9cfclZR<}$n?H_zg^C`UJW&-1LA2ik>>xy4=T|b zn0 zD=XnSd-q))(1gy)PCS{B`gI^`Y7KyxTg+lpRih_>4%@Rjh~u^Z;%VqsJgcGvyjC{S!?UiUo=t?V?Bqn zCkR0Ul@&^MMe=5n+#g|jL!GcJI85;;OMbelL9Qu(pnNPnj| z{`-NM8N7L=6u601&@cuUbUT-QGBiKLa(#_NMSfwIJCrACE@Yy`u20Jc9!LfD6*;eR zcX>NtA!sO7>oY!_mg62Hj#}(#P;44ob4etn&37@`coC$#iAAsmJQy8+T-Vb@=^*tw z0Bxa}FR*y{*)j7oNg>Ba#DY|49;BEXVu#MH*HuDQKw>^|tX<@W&uqRcKKC zoooDIwTMA#!0WEe{fBV!m-x+<;-eF6rkt<-^mj=dbs2Z`J8u;=?B~V|lqo9Dr3fJR zd1Sh&{F-Y#R6*H$+3+uvcz80!a_ti=QbYK7Sri|4yX;7iwVZybcL)I@p5#p$I$3?5 z`me4iV{XKPX6CKA&x4QO7a1!j?|U_cxZp8#9%Ky&Wg0MrfhMItTb3B@Vfwa}3nmKR zsTatQ{ge~80;E)8yn}%95<423%BoW1sbi{vI%ci-YO#SL$QN~}%2BY!uPt$&9fghEJ?gp0Tx1EU!LUo|tE zc|4?r0zcgBsq|`#YHbmZKR>|c#Ek4^Jfz7&CDxL7dEChUITW~!CUwnU9iD%(E}8|9 z#;>P@=g?6DSrFTpaU~bxCQY6SkQSQ4j_1JBR48K2pi$AmP1-weK-xcX{~?n9WO4Hz zH=|bmTiS>b(nM6shkTWwy<~m`-?cMJBz+Fkd@9sd?|6N=kwYwKwWGI3Z|z|wuZ5<= zL7~(+?dtptOE=*MJAlgFV`3)QPq`7a+V;W?uUz6f8b+DiKl6Hv0J*L%VAH=prIp@@(r< zg|S~gIcBW{Qk=i>d_W`jxMy>a`BU&a5pODlC34LTiILpbRKC7WLW1N-C6VW8-rwFr zk-Lt@$W5v*;E9mz2ih|g^L*vnt20;3I?C-+u0^W?qRS6A;l`c2#f%^#-Ayud`Y)#Z zR62Q10D6gfe`Kc{*t6#byu{7lntO9ee>-TFL(35OUNE{ok{BYj^?`kEhPS=BdI9NM?{a@)|i-T=falEm>Y$F`sgI31yiz));1}@7Co01}$Qlubo3axe z`gA!)@=p(`1#2jevvAlUgBNoTy$HjIVcwXiWjgoqiR#<=Sr}V|dME8-SzM0y8S<$u zX!431W~y4us2PYjqK~@ywRohB)5v}R!=UwI#lv28f}@4%`dK9G? zMT;GK%ebG^`5BxJljU z4L7#3BG)j#zC4x6EFI)IF`>EeE#^r_pObA|)TQJep&aG9Y2CW_lbH9ObLS_+(4metdr` zyLMbXMfU=RyaDDuHfGk!`(R~JHhMp-)Qh}UOyOAJGjFRdE<*L|jD>|!E)zKc@v;%; z`JXcA00ioJ`u%zP@yT6n*JGtuAf4v`A zKS77ZARE8)ff9^TiuwS(-Pcok6CE9avMALqbRqhIG*3Z#%8&I@>l>NqganSU4;A#x z*L56w9`r2s`SG+Gtw;0UnXIvEXfHqaxftdhDA(C)J#?qT=FO>bD-R*fJFUQn*z`~K z`H4lEYk+zJJdNay@x$s{F;wJ#IQic=+5*bxg_R|Ee&U7VVESFpmFORuc=q%Wo&_})`73zkG1>V2K+m_`(K{=I&2LmoVndoFDFK)jMR>3aQyy8O7GLtLzS89$M0SV zhOZ7yev@S2B5?+KqBqlD$-H6?5f67JR8H1BG*}&`LOFF!X#9YLAH7y;?JkHrZzOel zN*?qK1nXRbS(=%Vjh^23t?VsLozuPY0?7)>P{GS^fvA>!|o~u`_$lc9x zJfpc}b!k={{J=?zZ53DPLc0}%gzr(cC+#nuw|;gBCcFt51s6-*FvcEYB{&y#4~I(f zo_6yz*_Wbj&IeB&r@|&?ws1(<6H^$oASBS^B3zLkn57iQ>E6`|k%bm@|!BQ+-bKc1wT2un<7I2TAfEQY95FrAAkI9kkt30>l_`x^%wNKmm-<`gio(lMy*OcLTTm>MY@!LKim*J z3Y4#Cl~HE0m5LG^o2_^unwe?>wfIS(#7Cg(<h^Rx5g>m+zEWQ(`66co7!U(_vTJX+Gx+ zc57w>2PZD`{Xmd{oCyC>hYp(uvPDp29qk2=Sze&mdv0D6a)vehPMgUwUt1pS6CGf= z2BZVg`Os~(v|A6zc=CBk#!4A5)`em`*J3NwUg#GNhngiz)dslK*0m@1I>%4#w95 zLj2i*mLkP4(|&;lE~_kxs}xyT?{D_*R1ll?mg^TQ=IZ`L=t?HW{#JgSZr+pYN)7Y9 zZ&SEf&SM#5&f`$HuE_H2b?*vA_W63(mmUZb6kGWb7Zn*b5S_w<0f1OV{>W)a2o*Ah znMZm=B(6I$enNHb9{16tEEe*!ZMVWKu2M3He7u8lL(2~v^nET9G%S`6lIU_dX_FTO z;V5_AXAHkPQ+!I9*U&sVdVG-}wj|ZGF`gHkQ(O{@f)qpkMBV4Yf|E}J8j&7rqf$k5 zf&A+W+3#ecue-T~ciDVL>>e~hJbMSY>o47tiz8mwt6eSuhKc^#p12plzi~k(tfUX%RCFc=DQvOGhI9PefNf7;S~f6&;s!y zi!e)9pPcLP4UekzRaQ364|~?z3Z9b!%i-}c=uS>qu&1HEhDdogD4ixCGC;nF_V9z73eOCD2mP(DGN zsOfXfFK5~h1!(=tSCtPtOTszo8sH!KdZ5X4;v zzy{};XFha7XIFnjVN4jVp9kedL>pOp12I}f$Blpg6Y`RmXD!rIJDaZxPc98b)kaZb z5eL5ldmv}gZib+d3uZE^W0l?W(DP0eSJv44j)Y1Q$h`coBW{hfTjdM{P3581xKWhT z;!Q=XRYhNo6W&2y=OGKw|FsaKNGX_K?aY&y=DyQbUHPkudLR7!K9pPWma`q#zbIPM zLyt<(fOM4%5p=kx(01TU*-784M^D|xq+YAUthue7ZdeOwC?21uXV^)w)gCh22YEkKU*uz4KTa z2o4lvm3c{#o0nIbRXCqy{auRnL6~JO8&)P(5Qdp=)>#MYMG(8vUK5@!vxZ=zSq*Xp z{6y+!d$cRVb3pp+Z30|(s&?hoX)(_ELI-A>^{z$}sw>ji!+~d`u&YBOqnsY8G3h7N?R&ZTLn9oT2lgT4g6Tv#}PK$on zMZXmHwPn|qQ$zK3yF3S~g1yMNv%!yb=b`AXG=_tNJb?P|I!l=U`uGtC+v(xCk1Pc$ zNNtgKqCMx(=Q>R%qiVy?WS8rnl_e2`&gBQgYyD=Ej?~ zT`U|&-p3W~)YwNrK*ua~>4M_SM>-J4_uSpNuSHniWu3m_b^2xn$%Uuj?k8OKI3o)d zNR7g6Bwn7gyMYLvSQo`+<)bwga(46MW z>j&(K5FYN#s*My8a>cHoY9;wWgM;<*k2v(BIu^(z6(QIy5bU9k^YN|%dB%~#g$(4t zkU7uSAN0FR%h(u@c@w$)M`TBvlE{L!?x>wUT=@OG5VR;!K$5Ol;s(Gzi)8({7yT3xtKOBT*dUM0y!giai$E}JdAR57cCu)+iy3S)Sn2zuUuvqw>A9<&&tFjv~r9ly*DZD*vD(MZ?HNj(JAn4*xN+^N+ z9W_E?e!Lv*)5Ne`=XKGeeow`Y)8)0}jti|uY2Rf=r0&A$2-QvZp+PGRvw;nL=i=R` zwo%3`tb@uy+*+aL`_A@seRg5}xbDKpNcr@!&HyGnJyx%L#-hb>{A|0q zf?)r8?${5!OBQ-H=)14bM2nS6*$>aG&O7Y}g=i4RB%{p2p%@B53S?NYC~Fn&Wj5Vg zt~b)~eoZ}pc_g9ooQ7qNA!M%GbnU%|&+H9txB12%Ft}dHL2QKgtf+I{jf*!SPqhZY zdz6raC8fryMh^tCshy}VtwvE1;gpgRkpRSh$()#(;ZoBXR;oCEHtpW$r*^9K+LMc| zT4Nd@LuL#Xgnr3#C#CUwHp5uCDEh}k6Cl6~UcRiFY9OVWVX9=?m7F&bny8Wrg&~x2 zc92-kB5wWA>0{W7o#DaW2r&1PTJQk;3O1K(e{waSkeE+1T5WmZp*S&=@^L}>)!Uogva@BElx?+}Mdi0gcc!o;U$p><0 z`lJF`WJxtFGL)i*f`wW@>hYw~9q3H@Jpc_zo5!hwhF_uZ!E+8^!DrTPmzqN%;kxUN z{L8xgV;V)HJg})Y)C|L8W1JzDgBDgU8V66^?2D4y8Il~G%{dD6`13s|eiP)E2~TsY z4&`?mlw@$@J9@kB!dgIWl$hALAz3SDg`e?(IJNP6PnR;mxjOMcPZ!tdP84PwwP11^ z1QaY4Ao86waO33w5vOjiJ=8b;{WwUG=0SL{w`g^Mhbo!LSMa#l3;1eG$vWoVr!u~T zqGvD{sq@k(TI_w&lilYl&5nM+<9h7iju7kh2p<|$6f;9k@iIUdXP8T34pqz@@O zYg7|%-D%&<++L96+IIv+Jgt#v<#3LscpSX6aob+(q=Mikwcph7+zmz0#$zjXYN z+4)8YtJM(dbK^UIG*|6v=qm=vVo9|CDtyc*rW2HbU#u5r2oTjoz-Vhix~;q&h`gg&}?o9F5CSo(y`b3 z7{*uH)qkYNi-Eoivye43H17-o(piO_oH~WV9>SRW*46yYp5vMA+(n)39^Bd8_tqV@ z*WHK7XOch$!I%Kc7}i-CZTFZ@(0TC6og3m>kc^an@5baqm}t6$Rzau2$9(Y z-GAB4<{qT8x?t+690(al;{oHGa~(|ATo->pLB{IIGS*1PHzhNI}C6U$O>bGTs59;lwE~`H*yz5b`vtn2~E3YxIpit~jsBXCreNSS{7+JVHVh!qU zgK^GmV?3+AQMW&Nb-4i#N)AxWNY6pZ9SpDZ{_aJ9&~hz)gpJhr!n8x3S0;<4w0L!;s)G;E0 zB5uT9h_uABoO}qZ{?{6pCP1+&jxQ*xfR*mt$g8;5We`t6cZE@Uj}o3=42tIfi#}R% zZ*iCX;1ZzDbf#@8e&fX8?esSS(vZn<-*J!yMdUG{=y%A%u@O&+Yy^;|(yU;DYgSO$ z4oYB8&*qx~CjZ4WAP###TEggiKAcRU`1}qmCrcdB-g0`~R^~_N0@51i74g(s4HQ9j zE@m&X4L51>T7a|>XLdZNpqyq0E8X87s#xGA?Oie;&0gdMoVwa|Id73R;sVK7 z7RvoqUY=0S0`R}2Adr;G-1^&H{#rYjI?~z~OgH+o-2Ez0%IhocjM3b0dBjx7yF+?uZh4Z4ldP9_6a=~zLIwkslJKCxNs%-*Ee8|<{F z;w>q#Y_QzuA*nNmNe6MVNo8hbWbkV|;`d=4oky}ILxJDVkxsJ#rdHlkF~P&sOu*EP z%P(*?LhXQsfOfiCgR}&wGiYOmn-_{2#o`JHT=Bxc?;>Q#%v(~9eGL=f$zPqRT3YG> zM?2Hs`ucMJCqD)q>R_ns((^W0n-pXg>IX%fZ$r6hi=G$VMUe3;ePJ*^_MvNbsFwT* z4c8ZJA}H2D86s4YURnfsw`j|2txZB1`GGFJH(^I?ROS`MyDM3v_Ap=-m4y*^+SoK5I_)d(=x`wOXRboXeAF`cN383`{KXEv(uWU9_X%-^-~KMu z1J$11&GjUns&sEuQhA_ZRlqMi^O>pq@=&w>X>8}DyMrJ|-)D;igkBj-@{giAJLxR* zr$4!B7A;jG<`tgwYhQm3+73xXS~e-1zNpJp;Z&>!4RW|ktD1AZ(hHM@jcJ3>9IDi z_vJa;WtS?Xw)@gR51G#5#YgBvpDC#(QA;%r7muo;+D|tu(|%d~A?I;ebT*{6Uvidq zVQ)X$GH;v)Gg^e<_zF@T#yFv$KgA9y4LqK350{jZ9m%F%wh|W3yg+)&x%N`+yqa0j z;sMHnUi!Z0SQ2%L3Txxb-eA00BM*wMwAStuY^5h#E$4CHj~T1Qa0)LE$G8QFJ--j- z>x*Ex(Z_+~(~(f{F9_8^>c{sm?`qzVABC|5FvzeEN@W}R4fY?FKcO88?3&(XH&nA1 zDi7HrK~?D-lyX%rypakl0Y=tkAe20Jv`5>O_u7ToN;&t_V+H80W7;bX3UUv?%7l>X zY#3^f&9&KH=4<=yfQLUY$*$&SbD)BT{L@lf?fKEfsm!bbE@;(C4=TlDRwl_o{_@4o zlm|0odh`N)U^|nfFDIMByZIszpOzwa(;s|1N!@pT;JHEx6t`r8KxZ|7+-Bd3QIy+R z?2cmoW=*Q5L^TCUNj`6dZq-eTNryITa%9Bj{##wa46i)IU;K9<8FpMl1FVWVf0=w|8PEnf?Vu^QXH4F|oF>g~r zM_UMrjYEO0%&bKprlB&knB?;Jx6*;7I?LaKXHGE-IVbLk#X#@^!kXOy0lf!Kp*!s4 zUh?W)OhpcT0d-djU!dnxP?^oE*XxK)yXypr_r`BDB50tlVKTng>>IT6DR+Yf#yucE zvqV-d98^2{%pKIif(Q=Rz7(dbTQH#C|#Gq(; zQPh_Y*+j{}t`Tm|aO&nI4C1{Tb9-L_l=o3c=Fsv?_ayNYF5aBxhEj}Qh<1YqAlfpE z;-&>jke2<>zb3Xe=PoWd-=I+1@s>R~gJv@MIyU9hJ^8aWN36eDSXcl|ymRtg zk>df6${k0xOrD+h_*)yY&8P&fKz!77>f=sdCYFxA`!ZzUb0)RSqQ)7H=eqCid@Qh{ z=pbfC?Yfcy|q;>KSXCT#2R(;30Da~kh4NaB;6UK8X3xo>3r2eU_hv5 zW+gG2z*U>b1;NRcM76XMz|j5LP6ICjR)C9mWzfF9j`)*t>0psGu7Id~qd~t;9s#me zrE!dOF!x@_S4cTc>%9}#G7YizlbUmxED#X0#e#x+4Qs3ZYd2uC;(OcwM|;;E4P_dK zQ4Yolu@g>3PE=H^)FL}(w#%7NN+p$b+wCHfF_w|knAV_0TMU(PE4#*2a!D!56tlI_ zQj#vj8MneP#;v(A`}^8_qvGtJ`_Il_-g)@ALeg=lA>G(J7;}6dsZCC3k>%UX9 zC*2M5SPvY=TBCGv-*#V69apd^864bcQ{!IUT6Pn;#+(&{fEN?%5s}ji;ela$z4x*H zRJoU|s427_N4eg|SCG0V&VYXfjp@B;M(vpZ8e%0Sf_3;4h4QvfDCsMVLlPQ5geo`h z4eLtvhz+Jno6U;(&}owa>Whk2?Ao=}AA^oc!Q!IfI)}KW*-@+5PmpGj8r_Iy&9n9(K2CMMTkg6HJZ^&93!NqE&eHZNQ18aERPU8Z= zlWlw(cyLKzkfpV-3X_<@l}E2vgP+Rmzpf|(C#0)xHc#np(sP*Ho*+hp6~BW#4#ih4 zH|H0J0EnkOeq}^VlRv|cKZ{LYTl@m_}+#l%WdUHG$4!`oY}UA|hV$lmto$R-lzFX=FLyOt7_J%Mq3kc{={r zT!GXR3DpNdGPfNW^Lqephoquq%6Z*vDA?Tk328`I0p1iAuWhk%MP_CuFXv}1Ob9~^ zF82b<@^_c2E|yPBFgao-=}(h5M$0gG%-RSti4fJbXy2pc&fS|!A0AgTitvp;C2sGU zWh^4t0h>smq+a#dE(dC)L#)-e^6(0Cw*wHfWioMDdiY!MxvwGjsHe5L#Q*7~*6`*j zZ1ILl(0sB>K<<=kZJG&&8#6dd``agh<{=y2Uv|IZoIGSLT);YFz9OXNoSnt-MYRa7 zBIK^KQ4sakf%jXAD~ydtR%9=m1iY0FQp&{$N=YRE7X4{1G4AMaH@!9QfW2(6dN}m{ z!wBhK3pO>;%rSZtYzHgzRgQLHFT5yotn=&wa9Oq>1SQ+Iy$9-tgzmA3^Lcx0v9Wm5 zDI)ov;$&qS17pC;YKYZCLs>%D>}#9}36h=Wt(kCYl$Cv={KbzqTE*SA9D6)&bN$%? zy3|oF8y27Kz@_v9p73C)`ig)X=}N#NErH1eiI|C}%0xo?*F&6hD?R76uXm@4s*Ph2 zYl8<$l~Z!RaD9R(iPi?P43DwHRl~ZniVX2lx84Xn=!2>IPk{L)5}Igm&%T1->)46T z@L<(crq=Iep;zt(zb-w*v*n1l#GmS+-04{8CmQ7K51y;{Dg<)@FXL&8+502w>b(c5 zocpMctslnNNhUf|whq{2ozIY0aHJK8?@syy>(QAaN5tNUKF_xF7+nrd2XBD5nIEHF ze=G!6rOqyw)f7um7144L<5ZU4*Yk`OcYbx2T}bI$f;%?G9aVJAVJAMI zlr=Z|g3ZBL0H8TNyHcC*b@z=@1VT@xdPnKuc#ToWyjYBE@mspSG5tzk5oPBSKu}Pb z`J{NVN*=@fi_$=}+5i4?-GQ!s{OPOElvS`u8GLlt&dEJtvhN>*%WbaExQxUP#`WYt zp??i(j0)_Qn3+$SuYnw?b1B6$ly<1^L`wga({`XRf%1kA7X*8_J9!nNvrVH&DA6#G ze7}6=qvn?ZntQuGKzY{ZU84b6QQhr2eO&-jl4;sf`{*UQH-6Rz3*>wVwnd0t(Y>-zRx&biNhKKJLo&pG!w<9l99dF!Tqo9O81 zwyLU}(V?Sb?4YAtAG2`-xbsb5T_hbH!?x?EPoK9rt$f8DTijI0mn?No@!&k{Ub>(h{s@NygFc;I_mov-)Weo!p3>^g)3Y~P=J{$;o` z>N>AP@64O)0t!1%vVM5m9neiR{J?kUM#{(&;n(lazh>~^|6Mn&{OTJ!GcI2ut1uwX zrnstuI1q`4VY^&LyEZ@16EY0$;-MGXmnPg_|2?Z>psY;h<_BoqR%o5D;Ip73LA>ks z_kKjRjo`V;yP79+r>IuAwDZdA9(CStc_&@@-**c-%C1kDMt2xal0GvxU;E8mCTknX z^?gTaHl6;SXqKOu=&%<@ADNsL;!pOYl(j!%!g5buW?*vp+5SxK_}f&0|EkV@kxU8K z;;t|DA$jMV?X)Rt_tEyx5`*r;8U3INf84n+rwz@9UTz4Yg^6^Qb(I>rQ+bPNiwtKW^?!ftfrxK{#KkJe|;;r?#i?+brty5gdQ0_jTMlF;Y*8p8Rk- zSx&Js5AA-B{-hQo#oB^yLEBUYHQO7@K<)LP6rQ^nQ`qD(c=NE;z8k_fKeshRIisl` zO|Z@BCRnMf$Eq)Gf)+R!mMM?RYndy=3+vfl&5C<%aQxylJ!cgi zH2-$tMym~mGksHE6kpnWnR>~|>)qScr_fXD65|}>gt_zCs9VI@#M#7&(-S2wT`|R+c$E9ETdarFl96hpoOMgi$ zKd#_M;eoFS+pk4k@ZP^FOB+uh?WTw*pz&+y4kUCued(*16I9m%>%@{Uz+ zF`n+7Lc;Ayo!fk6*D&eU34v8#l}<;*#kPhz5zp*7fW4F z<+;82lUY+0AP8xTORAQdnsi6N^+vjN53kcPfU9-jZy)%hqoa?dpS#1@5xaiwdVLJ- z;jxfc{&aLobgE}g>fT;A+^PQ7qSb)uXLgFczMCr{W%`2NhP$y`Dm&jWGHKa5e%C$g zQRk!L`1+ZSymRD9$GSndG&4T~!^z0~|J{9dfboFfrUzOwWR+9xgUZFDzupw$8d9S? zQ}70^&0Uz>CInaCu%R1*07ZFoeNhZ5i2r@|4&6F>hK;OTN^2KuO89>T2}6tt)A|ub z?oOUV5M?cx8;Mx^!itl5745?z8)t}D{@zRt&y=dRRO+k6(lP$(K8(! zHf5Y`AnWDsNFUIY# zW;9GowbG;=g&Qdz>E1LIIJh@_i3tVoJfA0;G$KN)YR~2F7b7TKwE9Fy{y~mlXWV4n z3xnt-uWuaYiFL$0sgh!&)erZ8r=Ww!ewz{SqT~T4&Y&@}TQIT_y3|6s5K6BVtwPva z`XcgI6y$p9s7(n#M@$7@3vQai^w@WZP851N7!yX`SE7_08%9jDQgucTY~ZM~URFiPPf$e1kC7@jDJ?=tRS=eb|idPUbA~ z-0)EP?y`1o1m2#7^Tj$^_|^Tk0 zNUWnaN9?ba<2bGdpe5(FC9D`z(82qF)P3vr#Vix<@7vcvys}pD0#~i6da1Q@Jt#Tp zC$8}~Bt65H=WZkQwYNFVfpUE+@JFd71UcS>tH=4ClRUD-Ko9RepU1Zi{bRPY*!Ys3 zf%^JH9S#8qu{hZ6xUA<92T9rX4@>JZ<&AZWf!{v-2lk`vExSki#~@SQ!qfF2T6ga4 zimCHgNFy#8hQzV~^58pp*=H8s?{|deJSB~z-^&!&Fv#6BJY` z@Jojz^RmMsoA^7lnfu$9)Upuml=v|09A)|T%X6vd^DlG<0&|0$B1*1o$y`6V*4-!h z+??T5JpZ#sfWUK5T!g{HCffTJj(#nCr)X`7daEA2UtRi$+q^g9f2Vjcj)wFYvjPrC2Vl%lu{4!UZ(6HVu7D!l$^3J z6w~bgSX?0&lS7p{Lp>p^eTA225nYz>(Nms8dLQ~*Vdo|}$|Zr2nCk26xSz|FR!lUkRh8M*Bgse|z7?cu9W<%z#A*qqd5HYJosA=5Q}=g`#P7n6dyga$G|G6I0F!d>9C$$qJ{qJsRdzY8Q3VQqn>xkzzxRT$^6 z(qbtOvx0%u#xIZlR9zxX@3whr@Cval&~aphYV2quJ9+*#HLifPVx zYmK`DGUXw?NV_&XrDrCq+3~-{Dsl#mbLlfz`%|l_7~JIct3W=H0fXsMe|7iX5xMd3 zz{SN2GtAUA>`ty-nRnnlK-HyZ?XNCw#GE7>S*;I&==9Z)#>!9k0OC-%(zkmBa{>JT z-wi;pR`Gn_t*Lr3EP;WnfomQcvlnaTv_L$wL!UJQnU7m%^|8j)OATg?K$hxbjX>52 zWG&|UJ4BgE{wJNpwg>GkALj?wRw9n$O{1TEY?`Goo$@@>>8*kI zBEs|p`?3|s4`7t}fnI#uUw_3FSCaFN(${<}=sKzAlb@`u6$SCeWq-s1Sm9iN$hc1K z`Ll2c7HFQ71Xblrf(!;7g@PA0mi3FK|5zbl$w-17GPh>Tpu8VnCwdzH) zC*L>yewE~uCBAp5+nfus4ud%nzD-qc=Ucbrf>j^XBDFtYu9o?!nAr=Z|G*U6>vX?W z=3AV=+}~Qo3o1LjLt5on%7umLqsaV{5!pg+)NPO$;(trqSD~Xwk3z2SK3@F7+B|Nd zvw!F)^>kUh3;u78<)u^SpoHmy{cctKMlNtXZ``$w%rdw^N^HKP;k5vPQH(bZ&e;N7 z25#45T+2t=%MBn&JwqXX-&&LhBpQN&27e=`~zPVq*XJpLxHZ<#PZ z9sk3St2L%)PXAb@? zaZ3ZAxdN2dDxSm1A0uB=^#aAxK(Yp|IX?JfGHd3vz|k~HStF3S;NUO8{x3@)(w}7u zzAX4tKViqb))A^KNCo4-fWYi$sY9Sc(9zEJ!(WHb%{wkGF|ZtpJ}bAd4x{p)#$U|f12oI4^Zy5JulaXa>h=|mUpw2DSY^!4tK_rj;5Ng}8}tJAc)xMIK(bhxMl z+k$k9J3~ncIMtH#erHx*#UTQxN<1ndKIaOT@*V@&slv47lgdI17Fq{VhqOWB)LO;! zDqBA1?Ly8^o z3A(#HNzQFU;y+paG)sj)1oWa0#mQBRB!Pm&9a3ezreTTNjnLsGN5oN5h1< zD|^wcMWe*J5Rl7+kh43zvilSSa_Qf7TV-3v1lYKV7u0TFRNkU-R*4#rYpuzPdS$Jb z7b$~=$A5tRsBh1&xw8P4plS`|i!5u_+5Z31t{v0A6{jtXTYyWEfu|tsDdw^hf`c0r zkN)hrO004-jzL2E)D`CGGV%pT6!YUcxQOIR=;$NH)a!MPD~kq+NnV2EGnR8{WM{yp z7-g*r+eL(VZ|7}u66Q^G!A|G*Y!9cukm7BrHw#VX-`EP~b+1qLHuSYv%c} zX%m=cNATc{7eXeVO}5V_aP_*#WBfkZ^Y6(3C+@Z6wIIS0eVqqO zMhKJioWIsswx?r)X{S}tf*dZesYG5`D`D|gf|9U} za#J@2v=yCrm4%%@KOKp&qGF`j^DBA&ng{&hZj}k_J`NB4`5g{R1137SB@n{${kD~3 zBKQk1lg}M*r~ePMW~H(Qn~NRJ;Y?S4x(94DQP63-wRq&P5EHFcycC;2)!WWpZb}88@nu@;M{iQ

f3QBM&a=BE=;{ASl&xU`a4}h`^fHJ4sFOM;Y++33FLZA?HVWlOXst9y7z!_g*ZQQm2nxvB*@Re3l5ML zncd=6m52jyo1OPsS$2kv!-7CV`qfh_4+?1qzU&;Wi2c1|QG*u?+5)nYkciNgcGAx_ zw*m|a{7?SkSw%PL2r!^95yvd7x-C%+!?W$@^EiFRs3V=5-<#{X^Zj%wjDXcCjkE6C zUdHtJ@yUC4?)-ja*>FL^_p7zWcfT}#3EzEYj}X#fzTtibs%5IL!$RNshD)m(eHAZ1 zTz(<0H02QgUEvG5Vn@c#TffP8#W_{$EtOlKt>0XnJ35kVh}9+6UXB=Vvx;$`Y7vm1 z^b@sOS5y3ML9QO;C2_(kidSM;$2`TsFF8NxTZZ*dn^f{dFKR$n(M;WGrH{o-k2M!7 zdr`ldX3*~#eX1Br}y};U4|Zj z?=IF0i+u7racR5e?4eEpz-iJ*V*AR5s!?1a&||G0V-cHH7y z5(~jqw_kekFh9+(KCR2XurN8ns%=-6^=vgtY=DF!9Cwv1^_ymb=>xIJ1(>fRLtRoR zL%peCYyIlie+t!P{TY{}nYZcMBBq=(AW#atX|qaRE@j8iihi77 z`ReODfC)C4oI1El>AV|N@}zo>JX+<@Jzdl4Z`ZF9=ZO=2wQZHsSJw5sq^azHKFB-`i)&mIms#Hh zrL(2o-LvT4A|=HV0Oh8l?#axna_NO8a8?c<^;lO}zob?8-WYTXA>=&MDy1{ir-ZZK zTV6MOVB>I$yMvJ6MO_EE$-80tQhb>d?$&~085bO#+ z&)5+f)>er4l*=k&%Q%LX6y)Pjveam_hsJm^bToTsNTV%TPjakUbPz4 z>$&1aPFr6JnAKveHt1f3SGtR)hiN?-z?*){RWIm`r(wbv{{iNyoGZdkKrB-^#u@9O z+s69E^NGfb^a+q`vHQ8BiKS!Wvf}=B82s1H=Z>6cT(bUr4=%Y#uLdos+A?}`$=&%* z5sLVwN^PHt5*P!RCKc*Vr8tE zh5;)K+1oL=%40e3xMI9uXxGYyB9sMUf}=jNa|7CCw(OS(9{+#X=_%z|h9jem$+l+BsYjyuBhw-u|VE+^xOJ>CfzvwvWahNyxr6JwXY@SRB|40`NNMg zq385d-zCRMZb?Y(ztJDuo^r#|GQV~}ZbckgKLf1dlJ*Jq;@xMqNvQ*wn1OQ+d9F|H zdB%x8?_Q|~_JrTz)I7K^^})(9x#>$F1>fKe-2BlBi;=;waf@aNx5a~VDOZ=Z*7O8p zf(=SQGCRkk5-8`3k9PZUO>Mp0>N!CvCg3XZ=+yHz42_V#_#z;j(bLO>@^zeGNT) zD=n~;d))o)jHkWlf4gVn$_4-!+`iyt^1?G%FMZ8?_@lOObVf&mrkpx^0P9;OieHz9 zfAS0*j+o@j*_jp39@rO9d?mA(^lpENz?U5}4K(}>DKzkdEcOF{a zjsSu4J4Ti5t@Sav_5qF#&AZq@#!2Z;5Ji+WG)k^)#2S78^<`IX99$B}%)bl23iyi! zqTjwErn$t#0k^WbB)QHn94;k+2Q&iGFtS_T&wolQDFZQvc6EHyh2_ovqrE)|KsGVg z>{Ys(4PaD3Jmj+SGQ9m2-ZT`*w$|_k`2Y2YYd!wIBh=GxT=Phd`_~HBv$r6}yLb~5 zlJ)J2Oa~a(D}G4d7nyXCcYtZc9+psW)iSwF{2gTLtIn+uJ=f}L4Oi{sdgON2Hcrcc zDfM9{ECVJcDY^ZD`|GRO^72OVq^4XgsNJOzo7_%dJ|jrj>*YRRqn|F9Dy9?i@@<91 ztH4_t%(v0U^yG_>1y-J=>|^i`1@~^>E-j4|Eb29b&0LX2sCUv#!GUgX)5A7iICkO(40s+-;NR1bVuS#Bj$ReFfJ%#GVj#m6*JsZBGg z1{4oF=zqJVjKy4FBGs~LR{A-^+%Jskr;J}G-84O0Z)`MPABz4e?$C~j`}Ra@xI6@k z7!+%k8L*HO9kmOW$?z-|!sy{bbEgR}yQ_Y;1Si$t8)Xq8*E*Y~jQgp$BI97JNtN^r zDyq3^tmtB;L3t11Th7!F0i|5!7SH6F(C434NEC*QI&uo(V5#nJs$qv~+Rl6XG`;&g z;GeMNRH2MPH!(%h-odbDv$>&}!#FO!=*x9nA0cx_zZPdfta&P0*!r7piIGA=US&0W{jtR8_$5gnL*E9(yWUbARm zN;f9b*hoIn_m%L@dJvsD+uxCv^BKsMpw^xuL}Yqf>f3)d(TmELjW%jL-uQUvp{8%D zzw~H;;XBSqXSd@ZE69KPY0}H)s?%dKC!B926o^yNQ>o<)P1;R&LRp>? zrOaUUD%=KTU(Aq42CM>4kKrehXJm`5wm*GOPCaY*TarGR1A7HkPjGV-zRGxT0yV zqxWQ>K!YE6#HrPfI-(ywDa2po=VS=XB#AtzUTq4!TZv(t%yS>oiJa?hd2ZKWCc9y; zvc8oORr#U8=7ra@l3&AclIFW zaNcz1{>q^bEF#*6Qj&!Yb98e%zJ>E$J@!1h1NonyN+lf69_636$YzAGcRxU(kNm zbsNUwMh61?bzC==pRqp|%BkdeZk=-z%f>3;hl_yIp}WAg3VADi?6g@LqAwJ% zMG4Gw&^-#Dt7dr>J4TIHne9_DrK3;TP*?s&@>lra;NbVEr>cx~4xn{@PfDt*t1BcD zFqfwT`a8#+1|wjgSkrF|qxslqu%FI|WD}3sTaO5TPr-=-$5^h(g|Ej*9Y5~+$rg3% zsUdaZ;eyYbAC>&?e!+X%^v2PGq>z6*DL};Wn<`)GiRmA4+K)=bArOd-Xnx;IZS4YI z3LBT$CAglCT^cbp%B{;?TO&|WN_Jy&xRP?YRw*R$aq4-!VUVk zea$w9hI6GOBJ*X;DB`NMUWb^c>Zel7XQy0;`GBDEX2f5r?@=-*kCwLkBF01AV!Esp@aoxaM{F8*;~WX zX7vf0CTVtAvny=!4CjugO>MM@(e%aj?(K~+mQ>5bpEjc@%w^ND>l)~TlUS=6m`(YZ zj|58iB-L3#PFU(%I88`hxUuTpSJ967`@KunbEHf9;FNWqRnd83bL`q{5q$0Hazx$n zoQ|izUk;1<22^l5m2G!8Q75hJ+O_^^`!5;?Z8Q)(1P;bwz~OW0 z%PWf1*H1*I^NS3qq>f^k3z1F=MRhuxWAt2V3>!a_&g*`$>jx@5$9{>-=o|U65@r;< zl?KW>=HNw8u9B%SoY!wqHHWjvzOw*@mZrRGHASFsX@xM4v@3N*2Qz8s7_0BxgS$r( zNQ`t=iLR&M4n`Oi-U`x|#zu}Mc%Uf<^rL@ezqzi9HPT7n1}3wW)EUl6=LA)VMxovffv(rA84N1@HP7;&APv|kSTt|7GL-nXwlH*0BXD3!?VuBL2DB=ivD3jFjTGh0 zVez$8jVMDK0*9Vq&MZ8S1BK(VStkuU@|=1jBnB{|{v5ZjQoLg+Z_~*`ZL{+Ro{ZsQ z34E=ToHG;ewRHDZm>40Swi!r)p-+i3v!ClndBuCv9sBwQgwUQ=Y8=dtotPj%)?#+LsC2Au1d2Hb18{qMuu~YJf(F;Aaiq zmJ^_HErr3H6)?3X*l{z8x}1k8;t4J9VuD+2NSr*Jg@)O7d7|F1*#wKKKf|)f;%MJq z(t>Ab=3$?eonD`h4XD|Y(@a=zhzOBt7yW?^^@zFAFF91^|hyYhe7dbcL%tOhg#0joM$oPKA;N> zYHY-v)0l&?HH`8;%M=_(0`K3wr~RJij>CyeS>w`SW5a349it~KwTt~46N9kQA_K4e zhKio}UN8b8yw@}hG_yfI@TeN7iO8L@2}VinmvJ3;>kF^VJTc3+yY}?wA*CJ{tJ^fE zL9Lo{y4u8%2Qf$_;>WJ>02L<9PQ-N2l6p1EzyF>)0ibA((+Y zf$_1@B%W57N@ad4wdufA>)~$BKv!BMw?RZKhk0ttThif<@xcKF---Og5Fq9Z~_ zdK8k!Ya2P+X&T)|Z@1TQJa-_BD4R)2NzR9iHTIe!Xveefd7#8rP8fRx-_q(GHFjSv zmt0f&BT6LBNb?8PxJ>5L*%pf*t#txog>4o%{Etcu_L>l*wN}`hfDgU z_Dd;_nQ5XR)#JH+oivx3;Pk7R1t@#Vk_=SK!n%%NM3M{rRZE4V}s(v`KXx zhI1zpupN92Q4(q1Ld=s`i*^P7CtsLS`hR^8MMsTDoEYfu53Sa&cDOy$EJQhHAVvG? zJiVtxmCucgLnG$Ti{m)dn%tV2v6r z?F!hMUxb!XR%Z!6=bs897&FO%8ZvJE%*a96TQdz?r8*qlA~HVFEZBl|PitPZ)g;FY zaZ<4WXHnlv^{(74P*>WIRrwW`d@i3T;eb@sX^7>{G)Y14m-Pnc4RA zheo@2=hj9Y&~m?7T?BbXe3-V0&n?xEHe^}H>^CCOA#rD0A6wJtt=->7(@+hvxWaaW zA4QWi;UXCeD$01DredQ#M>)$V!$tYt)A1q39yQV?Oi;i9C9yQWj~$(iQRjs5V!eAm zFmZZ$l>a0aOnh#uJq?*sjUpWIb}OGzmzibVP;=lv20zJRks@wM_#U+9Sfl5~flHs6 z(jvCW4yR9dJ#5k!0u^^FF_ugAAYHJv-s-0;{k1oAl7y;&MpIEQ)EUCRU*3|xf_I6 z$h#0)wv+HK>+db$oE@GXFGam~ej67>{{GIA8+fsWW|qE6Y!!qTO478&v2rCEC)vL* zO4ACR!t(TVp>@3{szXR8lxU}DO$gHXkja#{UmF68Go6TV)Gn4+41OVN8tj}4oTp*I zb-=YHd7F;iu&s$2u^PaCVj6S%emp;m+}Zm$jkbqw&+8Huz|q&bLL!_+@QEgSv1pZI zeRNZ?LPc?o%autxoDdD0cS=5wi8h{PH@fL*e~);%yg#7Q_46gDhb8AwZ}@==DdX{N znP-7S2hvNV`8rZY+HA0FZPuLX@m$VwY24q`mVNyfd+nfXkYJw-T`Cl!7)SdAGLg$otYP zr>S1^qnNM=>$DEU%dJ2G(sZ+YDgLE7+`h7e*qo*C5Mf+AoiuLHzm;H+P4*7$n_;oR zK}DYp6+xNa(mefT{JZ`1P+DSg$)UP#FM1?hYL2LXi@n6V&P_pc9Qaf}!+l~{I{kY^3rpH(& z54i7K^AhNVO5GhCqO}Pq!FEs0z1CDnau9;6^H#HwTXCv>RBg^-qo(*`DNC|}0B3uq zMU{hnSCPAo6*axK{W>NR04;!D>|KWIEAiq>SVNtuFHBj~K-6}s6bNx6oht<%R=aL( zLYSah;)Gd!X zdG)I@N3(r877RTDQy&tUFt6`!SEJ6Jux2Zd^%6TeKTZw8m zsmQZ_e6l(Q+Nh^*H<$)7K`T+llcsP2ELz0IQWnLT`vh{Sj05=qZADn@I(_LrL-u|3 z0k)WQ5P)l!k+$z0_x|;W`&pg~@}+|=RFrwj1~QdOEOgf7;B#qwV=@gB)n zlZF}AOOYUQo9Kv#xp%ptUY&`Y>PCa`FTVJ-B563QN}?+!s=&gdu|LFwLN+GY(#QspLVh89nZq2w%*bnJ>_+Ei0WcRl^ciP zNZ&>ka2A;7wT6nRv~WcuvgCPr6SVy2bSP{nDKSkuliUjzai|SBN^aHJ=DY=TH}6@~ z{0f4qQ=>L`-|y6{u{*n;c9ub?qTF~ZT&}(xMW|4)Wd;v}zEI`t8G0EE07J0_$-O@p2-D4%);UmDl%L>swJicm@4%CEgsL77~@N zQDC!$97+4~t6k!)Vw%_MHeAWc=v;kL4$XD$VBBybr&cP#%7pl$D8}Hi6GfpTtO9*N z-@C6xr_E_r+>@sHx49V(_{0WQGIZ&{$ zGD;lMfpHPuW!1_YiFu|VZ|C)&4?#F;5*yAkROFKFK$}$Hynv(5v^I+k+PGbeTDZ~mWl5zL={&9~x&AHdDuron?ZYh=s8dT1W+&s{JV24yRg zfWU4@hFTpv#J@^vA{{(ob6{Z$TFc$667@zSvAQ}~+rob3#5GXcH0$lNLo+s&Q36qC zJgr1}x|m{*tfJjmk#rfs7|p@M?NwJk7K@lKY&bq9BzodTr4+N7uRK`TKSG0^0sl(7q!-3(5!$56UIq zrSoQ>OEVj2!>n0|l`wz=IPIUGn&*E!2To>)4it9iaKPPm2rX0apW4+ZJKrrYz@q5V zqIrLol#Rm!gSI}g3GLCi7V~g0$!`92W{}Pp^OOC~=zKp8@8%uSVlyIz53@>>2arTF6Y2ugM+Y}iF^A@r&)2I5QJ*Ijs(yDUCe3GApRr({4 zLj6txe2E8Mj->{AYq*n!oh_e)kA}3NRo$J{e8Bmf{B-3q>eN$94?Xjo^^(RwQZ)v?jR#LQQ)nM6y$ zK!*UNLO+uc3Fqoig{(-NkPR{?-xrXDsL4*fv5hcF%k@;viF*0XX5X0@^+M%@BEk5w zvC=?ARriZ(ss)O|{ZkONZ>TZ?LV)kh?0U|>b(?B1R(4{wLxuZAhCRMbSGFOwqMX^? zrWyo$ki0<@ZMDQ=XJt~qfT2yh3<()x$KzgHck{}Tz%thpqX-C0uD?6bN2l^2j%PdO zdRDdiQA!A;Ao1jcyWPHG>3HC=P4UOcA-2N}`G>0b2+8KNzoI#ZmpSqQE-geUe}8en z0g-X-$=2f0dn7BD4rR!#_#)Z<-+{HdqaLFEA%h*n&J!5?ts~XqqUc~ze?I{NRmkE< zeDg#^YYV75H!-p)<@<0>{A50*=M0hcYT9iz?<%92s89uIPh*KWu*@Oy5Ayez!Q**j z3fV?^@@L3_e6?nJ9H?)qr$UHeB3ZbwGOJ6ym>Qz~UR z6uDCgF3-k#PPR%m-@I_^=1_3ojF&6+M(M4Eno?OW{iyK}lsTlbaPKrLzv}mRjs6QF z+A2h>`!<+KGxDJYIW)~Ks_~&!&rEC3l%?^Gj&V&qzRmqclXr$q`;`>(M7~^GLi90F zw_Nm;N~G)!KEs&)Z=4GYOCWs=WWQEbB}3+Iem(0CK4J&%7^b#dl+bpeeUjMbY~^HT z^~#3gX^Goj*%fsRr&6oGy5KvcVv-ZS%GfLThND+$~ zHjY-q3HL}JCnhGr6uf#t!#tNcu;Wenw?_&nv30*bj;LEQY$9R59Z-GRG ztcRWGHxOuk6UeD{d|pP@(2Zc_%{Q-FX8x!6(iz|<566T!wn4WgQA>WjYIXUg;K_u_ zY*63~JP$k6ze}Lse%dWQ5}dwhL46e%09mY2km?N`7R}f;PrgDIOq0G~d7{&>R|)q# z$@WvxK}_jR8BpUe7v$l7fBx=QSt1LppD_4Kd^E zSZOi_VYk2kyN~nOOH)N*3;jxOEn?P^uXpjIosKOukt-clat%M(g}T2UGnSpk`v4l^ ziGotTmbso)Q_Tq({3P&lq)=dHe%a0RB~URRaR@iN3N*{8Ui4(%7_3dN(v(qiV~O_7 zR8h-pIf})rq!#nejnV zu8g@NI8424%xjN<_hM{}R0G?SxZe4DY&?$I z`VK6EmpLbgbp6?8>~icz+l+T~DK=%>r8N>-FTh%E+Eo^M=w7yssp>VaWXWwx48RG> z2TM)1ST5?Te~ne0wdI>@wNGIa_Og7Qjk2oql!R+D&OY(Ic+^;VTKPo_a)1Crbuj1+ zURRNKb3buNTg%;|GAD5KdInSkI~onk^gL}x-fp0fm}9)V%4m9aEqq?9^A~{byhD&d zR-w&Rkb-H_?{`%9=A01MgZ0qn+xmpg6rKyn6kOi8r(SiA&Qy3>LDU|qK)Xrg*yliJ ziJGediHSugENs-0rV;}46XGX`!N;0Tcw12nTQ6$AK~zt>K#(EM5Vb_(ux2vHbAmDF zG4rfd_F%RhIX^0miPq8Hh6yF;zX>cO;S)N-bY3{p3PkOx^0KOI zx2j?}iqf9jZ8ooizZc~i-Fk!C@+YpCi1>bIZTsJ$ zV5UsGLb046LHUQ5I8HlFKV4&vsg+C*Fbt492Bjyo7ya6%(An;{2PWPGzC16&Jd95~ zcKyh&pu!$)4S_0*O1?~gc;G1KshR{Nt-F7`zrx`U8GVD2?2i!m^sZT#;~<118xlPT zGpf8o$gEmm-1#ckF8&R6*6u9u^gOk$T`Y`BmxidziEANhUI|Eb2jEl|jR0~-6t+u^ Q4*XL+t92&rl}k<7#PPyMQ-20 zz`*Iiz&I3vdl>xXClh8U1_m~v-mP0Q2DgN7nHZXw%b99uY71){Yn$t7-VqkSz~J)o zl2_F|ElAc_~#~kZeSzf(iesdm^s=uVDZ4wUo z*446@jo8!~PmvMEeAemq>jPKS**rRD6GQQ2 zIMMW{+PAN-JX06Ez?kT{QP%$K$S~ca67~^`>GoGV9P!CaXR8G(uO$Ub(KQsftU6~2 zb{dqmyGVPdUvebtK9sW<$ZQ_a>p>hLKhRhVs>JWFk*jjzzsroi`doA;_dMLh?)1ANH6`=4aJjin`azXP+(Q43R&=a-3q-(YxMK#~t(N#mx&-FZ*YYE5z}YDJFym3aqQM zW|MuR=XF;LJ!)BT$!cw3#ac1!EpDGLHw6KuCq0`&=8QmvvtlMgG_iV?rL%WmM}=g& zUlnFVQ3U0nj315PqzYfzi6E~^=oeSJi4&I|klyxz5a~Tueh?LhPdTFdZX`zc-BMG} zM0W|(@&-osUHy%U@savV0#ebfFpn_neo~>@bJ1MgT-}VuB0^Zd(GJdTFqInh5r0T8P_`pN zKQ>LDrPepfnC{!?e&jPmSVCl_L^oy2+DQeodLW(;|79zIro%+5!~Ut;QV zs{3W3?8Ho?`RJ!=!ah&Eu#C*$u@|M41N{&2Q?D?S9~~@?WE{^O$va&iOPCp`JBX3y zaD}VHM08`FqTMb=+alsH*BZkOgi;naQO}1%b*sA7*PiI~7r-$-@Wt9L-mzsUd)SS| z)#Ot8MNyivHi>3@LD|-rz6;~m;{vtK)pdKvxkHWJ7&(!fhc@YL3BGDJR|A0H(!MA9 zNKz7m8T`h@!1U0=zy`lC!9Pmy4+8@$5^MV}I31CPwtpXrKwe}IeCLgU0mTr#ee&jD-kEyo-BADngs3$@5Vrb9QwZA(1=UGZ(;vCK=x_GEZ1lqNs+J4Ky z5g)_F?Vy5YV51oiaZcW`gOB{_AnY(U_S7+m($fP1+P)mx5W=Wvi&AlUOSqh5dU|n^(04{ z5S@6w{Q|R!iVFLu072Yn=CqL8-7(r4>qwR_cYQlm)x{y(iV(`8S2v z78NaZsrKsy=8iP4n@a9To%|%WHOnD!TDP%oU>t(UuVwN(o;7uje3wMJ&kkVMaImM0 z^xIz|pHVt-k0v`;RWn3Ytw?3CDdXedh1&=0E#n+;IlQ)ONDHVdEM`07ns!Ckx!YrE z=|>WA7Y)DVi57+fKG#M*EiBhgo=t<=%I5C?|F8b2{{poowUHC&WV0IcqZZak3^33@ z%_cI`ZD+88-YR!EZQJYqM(V_YW3ZJcGVTBKcK3CaLC3Ok)=_(8WFT-zwO8_TXxh#K z9WydpJ-$!c+r5Oc0jU?9PKrg-wh`!9d*346c31W_0#n1s?Qq~$kVMmVJLp)}*Gb_6 zn)_ob1!TlI2=foYXHmDEg*1nk?cS)BVb26Hg%9525JcU!5dm(;KSl3V7ErWM!GzeB zkxaYbI4xSAlwv!=zqEo-H5;}hZf@ZZGqXBTGS2y9gKgCh2c7Y^!NCNuc}fd> zZW{OjJzL={A_RW5r#K`})$;S;^$w@zrQX6h&JoU3{L*5wH2=^gaCF2r@6T~#d(UKEz{AFbV;HoDRnI@t`_=OCiF=M zBmA|_QpeZ)FY?l;4RM`JWa!kCj*d?6(o#-DRqoko0$4#o!6izslKOhtc;mT?*muZ+ zBoey|r`Zu?kK`O9mKNKi$i!rCm2Tm`)7nyLVyapJetPSN-ZK}3A&xKx>2Q@I%T^Eo zLPJAckt5N=qN1YGFfd>NfyNa9?+$D(bi#9O8dv|gKFe9$oo`2)l9Dn)%qWFK{t5&F z5oHu0(Zd%eRXRARogu_30l|T_Lt}FLdlth>Za1ch^ekHEj##|PWa-h-%$Il(<8KrtJjKF*&D@{V{C2mr!*O{~X^&^Pxdi zInc4VwQFcxq7cx!)hnWoDEsvU8V5QiwQMBycb}1eaXb!CRoiz3)tH`Oz@z}GhRwEz z?w8~Cn^w*Oc~+lWK*R0A0Nmdg%;w%6=Kew`L zJ3YEMzM&K8Rf&=-7#QSus0^*#;!%HAr9K? zN#cJ&4XhS>)`@aRCwU3AzhdKBGW499>TGR)ivgo1@N}nL`*}0`*v0^nK+uob52{Un zz560?Vb!tr5DZus{?Ws>p87yigxA2_qYQ|>U--imvH zggA%oj+rN#%Z-4%wP0IZM-2tU_W(IpkM28(=5jn>Z>e}gmVZg>_x))i(4In(ub0tW zmXU+@sF8jjJt&z!FMII%NwMSW7n*1;N5%r=J|EP88up(QpM}-GcX{=P(RSiVoac1d zTxyqHV%XG6$`hdcwcN7NsAv0$+voxPfov2u4>U7cE8>QHvrJI&V3TAi|H`A&iP@oS z&QpQ4I8)q2GL!qdB_j@o^0K;e>yMGVu-*lNqU1*_ek&92c^Pi(r`52#*jF4+M&L(W z--;?w9$2y$aiJ5X$@)DOX&u_NC7q87*%$XqTtu;$MpDw|8Z#OK?+NVq)G_gdeVy8g zhCV4zig`O*=$B?$>HB-0?h?+%2Frl3TiD@03CMacoZ}?3aqms z%&Q7@0EN(j04h{^hk5^KxBC&z0x^~TpE>9U{<6tp^w3BQSkXF_cWJAZk5L?(_Zt7B ztWr6ygQMwz0TCX-$^~Bb1AomU;#KL4TV3vb`K0}ZfqX237UY+=TB)&d8v%1Ys=-kT zmnn~<4OMS8ZaML{5bYs88lg>xtXPR5(*;<0%Cv??kKuZiVWu1>au_(taQ=FM63KM# zu`R?q*vT#Zt$_3vj(BW^Ce>rb135rIq|vRdo5hX?{ou1&N!?r(TJq-4b4repU{g0z zbyHvW(|N0qYPio}_T|3Nn^>Fk{3be`lM!}Kw5GN8PhafiP|!ReFYAKI-;no$$A$!q@&daug=OHCIu zzEM&HRlb!Kd*;D-7bqF*&6|+T{zT*PDA_COPO|pv?_LrfcA>GCZvnUr?MG&M6H`;y z3a2{ZRyS_k@JcngiN%fEv3@;%OjTK#ARF<?b;<#566EqA{s&;J-V9H=aYMu$m54fmCtJ)X4AM zKjl7#ss3GjVnMUn*a%A!-?O}5rrjz$=D9|Lcy9&P-{aKQ9l`(vUKWL5=+p zIR()YU2}50sLkXY$Q-1#h^w~EW}Ef@h8|cxj<22Q+p)~gAQ7EyzRL@PACFginPgw^ zbJTKdVWhAjam5*$+P@LT!*}xuv>K~v-A~V-H>qVT`Qp^(?cPk?!&upfm&W2&nn<|b04S8nZm6$Do&#Pj+R)5`T3xqEiF1UbGB2UN>JNOLO|Q)! z4bbTVFw)H+Kfl)}b{c~D0!l$Isho-$28ku1J=9*!C8)2;_yTSgtv8MaB;NypMAa(= zp@vW~Kt}@EjSA4v5q2ODb|nHd3A-p5lW%OYB5Htrb{=BtEo7j9`YNL+AaOr47SK?c zdLWR0O5O#Ae@Z@JMv#A=ydMDndGdaF;QoW_{V5FeA6y?GSpQ=34g=Zx@h>Ltmj~p( zB3{Mu(T{c*45MIAwsSr?m>_J;zLD!>U!lHCs?&;ix3|qIux=&rvX1H>y5)wq=F;7D zY!jinVY86+O%CRuk*zwp%f%}0LpFsqxW|+J6dXnF^yu5mHPb1tsZ!0jRPY?& z#sQA&_NPHU)9(-}X&m0^R3Lv+Yw0%P#eg-TSN}bqz0B`5;8m|5u!{f2$^jNrCo{QK zc!An6=W%r&uZ{}8_;Ke2F4xZFc;(yo*Ou5_yPZ#I>%H9V5}3l=7kOcPxC2WQ(^b4B zenYF5q9EkHf zpx*NiuuTvAT)w@}>_NC3u+kv!)ZW+cJPNAQ|IyN&sKd>=TFTPl>uX?+rl ztEzr%noUkjxK2(^-mRXng0Tb{-Bi*a8PI1-Ef7^L5)n3!QD;8%Fv36m(u^~LK*x^b$sH%)D!=Dbfr z@g!%RM783zt#Rwh7CV-af4tFIwH^iLv%;S|DKEo2dK0e_x5C5sl$*eH64Ro1x+V84 z$@8ZCU{wp4L_LuRYlmUl0#3?}BY4w;GG~xwOJU>csA)!uXj>gm1T#j;GvZhD_5})@PQfRQZ6!vOLJG#wg-48`PVFGaK_+w7MdmPS z>lpy0xLOCN#Jz>FUAKYV243_0sK6=I37AhdFmw2FLip|zd*4C=CKnm5;A*2bO=uS| z>-^z3d(?I>avM~sDj@!7CKv6%l8t|Z-h%=Fp8jciH*Ne=ZTM&2e|gtGpZ>cN^$*DQ zA;}hh_=nzmW7(E`{wIelq34b7j$&a`5-;g&YF}OZ=G<=hAZ99ntKhU{_UAAZ+<*tH zU*EvsQKa_?E`AxMu@u3kAjcxkiz3p$0NkD8@*~NB^Op*1IuKcN6Dwas4wBeE283K$ z4Wq{YpysR%pB!inD(0>IoDlpMKY(Dv@{}>R1q?OE3iJ!{tzmGPMmUYjnlCgljj*lN z&rJtzF5M4H;tJe-9wq_i&E679wf^ZRjE_J?(j+%T;z+Oh1|yswcf-L%WM1k*8sA%$1s$wgqBpi^l@Z>kBuSP-uExcLUjAl-}3{?Ef(=)H29uyg} z;;;Kl2~EZSpa}OxW!O_NCY)o+NxSOVi#^2BpyFTKjAl=Uj1Q>zM`{?LsrdH+f%La3 zy*;3UKkvr}6@LnL!{ogw-EO7?R(-DIQcx-X=(vi87&UUT8e&IHZ&R3W6ov(9%{rW5m$0XIe1Tv*u z7gfhwRs(9g#E;RI4BguZQYa_=szmfRfyWu>R5orQ@)P*i=mlg!s+$vVZA~KMv8nN#@&f1io;$2iNFsEt z99OnFn+tY?pkv)mhIL4%#6^_V=i`$Iyvd{RYWNMwsbGm7Cv$U>u0qFlEtBT6KB2`M z8yg<{glik?t1_KKA%&;Uz*X2rGpB;BGpT<|`B`!OjM>sqNU6t#`s#7&)2AOV3J-X{ zdL^(hBoN6C8_P_zv9>Px`c=?&eZ@*|ay$?kzY*Jw+|uC(77Ck`YF$~L2qMDuhY;W3 zWd35>N)7gP6iy^$)`FSE%t{p)YRAF-4w9{5$|y6`R}k6&mkgifn6{wzJ-&LVyv*#ohsCuy-~h$D{y>%#d%b*resAwj{eu~ zI(R5K-~$)FMT>0f64rrzk%9BXX3eG&QIm2_VD}moe-U9v9Cvo4_4YlOSjm8hDr;on zZPO}f0v3x4vBDKc+VV=a@EG;6iFwJL-b8}+lm#h4bGrntk=Qnav_#Q?BgLm8q3P

So zo=Q=uqbV_1W=k#C(uVq~j3*dNkgS3K{{C!N1|Nd;o0?-vA*ipu0Chx)tNLDOh?@im z;}WU{Xo%ZoFs6q>$+Ejj*xSQrU}>>;f`Jk0tBgW`oqvz#K*P>2gSdCuDtT99JE}we z_zHCW@>HhKuKKn|i_{kctSjb?P02)kHS#1F)8(jUM$~F71Iww)8#8|w#`h@+dH+8p zA26f;P{~48S1PNwEMX zY*m2#2%5`KUSN;BY&xiY3m-u2xy8L)}L=j%<>Km?HiX|Y;u z^>)?c;5#0?1DhCVU%Kq+?OxLY$}cYXAE5k$-A1bEKUKIVIrU^u4_G_1F)B4dj$Eot);Ca$sj@L9U-{=ND7jx;Mpag>hDy1&-VP zQi<;=l+=P~>JQ*NO?V5LjopQfU7j&oQcHvtg0-C$9>(-*%85@_1?{By-WIR-^_{(I zauGY1gp21xxb|T7h1}U}w%_9MNh$8_U7a?*WROujmaPouOPZOOxDXlGn|Y6|A9QOpzOBD!H`%kJ*c;McUWdT+zR_1h%v; zUob5Klb#F=43)}^KF|iNru4R?K)Kx9+*yt~_LPNB#3#MWEnp4{5oz*L16wJmwpLjYQTc30JKw4PeP4$P+EXy0*8|&QM>9hu$#nt+`tO;RYowYsa6r0 zDT*4Q%y5Lv0<-smJvaXMM-hn|qahkxg}RHMuftOVX*%xDF4@wDhL+jce&PsscL^Jf zbI;%1O9AnPhB{=tevx@$kH1ags&rPyZ4U8wn`ks7kMkyG53xDV0AkC(Hf|EE{_DlA z3=4^K=0bhh`1)_59s>mWKo7IlR6V%r`R+qiWJ{&Bw@x0L8((kABkrOeQp|p_?Ht&% zV7tQbjT>)v1*$9fK${qZxNfgADlL<{3_Ma2b`*XsyHb-4&AZb=0n%|Z=%C*DfB|y= z@dGitbZ*bkcRPtod`}9%Y^Y!QE@j?}lfa^YZXN6%`=W^F$QCaE5Ld6MyuY`}T?_}R z1yQtshYyW*u>(K^VH+N}fM#r_sZWa6)ujC=7;aHuIm3?D_TN)%4n#8;8j9u!1?(xHHyKQy9wzzsxWE>(m2 z_y$ZY1n^h*;EX65(fsdLyJx_SANy>sLcC{UEw;-U;oMx3x)G&gcVbg8(|I$s@R;*r zAX_2V*pBPM8iCdmByaDX*I_?%u*KvIz`rxB z!+Q+LC#<-Q%atLo_09Ub9uqY;(^Z-ycGi*lf7AuN4~*l}P_pu_`o7|MrbKiUroYu` zm+zU{@o*pSC;Y*|wIA-H$*J%F2PUO{^>e@RZM!3c2K08sND8d}87>}h3Q@Y6T7mtE^L~{&<&U9} z*vM0e9xu6kkr%SJw^tIV4qLD_H6=EJgWZ;irK6UV$+85bOMIA|MR3wtyX`^1Qm_-t z#i-e=VrXo-TMZY@4qe?4=?!~|P2M@>Sj#eUII_tNtEtvqP@RfE+WHbVCL5DqhX~oh zli&V83O68_7NNnxsOc>P&{GFZ^+-(k53dJ z7Uc;EXqF}Tf~0_fljQGB^jkIpeFao|IxhCnwp8|aPz2;N;s5&v-Lsi(!yw};KZyCn zL|Pg#KS4!TQH*<(r1dxs)~69X?6U$Q?{zP^N_gVCLT+p0DQi6^z`99f?ukizSoU1} zv)-Ji9)i#c$m)|z7Y^apluYpQb~cPE%XlY-Po*S|wsj@J!x|b)3J@FJli`XBh~(9C z9U&>=?0eP;?N!51Mo4e?H?;;dI?}z4iHC?CCpm^X_kpqFi{!+8Y{@`lAHh=4l7i9P z+b%npvF``O3yWk*Z-T=Jjcvw~`k0#JUaW_pF`%d?t`3wAk|C)5B61Y_KN~viqh!n3 z{Ue8kLY+6qiFLZKvwDipeY%~xO|7r6`Sb-EzJ*g^ZvO>2VhF=@TifDY zaZ69TezqeCuLSzHyBvdau0x!Pd*4Y?$4&%Yrgt?vbIhpZynNv!RorStqn|Msw^a~* z2U^1WrZcvFkIQEG7B896N}P@;eAb_1jfa?D2qFK2w;>mM-X(+>4~wA|BE$z*B!_`a zVV`2QBNI4BHkKgh&ZCA&6>gE98*>bD`)Equ$s7rb+VYaZ4Si#0*&ye>~ zE2xht;+BjR?0NsKAdcj*ug&?znd9d=3|@V}LNUZsmHDGX&4Kd+$cT*bbtLr6B^t;Mebu-YdVaNCM_Fdfb^>I8*rem2SMF|XT)`8`X{l9`L@8Hr=m~J#|9itO{bAF$=b?IT5<7(d4^|Om<2yNx)>+^C% zO2;?sYdI2L-TY(kur>nF>8^Xn_I6s=43<@wN85?*xNbB`2p#`zQ?OiMmo0Ah>G$2L z3R_$x?z(<8Y^Ere-8H<+GD|h-&;2XNrn^cHjj#{o638h)q! zbr4LpGnCk=O8bVe6Za|tfL^m!>>aZZ%!wonaDN-deuqd7yNyK%&sZ^@quF`027Jx^-+2r6rv2wxphpsexJwebQ9_V zAd%{S+01Sn8|*h zU8tm1?00&KwvufQIBlWCTF#*gmLZ z1Oys+8u**Je<&K4z!pQcj$w}GvsS>U`xLQ@6*8{?lyHmHpj&`Q4_X(;;NHpBwj<-87OIW|wFp;oqXr^q zq$_A058{Cu4W2-`fm;449fjBZ$4bAHRW_4*hMLn@C5X%HVdt2f>;lg9>(>+2<4N`@ zBa#`bAy$$oOwtc0UQ7hP@=0;fWh!r+uq)bPBXD>v)KUN<^A_sh;4t+RkMz825KCsX zT%?|H=FE}Aq$HNG7fNBIC;O;Hx6T*eG2r0akiy{rQxo5sI?v-c=O~2-%+heM`yv$% zDL1s&OZu6r7dbhOjE{?_MhAFw6)qj|i(P*GlWw08$w1Qdo0#zsSVT!bXo-(Jctyis z7=PKI`2!x+HABWW9TzAIZdte6(vAAg&NKE74$8Cx?q9j|entm3b+WhC2bsc0M-%Qx z;-?fq)lJsS^n+;<+KzlUyw?q)MIJOIzIoTb(29SjQD5>$E>uTnSO^c%l%yzr?NLGh zSI%hYnx(KrPO5VD#WH@L`}zzr)vl}GNVS_T64Imd$L}EL(8)5uL30M!0vSN+xUAeA zVeR_?Ne3SBc2Wt3hIH`)(lwrtd~xqEcG05Z18}!Tc?u8qNpio&4;X zP3$b_+zgxxtAkCu-c`%}GM7Yh4VVIw4##wnA2|I>B%yc(B#|iw;(FuiCX24GHtLMc zyYC|2eFLZx=?}b^iMD(nPCtPj#?A^kBS6{ERJ+ON8f3WHUCuC2__O0g_eKc6tBs-B z^hX!=BT-wYnqG>2;=1Z{!TJE9G{h@=-DITq9h5|Vw64@2-%0@PLI6L&43OLZHVoJ| zTnS2=lJ9z62@ZEN33+lBKf`2K$dS0Cdknxx^N5b@f#&ZLc%C}>jz5LYk=F2}NRBcR z*dnd4c@m?nR+OUAK+-MH7G)pv-`m*!$QNMFf7{a!498uW?;M0$s3XqGYWD{?6+!}E zuAE}Rc20)5IV-%4YG^Y3`U#^Z*|CE;l#*CaR=1b5ReoMUrf>;w6L0(s zI4ATLxS6_YY?qY%b`>SH2Yt}O0$w-2)x{4)@ABdX^N5h_xC+=5+sjJPgA#?+<9!dM z6i^%N-|_9pblBkED%)EJB!|<$>gsiGkH8Ej)U*} zjdwmqK!b*e)RBF0Y=_cBN`Zi8^;7{(vZVO^uJ;6C~40R*#Bg0pA4Ct{z=+d&GOAvowxH%_+g^@ zpA>=FL?2rY5+cYCtb&5nY^RyA%e|m3c$dTfdsXPW>ZD6ca>*ABe! zkDJMy00T_C#O#XN?UYoDZ^@y29Og+dk0_#kfLPgzeMaDGLVn*0j!WoA)tO?Ub>_NR ztOCbWQkD5Rz25f`aeEI)O*$s&YJe2>=_R6*A|UL;HOt^ebuCaeE~S=B4~&L zf^`L8SumA_iTjej(yjz&EM*esI#hAhGhyGk2nhKsVdLY!z!BC={7iGJZrHpClcup^{DEW1w_{EQl5>b#Wj{DzrGLQkzkb>yHtVhp0g8$v zbRDM|QK&YoN>J|B(j4n>bUKbu<#?>+LJN(oR|2T&NDFf6p;%K0o5!DDDCk;b*sMF= zrx+Y4J&|{(g!jjpd;MABIV~sefx!7UuIFE@@rHalQE&xp)qz05Wj?-F~#tgHm_S5c@g0{?Y-;@4b9_ zeL;0y)Fo|GHFXVhj~tuS+V%C-e>vw_HCUo(p>O_#XQQ+_ z_NeYhSBL8>qAaNNr;7z^O&1su(NI_*N_9&!6ePuXl#i!*g*svy#Tb$OgsNf(51Cxn z{N{-l78YiOmwSrkRQu)W`(y{s?*212ea5=xKD%F(KZjlz2fI3eBb!e07g`e?isu;6 zt&aG#^n=8{x#)9vZ01@zU7uV?!^zSWnB9k2aTR#&5&!PDPvOhg;xdWwpF6DnT(y%Hs&+iYe`8sDy?8TDFI16jvZ#7yGjfe&7znMGcg`jwv{SuiH~l!uZBo4`yNPD3)F?OkUx0?_v$_qU@`ct59gObs zkDKd@O>V}WvN!T?-jq(CZe!fsl+_W|3F5YR#9efyrWG5OwE@#6O-WjzH)u&Q8g*SY zA`svjqLSBLtf-!Qrro2pAK4Y_w&-2l+!qM+y!V5%nK&@-B~=w&8Z- zF&m^Rs%|(R4cB4J;@UX+H6q6BP|+c91I5pr{H&n`1!?M~qIh1n&4?7Lr6SA8;+9{q zENQXP%{Z3B8~k2!{Sv2bZ%YX`NSwX5A#L$k^0>Nk*{SETvGX>q22r!Cc?vrAMt50S zXR8<5;vXj|g^gy)CTp>C>yh_#GUqO7l(=3p>np2kXdn$>Q&+S6ei)`e{0#oO-(j#s@KwA_sXYr` z1yxgOw$6`W`ShybNBMG(`#;n2TR8tHk-r4{hW~-a_NnGt>76xw@&1Mvl+|&IM{#*J z*XA_7zBnOz4tS2n;zVm@)(NcSv&5tmZqBw=(zEK$=IDy9+Za$wp;8P3}_c$(H8j$=f6 z?t^nMiyCf*4%55@y8(oVjH%E)3atoisagVcf-8@LW7cnq#`Qrt0C7`L~U zhH}I5;DtB7hj6Bf^n38HY1o$E=#tH-MIK}J^Q=$Fefb7~B$V(6%vKD9k>tkqhX*s8 z-#`KjM&=5h3SZC|{r|^LXDkq1;9ybxJ@QCs&sPfdqvC-VB^N!ZI4@45l@cQD0Ek8R z46K~SnP+}+@jPbHAgc*ph)JQ{C!?(c;gxQIf~34gZ;6}Wm%{Z)6CzbrRl!w5plJvz zkh|U}(?mmk>2?-{a-tm(m0q*(? z$i~^#Kmb10+oY&|>?JuXerIQ=M)QaJ8X-nmc>UkJlI;4)+0;&}+4j0^dHX`MvPWyW zj>kvM&TsmJsmS^FqqKDut6zwJ;MMXXRPNP^+9N<$4w6`@uDE$m? z(Zp#kr1v>PIIfwgR4)nX)ZEYy0^!qUx1YhOE+9t|2N)f1W)s*{03*Y{pqzCfP{KQ^ zT3E@t!>rtN<|~CFYo%F}yrSE9O5Vi}pdcTuZ&3~ovM4fb(~EO^dsQcZrv(o=$~3*L zel@lg78Z8!j@1j(NJ{ycN;7^y_W2Q(S0O`({djV3wfctnGttf00iP{~-K*J(^7Y}e zLW$MLPX`TvbYhOA5J`QDg|N&rdid8H_}y>_$Om41t*13(UpCI0BnLt!-GFayuyxpU zJ5~~Oaus~n4pb$-24KyrDp9N4+i5;(I)=@W>9f|)XwhEjjREPBtajrNDnXh!!koF9 z8y0f71JZ4p-n`~)v6^{E5kO>AVM3imVuEHrI9gnnjC#+t->-5~7Id|@Q>7Fvwh{ZWE)TkrO5v8DwvcdYut9=Eyf2h)>PSrR#xG58 zH&SVy%Vn}tZZBOO-nk<;KiyT2e2s8zH_l@Xb(s1rDnqj|?O}m z=Y|6tkfv4%ocQoy(4l)(&DYSIZcx+LIX>ZG-yu2v#gE>DL*BI%G^EqilD;j|$X#Gf z$8{UmA4E5o^Utc8e!-!lZx_z}w)M@ZlLb&ZIG!0)DwO(sQQ2~<^!3r`4hECC)jmX4 zR#pcj6j6vMsGL&Ym<_DVMZ#mF5~zhWmsEi>GofNQ#)Zp61DKY|CIwcq4;@TJ@+Lls zR}@8h(be|*Ukb@BJ3hBe&xf7b=yI>W)MvIjn8Tptz2M8)kS$X~I*Jwl$%Ik$^)W@i zO}J*s*R8D*3&(W_cxk189aZ|OM1q4-31=FT=~$g-D4buPb{cpsEU=~tL&EU_NKR5c zJ|REy|sJ3L_+!tXKXrNuW4{PRgKZnELVuc-PoEbk|zV* z>eb<2y-!lbjnGHf zeHj6>A2A*n2KcG;5e0hF;e&8u`qH`&Vez{~NZ;g;Ad+CS7>j#!tUil0>>+=nw z{rz(>eIpAwJixO*>wW86r_Ew>T49nBKSergMu=G2CohmA@{4MvLawoXPBC?T{3*SPWkxf`rqfFC&X|VBnSc+!*<3vVd-XcRNq_7G zOG*U}JIKtYTWg)H=f5y*oh-ymg0!B&Ky|6M>)KWRbpTrmXS_^Y?dFEus7&%NBlP09 zur@MV)CdrrHtI{w*@Y)w-I&TTU7gHkXt@vgBD4S~aGXAw8mT~$$my?^^cL^IiAU#U zhvEW6t?$~=pI1lXS#%=^4em%V{=;X0VO;GX>a)0B!@s$v#SFVz!$n870kfHxW!~yp z71G__rA-By77h4{gKyNfIJ+IAx;79@-R*I7 z#c<7!0)}VLmw`;^RGgLvE3YOXvDvg3^N8zYc6Z^#y)dxz9afKfvX_sNw*}06K%%hL z*Vje0fPT#bODqUlstXE3=hW;+W2O_N9hu9b9h|r)Ga5=jYzyd~-`Xsjc&=__^~>7w zTxoXE`lJdw5+%4sqx}-e-aZ7whDP3j33ZX;lTMkn1?8N!YLx9|QC}7_u320Qoif9a z3Vk#iY>*<#cdV(Uh2mo2QlA$4;~29W5df;*fH`MH<{@OEDB}qfndBj^Rj-(n|JZv(f|YhDRNdN|J3tk2{>Jw8wiH>twolR_Q0%Z z%3k|ZsM%^f!wUyR0N34pq0 zZdT>QulQC*Wc0_XxftW7-_j6JTs$o}e-Y{S%UDCEY~59F0f6bAf{FT_r~mlP?q`4L zGj}Rp-%zf!Pmh;pwbFy}5Fy67Olzw}n-0eQnjavAJ%uChUzX%`uTMquZGpFpBa%q~ zU1m+sMQrj=)Ont|T5_X%xn{b(d&9Z{V@`B=?TavtBfDL!aK80;a&`^P?3T`jXzSt~ z1Po_;q`8c;JFV&Ip3AA!yuHfs7QWu96TxcdMT#_d|+a;HD~A=b=kMK48X`t^jOE8Gc@Cwlzj88bp5B3?0(Z8DZibKzbZ;pI!4H`!b?5%wGc*edc04h*((CH8}g zRg?TyU^gFq=RqADLINqQ$li)DjyRNN{LhHWE+XFjV#}WfrKKQE68~DqDT^@Ww=1bQlsha)yEpd?(*20P>sawp7`gQzk9tWnESMZY&M? zf%sc^03iKeAX6!bkHaO|$GYwBI{a(_%=Ig`#eZyNP6 z_N^)MND0_d@n`*RqK8d`9i&x;?;E!IErpet!{G10|4h#7YpMghfRn;#?e2tvve5}- zcJ_Wm(|3I=DV5MIqBxAxM6I6t8hA=Z99i&-2{^&Hb&knT7GfG#dyp=t4Q7BzU;-A)dl@}>n% zJC&MA6GSH`vrgpnztSjLUnBs6wRjeh?*-??k6=5& zf0-(RNc(p{_cTon%&?yFc_s%+=7Wq3vF z)lglQ`YwPAr>1DFy6C7?1t0L^Mv3CnQyfw9$n~0^Xo=Mu)y%%0=#7thg>Qzv+C%?} z`8g5C`eJs`8S8eV>@OZHZLjF=Y^7{-eY+J>y2_1f_K9`KV+}y)7Sx8R|#s_mjvHAGO>|qhRubh+O!aZV8AMgvgdbzN| zD@x_}E0nONjwCmAzXuVbSOiJp$`JH3>y>l0{1Fc7B*SmJomMA>^;0x~5yvM0KbN#S zf#w_E$!8yky;T_1Guyuu0;#$!2bTnyuR&Fk>7V}x4)XiL?;pCzd9;5|?~@5q>HjZF z?OSt(rQ7Z#Uqw(cs39QNC;G)t<BPr!@`+RS3tx`V9Gx4kl`gzy`0LXAbEbA><25D%af_Y%aU119qLb3G`)Og_YcQQ~ zyYr{b%8vKeZm!jq0{9O}w&O67PAXTocyIz~n_DIbru~?-l@jxC#J4MMGK|v|bl$Fj z`?6Tt*icLvzg$Ix_PSCfvx3vW)Kj$z)zD7=E zR}2|oJ(7dCbzbCdpLexl{O^-kxBIqp$AA4ab+D3=?BGu6Gb01)?Cfj{ z2u2AgM1_XXI05>ik(8W;53>D~7uCpm$#maKHg`pJM-ISi`3!-)H2@GDJ9FlYJd?8= z!E-Y#tca)^G@4M;ZZZ6Ho@rP0Ui0D?VL4?_Kaj#8#@E--~7wfR)p2hnjZ=SrPPZ+!CwKL5CY>drm z=4G!Y&Fa1Tm5aX?k>%4~V5&#Ka^RDf{ev3$r*isBbol1pe)60ASRAo2AJ>a4!Isi_ z^IUnj9K~&mq|HSuNkxfVt<>X>=j(+_K@blLG1g%>GG*QINZ2DXVBV)31Vgqx6kGp% zn&s$Em7g~h(jI(yYFaNyL2oq)D*DJ^DwP!{9YM`E4I?_&Zl*nrizsn1!w>cb#R3gL zmvCp=z#I;9hgFMe@3{J={WFVTii>71g8ZcUKAS4m+ZzgNwD*1CQeOo`n!IZv#l}t5 zrjz4>T0Ym>5N8n{NEnoj?>h8)DE8yd26Z4;bIX2?^4bJ-9z2k_t22IJ$r@kk_a;Iz zlV5;1Sj=UWb5BrQR0&!=RQyI!?NoEJvSQ;aU6Q!sk30TET;U7cF~DAKD;jRu#R)vX za?X6NZ(e@c$J1}tEmAFmhu~sZcB4=`S;N)uNjt3L+ygsOg5<9bLAr$#pdxak1F)*) zAMfFpWefUW-5{q=@a7&0nr=#U;t2eH@%plt7tQ*J@MrFyfuMeKdIMB)A`Ij{Y1UQ6 zmKC+AIk>IDi};zCq>ftvTJOOm7kh5?a4K^0tQSa@09ns6XWTHOGY+ZcrTw^j#t9~- zT$NTNsoRb@*WH6vU(CA@3euZf=i4=_`<~4MBhHS0eOa#nRQTRIE_-ot+V?)2=3-j~ zYTz{d#H(ggc3gOXqEa=D7S^c=|Q!e zGLP)S=@J6BybrsuE>Zv_IF=`avEx8qWX~GPLoI)b(uV+w$Kd*$l;QmFSMH7or@_V$OtZy zCdn!XvMMWNoZ;L6`E8zVw=n-oeOi-(@`*_*Jj z*IZAUcn`oFSzuSTbn0c?cz+1VkN*fg`tAcmvG(NFoxx)V3-o~OgfZ{Tt<7J1`jCo) zz5TVAlPx?n4U^4QL@L=l%_kn_n}U+tg2(7THy(wpXvAq=Tyt(?`er0v_WtP$I z`$Y19PTL%0R(FCFCG#c6mHEV`B2Xom2FU{X8wwit>uoUsc!;3eMZ@7>S3ANP@h_TKmGTQ0{>Jli|4+8y;*2d)OnAlWUN=*KG>=w{0ZuwLCnuO0v(r-U8PSu>-9ABxpL)cuFl`GSOgWvy%A`C|2n;(>@E3?o$jV0t83$*Vt!AZ` zLumE}sJtA_?y@)d1tw1tn+f-9eb*HNE1^O@DrRhzaFE)Jq{l&8*!!IRwMnyc%esO0 zq%s3Qw$1k#?$F&HpR;yI-UdWP;v#EMMe9J6cw{1r2vn*%M|RQj0&+WG0_X42I&$nj z`Y=%FxaN80#x*dezcf6iK@IRc z=K4xY5upc-lkF$f8f4jo8l1%^5X#T%^mSAfKhByd&hyLg2bIrPc&3XF3Fg%TSiA&E zt?wO6jmnOcq}==Xek9E!ncVExjHYt6{{NdV3jF=gyZwFxw^m_78nBRDvh({E_z`^xAxy$*J{r5~zP`HZ zdb{@qs1EOb2AtVB4KiZqnq|NVKs#Ws)zbC(v7J|egU{DN<)+u8`#GD>ewzMt-|>qt z_4j@Wy14J5**su@2I`#Wltdh=RTi>_7Yi7x)f#=pJNQ*}V;+U*>F@iI^l;s-_5QO= zG;4qZHF~SQw@K%5%>Q{N{Sa_)vg@08-Vv4`_y3%|-vaD>t}iJ6ab>w(=$6;L~+4{8WRggjTB9wYP(IHd9cIM$#7 znlZH$6MkC=>J5q~CG9Kt`GDPCqR-+{$Dvr)*He$&zj;&gQO3_hPd}a3=La^opScxp zK3@DtUhmP0Z#SOJD3Q;K+>~-MVE0>i`K2%+3N*f;x^?Y!q#og7kq*v>z{;@xM9`y- zcc$6bL{y(9KeF_@J1PFr6#c@GD$CP`$7O`q?f>`d$(7aX_gMiKZs_0Ci>U+-avuVA z4rJ!l|ND99?#W-b?|s{506ZY%!x`iAEen^WSw5NITvUAU__w|-Awu;z-Zc!bfeS*y zLQ-l9Uin$S6-k=?XvNoxd%zjfFq7xMfo%%OKC4$N3f}E}u6DidiL$)rCl9^|q;_Kv zu>1(VRX7VgFbfLx0NF;Mfo5lbHRXvzNlAap_y4{-;ds{G&u{bVtMjU698|vh`K#Uc zJHT)8$4SIN%@)Lz?OJ5 ze-?P$0+hKAtYCR`;tg=}(A2!BdPP&)Y`)YL#jE$`e?Du@zyH_O^-exM`=8ss=LAk; z9S#!|zFEjM^ZvhY+jp)^WjlY~?oR8}WA(t%;My<; z$LV=2ZNSq$dElb3GI!++OaDffPHu- zo#pUK4wQlsY8oE`=RU5v@9R3RbNQUhb>4SDS{lmitovE% z=;+v0RW9n#(J^+@(QSq>ZvjTW32us`qhr`+qokx|r=+apWbfpn>wMF~QrXhc(#6I? zNBIIB-MQz_^-Zh~>hG41EzK7?+8ppbB_(VdMLeRwUgzt>uAdake1~q~aQlMup`XWk z;%$zf8JK@-BPhT7{EiRr`ojCDMj!YO+h$;&io7Y%dczPPFxxVx{QBEomeJBP`Q_my zcF@Ld;!qsUAJgkP-pdwRB5V}ddyHOqf3^s^^+$gFP;ITW+XufEcE1)8q2QM%ULN0c zV4xb-g~jpK^&)192~?}mY%S$Y|MWcS$UN6@+GWK!2 zKR9X%=?u6Mwol~2V_uy8$Lx}@K>9OEE%F~G4Bw0)1C#3nGFVppU6$aH#!H_iGG1x$ zwL$|(prT7XcD2X=&5(RCzulHa~sp>F)*eBmjxI97Lmow%(-+qvob zew+}=^(OFf=c?PB_^0u?fwe?E{-4>Bp*?r#{l-PCY@`t_QptCooEIK{I)LAKEmgkO zAT1&40@+NYcz4|~xyPn)Tirg1xzA6}-7|=fVg3;&wU=%Gvty#y3V&Vr1TrY(f4jr1 z$PE_Q5aZ=xl=8fUG~SFzRK%R0loh2@Sj-}h6h zqN-s5vj>la4~p$OoWvW(|5^9;v)f;#uWS>qk38afd$RQFcdt!+IuOaH6;FS9oUfx; z-Hz@nfPcIKk=)S%?||DiyhJ#fO8Yq)JT1R`4N~6jI_!4TYQL?B+o!JY@h)&`wHXGH zYle|D+)82c-wYZ>UMm(KJ==7R)vwISs8)GWPUE(GvWUL@&HSV{H^i^a(epIY`IUN> zGh1yjnja*5RtU5EObFvS4jSkkl<#kLg}6ZOqV9h(={xCS=3;i2#}%S%``rt7)^0o} z={@U^O_X*w;X@~JB9JMze(-1{MRI^~}KRk^MlaGmQfds)U? zzGl8><##JoI|uATJ+0Ip`}N&rIInTrk7qXV1%~&mfzh&` zEpt&EO!81B-U1Z7Yi7Dlfi`puz||(;Z$I!yM@OGXzcj+wow#}FdNYLfv?V(>ydkQhoHY@f+};y&If_gs2B~^Dm{OBH<&(xnI-55Bjd5Nf-mkf zAG5!BNr~s!`Lk~m)gE5F%9^OD1ZLoTb2un;z(j^e<3~sNOmkyTW`6IeKtuC%DbA-^ z4)#K#(+*BXx%$IJ!mO;U>L$+Lr`tr&z`TQ3apPix3I8RU5Xm+ci7IP|k4n{rc=rt= zQcx(bzAh)0zpx)1xMQ|yN{Ynf51rjXnBDys8lBz1;Yph2bbt9dcM~|DeaxJ3;pYig zdIN=G>fpHB{1BY{^Z~W6jyN0m3*8gTs4RJUtvy&DOLTVPEVcy5Yf}v#i)G)AhT@A;-Ix`QMB5maJJBO?jHZT_6io;^vH)R zIbeNzPRzew4c&P5H`;CRYPG@rr|JecKR5i~MVckWa(MR7QJiKhWOeSPk!O3}3&}t~ zthEk0@B_e_9=zTc1Kc0DqXSnrotEQ|-vP&O{WmOB?P1tGZlv;c8=wu>wfo)=+jVPd z8u(USQHBxQxiGC!KS^uslxE=vuPFBW3)sL9E8bVs25*;>s~dR)$tj9|VveR4vB3 zcEzR1zjJDpAT}0W#>fp;uk{EU%C%%Ezm0FhoK}Mi1M~k=0BPp)EW~|__ zv)st$3ladTuBBnetR;ZvX2%CnK*(ecu4+T=2c0EzzR5XR(kAjJq+Vk5y&Ci8!@k&m z&GK8)E-bUG1Y@u0$8_N5EOGI{zrJGZPEKbT*fu-Zu0d_!{;Kx?y4HsgjOiH+naA!~ z$j+%e)fZ9yH+|NkeMSuhAV#{sAo#=k)p8fU?)#He+DMD3Vt+4%lkSgQFVedc*gEqi ztG~?b1Na7#0p0pLWxmKP(9O3y{x7K=mT~tu)@&2q`ef}moah{)<+f#gzf!PQtEBk< zc*A{}P#_VetsAP<*BnoHEG>1wtYn5rj>VC~Z^4iupvqs#J&3334glj<1D5m6O^-;A zK6fwjs(tS{6g=VAaL-s?`$r;|sOB!AZo7|n4A(q!oj1|h?EcW6g+XT(Fn{*5yE?gd zK?7N*xaY5sm0o%6S-Zt^kMCELxkeHerF@dtdAjpdvxca%QkW(g7Hcs-2zGiNep}dL ztwg|W4D&7D+pG_%{aZN}#TXALQvA0fp|xu*{>H$Zc^n|}dHaVon_X6j7F9q)1Rcsb zmTq6Obd@cjA^*QEY?To|W)6tdmkw+tUkn!yTQx=glc4vt@srN+rscf_I zN@{rCQ*2#^WMv7-vy;famPt&zv`ToMbuDI%ilSh0`RMpPi@9I*3S@l_a~KbWp!0cf ztNJPp2iLI8Duf0~5-u*-SId>YAR!A`DRTPEulB4{mDD6#-Pou#=oBoN=&X=ZX|+H) zcnf`qY5I*4O%$tge{UbT;K9_+@TqOq7i_7$e$u>x3J8w7l2i4 zJo_68H+Z#5XE)Jr=*B8A+t7^--Ppj`MZd9O3mdkuVGA3!@H=c;9k_193>z`Se?zVT z&M%5JiuK2m%ZwUzgN|knIUUm=f{hs0`dq|5XZGB%0`q@~@LPx+t$XR$r`} zWVXH;NTCjM-76Q=*{7JxT40J z%VYgr2?m8Bs!Z9k4J{tk)GydUT zg?nRyk#bZ}C3H;QV@--!b$XLoe`V7bljUS^?S(l|ZGqe^SvRW$INb=8Y8tz{FRgKf zD>K{y7`88vZ578?SEzE;fHZ$&=@oX-n6ts~b+lze&DJW(g1K!N*D5c&g!&th@+TB; zK*|QB{5}TR0Md1V)GA+SFL1Pap>M=&%&c4PbmcYQn5ZXkC*MC52TViVJ7A;Yz$!<{ zleoHBEH|<%Y<2RpxPam|AkqsysCM359K2oOOr2h36v=a%34K{YY<1awAskY41@4{P zTQ!H=>p2v3N`sYB@EBprV*x|?%P)ndtKz1P;QQ5nGB>&&E@7S^*vJV5v@K`*`BOs( zIVUJX&wq6uFzf8eJXaR8s@ccW6F3p9F(Rrh?Fzh^wY$_6ce53KocL*~TtU7ssfMQz zCQI>_*6Zg!IjXpH<0kr2AkZtti?J^eUqxbQ)~NUVfhSRJf*U7?jgrU{&*=m9zgS_# zAH8DjJ3I%!aT!321_s^XzE*Rreve3Hbs8%XcBpz{Ux-fAWoz!0h1bYS>~VFE(VwWl zI6@DQxaptZzlEx-9=H|SmbS4t!n{MPgo#)B!C!tC=!R}yL&gdPyo!qb-1mPn|ApQ} zXTr8M2aqc(faw6C)4kzaCD_%J->>eGSy^T+rf+O?ky9HIW!|x&x{J24VWYf?8(_2u z>l>(hpYDI0d+8JI+p4_ES5C--$rLci`81`kYnuFpiK3c@(#V)6d=bS`^1rt{KDO)~ zof&|zW@n4sauf#C=`a`^w&cJ7u5OA)Um>NM%+@-_N=V=IYPrv?&m4&30M5_^ zb zAAk9}_~EGSE4s2`aNGES-mADme$L&V^LQ>EqBHaZXsV72MRZ)ZWlb?L?>^5fLn*oZ zzx0{y2dwgyz}5@P0J7%dCD32`vh|G2dXzITzul=-k{VRayF%UStU>Dr(BQVQ@UoIC zZm@dUH!fUkDA%%XEL{8#H79WX*>J9&}KDKu9!vQJK(KOYv;P-D?_XB7;FsqmW_p%1@RxxYJFu- zi=}S?{98{KcJZGpZ>!R}Q_EFVnp)ptXolk;uK4+Bay`zBbN&lfvR=}RO6no71v}pU zZAgkjKsb?6B64+EYZF7NupZ;sGURiiREv3K^cNneti0S8YFmR$H0?cU8XH>9R~1JL zhvpqxRTN%TbToIT^#Vx0XIjNVXEpG!PY7_1aV(+gVk$ce?z&Jbz|XT!DUNdrFc^+M+Z2U@2@qm? zJg0~DdQc4=9XBuKk|zZcongGunk)STz)R_`8OAG&N+4r(5OsJ3DPyqSU!n38d$zM^ zOv3BMC>Z<{D8-AuLA$OFik%t2t;4b4gx&Lx6FsO^ec+sL3J>CzEAHEbfZ||gaq3D& z&8yf~O%GR)snZQHn=ML0O+a~qe|2pSmVdly2|Jl~3CxOfFy;T^UA?hYvGzm@kah;9 z;Dgo=V-@@Mvdu=GhIQ1zh;;O#^Joe}p$e-Eb62R#FHh3Ex%ig&T3}*0!6MKtl&o*v zPX0Wbla_muBq=V7PP`g5C)(pwpswXEfs^Fg372`A@Kd_WZH>_-)?k2&%)4Ktu=Mnv{V z257i$T_hw|8`$&ZfWkE|^9PGKW9BIg@Zg@=@8paJuufcEIAguU?+<%9n*)!4Kgb2I z4itM9T7X7=y)pvf0>v>B;)~Ne9|Z2b+by?JfC3(JU>M&s&f}lbTZU;h_$kyqioSDe z!3><$fRA%cN6#g!epPxE!(st8I32(8^xy1RWOdakpm1LQo$!|;P{%Vs{my6`{zY@v zykEU)&EIq10dmgRpl?UkN_8nM1qgpcIyEh~e5APa!=f5W@Bvz>7P03qnqvVJuR_vr zo$Jq?3%n;ly7Q*sFPd{u7tl&IKlop&S6={)m)wi>X_5DXKUQlWJcKH5-&08C-cYk2C>SNv~ z&TPxT`S=CebK>2Oy%WsztlAhl<$bm6`&e!j9cNHVWC>;76c(z;%O3w$2CDakaBl=f zBq$WlXN-^$1TQH`Cm4YuU!2jKVFvXEtwzbMI*QePp>th-+41|Gq0T(9uXq22Ut4v| z(Yyx`|JpGZBRK8z$fp|7IQcuf=cJ8z5TKkcKhm*X9`GW##Nz6S@|#!)bHZ&4AJbZv zmBmppad(iIQ2GdJyO9rd?vqGX7Uig4rSsriR?Wg)=CuqJI(KTfsClf1ia?kDIY!xj z`M7~M2FsJuF2pX<$A)C2xAD#Hnkv4h*Va@1m|4eQL5@|?Y|r|z)zKmUOstWs`A>#x z==jqa2J9xqd&XJ@Yaaxj`>l!Zw5xuIKRR0742H~(Hm;EVl_+JvSD0*@`P>! zQr6)9A{1{x%6~bem|MCk?UhKAvf>Cbcg`JD8gf@t>t1U(lpBRlZAN$^S3t7h& zfLSjqRqYy2I;G*gd=j%5cSZ{5-Zas7kiGReb^BOte0lmvGp+|QpYk*XxBt5Gh_z># zHxcU;E}=} zRF}ekLMr-|x;~J)fN$=e_~Or{dQZiD%(24rV%|MwJ4VlN# zbBs4KxJj?&A#aNhxTbxk^0{e&*bR9(&1&f0f)U`w+$t^B*_Q9G5AKOy=hIWPBusl3 z5d0PHY&Bayj^VljgmC|jkAq(-bqf7S`!jG=CHc&GH3L!k{x`#um&M->r_YUGof15; z?`F(k0Haz&0mA)N?E?R$0M>C;Q{Vj#YpUsCZl^_P$7ie8AL~|jpPGuL16Q)Bln|a9 zDy@ksfr70rV|!LwdRxY2(K$Jv3|j;=3E?CM1k+WC3`e_}j^&vAi+72q=mUAK=_@;M zL7hFuBAj`k+N~D!3|j>IlysTWavc73`|r4r>i|IU`+Zly>lh{A@T+)%pm5{ql_2^z zcx-TO5xUj_$p2$)0l&1^^_h#&Wj;p@q9AnxdM85ZRYLZ0JS6B}=Eijs+~YGoI$!HH z{d3pJSCsF}fja8AEK@fUkGij8ghh)7J;P%&07IGUt#9Q?pX`ygU@mWWk2-!7SzhGA zyB6fQu7T5rV-nQ$M)S{pD}7>XS$Ok${Pa^g@Gn{h`{TXw`#0$l+^1>}#iiPz%3KrT z@BKUd;yadmTIxv>THvy6lUpPm_ye;_$@V&E#x;XMc9JqrZ`*4nkI;vt7WSZRYaaz4 zWBa5n9McR`7tg9y1*S;YS3O#3A6TQ5P=FZR^9;lFbJxV10DiL{aPD8Hga}xo(HuK~=9-GHx&UmJjipm_4TBbP^)Py` zbaJ2Dn6|!t*m#mekDHx7R*;1dG&1$jb?)6XHIyR%x~yc*^H{$>^OKi%X^f}p<2Yw;q95<92HBtSJ|@hb zI^rOH?cE7_rITV0oU-@3X!rc37J8Xgr9{%DgYhr5Hg`6a5`;*){5nelJGOocNP#cV zq~+gISlp3TF(BA1BR#+Mem=M(`c);*kB)R{yN@{uEzL zk_ZqbIo-vsRoaEAt^cX2^dm5px#Z2wlI@a;3vRucYnz(;@pZJ6o1hESIOfu_MAoO7 z%V?8kNeH%u_1V9yn#T7DW_vGZef8kJ0hn2NR{A~MK5k{XeU5++>*wZyuE#?2`}D16 zaIfLMHNSGAd(T#73ug?Qkkb8RP!hkemij*i83Cc~J?ir3V!((xXUCaI?zzvLZ3k{? zHK=He8eEec%S=}exs6eN*UC4me30*LM#g&F18jo}*oWkucZ};b;{mE7!L6;Y?09{o zGeE`(Bd70PAN-*ZRSgtJ5--9T3v)JF|A4GLCq{&Tjg4& z#6p<2U%oCt=(vAB1XCrMadl zBva`Y(f-ZPNz&Z&T(i;=TN*jfO^7}6d4oQEa@5zXzVSx}dQh8Zvsr!N{F&?5j`4vs zBS!BZ{Fp~!5he}Zos~9~c)+@6cc`;js5Ko^w~?Qlt^0JvrUGNL@Lg@4$$7(Rwmu2= z6&aOJNP4Yq)48^JU3%D@@lU>kl!jX%{VbzX+VS4zTT?PJCfPc)=iBNnCNVn$`Lzjc zQ`92)=e`bK29NlvB_wo&aotmNL z_nwHI#9?HJ9&Sn^FK6C|%^xrf2Pvh#Jl;yRovBZ%?9vZ+t-XV5{VA)d}ZW*sA8 zEva|x?2h}H#!w*ICz@bMc9XcDyIpZ56jT`0UspSUrAR>M+wtzs7b>@DG;H22ql?5unOT7BqI)3$&bG&Y3_c3fWt2DpQot zD4&YQDTTK^o}y-y9uF}N{?QlJ>W3Hz$k^k}7YgE25_hlENjaK!d7LTyHAmaN^=(Oj zo+^%(fxhJ`;_sfMt8Kz%;e4hE13vpI%KqYvPtj+19~#b;>+gL+2otWzExfhxk=FtK zT+7Bt-{|4n?g$eP{o-El(OE`;BeYeoYne|DeQA5lejq)qqGq`6fRpir=R(h4)hx?F z_wU+mzv_8Fytz4kSi83Ip7MH8m7P0z#nkBe-<~NZcOjOSi}#XR=olgh;xgE0~ZAiK>NQsNIJEjt;&n&Nog% zUTVotegIGhY|1h=tp72~J5aozQsE`Lq99`4DR%wqK+tp1 zJn!&b*6?+)8F(v34=8u1R-E`tJv#*mvm`Cwe*9Oqy%e&_aRL#OU{1qdgd_+A5$gMF z?*1iW(geJQPeaCE3h{r9eir?1i!R`>67cCuAHG___=S+=)e*q2M!eX=zj*h*eg(E| zZmDT!uvpKCHtN&Y)zw8yPoYbu#8Pd(XuSMro+2jUB+8`?%1bImzmKL}Bl| zt<)`CFVtTmI;ufqeSHQL;V=ANKSlhHx|vHK9Hfmc@n32%SQ0j1L)Lpc@+=!)4Ft=K zAMU(2Ut3$-C6rzA!vaeZ0q#yj&=CTLyRGerYmC`lB07qCsR*liie^iSJPcdhMWTfY z_~m~E!5gOg2(Iz7zS%7B*wJ%H+9HYa;G1Q8;{0YhW3Oc!6Lm}X$nqf`@bfp|?++&n zf{e^+Z2<#O^q^00#x;M|rfs02suYvp^KEc&kVJp?UW2&mJ($R-g5_DVZXGccGb^?V z6Got=@A`%bQ(rtJ4No3&S~yr2)-;dKW(4ryT+occu{TkJ(zz!Q;4pKLf&b;wsRp5( z?!pR{cpxeTCj$ix(Jx!0u5E9-yAdBF|4*4oHT@+^l zD9zO(wB~?5x%b~dpJO3BDi{N-z6#Iqc-SzMe@yfff&A2!{W^r`!ORo_ZH^z9tYl(t4y)o{<`7M2E)%^QZgKaF=6+94RRpJ%=yW##bkvNtK;#za3) z@bmaheRVQ*+?|@>J#sT`R4Fa>D3Yo<;(w20gny7_t_EM*aHDf3@|&rVjGaN2;WXxk z+1H{k3*Yws&MWrL?!yHW%^w)c(rX7*ibUNq$pB+`b7jFdOZUXxt=p$OL;`t*k+G#) zB5sqC%RO)u|Iah%=Q;T-JKkvmfF^%c98e&0VMYn3-uYJyGw(Qz9j&Q@uk5mkb@t#P z_mhz3nJ`|_Rz|N8vJFAxB$ldt@NTVLYcJtgss9JdD3h7iQZS`n7V7V#I)gF!WnhK8 zR9Y%8icTon)7f6&>VAC4w5`XSg z&JIuQY)Nd+-dNmO62JyU^C0>fXAzY=a@H{AjM3pi5;dd2tg@*63t;79!hjd4In6N# zd=L?K5wl3VBqFb;f^14v_2zP9Y8nZOIhgwqPLJyNp_s*bi!KT~|L^~d(%^Lyf2 zz0@dYr=~r6y)b6?93ggcSl{;!C=4=kL0PI!Gi>n^iOxb28`CT%5qh8(ez+@d&;j{} zEDq32>${K`1LDCT$)G}nFpn+_&l=V=VjBWT5ruGKhYn2-i)otv1e|+dqAO5B=690E6HdS-7}7f_vls1?@b7G!qRxC zh+@1p1HHsfQ~oLy=0TR~U0pJ-V!M$@1m;F%z8|XY`2k5QvJe(IVyb~kXh}cAGv;k$ z*SX-OBl*SD0F%%?sd5(HOd#@`di1z^h>D(G_|U&%F?~Sgp10(^1qAW!NaL`Fq#9R~ z60t_BAuF(MK1jVC*DzmZPpWFNI`2N|-7u5B;Boc<`5~hE9S6X^XAnh4A4$#&|Fnv*vUw=tLHDS_F+ZH| zB{ZTn^|{v*vbG>q1g$DH^tyAV{aRe{k_qXx#oU)O0hsLZ{A`NYwVKkE3 zvy2FJ##gytnx#h)2;(rAN92OS@X!ZT?0Jg~EU1qj{SX*#4mw|S2wxUGf1#+N9Uq0i zO>%1{Cc9`1@uTwmoRLg z?{)3=Mu^AE?JfW-8g+lw=w_Erw;PF$sq&ow@_EGo#w~s#DnAATzXckkR0zZLplKhJ z4!Z%fZB?UjXEX0Dl*WWY}*7n}Cair4<0u_|(&QZ0L#PyUDl%2|kQ+f*Z zGHJ>NL_%C0g}k_4IcXFI6^p0P!l1AjjT^L19dIS<)-l6Sfe@#VvmmUSAITeopTQy< zYvgeb4sh|?)33zs{1X>}#h+PiCTXVwV1xIoezFXH4$UbhNaxr~W%~Igpp`hrrEtMs z!6qZwFNuk72`|H4TgjP#Tkom({v>XpfzFj}>#X6#%#{6HcKP_+qf#I1g-Y9$A&naa zbrZ7{^!~ zhP~^#SG!ZW0O#jMdSXcvjUgZ!MD++QIQfTl3|Wk`D~*xwAa!?h`#4)BJnG)f(_1Fk zj0YY6dbd$FP}JLiLl73~Ayp~tuAq>^HQVt<$eEr7sBR*F-#MQxm5TB4BUY7Dd&*MW zI)|0f6(9$hqWQvhCFG(PuR6jA#F+v;O>)$zuJTxzi=T7*cH-6U8L}m@Y&5%E237)< zdCEk&An7g~{T7#5Lp#EYevgsa@x-ajiRu5rzn%xtTY=kHwE9U*wci(DYFpE-lIVdp00%*y9sRt z4s*ucu?0;xValaGoC5Ui-BsY+(_J;4mYodni^Ydh&Z66n6*%r1mm2R2`G9C zhhwc$#tF&IX22Ehq~GaqYV#YIHr0y=E|8zH>sVw7FYKB;m2Gxh$*Fyzal6=TS@ z-yY%^+txutEpMMr%c!21Ku5Gye-v>XTO(>~y$6b^EL`%Z6Ur%`|g<1@NQsx%24IOmH0ab!o6k(@ghm zNL=g~sEK_Bcf6Al>Da9PfRZdV122JxnJr;(q2Kp<1nnk=L%!;fD9L}HaLMhhPnyw6eLvVL8?H@ zD+xr3(ADT{=|V^;jOEs}4|WXbV9w;@)QOiqv^QI1(sH?~Z?yR1x?xEC!gq_^*?@Q; zvQN`z<_o^oIW1ffx&W|-!9`YfKle0>L^Jy1_h@zhq$TJ$5Og+FkS^8<8wy7m^fDruX<7lrsFge9}bxx zEVhzqrgbw;0WFl!sIn2-sc$s%ph=mNhCmKneN@lU85K@Qf|YO@a!dqbY^EU%l~41r zy|OnbZw^v_wNt!?Qj2g`p-c!(x#{mUz-dF^n5bma)tKJ*5#e!4G!eS8O_2=6JT%8> z&930{wD>BN$<`DC5%-sSk86Z;JE?vna}rAj-|l-#`=6?iLH0am-uS%&2@cP&?v)bY z$8zwt*n@-a04PTDD%YPWI$A?s9q2$L%L-z8V(`fktu9LC(vt*?rUdAW<_q6rjcgic zaHidnn-PQaa;0AWI$kcxanXM0%{c!z!lL)Cn8-}d#e9j+Nxfk&7rYSlb~4TZSu}K- z$?=P*A0!;+JU7vlpvk|_t!{Hj-XmZi3?sX_1`Bx=gyLTKP*7K86`~P{2yFK*&zP^MuLiF497{|o?Kp~1YFYKpx2`>R-Ny1$$^=Y8{w+N zuQAyQK2sN3fL@JN53ER_1q87-{aV9RW7fF&1%VJ%Pg_ny4H^34au00!Sg-GD7d@0QmoWE)d` z&XWbb#!0gsn&ANyh=l>^EuWOV^zz|kiv@T17hnUIzg5Lx3nP$X>V~%)~4!Zqz$* zKWhN`I_Ojg;h!hV??(VrbBu3JLM(snwJMZFR+j8#*6`%;sDWsCYi+d8aGK-tRF8o; zLUNwx{=_mV+n6J2C+l^B9YU3JZuN52@EsTw&|A76_?{7?ul2}zR<>oPvU8q0a~E{Z zQdfC?d$TuY)Y9=&5gwfWG^Qair&1WLD#)K|uR`>0P)MzCxFeN+Nu7V_Cni}|BzbD` zp9s+u<5(B>22`?Ia+7%5zDbMLPfl-TPbMGzW%PMQ)QYH}BOi}%j&MqeUg7={&uAm& zYK$71#vZ9^9yhLpRk+T5wYOHFnptfV0IAQtiom&#IVsG@bP@(598<$GL020pBXrn1h)IojOFE#C?~95qQffezGdPtCj{sF@jc(Kn;{wCLwqGqvHkk$=1#PC#Xo+e}q+;SywD ziK5_A!A7GyGM|3G8L*_bOZv+t3dW!H7Lqa^;=!J-Xnsh7p)0m0k7;^&Gz91x>Uxbp zD@;?S2R$;ND4RoK^%WIHl@+H`4pM_7f+9Lo5O*wqwNc?NUG_}P_C~f%SXi6@>|%6= z!m(cbZcv6M4q}5?=M0->J9XF1(>`OGANr`C1j(S8Fz-*~nAseA-8etz6)aNTP~O{k zmztmx)-kD$%*%(4!*BadALJK4Hsqd`QE?%q?J^O4zEc9>cH>?_u*hd3F*rVB+d@(K zH+LUaU635*+xbvq*${U81S_g?h+3Y=aq+s+P>+!!h6VefqNWFAiVCmsgg;`tbFDYl zOVt@JNp`Pq*3GB59zqToVvi5uZDVKNdU=)kRT}*8EzWvhlV|*6p}@Te0bEys^3MB% z*A~u?7KXm_wy5L1itacz*TKIOB{?8dk&#AEV-493O`^WcHALY1--3|uor>D<i|{f?AHS5LPq~UpbODKM0%>)!)_oxICm4s95|NBi(hv zy{X;QtJueGE>(E`o}DGjBwqUSqh6}K5zijvcQ2{_y}HesMEfhmM7@P`wFNGKFVjx6 zZbdULpJ?SWfThFWSFLA4b-NVIrzXZq=R={>Il|&Y`oj%ux~4C55>h}04KadflNlZr zDXA4g6wSwIwE6$TxKLuJ@j3S*IQcjvs-rtIwUECX3AqQE?%OYMQeueHW-?hYN7c)@ z0rfV59|;S)MLR%PMDP|`6}XPQ^!_pkURE*pGcs!od>*;|8u=cw==@3fBhRB4NH&5b zU5ZtMjLu@S?7{^5g|vDHtXF1J>;uz3_3I*m#f3qQ&kyNO%?T15Ehylr(UFKSd(qab zI!BS)wPu&!{8J1EHW4d3cZ(J*E)W#0nTQ;m^mP~ZK(Qa=_f^U`>^tOL3b-w{JsV{nT zEu?7^CBnnC7msoEdJRs`1+&CcdZd>DH3mqujTw`Oi5@iut`F+QlNCvmqPFB_ae4Sn8f0H4;e#O0w#-rS^tIOThp@WQf63uRRok2CJvh#Q(|7AMf`hhAni%_-~p%UKp3 z^&6cS$k*!4p%g@zsdm2nCM6;<^z9yIiZA{^S36HEI?G|y^1W=b(<(tO=?5Se@Tons zqCr^|H5E`F!Gy^vInU) z5KMjXsSih=_*8G#FxwhjJQ=W-iV>$y8842S*@v4C`Ndm7{9% zf|gN39MS_$V+;olMtR*H}2s0aoTP^z6VI$__jy2O^28P^6EuRNd1 z;exR-SqyeE&iUF*A;-^nOkukRTnEFH=TMp27sWBj1OKKmT+<`Sqej$fK z_6HnKJ&?KMi(>H5rV#a2Ah{AS(egN!iqpRe_ydtqSKrK9A%BPjjZNxac~eR*$ukE2 zy`vVuvxMjUvJi~NL<~-zv68uY2YKc+)$t0(D?cj=Q6FK@+%&@)Z7+Y@P^}4F8}^oZ ztHB;yROA4soY85}3x@G07v_kgVjV=){z?JsyycHqS8R?wZp60<8tEFgKDr^0bJgb1 z8N@uB)R6WWe!1h5k2ul5|UXFvQ8=zq9SDrA$!a0R5Z*GvI{AD?>$5IUgsDY8OL_a zbAH!RR`GrQ_`W``=leXr{_uL;?sMPQ^}gPFUDy3a_O>_?{waJcEG#04o7eARVIAth z!a5j+dl=klVmT0ug@r?`ckP<2{x$Jy#sn^Ji~j6pwG3!QIA}U85-NRKp%NAA_{3UR4vlA$m-g2G=6>ScH#V zB`yBa=hKH)DrP?YBzDr3{ZpFkC!81OmKs*XKQ>X~jb~p<&GpIB&#&oO9uA&z9D$i5 zU<6)SY)XDGMr^iI3G7471F4n6Wo1_^iX9q=92(eJJ>H*x&vbxlu%xhSa*DnJ*1njD zMC*(v$ci6$-Rs;D$5(x3KpP8nygWta8P3(!Z+PvGmhj3141(zg$V$_(6i$SaOsCX; zcz5x&+6}gIF>a``?$<{~7#0pk zsKwV9-o_%<=#~#Ur0^Fumc@eA6^QF==@-<3@hu(i1``gG&|>usoM%t6MKaJPN$Z_| zUE{8xd%1G<^-|U_#bay-1iOyjmG%bysK;-wvLRdtXOG^G7A{lx8tN~)uEw5utb$R< zMKzev;v1Lc+QN#JLdXZ)0dIavf>UmcocGgbM87#Hq%%j7s%2O>c@Fe^lkWDZJ`h$I zc4|o0ht6kGS-9+YfO{3B_~p}y<6P?G*S+XT^z4-zFJW0m zVP(oaL46w^ZR8UDjAoc_h$)%Um1oE!bbP8CYuSMJ*o2|wf&{08_lqU!Gd@4KPM(gS z_hzoTr{$*Ac;yx`Po>`(bFI1T#+IiC819Dgy5_l#T3@X|>1YM?rPY_;3gad1sPCxP zuYTWdqiVY6&r`N0+FLv?r;J@G26bjyN848t=ZJ z$urLV{XV`!j|5qh))lB?yq3e)nGYf+vMWv99CNUfvgho)~`Z( z(=j;>!hQ(%*O`Zzg_**ieN*Y>R6Mxe3bc$Oakr@u9pau*el?#kic4+l7m*Y5JIrkV zd2s5|!P`cIFBv36PM&c#%(Z|DF7lNa zOQ6;%yPrmBn};3dTVobLDrWGL^u--)SkQn%w6iz`JK%R!ba+Z_2ewYO|}3=st)?($K`&fR?dJ}8nzh?Xe1C$mA2O&g%{^~w(;UMbvgcrQs@Zwof{*mj9zXtm2sb@vK z{C_NR>q%Qu(k$e&FF1d_^lN>jSprA4p51)`A;HE*(vrUa6MvgeVOx*vgCo+>tB^j} z!B1rSpcvAJpx$p(Aza)ZJBZx#eTK&E2|2jWsNqKrKIO%q$b?+uYpD+P?f8av!>|u#l3TzOYjN2&vQL zTqKJ_D`+E2K|uj?o0}b~nH?y1Ys=0Nh=i7mZy`Y5FsD1H>DKGaOVh-ehsy^ zFi20OT%uFs@Ix=AMs@O?l zp{feI@!Q)gPp#xSEjt&jYu5#HzV=vhw?uQSNuTY z?P97TsY7{sV^YgB!GDbSo2gyS(3{XzGu7@R>6ea^X4U(`i+2yYIh6W2Aa)-OnyB|? zbFO;_psW9;-pw=r5Wa^w`p0IwnFM3E{!8J4HcELS`Y@u$bppy+@bDaZ$vRWCE;Wr? zZFtzRv#YbyZ21MVkD6-#r9V-=(_TXFE_w{tOreTzk>NY7Gd}dayj$2I=MTKO7GtUB z2c(`K2Vs1BHE-T+_O;4XKHJbd+an#@Gk@6g6nxyCRHNH)02waZbmt3V^iDrGkwKH=f^L>OKd*;~JO-G%gpni&Q%?H=>@!%$tIoOG!g zN%nRpB9D<~MJoq=-o4mOFz5rH6$y2T&0pIM&!#`YatH^((*9ZRPrUwm{WTN4iD$;q z^<9d1bL3}`Tfp}JpO)w%x2->0-Wm@vk6W;+@h#=BJxS|?Z^g1TY%hLs{N ziioIPzI^$jNBGD|{J8jK-k#h(HAU4>)N*jH>otBcGH7f>87oJV*TPEZ3QqlzcDc>521<`1i(!DW*< zh^(z065#W`rge<8L#rn+G?BGoU449}$}+u&!v})2wnO%ds(-=mCC66AC6o?d6~E^x z>5|ck8lJHzL$S&K$xpwK4s`)IC*p*U?#&AgVUPfS-=AXD(~6_L`bugATBFNmg~H6! zr=f_#C)RYm<7iu=J`#!Ld?cQfYGFuu>(slc+>mi$Y4wZFi*2XF9`lvisR;_tWNE$b zHnjfi3Xp+K8>W17$?_aFdrgm%;@D5omQd8|*sR*ghxs_; z^^gz~SI>>quLj2>6?=m^ClCnLudDMvo6T%(ZHKO?k$yYhkk4G))^?wtpP!{Sds4KI z30o%2(l}?eQyMXlkxAMC@8$$9PhPoDuQou?!SYumbOp3iPJa%5*`1}oiJPFR1#77!3fRLga6aw@c-q-FcxGCe8XY@DbTS1u6 zs(XAN0rUgEvKw~C{rw*1j;u7KPxU`Fu^2m%{{4+5dCB+9Pvp(fts8vx%@(}3mM(&h znMm-QR$nQleYl6$#a(%uDRj2w`mW zCTK0uLzwl*^ex9`U;OaH=E@vQ!$Wx7aNOv;C&jIYgs4oU)-6*T3tn0e(OqxjoWa9E zzY`*RuL|BbL1K$6^}m=MXy`WV$+z!eFf#T{G3PXLQqdXI8$b<)RUqzI??z>~%d=zA zE-`_-?`}@f5d2Ihi#OBkAUVC)oxc9tEU`7o0&tOYL*r^?e+>mZ(Lk{Nz?>)K^pJ37 zsPoTpD^B)BxwyL@62vKYV+!&NQUjj#%QUva7Q(e(epIkFRaxxQhy1?0KAAcj8x~eD zVy%2*6OL`|+-C(|>(0)mJb(?yUmM}{s}WgK=>92)8cr-^L-!>X+-%Qu`CB0m0E04! z5YxeF!ecvYLp3~;Wg_4%1I_qT3Y%SuzwVv60-}P3LwRrAJ_Wnur?;8)Q@` z#g46sy6$vss5$j6vFDLuL)=~14@d@)Km~z`&Bk3WEol9ee@eg2UeP)Gw~wDgAtufR^OAq`J3&*0b+HqlWJO6jt7Yw)2c2HzawN z1{>!to*Ph7Qqwfkt#{7fuO-`Nj9=mvNO6;tmnWaDl$>5xLR~Z6_lUszx5x*J$imU& zfV(><|MjLk#-)>2E#D;$TjCXd9C$yhL6?~~*>j82HZJ4VM3&DZ~H7X-gV5F8(Qy-KOB5%G_PM&9bB}tZ9>ov7BFQ`)y~qhyN#ui}*>=kI)%OrFC^Dpm)=sA#Z-9D= z_Ju%Zp=8xUCl1U%$fBLUGS%>IA)L`9sOLxSlWfN<^|?ix+4G7*6V+Utj@L@9HTxEQjf z#S?4Ua39~_ga*o0Zz96ScdkB6r0{nArQF)4rn^s9KWNH?3bI5;M_(GRg5u4yGzg_W z*4K}vrla$ZmI+ghou3=&MN4%Sv>Eok29DdiLpchqE2(hTp8luCGM`EO9h23nV-*ss z{ndmyds7|hgzcABcnep?V$H0qD4cL<$g*6DhKC<_c68X7*UZc>gwcvPt_|ylk$&Sy zN=?1z=kH$wgQ<4H!yGlOPjg{G5f2MVXa%z_R;B9HS2s2`z8|;0N*@bBj!}1acPFM6 zagbY7v2LU@YG2{?#7ckR`t4u#1!Aj=BK`=wjad6CtGlbS>GpO)NwdzXX*fx3p_P|u%5noX;#Oh%feRx-`9-{|q6Xp~`w*e~Yf07*|yjV0gRp7CZxiraG^ z(&wnekNhK(x~0hcLDt2e%YLJlwRLm*!iW{DEk1bl=q9vV18-bFB|(TTc|sUdo7xNh zOyHoy@7JyGwj*1Q7BK?UFcOCC?V)2qyYbzO?8LWW&$5I1G|y?Gmd5WaN24_&zSq{i zUs#wMS1nLx^{M)S2+FBAimpzi_7g!aXV$6>E*kA5B}j#0Bi)pmFa3hFA+G3W=klls z$~M`8PJxq3p^$LC6`4_ogMco6JibE$#z5hAJS%1sMPJS*aXDxd4MoMg8jV_tjkxI0 z=D->DzgIe)P}Fsc#Z%Z0xuV;?)=%eeHgl1$(YAS4vU!DK`tw%@ z*O+|>Ee*o{Am!YT`vgkHU`F_-vAyX8@c}DmYB$o|v8o*;8C3#lyUZ`P+hpJIBYi_8 zDA8A?Q|*&Vr(|)vQN&h0Ay+ZEqMp({!#f477hQ$*gJ(0 z82x{;yk$RrUHmUqUlB~vm${)u*qp>8)gmjI$j43nx*Bp~u2F841Vc+UtBOKvg=%cd z<5ou3|2Dqrqd?<-H14qfi9;+iQeB7=iM@o#C1}*?Ep@}A4*dgzz_=F?0aeV4V{VRZ z&61R^T5Uf~>3GFPzIx`TN(>+HcmK2v&;T$&fL-HpXghXpvw|O}TSU)~XhL(F-~T;0 zgqd_LJJoLwI5!|S0|wT7Lc;&gIeyJbstoC)wZGc6w+92I25?Z@H8K7TBIXVb$Z#G} z^IF_3Lz@uNzXECZ%212lRhlg@iUCTBDI1`?-fjTNehBqAVRGBLG0-ie4);ixxx#FL+1spKcQagdL0>) ziJFoUD`>D-zioY_)ymp>s_z_eqj!;3RFvMY>U%t{L2s@Ct#Dp@b=GhkeZ#u!Drld? zfB*h0mlD+7-Mz^ni}XZH(fTU#)s?{PQxqrM#c2Jx^U$8|w5u#bbmOq8zYC_nLOyz+ zaOqte4*wy*zp3>Dgaae6FvQ+r3jJ$HK)Z>^l`H3a#eYa5SEP&!GhiTe=NAxg?a6?7 z7#!dWvn!c3R_9?mo^34QbzO)0u(ta(_og zFI9C1hkP~;4nKuNRcG`=KB0^Q2&r(pLihOic-G2pIGhutCN|p|kdug2YyU%5AHpS7 zp_7x7PcSKfT=IpbrL3-ShhwUWinh!qB7%bRl;U(*Px6l1Saz&el0#RiNW(DeFQUh} z?IEN3>eh=B6{OZ@8iYEBCM7AQa!60SEgBme8^4o7-;^!n8y~2tq0t{wlwV`}Nu;=G z7`I1G{o;oun8Up^^~}VRS#}a1)N9&^_rW1(HX7*(O4tX70l;W=h^Fn+Y{U}bmPpJ1Cq#9nZUl-Uikh?Ct?t%U)bK{(SLOpfB zHtGb8|CYR&N%`@Q%DeanLjRAkH+kc?c>eE{<)U*BM7p-qWnARYQlGo18X12bvk4jg z(XOVfwF+c(ZSD>o#bpi>h2Iszw=@;6iNV{$%L*>t!qWC!DKiR7Fc&q z;{x(*bi=CBn{8CMj7fQX4$|{|o`N#_!X*V@=9` zSe@^VMBNWyB_Wnv?o`m|YQ)_!2Og$Vqa;f2!)ElfJL((&#$j;sy7&&{?;xO;EHDlx zdW!oP2OD44K9t1J$b0AYV^daG=s50TZoE^%8&?2mST2*huNfeUt5lBD1o z?(my-|BZu7 z@tihNb&Vx-%HM1rY&aOSj=i>x|4eewp-@+wziq`{k_LncYplV^Vs(9+e4A!f^G98NjU5~D6xY85Jx~!6iwhC_G0s4 zY(UY2Y*z{P9GTur4N%nS71JM@k9yhq-;%d5_K(Vcu;@R=-r|kl7ypg2TyzdXqDU{R(#MNlHd?M~ zrjA~(gI8KkNE~c{Wr{ z3)%E3s&uW^ZSB8P89_gTt~KfS?xek51$*lx!Cpbh`zm|uWZhe!+o>goNOEtrn+}Hl zH}Mw1|Dk#d6~8Y2G1qQ{{O=Seb-CE2oSoVwi!?y0PJ~LvNr*;Gd9}ANG*sG{cRef1 zEgG3!x6WaN{#vL?t*?>boBdPVujbpmn3T9%VZR0_f&hoEnN?%wl<4Zp*VAtpd&@Dc<*MW^Y6_qxb$3#0f#$k4xGwCC8gXd6~tP`+}spuwG6c2e~@CbhPfVu zNvVVK_G4?49c5;`Lm8QwkOh4-ttm~<{kA!v1Dl!Tuw&~0! zA&TM;F*S#My=~-RY@MeBMOb#{`k&p?Yj)v%>=4hE!w&?pepdle4P5BuM#l=@U;qXM8vr%|GArK_W9BEUONQNQXqKYAzqz*(>VC(mX0Z#xj;-^4p*=s$Y)#y?d5L-l{` zV3+?j%!Mw@U&Zo?J5PSt-u8-A9iiU07jatGp@;Cso`>Up(pNn8&hm!(LtlA3GP&mm za3~zSj;I`yD|^;=h9mdWbCIh9&wprWxo|~lm=V*Ut{k%bI`&hpS6&5qKY!$@OAfLv z-n?)wbie|s5M8$waeoPX_R_9ZS6*t%wcK^#ewMx;b~8Udejjg-=KvlurZHxpLljR* zKuYr8*(xb*+xVTfI{XPX8A3in{=%lA-I;#`yNbL4XbcM(8QXc@o&F-E73XYEtXS-$ zeG&j?0cc`lhK5^9-T5*WGzRZxmV*2J^1T<r8;+z965xaQr(=DgK?w6u~$1Us#1O9Xi`{snhWJPEdC8FNO_KQg-9JWKuWj7*%Kw}vt&)2VZ zv*q^W^!=e#M&#Ukb8jS|l8~X$8QPr)+k6+7^jjogZl+x6hQ0aE>oVZpw1w9;o9N&D z7`+c*&;Mr^9?ocZ;0-escKf=e)Kclah?JuS9MzQmmvxx#L-&$pFKMt?gGHs<2uGtk z=2^(>cRZfguy(KbH)U?R0<!5_7;kJBKTRO`7%sKm|okF1w|K0~Azo0Z}ZYl15y3a-v(wl&z$np0nzd_We0a;#T z&fVIZ=JZ~;H?x?JUEZ6f&x-nhv>Y)WdB5k%L1=Rn@Z&jyZ64aK(2BuoNnmxXd#j{p zkTZZ?Wjl7gvx9SAP*`R|%2H4|e$v&;W>f$GI7}rU~-UsLW&3w1;gKV$`gb1*h{_Clxoh+s+2YnZR zTIxdps;yp)x+G_DzLG`s7rN+a0P=p09=WrV>B2wa1e*JFS9(e~`B1XgGWImnea8L8 zbx>d2rQ6E4u85x4Il(s1c^P6P9T_&dH9#0eC4s)b{9T0sb?jP5ykG)pe+-5tm2zOn$tULip+f`6|Cirv8E_tuaYjRo=HU z;s-3#)6<>5-i!8Y$<=NA)Z!#7OJ?G1bwB=Xn5<{4tYOSfV++YSNg z7qxG_hR>^Jn`u8Nuzy-UCVv#Fh+ii0mdYqgLjw0gd+OubKyOVeTrGKeM+Uv7NQq^w z)!4*>z}CmF1(=hnn1bYLi;oTcPjxrbY##zPlmsAyT0bh)SJgsJzm_QbBa&lB%pQ7Fl zlcMDd%C4}gO?54Pu6`9G_Dh(<)qwChz6suGBM)G^b8vC+W;;j?F@I9<<#FVj9vgUj z|LeuyuSkJcE*1yxKI7b-nafrS*QX*nw>KmN=m*5|S|#KAN}z7YM(5LrvGsZHeDz-UHb3z(OTnNha8}=&c997r&*Y+<`KM;pWG=Z{68-A!`Zn5JR53HQnwD?&p|D<$veGp?)!H#h9~9cVZ42 zLttT5VEQI;t-g#aCw<)gAPX!|@be{Qla7I7;^(+GNX%sdkOo!a_t}jsEz!Oig|3T7 zbqLM6vOK<*otNEsx*-hU&`C7(58Zx}Jb+vH<*+a3nOrLs+?xB33GZiZkS3fC!_ChG z|8U+@n7B+0a2f6iR|zq7Gxnq|){${y4CFks*KB?6Dgk_M7h$&-wWq1u=0r#ZVBSkG zXvrV&{T>Z!fw4Uibl3N>JtqP4*4rGx|KrsEO{_MZ2DaS8k@V0`TfU8REoI<+4bq(3 zIO%^EAvT`B`3j)!%F5MadoRt)6ky8DI(&MEx!EzuzlCp7VH@F?JO3#D|3g++yhvO4 zr<_0u@#FNJ*hjTvgG!!eN=Z2ogetXA4=3sp->bBE$sTPHDGU>RM%VFFyTf$Q^0$?i z)doU${$T8%eVh-}!q*pq7seKk_OHCEjB^sbX2TvYimGgEge=~Q*=>0<>q8q8g(F%v?cV2nAB zT2DhYOu zXL%#GPlzC!0F+twBY9yF>%@She&6$Ik=U)A4<4~+;d908^;sS06_D_fQPLT{h#;?w zV*j!*_%KhZ#KGaX_-=Xr1(mMW0RmHAvnhRny;ZH86hQhT-}Cz%I4?#4l50O;?N%E$ zYukGKHWXh10PyAK>m(B9dpb?>dm z!yf^PACHjRXL}WQ3IL4(S&*?$uB;qnHdw{Jp4n?=aCWd308I?xV7QM?c#FxVy4}68 z2iO>9{DyJudRDu3`;l7@AID@$liE4kIAN9xOIH1fnk?E zhcJM=$UlPr#Zi#|TY{&_#WC%PbFcHzMEJ$if?S#G@)wBC2AIQA&rW2`9olE7K#}+?pjJWj&0ro|Ek&(>8h2SePKGFDN7%jx zGM$+AW#upKP(?4kTW?F+rvU8tUq=m~) zcBGNzZ<`Zl44 zmOfGcVUwTlvyBDVR4GL5ba3IzPJ>6L-&zEx)V3^67tkm~F$7$3JHvyAJjx*UG9x2H zjyy9huD%tdlO9c6V`tB{J@zO6VnHnkjt%ovS~O%``02qT)}F?N3?pRf5%(n2`2NLW zHNnt{y`ZiqlO`d@SUKkf`&$H!u_Bf5lAp&XhRduhNsfoJz0>{gw12r1Q3Ag6QDbxC z%Iy&DuNUdGZwH{o?Aj9SGzH?7oD*frWo}+NIyLS^lbw8aawelt_(7#t`%nf!o1O!w z#jtR>J7dKMt8UTYnPdh^Yl;E)SgvUtyYJGatfhQqzR=H=qV^9@R^nSd zwBbDV$lY_pw8EqL{mSZh2 znfdQtIDt84+BbRRM$2RG$5(5Wo4aaPI}{f52|+-=s$u_uHo8JYrl56%bDXcd{Q45(@XA8{P2UF2=|De+ler!{Kxx0 zP$I7ALig_ut@;)@##Ha7GM7|ePrWhCM%OEvp$nt3%MzQ)(d~~u_(ClS6-EkTPNCC> zg>7krW-Sjy{G1IoTw8&U_OOdIISz)Om>PILQWk7H&$T~dv%l4;oSGf$K~|5=e2v8zVaP4#_QZa4dl@kCy* zq6@x(e+LQ~Q>HIvae26ZbI&BdIGuTYEtk1M@FLRgsj||Q$@2QXv4w`f9{AB%Gqj>v z;fO~~5uD7q@P+sg%I`J0NfqBoQmcQeFK(TXW8UHWhhl@2@o&3Ab`IWc;V-sCc+xf6w~ znlXM|1bIsXu8ibZii(OQ!$HQXt3}r#;iA|V4xB_E_9%QomCO1vCNPko3@(AlohtC= zy9~1#bScnL!*dDwPEcklP*6V@kt{IR`!M}*cR!Z>O?HLZ_=_98)4IK#KPC zMA9|H?SuFjogaC>@7Y0OT+YHZGctIiI2}#F+7Ku6>PBUY-T|9Z&E7O?;4Q0n(EzXX z;MCx+cNEkYCp!Curk=`3JcFZA$ZKm3%D}!sB5)(^FBZ$XX6l8IWG?)bi1SZxqua zW%}MLsN&5H*GgjR>*?Wj8y7mH7;jYRnwXQUCcC)IhrfFlWpq7>#Z)1FjVN0WmbB25 z+qH)~hM`X>le)wQjR>pLf7z}L{D08_2(v|~818e>p9Tm8=q^8@+$a9B#rSF?u-40a zkA4DEHvbP!uKRVQ!qQj?e0M8=*H|?`z}o0RzO7}zWkbb|C$aG*-`+9ghAGahE2`!W zxZgPq7VL5-ylrp|Tw^&eHvM&ouDhA6F zsr4?-1eC)hlX-J>6*G^hy8#=WBfDAJK~p&%9cp{t4OFfSlFKPHfDXHHvg$qzZ!fGxX@p8kc1Gul88PvU==0Fo~ZIO;|u1% z!crF5nwhyMe^q=1Wz!p3b9Dl9bPW`lx!KwLXpKo7;kggfi#lO$)nF6?vS_*2Y8FOGj1e`yz7 zK5L9#G}Zuu^fYWqLO0kwtA-=@CB{2LuNI;SkT5&ri(e{-v^lbWcqbJfrXp;+^i+jC zF$8C$w0-gzfOZ*7b6MG>_|TiKEYrafk+o8hm+_gfD`@sFS!auBtb2|QXnvf?=r&qb zTN|uD?hGb(X9IM|jP0lO)XOp;)GWuqLROIl$b6H@^!DLSP@62_9|=x{ zwWH~5M?bDjlr3Fj^2^Hmu23-her-_}b+1OBgwZGwqE47Yy2JA|L{LkE{V&OH zW2K)LW8YmtC(Mr zI8MK)D!^3fBc;QQq6gWPGT7FJc?%`-WP}!47Q82Cs`xI=47hUMuFIXw==P>M&v>M! z=gUxf4Pom~z@InY10JYXTOU)9ND*>uW^ugP-F)}LjLX+B)O<9Cucsej7aTBpb5}P( z9840&3~+9juWoi^Kr7I^UdTFM%T8wG3eag#vEyHcI%t@)%Z4=Y858Oq2i`CbD=?g+ zcJ-8&mR^3tK4nuW;9csp(j4Y(h-n1583E~K>M_onsrXTGGsw8$sl=m5JMoFM=Gz~+ zY$`vvno2-F`YNj0oinw=?67;n4radOIQUg|pmt#;_nlRq>AjC}%GnpchX`aQjboB$ zL>S<5nJ1g%v3343o^`jc!KANoEa?cVd}3%>T+XazlHN(b9l!fXcKL@xGP!-YB#h772Ss^@?ys;Ph7`N)+W|JC8O2Y@&EZZd;vBE2(q zI<<(n2ldGT&Z!GCwCM66o&|-rcqPh#LeV#tm}To;hbnr&d-Deks*D}Rm6l6qf^O*q zn~GIE=v}v8#XKMf9_XEcokI3ntBKN0g|w*Y85t25B)5clkKmEsbcLwYnK&V`M@qmq zsmTYSXX^%S^UE(C4|_WN;m5*|LCb8{P}xuAUmWT;s1tlA6^&XQF)px}NUn5gj1WiG z%(dK;c^^lF;oEF@J0GUSXyF`&mboLm1vBoL3i?`qy%TCqW6+%!;rP}83`Y754~U2( z(0wIc>H2f)Tvihu)7DN%>y?+_bxTHB|4Th;KnF(p3=mzu+@%|#RhZ~*152$J4iaHR zO`nwdI+T8dJh2_4RoSs0Qi&vH4+p+9>PpiSf~oWH7h^2_*aLd@LF7Wa8XZ_(Xr9Fy z=>ofq!CV-J4^U5F($Hxo(`j?E)ru;6nZut3=Y_Ww%}{&t+}Z| z^MP$4uenCdf3`CN6v&`ry%=t^)vURX<}13jz9ansnjU!VD%L6}*e%n;Yv7~drTIu0mE){W*vkk{;VV5>-G)`; znD!|8T8wq!)RFE5UV3EW{Y2Fe1OL=JYuEI%5>;*oW13$fT{tNh9V;U1FnaK%F|Z~5 zgLG({U*3;9lkE7608C~u*t|}{kC|^Wtyy&DdZ1YEp%-tkuxN56u3wcKCz%Ap6hUyF z@LN%;2{83==8S%t24nDn9*f~?p4lG|tjF1a5(~C$d)SXrdyv2p>J0%&;)TjJ#R4_dl8d>jl51zFsPIFb&;}Q+L_d;-;>dCorme^K$j0j z6P%IuZYLKvA{?;K#k>3i=sKjTD74ac@o@PLyDFR3qe z);s!H!wtZ38*i9HJG>mi8v&5#6oAUGHZ2k2pdzn1Do%a0U@m0pN4o)M+)rBO^s*?b z#GJ91A3>5dG&KDs1e{WjOZ~fzMt~Qs&WAI0v0oTCxMfDQfjm`KPE^jhT9tE$1(cHg z+7XEkm;y2+@KBSWqcFxGrG~8=VEi=E6aH*AQ+Dtm5W;~6BJf+Dta+qfsu!5bTYKq` zG4Yq`1uwaQPMtfsS93v*NY)P$Ux7HGrLV6q5eK{+J=DQwK0l<~!0g3J8f)cQxwYOk z;NVCtVh*ODH^dh5e5~i1^4(@2B#t18?~N*7Tes#+_6zB(_Svrd^cqt@R;{b_@q;74 z2Y82mqOY+i9c)VObLADStuDobatz*M2rxkDqbLe2En4n~JA)^a#|$k2$#Gj;G0==E z*iUAm-+9`fozJ8;2_C&`@8rR6K3wLHNjKh%f~X|)3mf%h;Rqz8QW@tpb~8s+y~%cG zl=M5B`wI|>X-tUbbrs6(5!SBeq+PFkug2H%~bgDqxcYRf+O21fhh0b#G0 zQZmlxS?ecp`o^mZ9L|1rV(4cnHwYI)&#)4mwP%IyZ; zLtq;rjTsD6YcD%T+d8<_pp1aaT4g&`FE}TaIAV(l)Y1Wuy|kO*tTlB=1Rk#o(dCYC zwQ&X2r;PkMKzCJH@l&PeS@D}*@dpp6}yI@z9<2NN za-6*6MW%+FE+rX}aR9<_c$RDgkTRSJ+cG=yJNQDcWE+khP|GXjD!@;D0J@gUV8j9w zUKmwUqwh~1Z4S7^>oPRWEo|mRSEA!WEMwJTfEEaB3pqPOGkD!W@9s@!h+@T*occy= zdh#gHYeJe8Ze&rNsXG1>$c%e==ZnkUklP8=V%VcaIh;c$t8&3o)9eQjm2U?t6a5i6 z;|UIrD1{l_nWaMo`3-=V;SdV%_5rvtzQ7O4DNr`tNR2f&Nw0E7P2lN>FlyONBa3dI$te|dq zEsrKRNXw%%1_CGb+v2L|Z08%rOAA&JN;Wy|mD%PaO!bCY{Vr7*za2FWa>UVPkO{a+ zhL~}&4g+z=Y8ucj-997MK%Z#YaRDMOst+uj0?UiMfeD2$YRf2l$nWJ~-wTpDP99P; z{T)o48g32kr!5?Gk3C{LHwHd|wBcY%OslPSwLkyx4(}D1@YDnKtV#s7r9Rw z3l?F@DK8=4ySqGJe#Z(bP8IW79=u}I>J(ia-=G_PXQ&sZUlx)GoR2~~qH4_0^bOG% z^@_1&Zzg9d=|~h*Eag++%@r7*o3zmVl;oOUv%3EQ#8;zA@U*NRbhzhAx>~$Nl-?KP zwWXQUFdR$ZTrZmp5H9i-F4vw;xOZQ9Kv9D^%-$@;(Jr_b^;O0pX31A;bwmXH)KMCa z5y3L2Dckm3?~%8>F{YCPD~3Q1hN~Wm;c+C^S`%KKNG%1LI3U`cw@!HO`=x8j^$x8u z@&{MiTUzAI&|bEa43n78NXcNgo+vzW(F%D?5~&G-L!v^|LZVNpX~rtZ275bfu*!yu zgmM2~zgaAaTi~k^;^1j^_?j4?wOqUPMU4JU1n`QiQWc_?Dn(pAI-=~?W-9&J9?B-J zN2mZoj7o<$4O%;CS{s{Mh`<~qJ^&qE<$baD-2^#(LlU4^?%>%fpW9bhKFpIbCm8^a z(Fk)`#1lYdX}*pm}EBfSeX56RgzI} z&NLjo4l?(>0#Wht?Dlg(@Clwy*!mi3QUB>A>d~Aa(9TV4vaU083Au<{m)>+>^eY}l z;yye(dKUb67esf-b`kEEtLs(KEA54}11~H1=(y`_J<+!3P4R*`otA5agoZGF^j${T zO#LiM-$5)#;21eGc<`MmJ2}xSxrW07J2s^wvih(?+g~L|L?{wu80>CB?J%1-p0IKC z0B2Mv0tnHwqJ~2*c5Ae@Wlu1PB#gg1Sm91^p?@QY@%MehABfP7jnBYWTWRta&HI_o zSe!H7!3?2y$F|Iml#=N)b%1@iq%+)Z;HmFY&QmhLoKt!SgbMw-Vfq*uRm85Se^M2L zQOT{xxf~VR6)=_TFD@8~c+aXZY<{_32&pWrkoxm;kc(kvZ^o%wIm}00W0)FDK>wV? zzWam}!x8?zdZVz`Utci(tFHc^&g=ZQCYAn8j?t@o&>ZTgk?T#cUDgMMQz2x}B@hrW zvu6)_2$X>Q{4d3|`8IdLvy%w-ZlvN?qk-&M6A){;M0i|@8NFE_L?SdVYcpMZ#K#G2 zrxpqeNRBvY=u{ENhzaX{!%%u2>}81S;n>P=0viwP^{Y~10k%B!`Vps(bE$WHq;(wLTkQ`Hj&)2?0bVr$9o=Gs$*gY@n1VwRd#VIKZRrSI;9x zMm5N}N*y}BsBATT0AJFTg8jTi1}_g!6nj}rMf2!n;`xN?t-9r@yPyx`bgoLo)}2kz zH)aiQ0twpp6!QCg$c`Jc@#vaWuGl^)>8L|J-04l9#jH`mDJ`^ zOQYfgV$^`%nOY=1`eS5O%fdJ4|oG;Lj;4EXMZ%!Si<2rYK34camvqxqt>3O*oM zn%=G&a+CrU0X5?ix z3#|FxI88Su{<=mYBxjZfObEzga`0yubf!$#sG%+f11kd#3KZf0syo9ARj`4*74TDOW?yrnGt)wdX?iD^3C*n!m^B(Z2^Q-mr|x$t!kYR9Gi zkEyAt^`FZkQ5!{_rE*SUzD`=!we=|{IuvROEi4F3yhEFaFEeNEM9MTKdeCO>9^|33 zn@CQ=WJCPBPu?O_-R?O9mgR9)bh1L(R!5X94-}K(_JPe{1BaauxO$Fe@gSqe5e)Jy zRj40TKBcQLWPz55kwsX)>YA4F^WjTj%TgV{oQT>_f`n8FaOO@XfbtS)J2xkX>6-vx zXe?Qcy%#AVta{(=}E6Yx3qE@ru`2lJcH(qSn(E)Qvdc$3lex=$94 z2S{%GmhtdVP{JAi%A1bK4T} zCykwg)EFE~WY6e0Q}z&1&Irp}0D&f_uvX9}x}HIXF`d`PodR#K0KpmQ zZNC1OKYT%DbwmXBCNZHY18gEKD-W4JMbvGODn0X2HFGd$GD6&w<0%S6A}pPm+uzrq z|EpHlBG-3~Zl&Rw-wi!OLn0-^ba{z5jB4)m6cAbeDI@9O001GuxXV?^1y(tU1a$s^ zU*+ELnz-|7y1zjJr<^a?wBqE!gq*KmSq$jyZWmTZ3>1L}sKrp0Zfv8{}6 zIv0T)D{mj)qY@$5w=~%SBB@+|n~2td6i|MkoLbDK@#(r3eOuZu_D%b1^k=CLO;h@- z0;lU_J@qpxonEl?8u#UZ(p|CKAkP+|aqhB$8faI-QH+b&E2ApHb3_G-ac=9%QxYUEV|rn zaIXoG1!6b};TE#-uX6lAC6{3G0t+#$J+hYmDpq(ia1bQ~IZ2ZQNUu0}s6%hJHv^v)FA+ zH!x!jl4u`+)%}r;5J(m(k1AxedRw2q-G4?;fbHj7CCd3`t3x;ZG|r=x{8cvO5juM= z9z*nUy^|_gjR0)MV~yw@$lmoi`b^FMb7t(tP48cgVL8JSMIV zDl-Had)*XX2>Jo~fkBgAJd$EM_BGn&PK20qmZR+&rN1?cYL_;>rG0?R^M~)d$hp9(UK#E($K&n5SI%xh`He& zp*De3S*~;~FC;qU!y_#EH{Jwew*J&Xg+lMQ-5LE zFJRFSQM6|J+~xD@tmXiV{@1p;5BJG+BCN&OF9O_J{IP8baMbGQC*XLfh`iLdw}p?7 zwdU9VzO8!w?^FGH$$h}uy3I8E+7uc6d!3vg{A(TwKLid7>)OeH#%QO$5r04B@;_h& zXIL^{P(J=eM%Yr6u1kz{DFTYp$5I9h-X=A#k|Nj^N|03V+*Z-fC9anPEH4!*K$N`!< zl@`;Dnqng^{PyDw;CO{_QqsO1H7}gyx!PsRB0esh^tR~M{cG369_9ReR0JG}YrE`k zU%Pkf&BvA>o4YMm+a8md{LXeNE4SE}k{gCF=K$Avih`CuoN?1HK!`bubZ|cW{eJ)c z<57=#Kz-6_Do>LiS?b*l(kMJR-9o!o;VGzMy&hMcTl5Olpei_HcwFW8QEA}bLoVPz zMM4E|hNO#M{dRQT&QuB8s*)MNsgM_$nbVs2tTgtE)%0v%ALREtS?43$nr?A@y_H7y zEJ}f%;4oZfk!?Hg`;W){)7Sh2j+gCj2ld|P04J+YX4`+;*gv&G#UE+!HE;!_@g3t^ zg@@n=Bdq8-a5X$$cA4MYTgj=08~<(J|99>2=c{Tz_~usy*HzAVXMC6YI?%ZE&&J1h ztKXhIYu2H5`#%p0fc0R@ze#U5t}D8=|EO5>lk@WSbv24Te;!|2>g~K|8kz5|D#q16LsRmkJ1aPADSES&w> zczgA#72BT%R9S7mbR0Av^#M3gWqIVt7vRMAw+q0_&t9u0DOu|&e!jl{pXvTBKHtCI ztgcSn`4%)y;XJ3d9ynR{P14`z-2c=2|9H=^EKb`2Tu|`&c|F8 zXZ(KqQ{wsg`Sbmg@`0n!ivMOCCcDi5?w*~X7n=9`vD6#GpK|+I4bsoe5fFX_oB}Am z0c@BBJvCDi(TB%~LO>g^rz9ES2igt+t2dDudpUv5GM7A#$TRTF17bKx0?YH%1WO!e zfN*>PE?d7hyXP^YsDXPA#8|)sT*_j!VGfQ1NLZ?X3uWH>9s>;=qgV@dAz{aR?D($s z7}pA34QF5^*4#@1>)K z@G0PmE`8?HE0Ih@_TvI`V9?x4k-@$ffsrW{xEF7FqDK literal 37827 zcmeIb2T)Vp*Efm?DxwroL69Oyks|OYf|L*yMWm|~MF{`bLQlnz1Lplx5`<2AmF4EA@chS&nMef)J-1&NBOB4+a9h3E$GdebBRL?lrIyhf)yl!TpYGH5T zY;AT?^)wBQ+@nW&##RUQ_JSe{v&9bA-Dyrpc*;bU3C*#+*m$>dlx&f0*Cifen{(>% zr^)VUYoTLp0sPWaHR6ik4`s~nwIbazDN8x~bxer0EvC_I*3 z98zFYTHCcS9EF38^tfPq7#|mi8$Ih0q!s5(lNf3m$gUo)sE~Jk2W{95ZIBQP3KI@ghg=#1ju__eS@jW5{_%sH6&FbkBv+vQwvPzluhMOI`Hl`!lzEeSgunLerxPhJ zv;>+;?-1d6XS;1G(08-i>V4~S^-Di$on6U7u_&}=m=d5d zE-ty}ymJavVW#I(a&Xi&DOt9$Tr9CU!jh%;j;Gr@#hNOt%2KX0Bx|)feVP+nh zz5!8*3~zz}Pll$os9)_P1FI9&(|+>>!~1X2La`E-*79u)C*yBEJSC0|7@TI+PXtvM zB*lcECP5_f_f`oi-8YHa<@!;|ZE0@N-5@$*$H3E*?2Md&f|B~VQ>Q<|4RVEFvq17( z;lTr4A2rb-HCvDUZ%BTRv(ghN*#+~mN^xsoxala+EUhM~ z_VmvDLH>|$QU?yj@jVs(bjdu>yixuFlT7t9ei!qZ!p3H=Edm#jvH>LlqaLTK$d=~M z`*P|lFCb-E+UwivZEC{W>`mmM_67mP=k$@qtuAA(hb=j8Nw|LOY>sxWr@V)Zv}Hg> zWUuZbZ-;G#PoVYlWhRb)*53&&axkh;ol(*<2gOV1*Nk6buLI}q*L$hkH&pRogvN;Cteq%>aAuk+;JOhdR*qt zVe4?+F68N}?GlP2=J%A|e|T@Mu06W%{#}OalHTsJDQu6}jf=NcXE>OrK;PbGPjZ>G zf1BOfuYCF3vu(n@34^#}Tea*5?+U0XAK<@dSL}TkGne2FQ&;LtM^w2?*(%cC@P+su z2kljU?|A1xZ$O#ug%bgGJ4754xQ+Oxlj6CfHduZByOHC+5k~ef_YjZD6K`dn}MbMM6(yX-> z00=n?L$#Zlnlz%o^$waX53FhEfU7OQe@@^(4GnE9?XNrZU9nq#U2jEFe>@)kGMI)2 zOrxf9>aypS$?oFd#1Xyi-$!JR75B{9MYnf$tLWeG7on#=0)Bb^%$a=*oQFkOPJ_>| zLJrr6G>aTMyj$e>&jcHkquZ$ReYBgx|InZfS2cO-nw(k)T-CG|5g z_2=UzEnp)`BQ8OcU)r*drFsc~Z_{j{rQ5;6w|TM2g#S-8A(6d3njCLz;^maI_`O&Z zm9sQITnxiL_?r@z8}C?}nwBPdlv3UsmsCCYi>e}8=$Z6!;H`fd#&j#KD%bOOJC=X$ zYo-lHc2VlE8A{IMv^FJ~=Y61U=79wGt7&3EztY{w{9d=)y?K$cj^E!yQ53Nk$geSdPT33sm6rCS<|7LW# z^mN!4Sv1&K#I_pH#(3V->8p1?IZ*00ZXlV%? z@u!zpx{faD9i1!SJ`*qEP2t~``9t{;&u^D2ol9cbSP?GoXDKk~DeGX^Py~EJe2&4o zqAGt(xja)Cu*k4{2Y2cs*R5uGDnEuDU1p&>*RS&z5nzig2%pX6{^Z)GbXV2q|F6n? zuu}BM4?Eb8sD{BQ4O5l)DSxS@V#ik&)?w?dHc*_;oWo0j3JT?SX&>;~pz@b$hq&1C z(kyJc8=F6d89v*tYhPUX@#)zQ?7MikEKAnNX`zR;rDrgJLQG|l4aswa{bPTAA>!=4DJJs4dnbm@{hsH z08FXwd|$OT8VunmqNDJ!jDou4|*&{XTmVsC3EnLk!EwRf79oNOW?kqO9pm; zmVcuIm4?0$a74z{cHO+pzn1+}JuQ*obM)8=%=i3!U!!_zG}jWcE4`$(GqO$ibc^Wk zn#^}t%F~wZ#l-`_o3<)_WX4qE5{Jp_X{8`{c+qb$2;Gj^JuC%;r+VRF8H92tvUm|p zoU}EADBGu(Eq&=`zByrpTF)M;y$(`M4DBDZL*t0!kgrb(cMd!{b-`r>-7BF)!P`P7 z!q7X@NEqo1w`b5e_#n6*uN+|6SQBYBKyTX>oXT_xf`rr>aFY_*8F97d_Cp7;8 z?^Xc3H=cOK`-h~KDSdtsfcK%!<9~toI6&~KXg}B=8u3HA|FMhiv#Lpx0oIK0*;@b` z#LyD)3n}%J6g*F@8+-xQOJe2u9TixBxEtW458bRYE#2_m0f_f&SSBGi5M0-Udn0SM$9 zso4i22f3dA{o(JLm%2CBh8-+B02|uscVR{Me!D;vbFHzRbpvk!QUDrVhK)6a4?xAg z<$Zj>kIa0cf3E2V7wNF}>*iUb=5#<7w?##8WBs~)yS#h%Z{+_X4gvhAbo&k6#`ea- zQc(PtU-(#nAGfoF{f!B<9L3!Kmll8?O8+qTH?Tc*lmAV2N(?Q;{jj(_b(#b z(X}beO<``?w9HM*WZ8sSx=ok`T-Sf;GlOVlLVx)$4GBl*X)Pkb*cMW<)Jzt}E!7k# z%b&FB^%+YkhI8hhiC!C-!~&&)($+G~pS9GkQ+>n5w1hjxM0a#||DA11@k8mNFdyp) zkL|Xa>T4aH$Pu8BQRsf=XOyX|-RJnPWPwMPgB_~GXI-9y$OMQt!<>=*@p^d;t+sDg zZsQrk2*e)KVk36OOL3iRF3~pqx4z#SQV&D?#Xs&61_CL2LC!x?wPp9aKI8Z!(2$A( zqUVAzE5D5gzX?Ro^#w9Ye~F$Q0hiye|LV}MuwxzNEYEd;=y|YpR^yLZmji|mK=k~; z$p8MvQGw|>AY}+NYC5)l%wKZ-A6>NS2e;QNYeq2d^_*G6^!DWAxeSm!aKct)&)23$-R z6(b*h3HZgQ3C3%3sKZ$1wBG9NZW+G&VLtss%!@lvs%zMczyM)xeztnZ&k(GVu1*5} zlndkt+2eum$^3Bq=n7jA@2REy{vocvl=7Vc8ArumSgY;7gaDNC4S`a==fb(al=1=P zQnF0ivohDZi@iW8pWURaapRPc576rRE6M9~(-k7_0V(0Va0l0o74IXUSuW2+*IM=} zZ@|}qIDT`vKV`Tn-A!fQFrhzE7SLmMSS9O2k8YxO3{6dq*+b zB(=UKp4b3#U0GQQJg)17g3p;Upy3v6o$SY2F0b`mzXF8VL?A{=OzWgOP0L=F?@qa= zlc{B4e=r~4IT8I(Z2ed0WxO_}1w1*O`d5C0(RHF(a3JRUVkGcQMfSDAALxzfq52|+ z>vJ0r2zavCyTH^HFLtl5imo_?Qot#c-fQ`bFWLk6u{|~?4zKe;D;0`az!?$t>mz@y za@Ai@?_2=9sruWF$1781iswd#&_9;5Je9~HAT-Rpd1h@*c6D^H1K^D|7yOIu zn-X3R#+xd=mLG^s8(xQAo1pazH>byj&J-Ks9eiZ=EHN9Tt<~9EGC$XiTACaouW30zxB=z9i2|RM&WQ5cw8F*s+U>>o zZ?{vSrs@xh@xis*cXTQ1d~#R~5l1EY9B~el%WYK49x#OApg6>Hip)4DOA3*_ipEvr zF0E--O$Gwg6x+_I6#(#%aD**fnil3Qo?wPxwjxQ_ZK`Drd`h;jspNg<+0uJ_PKgh8 zVKp9I2dG*CeaE`APVK&-vs z0eoBk@nZQw+G2cC_h>XzZ{O(c#npPK4iGt;_)rplh3rug<#FLx733AOtE0zHQQJz4 zWVPllO0F$!g4qfbeho~6IL7MPcf*Fg4*4lgi}bk71Y#oUsGN&rUuET+qkWMH`Y4*2 zH7j2eRDe~0kB`?c-(9!xmCP@h5#TH2_QJ;b2p>Q2*;`8V^v3LK0n(8c$?~NY=B>M6 z0rD+Xj(raABRd;n+H(t;ipcfz= zwq^L29;{Hie1Y%-%82jZ?AUlgm)U`i;7#%Vl*6WY*J#+L^{zFUP3v95jZJV~aTvhG zCOEHh=NsERdX*~GOIPEP z^6!B6?KgORY8Bu-_7`|L6Wf@X&`1g8qB+nKIxTnPnUJ!yZye|99wNt`KojxsUMrKo z#3^(=VnCSJD>g8)>ez+Y3Kp$wm`x5AkJ&hgBRk1)nLf?jEB1r%0h;D}Q)1gzV=BWd zrVIZ_U`)TGii?U{Uax6=RYp{a%JsjXc+cJ_s2g{IePN`Ac*E=A!@P`KF}T=+6%m*;Mbf_WA=C z{+l+9h?C*PcF@&b?W+mLqdJ+;kmxxVT)&rg*9V)@&~?!BLq!qC00crF%2VCV=h)8E zh3OpGHmbt77G-|XXsZFBP3Aq$5iI>t_#{@@JvG>ODy$Vx%#FboZuElhUI1ZK8>cfP zSq(w8rApHc^MgyHEv@!DyQ(3fOdDjK;=l*8&F$hF!yB$iYHCe>rE`j{upOqS*1wvR`v z`LmM?p>a@44__hXnU&BBK>+%$dQ}J5*SPlcj0aKNTX4X3H^GnOTSc&XZ*|m62{eyn zLDXU^sLz&;{#mKxVgsTn+m}_V(UeqC`MsGqk9J^dnFGPowY@VH*uajjP3%LtnSEoL zJNMIBz7YUwN7*(Zs}(;(<37iQqZg4yMc!Pzo#iM=h{~`zLzbjcduLoYX!e5v>304z zirjZdeQM{w4^~3M5(%JCC{Mp}Ai23Og6h9EH@R$fUjqp7Uv^(_?pOk<^P4-CHg_y- z?pWH~OStJX0eA7=@R@xgI%n4JxaBz2_bAWCPPtZCA7g};!1eqJHqq2_oMpJsY5)n2 zjV+(!!tH|2ITyFac#Vt*P^?f6aMDs+CvQ+!+{&B0dZy3nedph}EO`DU_;XC41$`iC z6e_Jdz=TA{gDUZT@(egEDR2ot9c)DW#3kVI=2z*nd<>`nCg#svSUc!0LC1byo9%Zf zO2Z%C5xH)?eDRas1h((0(PR1v*VjJ1n%{F!_tFgL&;DgUL=zBsCmKcE-=JaujA5z* zlo|Yt8ri7P{py&%st6juRtu!P1*gzz>2pmX3c(62L%{y5_C~J)+wY@+4Mas@*3UPn zoB-3E18OJ11^bjX-iuN03e>d!rxxva+_;*PN2{;q5;3te&G3YfY13?8!>Lty@aafzVIVv-X6avZZ;cKA zXHRaL9CJP3#X3|O7s;?8e9+a_FdyNWOK2^08#`koq%c-DBb=71UNZ3WlUEI^;{%_Q z*sFqTSg|?`;yy#chtlipmp#_%sm^vpi&(a8H)~5!PD@Re5iZ$1@YT;grDQ?Aev{OR zL!4_tA@E-L)A^FQnxPi#_-BpWLAIYC$8?mo1cxT|$guw9beU!yK%)2AH9!7EqDp{7 z$Bo%oH^xiwZa|%EJR9%+WlLoXRh>2`|I-})AK8vb8ozg#f31Xp&5dQ?6gTj$U8XPE%T1258>y0`EMNmIq%TU%S)Kkg>qLnZnfG%OWJw9 zfFKtCmv6N!qlftVd$v{|UC*f%OKV66C_!Bu-&lQV5InSduu6`TYy0`uGH!G7bpl^i zkI_R?EoMmL-#`PbNr%_0r~v2G)4fhIf(9CAAy4B==H_xv&>FhR<4V*|B^KpF7Y>k@^O5>WTNJyXy z)5O74aU=E-&`}$UVqu}Il>04pH<0-7s#y5EU5^Bq%M}oJTbmD$59EKuz*NlIA0)(c{t9z9;x3vDIX8J zlJ|C?!+$$(O;)#0w(UQAur^F7AS{&mX2-1S+~8g+P`(h+nF`MldOGoYF8-MD?UiVY z2dOn}$tO`0F@<-1eA#*yb6Wy4Ia<=X_h8R5*8)h$5l;op_`JN0bu>1U7VDVa7vKH8 zs#UTgJmZ?qy9W9Dd+WQ6iYQ+0+&1lh9F<1R@({y}=L-y`IJIx8^S>R^+m(7r<0&Tk zvh8oczYN5tT>!3%`Bo^ZWkvPt7Jo0s5WM-pzmOAAF+U=0s0T!)3 zo!|KWGtJ|Opswsd?q7}riTwmPBh9j+#b2NOeoIdUfXJ73^X=bwyUDdRMT9j5`=6{W z&pEHCZ+O;^>2cb08wrSV7-`mu)2Kv$0NaPgD#8bl?6|->71JERfa2y_IoGh^XK00Z z$#_sYEY;+n2&n7mZVC6TsgpBK7Z?bY?rvpI0JsYdyn1GXDD0f1RPNzgA)#}Jj5&mJ%~iqYu@u0KPuuMq7w31<}2 zq7~Q+;LD-Bgg4t4xlx3eJyxnrvcCx$9$m zw0*}ws3Y%|ETKQRPWM6}vY+D|VS3`U29+(B9Y!rvy z$mZNS#EtZBcN_5$%F~DB_pn|lXd^EA$NXCJio%&z&>lHda=qJ+i#wxm*6*3TP*=Fb zm#jD*X;Vw}H!;Fp!r|tW#Jj`no!{_s-{*1yvT^?ar4M)Ar4`Q-(L7OT^2+8d1Ps!ELm+T;d`@YGb;;u?_DK{b9}f7hqBKh zm*(Dag4=z|G~s(0cxJcFmwCSWL??uY;m7Yw^hRop!^C)I3W>V%zFdTtz||gd^7n6 zCH+)2G;V4~S$*jVgjO!8h8hVt!>g+yU)s)<jJ?k&#=mE!J z^S1uTPVFG%y?sw?wUKX%iZ2&?aR&FM3YhIuI8=2PDlK&Fr1sobk7~K^cT)XrH7lSt z;=TIbU?o~V%4oWurDRN0as{pf4*Yiw9v{Nps>HRMFQsW#*H4=72JM!Uy-(kjJ5`J~ zUAWyX;MbcPH?YXdg|p%D%e-zxc+t|%HU*LyFy24-9&cEd$f@fV#1E@)t-^Iou^sE^ z;ovI!TBz@qcYln{D5Qfmb!_q(hmS+LmN_?n#3y|V^{m9#O47q7tY-GP6qVi@9$vGy zMGj`{!^fzWm#SeMd)wg7H$)ZePQ>cFYkn3Z#d}V1<~iL^bJtjk>1Ib+wi#^8Qs4Dvb=q_0nsbcy;H!;%U5=Uk_P05(#ruTADI$A^R)yU>b8*X4`lVM09PR|{zs z21-Ah4M4v%N()W;N%!C1dAIr4-TCg$gHBqNhWI%@5>ZLaz`|0j7$y4h_{pI8jyKKC z=CQO-8%DQb&sa-zxI9gvoLEy)!t*Q3NFg*k!0JO zH;1boN~Wq%6MDVNS(u1H-~3>(vM~R=>%&(qw@Q79cnsXwUS+v336!3m2ro2#4Dpq2 z@h70ug9vEe@gFZ9*EP-ZkNztBTcrC7$fa%pWg*=Fo8UhXe)$Q`BS7x=u{QbA#@g|p z{5B#^gINNsDvUDhk0bo(y>2Pu*0_bk=lShbe6$(-H~AXY=F3^RK1~ zSNNLkYR|8np3?=fY$dpT7&o|rVM07pPnGPDrN;IX+?C5;_POb5IExkT{!=_=t?kpvcw>ni$I*t`Z#J)9)RIj-pm9)C zC*Fw|c&x5nN=9bxn6$mJWEIA;LPkwC(1c^CY0w)w8%cv$+!5HqjkSz+Yt0M^2|@bR zx||CY6R>tZ_0}PHK~35Zbuy2eYbf0wKqeQ5vW4LXH@tKcvO0}J`=Y74umpEf3BD*K z*xt*XzPldNNJ<5))2GEE+}Ir&EbmT5iAgG@KBwvh?bH07NV-o77H%Ex(#HHS(!daK zSQUmNJvc~(X!M@a#gT1L^*nmdByUj3mwVwR-eYM_MMoDe+y+DGtAzSN;ff14cC~X2 zI+IAL`8|u5Dqk-?lQ3$PxRUivJrmc=(LjM#2XRYw<=LUPKJd1#y+zO&bf+GZTC-oo zW+{ruT)nT6GFN!281)us5^n1V}FEt$%KdNG;qm`;y57p#d}&8>U` z4LrcBSSDJFM@Zpl*RSKAyXS2=;?0SWYMb|r0xw~geW$J6y7XMUZGAkvqeVE<42xXH zkd=#1-=7EoAc{jBkyV9V$PkE_?c_jPhG1q|a;cfs;9;FGC!d+&FE%&cYI$VA`Kl&D zZBgG}KH%}rGAGKBj*p8WZZZU(eGeV1dgKsL>wc}sRoavCDa^oRAzCY3nuqawSbNMK z32S*ttT(*wLjWT&|E)Xw{?s_Ci{u6-trrNA8^|AU8`v&T2Vl?CPfg6uGrt#OoY)T}7E;fE#deowG(|^Br%|p4qS@z?EqMV( zR_Vs>9CSa7Hb}izIL&MJ7G#O#^tBnOi&k!wa5xs!riNr-d4mKGvSEc|JO{2%Md2Z} zl3!+LT^CcV+m7@E;(B?j<45jGSc#@|)6-Az0YbfeKDJ`&n9@y*<)B+%n?ND?o&DiV z+}Cyjx{@@-dpB`kn*`A40FwYV`T+ zwVt#~hdU^TdJi~MA=xBpg6rD0M})Uv`J|JnmM=;*q$=abV|8=fP6kAu5f^`XitM;= zz7Fo&`>bWXj0W`5Lvj>|BT9}{%~e;JF_;{{O#}pQop5^&rK$iULNpNl#1;-QRaV{} zoVh45b}4?Lh)VakXu~{ECS)B~XJofD5+{_z3G%QzIy8UcJ(+F3Fg>JvNv;f6nbnC= z08>B9=;%`A>UoFKq+7@Q4EFRNBEP>2REwi_V%oxmY9et|Qe-FQX(vaj%491F$hU$8 zM-$8y0DTkJ!52V>BP>A@J!eqzsBM|PSH79`grr9T{Ee-neWX=T-Tm-Eb!7*o?JGxl zKEWmP;oN}cV*Q+pMyA#k%zm>B;6n^TerM=OSXH$_FAP^oAfH9qPc1s0d5LY?S-Y$` z`m`27-O;gwY{|ia+NrSPc&OY{S>)K|>JwDzvcdFKn2!X>LcSjDL{<6WCgKb|mF#BY z*hU7z`Isn9b`f}#hBuEPgn=M;6JE+e(N?R6AN+QDojjHaz;yyp5(6_Hkg?D-ku?!Z z`x5?zs=M~f6udQfYdH0?om@^L^iu9?5$%9NXn6r+sFJ-yN7hjM6nWv>d$)F0Y3M%? z?Rs}*;$${2*F@!A-!gO*V4Gp=&y#)cK43BJ>Tte1^_`;uC!R(yEXyx&=q_^OG9wvP z+Lb=5U4sp7oXUeTLrI0!zK00+erlv<>;*HA!&Y^S6!xlur5u~I!kZ%n#*8GO1P@lG zwFpKxl4~D2RXq~t4ZcfcuHYcQFa$(niQG#JuU_0LjS|X(-opAkTlAVWn`(YW75+nT z9L_QL)FSYGb_Z_!(!#qNr9df0DWL$=>wE=M#~w}slYN>aS zu@I%>W;8`bd_!8j1I1>xphH#PX5x?z!A=X)*XP>2sDpbT{;9^yg5*1UDWkpS2PP6F zjf-Z-IX*NI9J*L%W-F79bifQlvu{uqoVrkFX~|QW)L0ulM9&%hlcuH0+1o1K`6+C7 z7Pia{C~g((0$5}Ow*@{^gN^CN|AAFadapTKPm- z;vl?oz#+kn>W7j=zeBDJC7<)$;Z#{pA`SFsmZcZ;*qwZe+3qW?`Zh86pE;$l7W>{U z$v`C@@o;DJ^`)+i>mSnTdYM%Ur}1b9xaQd-_s#;pJz)q{a##Il_<_KESyeB)CDz&D zCvMlM6}~q~;D|x@Zw5@B|AG%UQp7o!&*!mU@tAC%ie$wZ-?MX&$K*6Io$qAFUjce; zz=Cvu_?Y`C;-b~u{v_D!==TAq%%$$Uxdr{&TOMTvlT_ig(2FX;Vw|cDa1AKaJ1|xl z5wP9Ffk+_gc$s|XAvH`FU=gvK3>sNTd*rlWrVH|-##+8~&=%?+FL}YI(^ZWj6@<%nvY37LmGA8M|LBVP0%hqSB>Om14l&<|EGg z*fDqzi`6B>8e8Q0=oH$S$1$uIRPY>>8`E{n- zNr=(Q6Nv3R^YJfT>(l@ZZvay@+={4h_Up&|*Q(XCQ3KE6w^AHWql@&YnsXtxu^!N5 zFJ1C2G%RKz&D4i8ges4Z*ycKZVuL=nB0}m~zglSU25lY09EDzh@BdfvWk0ddr{R8xU z-QoY8;i7u~V~FG+iQ&s=^rFaEI4I47?jxpHEo16tB6IHRvx>tYh$U? znc7Fvc>4S+Gjd~jQ!{^n!YX%&Ebu*e3VB=E z&zx9H%nYC-rNm*k6O&S?tA24FG9Er_efhD>fCeZGEklX z-=VMJ$Y+dl2pH1-oQgU;jM8oQXc#z>80Bnk8wHKh_)Mt$B4xmH`O`M4hMlK^rdr*U zZj!y?1YbMK0RowkUOxuW0o+lm(<`p7$-B zK8#l0s}|9Vc_11i=B3qTx6lk5Pd-D%Z-&d)C+%M(kpY7>eGd3#v94%w zlYZ9gbg1k>uWwJ%#j(8l#g!+-slk~)?FUZf5w3iJj13y{LSnfLKB) zWPtBy8>S$s+B(IV&$EF9WMGlC_smc@gj}jMNBwdP4x_8$?~f@TJP?d~*nu{?9pnFQ zsebTeae9rU%Hcld;9?%Q5I&k0?Ox6OFgrW}%Lid?*>0WW%d=O9&8gct(7C+(j`mr=2O7Zs=rt_)$G zz`bl{eIP)X%B@CdQ%xIgKlwoLNs8BEb93{^pc2t_QdyYi?99u50&}SG!YO*8ZA!7& zIkWFD_g$?hwxO}caGy9|ftn-Io{|9z!h?fqC|0;M320|h_@ZQKYjgP;Pc_b;{b6Dv z>Z`lFqcj@h3PS?`+He_Bc~IHs5js;6is;dnsE{_UhkQdjP9+*{KEQqDprbl*`carG1;Ah!w*VnT`31dPa&-#cw>fB+h|k;-JSAY9pr z5xPCBL&~o{t5|;tgZmf$wFEhOrf*JnWI`7k{8YGe2I!jMy`8+#sMI!>SLIoT3;7~m zSxR37y8=#A)1sd`9Qfq6q$_7!Kx)bgO#w$UgzM(x&nl;|t?n%6(@_V?%U4ZKoC2Wr zN6C5D6;o&wrJiUzcpo&OSK7%3P4k9Sto|*Q*u99Pi&tBy@yL(mBF1-Ws95m^XXVwi z5b#&hYg)EpT*8R_)Fk&OLGjcU_2b^VS0=f9xlfiqZA9;Q-t~JjK~SD&@iQw#1!ms9 zOXPs~8n1Np%AN1)$Qo&Kf=h-7|{8!7}evvZcNZWIy~`o5L5Uig)G zlHs)vyDSe96*aU+RvL*pT!8gTQ?@j$9DRzof(Z2_JBO+UJ*m!EEIGQXE$~TP+6px+ z?UH@!mk5^(e@)23aS74%suvlM^)i*BTJ237w8*Q@o4uEOM`Ntk0KzpirmN-WY#3_v z$`@2a?@}wxW#z5W3{wjoQBiZ^VI8_JVsN&Qzoz$Wg#TB&tDiy2M>rSeM6~^%KArc< zB1L8{wTM9cr(cSAoRwZ#X9wDK6v>cb(bw7`WfC<| zJ7Rzv&L3Lu_Z1iVbPgAkC3!)<9xGBj{48Lk^l)A@M|@Kb2UKgsn0@Gj?nQCta|3FX0M+AlHH0BmoH*p(vD$gEbGEt+1;hBp%&L6Cc@p7-5|FM z1(LxR;9P>rkfJ!!vRr zYk!)D1bqcboI@H^s7VGr%@5x*8J$2mz%?T;TRoki6}Dl^7NGez8D1AR&U|xx0Z*#O z<_dRFB!Y;xp<^Pv{?4wUz85@76RT^#dB8?6B$&y|T16!zkkUUwEtDn^HeGp5)IP2m zmxP5Fkwn*IxqQ2q(4%B0eiG|TBgG`t*io`#f_7c5&0ks$cJDW|nl4o8k9k_#8!-Kr zM}KTe%xjPQmvo%2EapPJw>GeiCN#7HD`WR4y3z&0JyBb9Fyk>OJXzBNb#^Y-~%?nu6ZvrSE+rvq-RM8-B6cK`H0i4vyzqjFs5P09 z+LQnzE`64pw~SL1szG|l>jvAcZ?}Jw50rmO(~+Yq47)Gf;4tm=lC_I>`+hcTihPua zVAsspyrJP}co67_@+ZX^7_mgGE~HE@w=L&{d%|nqOy(r=!`a|fL$+$gCt`+wlW=oy&LV%92wY(KT57SO)NQn+Usm+o2r^e z6I`ywTK8-Ar1HL@yCOoXVETytv7^J1VC$)0w-EF@#g8wPln=}E=xY?Phg0H8Bx)LU$wC*3vPnj|Ya~;p1%3~mJX*-K0?N(jP4y17&RWEc1?Zs++VzJA z2IHneO_c>}Ttgv&(~0Ze*5^~IZd}!;+vV?Q@AP1x-w!ZBYaiJqa^Q`zB>chy{xq>y zug!g4)IH+w0IBz{{8?gz6SbdaBqbfUqAR6T9uwrNUt-Zc?*H=I81b6RD3LA7l8~VE z;1FM-nxeuGC}@~B+UUe;Bd1g=pvPv=1-F$BnAitk4S2qjn-64Mr=&HIV{^NQB&2rLGiP635(bmf#`uq;Bf#Gt2he^-qmB|6V; zCN<4}C!BTY%#23|1f=@32nRj z^}gXeph4$M^rKg98Qv}r$}@{;$m_9l(?bV^e#2VcN^gV3xCTXt;H(rnF298zsWFOk zz3_FUg?At0*ur?d|8$i|@v9u|JNT2i-5`=D@&5b8kQ-j=*Oep^if1)fTfA!iM#TAdvc?{~^CtQoJA3?F9ANtPT5}PlL9Up^wkc%;XIEwghN9^Jt-s+f~uO@_&{jc@f=T$t6CoJgcn-= z(U@xA*y=5b)n$r^9@w=qvd#k+m}uTy5hLsnlsw3UdClQ|Zb2io{#>Epg~bnN7R}1F z&wVn}n1SjZeJ)0*Tzaxr(bqs1UxO4vRu%s6Q~!YTg}sz(FHuLHK(#_ct&X;;*N#1r z41V<0TK>cd*vSh-=_3nEOIq7M+xeJ$M)Agz3bZE1rliN79E;}J!WPN=eA}3dyp-UW zgWuPrZeMg>JL=?x7Z*v}*Fr3jbmocbXD-DB!Hm$HhCBH63TO1>CQ+KeaG zSF)uBgax0q4n8E<3E5|HC3Il6$nXg0^vJj&Tr2ZmYN_pK(4omPIyd!IXjYr|*Bzi9 ztkTEo)Q}zb`mXZ@Q@G@XFrZPRh>P4VV!aTlo96Fq7mAlW{YVq4$v8H%DCgp>s8tj~ zUKHsKdiq&jbF5K%Ojltn0*j7wO<^xy14*kBtP6O4I;fuk-{w!NvRM(*=EbIxtRyJ^ f8y79C^OUH=GD?@qc>-vFe`;s7RMJkH{` + +

+
-
-

-Introduction

-

This vignette demonstrates how to handle cases where your Stan program contains deprecated features resulting in deprecation warnings. In most cases, the Stan-to-C++ compiler can be used to automatically update your code to a non-deprecated feature that replaces the deprecated one. This vignette showcases how that automatic conversion can be done using CmdStanR.

-

The automatic conversion of deprecated features to non-deprecated features is done using the so-called “canonicalizer”, which is part of the Stan-to-C++ compiler. We recommend using CmdStan 2.29.2 or later when using the canonicalizer and this vignette. The minimum CmdStanR version to run the code in the vignette is 0.5.0.

+
+

Introduction +

+

This vignette demonstrates how to handle cases where your Stan +program contains deprecated features resulting in deprecation warnings. +In most cases, the Stan-to-C++ compiler can be used to automatically +update your code to a non-deprecated feature that replaces the +deprecated one. This vignette showcases how that automatic conversion +can be done using CmdStanR.

+

The automatic conversion of deprecated features to non-deprecated +features is done using the so-called “canonicalizer”, which is part of +the Stan-to-C++ compiler. We recommend using CmdStan 2.29.2 or later +when using the canonicalizer and this vignette. The minimum CmdStanR +version to run the code in the vignette is 0.5.0.

-library(cmdstanr)
-check_cmdstan_toolchain(fix = TRUE, quiet = TRUE)
+library(cmdstanr) +check_cmdstan_toolchain(fix = TRUE, quiet = TRUE)
-
-

-Deprecation warnings

-

The following logistic regression model uses several deprecated language features, resulting in several warnings during compilation.

+
+

Deprecation warnings +

+

The following logistic regression model uses several deprecated +language features, resulting in several warnings during compilation.

-stan_file <- write_stan_file("
-data {
-  int<lower=1> k;
-  int<lower=0> n;
-  matrix[n, k] X;
-  int y[n];
-}
-parameters {
-  vector[k] beta;
-  real alpha;
-}
-model {
-  # priors
-  target += std_normal_log(beta);
-  alpha ~ std_normal();
-  
-  y ~ bernoulli_logit(X * beta + alpha);
-}
-")
-mod <- cmdstan_model(stan_file)
-
Warning in '/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmplsuXnS/model-840d5c7122c.stan', line 6, column 2: Declaration
+stan_file <- write_stan_file("
+data {
+  int<lower=1> k;
+  int<lower=0> n;
+  matrix[n, k] X;
+  int y[n];
+}
+parameters {
+  vector[k] beta;
+  real alpha;
+}
+model {
+  # priors
+  target += std_normal_log(beta);
+  alpha ~ std_normal();
+
+  y ~ bernoulli_logit(X * beta + alpha);
+}
+")
+mod <- cmdstan_model(stan_file)
+
Warning in '/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMBUSHs/model-17e6a34f96f68.stan', line 6, column 2: Declaration
     of arrays by placing brackets after a variable name is deprecated and
-    will be removed in Stan 2.32.0. Instead use the array keyword before the
+    will be removed in Stan 2.33.0. Instead use the array keyword before the
     type. This can be changed automatically using the auto-format flag to
     stanc
-Warning in '/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmplsuXnS/model-840d5c7122c.stan', line 13, column 2: Comments
+Warning in '/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMBUSHs/model-17e6a34f96f68.stan', line 13, column 2: Comments
     beginning with # are deprecated and this syntax will be removed in Stan
-    2.32.0. Use // to begin line comments; this can be done automatically
+    2.33.0. Use // to begin line comments; this can be done automatically
     using the auto-format flag to stanc
-Warning in '/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmplsuXnS/model-840d5c7122c.stan', line 14, column 12: std_normal_log
-    is deprecated and will be removed in Stan 2.32.0. Use std_normal_lpdf
+Warning in '/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpMBUSHs/model-17e6a34f96f68.stan', line 14, column 12: std_normal_log
+    is deprecated and will be removed in Stan 2.33.0. Use std_normal_lpdf
     instead. This can be automatically changed using the canonicalize flag
     for stanc

The first warning is about using the deprecated array syntax

int y[n];
-

which should be replaced with the new syntax using the array keyword:

+

which should be replaced with the new syntax using the +array keyword:

array[n] int y;
-

The second warning is about using the deprecated commenting symbol #, which should be replaced by //.

-

The last warning is about the use of the deprecated _log suffix for probability density and mass functions. In this case the _log suffix should be replaced with _lpdf. For probability mass functions the suffix _lpmf is used.

-

We can go and fix these issues manually or use the canonicalizer as outlined in the next section.

+

The second warning is about using the deprecated commenting symbol +#, which should be replaced by //.

+

The last warning is about the use of the deprecated _log +suffix for probability density and mass functions. In this case the +_log suffix should be replaced with _lpdf. For +probability mass functions the suffix _lpmf is used.

+

We can go and fix these issues manually or use the canonicalizer as +outlined in the next section.

-
-

-Using the canonicalizer

-

The canonicalizer is available through the canonicalize argument of the $format() method of the CmdStanModel class. The arguments accepts TRUE and FALSE values, in which case all or none of the features of the canonicalizer are used. It can also accept a list of character vectors that determine which features of the canonicalizer to use.

-

The canonincalizer in CmdStan 2.29.2 supports four features: parentheses, braces, includes and deprecations. The parentheses and braces features clean up the use of parentheses and braces, while includes will replace #include statements with the code from the included files. See the canonicalizer section of the Stan User’s Guide for more details.

-

In this vignette we will be using the deprecations feature that replaces deprecated Stan model features with non-deprecated ones if possible.

+
+

Using the canonicalizer +

+

The canonicalizer is available through the canonicalize +argument of the $format() method of the +CmdStanModel class. The arguments accepts TRUE +and FALSE values, in which case all or none of the features +of the canonicalizer are used. It can also accept a list of character +vectors that determine which features of the canonicalizer to use.

+

The canonincalizer in CmdStan 2.29.2 supports four features: +parentheses, braces, includes and +deprecations. The parentheses and +braces features clean up the use of parentheses and braces, +while includes will replace #include +statements with the code from the included files. See the canonicalizer +section of the Stan User’s Guide for more details.

+

In this vignette we will be using the deprecations +feature that replaces deprecated Stan model features with non-deprecated +ones if possible.

-mod$format(canonicalize = list("deprecations"))
+mod$format(canonicalize = list("deprecations"))
data {
   int<lower=1> k;
   int<lower=0> n;
@@ -219,15 +252,25 @@ 

y ~ bernoulli_logit(X * beta + alpha); }

-

By default, the format function will print the resulting model code. We can see that all three issues were resolved. y is now defined using the new array keyword, the comment uses // and the std_normal_log() is replaced with std_normal_lpdf().

-

You can also use the $format() method to write the updated version of the model directly to the Stan model file. That can be enabled by setting overwrite_file = TRUE. The previous version of the file will automatically be backed up to a file with the .stan.bak suffix. If that is not desired or you are using a version system and making a backup is redundant, you can disable it by setting backup = FALSE.

+

By default, the format function will print the resulting model code. +We can see that all three issues were resolved. y is now +defined using the new array keyword, the comment uses // +and the std_normal_log() is replaced with +std_normal_lpdf().

+

You can also use the $format() method to write the +updated version of the model directly to the Stan model file. That can +be enabled by setting overwrite_file = TRUE. The previous +version of the file will automatically be backed up to a file with the +.stan.bak suffix. If that is not desired or you are using a +version system and making a backup is redundant, you can disable it by +setting backup = FALSE.

-mod$format(
-    canonicalize = list("deprecations"),
-    overwrite_file = TRUE,
-    backup = FALSE
-)
-mod$print()
+mod$format( + canonicalize = list("deprecations"), + overwrite_file = TRUE, + backup = FALSE +) +mod$print()
data {
   int<lower=1> k;
   int<lower=0> n;
@@ -259,11 +302,13 @@ 

-

Site built with pkgdown 1.6.1.

+

+

Site built with pkgdown 2.0.7.

@@ -272,5 +317,7 @@

+ + diff --git a/docs/articles/index.html b/docs/articles/index.html index 4daf22f4d..dfb4bb983 100644 --- a/docs/articles/index.html +++ b/docs/articles/index.html @@ -1,74 +1,12 @@ - - - - - - - -Articles • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Articles • cmdstanr - - - - + + -
-
- -
- -
+

More details

-

More information about compilation, passing in data, how CmdStan ouput is written to CSV and read back into R, profiling Stan programs, running Stan on GPUs, and using CmdStanR in R Markdown documents.

- -
-
How does CmdStanR work?
-
-
R Markdown CmdStan Engine
-
-
Handling deprecated Stan features with the canonicalizer in CmdStanR
-
-
Profiling Stan programs with CmdStanR
-
-
Running Stan on the GPU with OpenCL
-
-
-
+

More information about compilation, passing in data, how CmdStan ouput is written to CSV and read back into R, profiling Stan programs, running Stan on GPUs, and using CmdStanR in R Markdown documents.

+ +
How does CmdStanR work?
+
+
Working with Posteriors
+
+
R Markdown CmdStan Engine
+
+
Handling deprecated Stan features with the canonicalizer in CmdStanR
+
+
Profiling Stan programs with CmdStanR
+
+
Running Stan on the GPU with OpenCL
+
+
-
- +
- - + + diff --git a/docs/articles/posterior.html b/docs/articles/posterior.html new file mode 100644 index 000000000..0e0439f75 --- /dev/null +++ b/docs/articles/posterior.html @@ -0,0 +1,309 @@ + + + + + + + +Working with Posteriors • cmdstanr + + + + + + + + + + + + + + + + + + + +
+
+ + + + +
+
+ + + + + +
+

Summary +

+

We can easily customise the summary statistics reported by +$summary() and $print().

+
+fit <- cmdstanr::cmdstanr_example("schools", method = "sample")
+fit$summary()
+
Warning: 130 of 4000 (3.0%) transitions ended with a divergence.
+See https://mc-stan.org/misc/warnings for details.
+
   variable  mean median  sd mad     q5 q95 rhat ess_bulk ess_tail
+1      lp__ -58.9  -59.2 5.0 5.1 -66.97 -50    1      224       84
+2        mu   6.6    6.7 4.3 4.3  -0.55  14    1      394      115
+3       tau   5.8    5.0 3.7 3.4   1.33  13    1      223       92
+4  theta[1]   9.7    9.0 7.3 6.3  -0.99  23    1     1066     2034
+5  theta[2]   7.0    6.8 5.9 5.6  -2.54  16    1      900     2321
+6  theta[3]   5.5    5.8 6.9 6.1  -6.25  16    1      841     2201
+7  theta[4]   6.8    6.9 6.2 6.0  -3.13  17    1      781     2193
+8  theta[5]   4.6    5.0 6.0 5.8  -5.63  14    1      513      940
+9  theta[6]   5.5    5.7 6.3 5.6  -5.61  15    1      782     1784
+10 theta[7]   9.5    9.1 6.2 5.8   0.14  20    1      882     2164
+11 theta[8]   7.1    7.0 7.3 6.3  -4.80  18    1      976     2151
+

By default all variables are summaries with the follow functions:

+ +
[1] "mean"      "median"    "sd"        "mad"       "quantile2"
+

To change the variables summarised, we use the variables argument

+
+fit$summary(variables = c("mu", "tau"))
+
  variable mean median  sd mad    q5 q95 rhat ess_bulk ess_tail
+1       mu  6.6    6.7 4.3 4.3 -0.55  14    1      394      115
+2      tau  5.8    5.0 3.7 3.4  1.33  13    1      223       92
+

We can additionally change which functions are used

+
+fit$summary(variables = c("mu", "tau"), mean, sd)
+
  variable mean  sd
+1       mu  6.6 4.3
+2      tau  5.8 3.7
+

To summarise all variables with non-default functions, it is +necessary to set explicitly set the variables argument, either to +NULL or the full vector of variable names.

+
+fit$metadata()$model_params
+fit$summary(variables = NULL, "mean", "median")
+
 [1] "lp__"     "mu"       "tau"      "theta[1]" "theta[2]" "theta[3]"
+ [7] "theta[4]" "theta[5]" "theta[6]" "theta[7]" "theta[8]"
+
   variable  mean median
+1      lp__ -58.9  -59.2
+2        mu   6.6    6.7
+3       tau   5.8    5.0
+4  theta[1]   9.7    9.0
+5  theta[2]   7.0    6.8
+6  theta[3]   5.5    5.8
+7  theta[4]   6.8    6.9
+8  theta[5]   4.6    5.0
+9  theta[6]   5.5    5.7
+10 theta[7]   9.5    9.1
+11 theta[8]   7.1    7.0
+

Summary functions can be specified by character string, function, or +using a formula (or anything else supported by [rlang::as_function]). If +these arguments are named, those names will be used in the tibble +output. If the summary results are named they will take precedence.

+
+my_sd <- function(x) c(My_SD = sd(x))
+fit$summary(
+  c("mu", "tau"), 
+  MEAN = mean, 
+  "median",
+  my_sd,
+  ~quantile(.x, probs = c(0.1, 0.9)),
+  Minimum = function(x) min(x)
+)        
+
  variable MEAN median My_SD  10% 90% Minimum
+1       mu  6.6    6.7   4.3 0.98  12   -11.7
+2      tau  5.8    5.0   3.7 1.81  11     0.9
+

Arguments to all summary functions can also be specified with +.args.

+
+fit$summary(c("mu", "tau"), quantile, .args = list(probs = c(0.025, .05, .95, .975)))
+
  variable 2.5%    5% 95% 97.5%
+1       mu -2.0 -0.55  14    15
+2      tau  1.1  1.33  13    15
+

The summary functions are applied to the array of sample values, with +dimension iter_samplingxchains.

+
+fit$summary(variables = NULL, dim, colMeans)
+
   variable dim.1 dim.2     1     2     3     4
+1      lp__  1000     4 -58.8 -58.4 -59.0 -59.4
+2        mu  1000     4   6.8   6.7   6.6   6.1
+3       tau  1000     4   5.7   5.6   5.7   6.1
+4  theta[1]  1000     4   9.9   9.5   9.8   9.5
+5  theta[2]  1000     4   7.4   7.2   7.0   6.3
+6  theta[3]  1000     4   5.8   5.7   5.6   4.8
+7  theta[4]  1000     4   6.9   6.7   7.0   6.7
+8  theta[5]  1000     4   4.9   4.8   4.6   4.1
+9  theta[6]  1000     4   5.7   5.8   5.6   4.8
+10 theta[7]  1000     4   9.6   9.8   9.4   9.2
+11 theta[8]  1000     4   7.0   7.3   7.0   7.0
+

For this reason users may have unexpected results if they use +stats::var() directly, as it will return a covariance +matrix. An alternative is the distributional::variance() +function, which can also be accessed via +posterior::variance().

+
+fit$summary(c("mu", "tau"), posterior::variance, ~var(as.vector(.x)))
+
  variable posterior::variance ~var(as.vector(.x))
+1       mu                  19                  19
+2      tau                  14                  14
+

Summary functions need not be numeric, but these won’t work with +$print().

+
+strict_pos <- function(x) if (all(x > 0)) "yes" else "no"
+fit$summary(variables = NULL, "Strictly Positive" = strict_pos)
+# fit$print(variables = NULL, "Strictly Positive" = strict_pos)
+
   variable Strictly Positive
+1      lp__                no
+2        mu                no
+3       tau               yes
+4  theta[1]                no
+5  theta[2]                no
+6  theta[3]                no
+7  theta[4]                no
+8  theta[5]                no
+9  theta[6]                no
+10 theta[7]                no
+11 theta[8]                no
+

For more information, see posterior::summarise_draws(), +which is called by $summary().

+
+
+ + + +
+ + + +
+ +
+

+

Site built with pkgdown 2.0.7.

+
+ +
+
+ + + + + + + + diff --git a/docs/articles/posterior_files/header-attrs-2.18/header-attrs.js b/docs/articles/posterior_files/header-attrs-2.18/header-attrs.js new file mode 100644 index 000000000..dd57d92e0 --- /dev/null +++ b/docs/articles/posterior_files/header-attrs-2.18/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/docs/articles/profiling.html b/docs/articles/profiling.html index 58cce66d3..0bb97c2aa 100644 --- a/docs/articles/profiling.html +++ b/docs/articles/profiling.html @@ -26,6 +26,8 @@ + +
+
-
-

-Introduction

-

This vignette demonstrates how to use the new profiling functionality introduced in CmdStan 2.26.0.

-

Profiling identifies which parts of a Stan program are taking the longest time to run and is therefore a useful guide when working on optimizing the performance of a model.

-

However, be aware that the statistical assumptions that go into a model are the most important factors in overall model performance. It is often not possible to make up for model problems with just brute force computation. For ideas on how to address performance of your model from a statistical perspective, see Gelman (2020).

+
+

Introduction +

+

This vignette demonstrates how to use the new profiling functionality +introduced in CmdStan 2.26.0.

+

Profiling identifies which parts of a Stan program are taking the +longest time to run and is therefore a useful guide when working on +optimizing the performance of a model.

+

However, be aware that the statistical assumptions that go into a +model are the most important factors in overall model performance. It is +often not possible to make up for model problems with just brute force +computation. For ideas on how to address performance of your model from +a statistical perspective, see Gelman (2020).

-library(cmdstanr)
-check_cmdstan_toolchain(fix = TRUE, quiet = TRUE)
+library(cmdstanr) +check_cmdstan_toolchain(fix = TRUE, quiet = TRUE)

-
-

-Adding profiling statements to a Stan program

-

Consider a simple logistic regression with parameters alpha and beta, covariates X, and outcome y.

+
+

Adding profiling statements to a Stan program +

+

Consider a simple logistic regression with parameters +alpha and beta, covariates X, and +outcome y.

data {
   int<lower=1> k;
   int<lower=0> n;
   matrix[n, k] X;
-  int y[n];
+  array[n] int y;
 }
 parameters {
   vector[k] beta;
@@ -169,7 +181,9 @@ 

y ~ bernoulli_logit(X * beta + alpha); }

-

A simple question is how much time do the prior calculations take compared against the likelihood? To answer this we surround the prior and likelihood calculations with profile statements.

+

A simple question is how much time do the prior calculations take +compared against the likelihood? To answer this we surround the prior +and likelihood calculations with profile statements.

profile("priors") {
   target += std_normal_lpdf(beta);
   target += std_normal_lpdf(alpha);
@@ -177,132 +191,163 @@ 

profile("likelihood") { target += bernoulli_logit_lpmf(y | X * beta + alpha); }

-

In general we recommend using a separate .stan file, but for convenience in this vignette we’ll write the Stan program as a string and use write_stan_file() to write it to a temporary file.

+

In general we recommend using a separate .stan file, but +for convenience in this vignette we’ll write the Stan program as a +string and use write_stan_file() to write it to a temporary +file.

-profiling_bernoulli_logit <- write_stan_file('
-data {
-  int<lower=1> k;
-  int<lower=0> n;
-  matrix[n, k] X;
-  int y[n];
-}
-parameters {
-  vector[k] beta;
-  real alpha;
-}
-model {
-  profile("priors") {
-    target += std_normal_lpdf(beta);
-    target += std_normal_lpdf(alpha);
-  }
-  profile("likelihood") {
-    target += bernoulli_logit_lpmf(y | X * beta + alpha);
-  }
-}
-')
-

We can then run the model as usual and Stan will collect the profiling information for any sections with profile statements.

+profiling_bernoulli_logit <- write_stan_file(' +data { + int<lower=1> k; + int<lower=0> n; + matrix[n, k] X; + array[n] int y; +} +parameters { + vector[k] beta; + real alpha; +} +model { + profile("priors") { + target += std_normal_lpdf(beta); + target += std_normal_lpdf(alpha); + } + profile("likelihood") { + target += bernoulli_logit_lpmf(y | X * beta + alpha); + } +} +')
+

We can then run the model as usual and Stan will collect the +profiling information for any sections with profile +statements.

-# Compile the model
-model <- cmdstan_model(profiling_bernoulli_logit)
-
-# Generate some fake data
-n <- 1000
-k <- 20
-X <- matrix(rnorm(n * k), ncol = k)
-
-y <- 3 * X[,1] - 2 * X[,2] + 1
-p <- runif(n)
-y <- ifelse(p < (1 / (1 + exp(-y))), 1, 0)
-stan_data <- list(k = ncol(X), n = nrow(X), y = y, X = X)
-
-# Run one chain of the model
-fit <- model$sample(data = stan_data, chains = 1)
+# Compile the model +model <- cmdstan_model(profiling_bernoulli_logit) + +# Generate some fake data +n <- 1000 +k <- 20 +X <- matrix(rnorm(n * k), ncol = k) + +y <- 3 * X[,1] - 2 * X[,2] + 1 +p <- runif(n) +y <- ifelse(p < (1 / (1 + exp(-y))), 1, 0) +stan_data <- list(k = ncol(X), n = nrow(X), y = y, X = X) + +# Run one chain of the model +fit <- model$sample(data = stan_data, chains = 1)
-
-

-Accessing the profiling information from R

-

The raw profiling information can then be accessed with the $profiles() method, which returns a list containing one data frame per chain (profiles across multiple chains are not automatically aggregated). Details on the column names are available in the CmdStan documentation.

+
+

Accessing the profiling information from R +

+

The raw profiling information can then be accessed with the +$profiles() method, which returns a list containing one +data frame per chain (profiles across multiple chains are not +automatically aggregated). Details on the column names are available in +the CmdStan +documentation.

-fit$profiles()
+fit$profiles()
[[1]]
         name   thread_id total_time forward_time reverse_time chain_stack
-1 likelihood 0x107702e00 0.79556800   0.64104100   0.15452700       52380
-2     priors 0x107702e00 0.00536866   0.00314377   0.00222489       34920
+1 likelihood 0x102122e00 0.71089600   0.58314100    0.1277560       51969
+2     priors 0x102122e00 0.00482875   0.00293865    0.0018901       34646
   no_chain_stack autodiff_calls no_autodiff_calls
-1       34920000          17460                 1
-2              0          17460                 1
-

The total_time column is the total time spent inside a given profile statement. It is clear that the vast majority of time is spent in the likelihood function.

+1 34646000 17323 1 +2 0 17323 1
+

The total_time column is the total time spent inside a +given profile statement. It is clear that the vast majority of time is +spent in the likelihood function.

-
-

-Comparing to a faster version of the model

-

Stan’s specialized glm functions can be used to make models like this faster. In this case the likelihood can be replaced with

+
+

Comparing to a faster version of the model +

+

Stan’s specialized glm functions can be used to make models like this +faster. In this case the likelihood can be replaced with

target += bernoulli_logit_glm_lpmf(y | X, alpha, beta);
-

We’ll keep the same profile() statements so that the profiling information for the new model is collected automatically just like for the previous one.

+

We’ll keep the same profile() statements so that the +profiling information for the new model is collected automatically just +like for the previous one.

-profiling_bernoulli_logit_glm <- write_stan_file('
-data {
-  int<lower=1> k;
-  int<lower=0> n;
-  matrix[n, k] X;
-  int y[n];
-}
-parameters {
-  vector[k] beta;
-  real alpha;
-}
-model {
-  profile("priors") {
-    target += std_normal_lpdf(beta);
-    target += std_normal_lpdf(alpha);
-  }
-  profile("likelihood") {
-    target += bernoulli_logit_glm_lpmf(y | X, alpha, beta);
-  }
-}
-')
+profiling_bernoulli_logit_glm <- write_stan_file(' +data { + int<lower=1> k; + int<lower=0> n; + matrix[n, k] X; + array[n] int y; +} +parameters { + vector[k] beta; + real alpha; +} +model { + profile("priors") { + target += std_normal_lpdf(beta); + target += std_normal_lpdf(alpha); + } + profile("likelihood") { + target += bernoulli_logit_glm_lpmf(y | X, alpha, beta); + } +} +')
-model_glm <- cmdstan_model(profiling_bernoulli_logit_glm)
-fit_glm <- model_glm$sample(data = stan_data, chains = 1)
+model_glm <- cmdstan_model(profiling_bernoulli_logit_glm) +fit_glm <- model_glm$sample(data = stan_data, chains = 1)
-fit_glm$profiles()
+fit_glm$profiles()
[[1]]
         name   thread_id total_time forward_time reverse_time chain_stack
-1 likelihood 0x10550ce00 0.44504100   0.44354000   0.00150062       17161
-2     priors 0x10550ce00 0.00457269   0.00296803   0.00160466       34322
+1 likelihood 0x1066bde00 0.45516500   0.45357200   0.00159287       17695
+2     priors 0x1066bde00 0.00399743   0.00242302   0.00157441       35390
   no_chain_stack autodiff_calls no_autodiff_calls
-1              0          17161                 1
-2              0          17161                 1
-

We can see from the total_time column that this is much faster than the previous model.

+1 0 17695 1 +2 0 17695 1
+

We can see from the total_time column that this is much +faster than the previous model.

-
-

-Per-gradient timings, and memory usage

-

The other columns of the profiling output are documented in the CmdStan documentation.

-

The timing numbers are broken down by forward pass and reverse pass, and the chain_stack and no_chain_stack columns contain information about how many autodiff variables were saved in the process of performing a calculation.

-

These numbers are all totals – times are the total times over the whole calculation, and chain_stack counts are similarly the total counts of autodiff variables used over the whole calculation. It is often convenient to have per-gradient calculations (which will be more stable across runs with different seeds). To compute these, use the autodiff_calls column.

+
+

Per-gradient timings, and memory usage +

+

The other columns of the profiling output are documented in the CmdStan +documentation.

+

The timing numbers are broken down by forward pass and reverse pass, +and the chain_stack and no_chain_stack columns +contain information about how many autodiff variables were saved in the +process of performing a calculation.

+

These numbers are all totals – times are the total times over the +whole calculation, and chain_stack counts are similarly the +total counts of autodiff variables used over the whole calculation. It +is often convenient to have per-gradient calculations (which will be +more stable across runs with different seeds). To compute these, use the +autodiff_calls column.

-profile_chain_1 <- fit$profiles()[[1]]
-per_gradient_timing <- profile_chain_1$total_time/profile_chain_1$autodiff_calls
-print(per_gradient_timing) # two elements for the two profile statements in the model
-
[1] 4.556518e-05 3.074834e-07
+profile_chain_1 <- fit$profiles()[[1]] +per_gradient_timing <- profile_chain_1$total_time/profile_chain_1$autodiff_calls +print(per_gradient_timing) # two elements for the two profile statements in the model
+
[1] 4.103770e-05 2.787479e-07
-
-

-Accessing and saving the profile files

-

After sampling (or optimization or variational inference) finishes, CmdStan stores the profiling data in CSV files in a temporary location. The paths of the profiling CSV files can be retrieved using $profile_files().

+
+

Accessing and saving the profile files +

+

After sampling (or optimization or variational inference) finishes, +CmdStan stores the profiling data in CSV files in a temporary location. +The paths of the profiling CSV files can be retrieved using +$profile_files().

-fit$profile_files()
-
[1] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpsMj0TM/model_20fabfb2aee52e6a18d30460e35ae184-profile-202203181228-1-107daa.csv"
-

These can be saved to a more permanent location with the $save_profile_files() method.

+fit$profile_files()
+
[1] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmppMVUoY/model_6580008f67848265f3dfd0e7ae3b0600-profile-202307251456-1-5100ca.csv"
+

These can be saved to a more permanent location with the +$save_profile_files() method.

-# see ?save_profile_files for info on optional arguments
-fit$save_profile_files(dir = "path/to/directory")
+# see ?save_profile_files for info on optional arguments +fit$save_profile_files(dir = "path/to/directory")
-
-

-References

-

Gelman, Andrew, Aki Vehtari, Daniel Simpson, Charles C. Margossian, Bob Carpenter, Yuling Yao, Lauren Kennedy, Jonah Gabry, Paul-Christian Bürkner, and Martin Modrák. 2020. “Bayesian Workflow.” https://arxiv.org/abs/2011.01808.

+
+

References +

+

Gelman, Andrew, Aki Vehtari, Daniel Simpson, Charles C. Margossian, +Bob Carpenter, Yuling Yao, Lauren Kennedy, Jonah Gabry, Paul-Christian +Bürkner, and Martin Modrák. 2020. “Bayesian Workflow.” https://arxiv.org/abs/2011.01808.

@@ -317,11 +362,13 @@

-

Site built with pkgdown 1.6.1.

+

+

Site built with pkgdown 2.0.7.

@@ -330,5 +377,7 @@

+ + diff --git a/docs/articles/r-markdown.html b/docs/articles/r-markdown.html index fe246b59b..eeb298b19 100644 --- a/docs/articles/r-markdown.html +++ b/docs/articles/r-markdown.html @@ -26,6 +26,8 @@ + +
+
-

R Markdown supports a variety of languages through the use of knitr language engines. One such engine is the stan engine, which allows users to write Stan programs directly in their R Markdown documents by setting the language of the chunk to stan.

-

Behind the scenes, the engine relies on RStan to compile the model code into an in-memory stanmodel, which is assigned to a variable with the name given by the output.var chunk option. For example:

-
```{stan, output.var="model"}
-// Stan model code
-```
-
-```{r}
-rstan::sampling(model)
-```
-

CmdStanR provides a replacement engine, which can be registered as follows:

+

R Markdown supports a variety of languages through the use of knitr +language engines. One such engine is the stan engine, which +allows users to write Stan programs directly in their R Markdown +documents by setting the language of the chunk to stan.

+

Behind the scenes, the engine relies on RStan to compile the model +code into an in-memory stanmodel, which is assigned to a +variable with the name given by the output.var chunk +option. For example:

+
```{stan, output.var="model"}
+// Stan model code
+```
+
+```{r}
+rstan::sampling(model)
+```
+

CmdStanR provides a replacement engine, which can be registered as +follows:

-

By default, this overrides knitr’s built-in stan engine so that all stan chunks are processed with CmdStanR, not RStan. Of course, this also means that the variable specified by output.var will no longer be a stanmodel object, but instead a CmdStanModel object, so the code above would look like this:

-
```{stan, output.var="model"}
-// Stan model code
-```
-
-```{r}
-model$sample()
-```
-
-

-Example

-
// This stan chunk results in a CmdStanModel object called "ex1"
-parameters {
-  array[2] real y;
-}
-model {
-  y[1] ~ normal(0, 1);
-  y[2] ~ double_exponential(0, 2);
-}
+library(cmdstanr) +check_cmdstan_toolchain(fix = TRUE, quiet = TRUE) + +register_knitr_engine()
+

By default, this overrides knitr’s built-in stan engine +so that all stan chunks are processed with CmdStanR, not +RStan. Of course, this also means that the variable specified by +output.var will no longer be a stanmodel +object, but instead a CmdStanModel object, so the code +above would look like this:

+
```{stan, output.var="model"}
+// Stan model code
+```
+
+```{r}
+model$sample()
+```
+
+

Example +

+
// This stan chunk results in a CmdStanModel object called "ex1"
+parameters {
+  array[2] real y;
+}
+model {
+  y[1] ~ normal(0, 1);
+  y[2] ~ double_exponential(0, 2);
+}
-ex1$print()
-#> // This stan chunk results in a CmdStanModel object called "ex1"
-#> parameters {
-#>   array[2] real y;
-#> }
-#> model {
-#>   y[1] ~ normal(0, 1);
-#>   y[2] ~ double_exponential(0, 2);
-#> }
+ex1$print() +#> // This stan chunk results in a CmdStanModel object called "ex1" +#> parameters { +#> array[2] real y; +#> } +#> model { +#> y[1] ~ normal(0, 1); +#> y[2] ~ double_exponential(0, 2); +#> }
-fit <- ex1$sample(
-  refresh = 0,
-  seed = 42L
-)
-#> Running MCMC with 4 sequential chains...
-#> 
-#> Chain 1 finished in 0.0 seconds.
-#> Chain 2 finished in 0.0 seconds.
-#> Chain 3 finished in 0.0 seconds.
-#> Chain 4 finished in 0.0 seconds.
-#> 
-#> All 4 chains finished successfully.
-#> Mean chain execution time: 0.0 seconds.
-#> Total execution time: 0.6 seconds.
-
-print(fit)
-#>  variable  mean median   sd  mad    q5   q95 rhat ess_bulk ess_tail
-#>      lp__ -1.50  -1.17 1.24 0.96 -3.94 -0.18 1.00     1304     1536
-#>      y[1] -0.01  -0.01 0.99 0.99 -1.67  1.60 1.00     1993     2262
-#>      y[2] -0.07  -0.04 2.90 2.05 -4.79  4.54 1.00     2050     1420
+fit <- ex1$sample( + refresh = 0, + seed = 42L +) +#> Running MCMC with 4 sequential chains... +#> +#> Chain 1 finished in 0.0 seconds. +#> Chain 2 finished in 0.0 seconds. +#> Chain 3 finished in 0.0 seconds. +#> Chain 4 finished in 0.0 seconds. +#> +#> All 4 chains finished successfully. +#> Mean chain execution time: 0.0 seconds. +#> Total execution time: 0.7 seconds. + +print(fit) +#> variable mean median sd mad q5 q95 rhat ess_bulk ess_tail +#> lp__ -1.50 -1.17 1.24 0.96 -3.94 -0.18 1.00 1304 1536 +#> y[1] -0.01 -0.01 0.99 0.99 -1.67 1.60 1.00 1993 2262 +#> y[2] -0.07 -0.04 2.90 2.05 -4.79 4.54 1.00 2050 1420
-
-

-Caching chunks

-

Use cache=TRUE chunk option to avoid re-compiling the Stan model code every time the R Markdown is knit/rendered.

-

You can find the Stan model file and the compiled executable in the document’s cache directory.

+
+

Caching chunks +

+

Use cache=TRUE chunk option to avoid re-compiling the +Stan model code every time the R Markdown is knit/rendered.

+

You can find the Stan model file and the compiled executable in the +document’s cache directory.

-
-

-Using RStan and CmdStanR engines side-by-side

-

While the default behavior is to override the built-in stan engine because the assumption is that the user is probably not using both RStan and CmdStanR in the same document or project, the option to use both exists. When registering CmdStanR’s knitr engine, set override = FALSE to register the engine as a cmdstan engine:

+
+

Using RStan and CmdStanR engines side-by-side +

+

While the default behavior is to override the built-in +stan engine because the assumption is that the user is +probably not using both RStan and CmdStanR in the same document or +project, the option to use both exists. When registering CmdStanR’s +knitr engine, set override = FALSE to register the engine +as a cmdstan engine:

-register_knitr_engine(override = FALSE)
-

This will cause stan chunks to be processed by knitr’s built-in, RStan-based engine and only use CmdStanR’s knitr engine for cmdstan chunks:

-
```{stan, output.var="model_obj1"}
-// Results in a stanmodel object from RStan
-```
-
-```{r}
-rstan::sampling(model_obj1)
-```
-
-```{cmdstan, output.var="model_obj2"}
-// Results in a CmdStanModel object from CmdStanR
-```
-
-```{r}
-model_obj2$sample()
-```
+register_knitr_engine(override = FALSE)
+

This will cause stan chunks to be processed by knitr’s +built-in, RStan-based engine and only use CmdStanR’s knitr engine for +cmdstan chunks:

+
```{stan, output.var="model_obj1"}
+// Results in a stanmodel object from RStan
+```
+
+```{r}
+rstan::sampling(model_obj1)
+```
+
+```{cmdstan, output.var="model_obj2"}
+// Results in a CmdStanModel object from CmdStanR
+```
+
+```{r}
+model_obj2$sample()
+```
-
-

-Running interactively

-

When running chunks interactively in RStudio (e.g. when using R Notebooks), it has been observed that the built-in, RStan-based engine is used for stan chunks even when CmdStanR’s engine has been registered in the session as the engine for stan. As a workaround, when running chunks interactively, it is recommended to use the override = FALSE option and change stan chunks to be cmdstan chunks.

-

Do not worry: if the template you use supports syntax highlighting for the Stan language, that syntax highlighting will be applied to cmdstan chunks when the document is knit/rendered.

+
+

Running interactively +

+

When running chunks interactively in RStudio (e.g. when using R +Notebooks), it has been observed that the built-in, RStan-based +engine is used for stan chunks even when CmdStanR’s engine +has been registered in the session as the engine for stan. +As a workaround, when running chunks interactively, it is +recommended to use the override = FALSE option and change +stan chunks to be cmdstan chunks.

+

Do not worry: if the template you use supports syntax highlighting +for the Stan language, that syntax highlighting will be applied to +cmdstan chunks when the document is knit/rendered.

@@ -253,11 +285,13 @@

-

Site built with pkgdown 1.6.1.

+

+

Site built with pkgdown 2.0.7.

@@ -266,5 +300,7 @@

+ + diff --git a/docs/authors.html b/docs/authors.html index c44f2bc06..be12ad2f9 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -1,74 +1,12 @@ - - - - - - - -Authors • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Authors and Citation • cmdstanr - - + + - - - -
-
-
- -
+
- @@ -213,22 +165,20 @@

Authors

-
- +
- - + + diff --git a/docs/index.html b/docs/index.html index 079d4d868..c14b85fd5 100644 --- a/docs/index.html +++ b/docs/index.html @@ -19,11 +19,11 @@ + The CmdStanR interface is an alternative to RStan that calls the command + line interface for compilation and running algorithms instead of interfacing + with C++ via Rcpp. This has many benefits including always being compatible + with the latest version of Stan, fewer installation errors, fewer unexpected + crashes in RStudio, and a more permissive license."> + +
-
- +
-
- +
- - + + diff --git a/docs/reference/fit-method-grad_log_prob.html b/docs/reference/fit-method-grad_log_prob.html new file mode 100644 index 000000000..9b8626521 --- /dev/null +++ b/docs/reference/fit-method-grad_log_prob.html @@ -0,0 +1,173 @@ + +Calculate the log-probability and the gradient w.r.t. each input for a +given vector of unconstrained parameters — fit-method-grad_log_prob • cmdstanr + + +
+
+ + + +
+
+ + +
+

The $grad_log_prob() method provides access to the +Stan model's log_prob function and its derivative

+
+ +
+
grad_log_prob(unconstrained_variables, jacobian_adjustment = TRUE)
+
+ +
+

Arguments

+
unconstrained_variables
+

(numeric) A vector of unconstrained parameters +to be passed to grad_log_prob.

+ + +
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$init_model_methods()
+#> Error: Model methods cannot be used with a pre-compiled Stan executable, the model must be compiled again
+fit_mcmc$grad_log_prob(unconstrained_variables = c(0.5, 1.2, 1.1, 2.2))
+#> Error: The method has not been compiled, please call `init_model_methods()` first
+# }
+
+
+
+
+ +
+ + +
+ +
+

Site built with pkgdown 2.0.7.

+
+ +
+ + + + + + + + diff --git a/docs/reference/fit-method-gradients.html b/docs/reference/fit-method-gradients.html index 06ad91dfa..e022df320 100644 --- a/docs/reference/fit-method-gradients.html +++ b/docs/reference/fit-method-gradients.html @@ -1,76 +1,13 @@ - - - - - - - -Extract gradients after diagnostic mode — fit-method-gradients • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Extract gradients after diagnostic mode — fit-method-gradients • cmdstanr - - + + - - -
-
- -
- -
+
@@ -181,54 +109,58 @@

Extract gradients after diagnostic mode

parameters.

-
gradients()
- - -

Value

- -

A list of lists. See Examples.

-

See also

- - +
+
gradients()
+
-

Examples

-
# \dontrun{ -test <- cmdstanr_example("logistic", method = "diagnose") +
+

Value

+ -# retrieve the gradients -test$gradients() -
#> param_idx value model finite_diff error -#> 1 0 0.3291950 4.51253 4.51253 -3.28079e-08 -#> 2 1 -0.0351071 -14.28740 -14.28740 3.60592e-09 -#> 3 2 1.7559700 -31.76980 -31.76980 -3.22111e-08 -#> 4 3 1.7963400 -12.81930 -12.81930 -2.77577e-08
# } +

A list of lists. See Examples.

+
+
+

See also

+ +
-
+
+

Examples

+
# \dontrun{
+test <- cmdstanr_example("logistic", method = "diagnose")
+
+# retrieve the gradients
+test$gradients()
+#>   param_idx     value     model finite_diff        error
+#> 1         0  0.788454  -2.90866    -2.90866  4.89447e-09
+#> 2         1  0.538042 -17.17950   -17.17950  2.76466e-08
+#> 3         2 -1.725840  16.99630    16.99630  8.87535e-10
+#> 4         3  1.854370  -7.63726    -7.63726 -8.95156e-09
+# }
+
+
+
+
-
- +
- - + + diff --git a/docs/reference/fit-method-hessian.html b/docs/reference/fit-method-hessian.html new file mode 100644 index 000000000..d8b35a7ca --- /dev/null +++ b/docs/reference/fit-method-hessian.html @@ -0,0 +1,172 @@ + +Calculate the log-probability , the gradient w.r.t. each input, and the hessian +for a given vector of unconstrained parameters — fit-method-hessian • cmdstanr + + +
+
+ + + +
+
+ + +
+

The $hessian() method provides access to the +Stan model's log_prob, its derivative, and its hessian

+
+ +
+
hessian(unconstrained_variables, jacobian_adjustment = TRUE)
+
+ +
+

Arguments

+
unconstrained_variables
+

(numeric) A vector of unconstrained parameters +to be passed to hessian.

+ + +
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$init_model_methods(hessian = TRUE)
+# fit_mcmc$hessian(unconstrained_variables = c(0.5, 1.2, 1.1, 2.2))
+# }
+
+
+
+
+
+ +
+ + +
+ +
+

Site built with pkgdown 2.0.7.

+
+ +
+ + + + + + + + diff --git a/docs/reference/fit-method-init.html b/docs/reference/fit-method-init.html index 2183783ff..e66e48080 100644 --- a/docs/reference/fit-method-init.html +++ b/docs/reference/fit-method-init.html @@ -1,80 +1,17 @@ - - - - - - - -Extract user-specified initial values — fit-method-init • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Extract user-specified initial values — fit-method-init • cmdstanr - - - - - - - - - - - - + + - - -
-
- -
- -
+
@@ -189,74 +117,80 @@

Extract user-specified initial values

this in the future.

-
init()
- - -

Value

- -

A list of lists. See Examples.

-

See also

+
+
init()
+
- +
+

Value

+ -

Examples

-
# \dontrun{ -init_fun <- function() list(alpha = rnorm(1), beta = rnorm(3)) -fit <- cmdstanr_example("logistic", init = init_fun, chains = 2) -str(fit$init()) -
#> List of 2 -#> $ :List of 2 -#> ..$ alpha: num 0.0834 -#> ..$ beta : num [1:3] 0.8592 0.0505 2.3089 -#> $ :List of 2 -#> ..$ alpha: num -0.859 -#> ..$ beta : num [1:3] 1.54 -1.61 -1.08
-# partial inits (only specifying for a subset of parameters) -init_list <- list( - list(mu = 10, tau = 2), - list(mu = -10, tau = 1) -) -fit <- cmdstanr_example("schools_ncp", init = init_list, chains = 2, adapt_delta = 0.9) -
#> Init values were only set for a subset of parameters. -#> Missing init values for the following parameters: -#> - chain 1: theta_raw -#> - chain 2: theta_raw
-# only user-specified inits returned -str(fit$init()) -
#> List of 2 -#> $ :List of 2 -#> ..$ mu : int 10 -#> ..$ tau: int 2 -#> $ :List of 2 -#> ..$ mu : int -10 -#> ..$ tau: int 1
# } +

A list of lists. See Examples.

+
+
+

See also

+ +
-
+
+

Examples

+
# \dontrun{
+init_fun <- function() list(alpha = rnorm(1), beta = rnorm(3))
+fit <- cmdstanr_example("logistic", init = init_fun, chains = 2)
+str(fit$init())
+#> List of 2
+#>  $ :List of 2
+#>   ..$ alpha: num -1.25
+#>   ..$ beta : num [1:3] -2.2653 0.0495 0.8638
+#>  $ :List of 2
+#>   ..$ alpha: num -0.172
+#>   ..$ beta : num [1:3] 0.437 0.285 1.047
+
+# partial inits (only specifying for a subset of parameters)
+init_list <- list(
+  list(mu = 10, tau = 2),
+  list(mu = -10, tau = 1)
+)
+fit <- cmdstanr_example("schools_ncp", init = init_list, chains = 2, adapt_delta = 0.9)
+#> Init values were only set for a subset of parameters. 
+#> Missing init values for the following parameters:
+#>  - chain 1: theta_raw
+#>  - chain 2: theta_raw
+
+# only user-specified inits returned
+str(fit$init())
+#> List of 2
+#>  $ :List of 2
+#>   ..$ mu : int 10
+#>   ..$ tau: int 2
+#>  $ :List of 2
+#>   ..$ mu : int -10
+#>   ..$ tau: int 1
+# }
+
+
+
+
-
- +
- - + + diff --git a/docs/reference/fit-method-init_model_methods.html b/docs/reference/fit-method-init_model_methods.html new file mode 100644 index 000000000..437e01d11 --- /dev/null +++ b/docs/reference/fit-method-init_model_methods.html @@ -0,0 +1,180 @@ + +Compile additional methods for accessing the model log-probability function +and parameter constraining and unconstraining. — fit-method-init_model_methods • cmdstanr + + +
+
+ + + +
+
+ + +
+

The $init_model_methods() method compiles and initializes the +log_prob, grad_log_prob, constrain_variables, unconstrain_variables +and unconstrain_draws functions. These are then available as methods of +the fitted model object. This requires the Rcpp package.

+

Note: there may be many compiler warnings emitted during compilation but +these can be ignored so long as they are warnings and not errors.

+
+ +
+
init_model_methods(seed = 0, verbose = FALSE, hessian = FALSE)
+
+ +
+

Arguments

+
seed
+

(integer) The random seed to use when initializing the model.

+ + +
verbose
+

(boolean) Whether to show verbose logging during compilation.

+ + +
hessian
+

(boolean) Whether to expose the (experimental) hessian method.

+ +
+ + +
+

Examples

+
# \dontrun{
+fit_mcmc <- cmdstanr_example("logistic", method = "sample")
+fit_mcmc$init_model_methods()
+#> Error: Model methods cannot be used with a pre-compiled Stan executable, the model must be compiled again
+# }
+
+
+
+ +
+ + +
+ +
+

Site built with pkgdown 2.0.7.

+
+ +
+ + + + + + + + diff --git a/docs/reference/fit-method-inv_metric.html b/docs/reference/fit-method-inv_metric.html index 1b83c5025..cca5c0ce6 100644 --- a/docs/reference/fit-method-inv_metric.html +++ b/docs/reference/fit-method-inv_metric.html @@ -1,75 +1,12 @@ - - - - - - - -Extract inverse metric (mass matrix) after MCMC — fit-method-inv_metric • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Extract inverse metric (mass matrix) after MCMC — fit-method-inv_metric • cmdstanr - + + - - - -
-
- -
- -
+
@@ -179,128 +107,134 @@

Extract inverse metric (mass matrix) after MCMC

Extract the inverse metric (mass matrix) for each MCMC chain.

-
inv_metric(matrix = TRUE)
+
+
inv_metric(matrix = TRUE)
+
-

Arguments

- - - - - - -
matrix

(logical) If a diagonal metric was used, setting matrix = FALSE returns a list containing just the diagonals of the matrices instead +

+

Arguments

+
matrix
+

(logical) If a diagonal metric was used, setting matrix = FALSE returns a list containing just the diagonals of the matrices instead of the full matrices. Setting matrix = FALSE has no effect for dense -metrics.

+metrics.

-

Value

+
+
+

Value

+ -

A list of length equal to the number of MCMC chains. See the matrix -argument for details.

-

See also

+

A list of length equal to the number of MCMC chains. See the matrix

- -

Examples

-
# \dontrun{ -fit <- cmdstanr_example("logistic") -fit$inv_metric() -
#> $`1` -#> [,1] [,2] [,3] [,4] -#> [1,] 0.0481393 0.00000 0.0000000 0.0000000 -#> [2,] 0.0000000 0.05628 0.0000000 0.0000000 -#> [3,] 0.0000000 0.00000 0.0407205 0.0000000 -#> [4,] 0.0000000 0.00000 0.0000000 0.0702359 -#> -#> $`2` -#> [,1] [,2] [,3] [,4] -#> [1,] 0.0462024 0.0000000 0.0000000 0.0000000 -#> [2,] 0.0000000 0.0708086 0.0000000 0.0000000 -#> [3,] 0.0000000 0.0000000 0.0509179 0.0000000 -#> [4,] 0.0000000 0.0000000 0.0000000 0.0663432 -#> -#> $`3` -#> [,1] [,2] [,3] [,4] -#> [1,] 0.0401421 0.0000000 0.0000000 0.0000000 -#> [2,] 0.0000000 0.0599614 0.0000000 0.0000000 -#> [3,] 0.0000000 0.0000000 0.0409305 0.0000000 -#> [4,] 0.0000000 0.0000000 0.0000000 0.0636495 -#> -#> $`4` -#> [,1] [,2] [,3] [,4] -#> [1,] 0.048948 0.0000000 0.000000 0.0000000 -#> [2,] 0.000000 0.0612541 0.000000 0.0000000 -#> [3,] 0.000000 0.0000000 0.053141 0.0000000 -#> [4,] 0.000000 0.0000000 0.000000 0.0843771 -#>
fit$inv_metric(matrix=FALSE) -
#> $`1` -#> [1] 0.0481393 0.0562800 0.0407205 0.0702359 -#> -#> $`2` -#> [1] 0.0462024 0.0708086 0.0509179 0.0663432 -#> -#> $`3` -#> [1] 0.0401421 0.0599614 0.0409305 0.0636495 -#> -#> $`4` -#> [1] 0.0489480 0.0612541 0.0531410 0.0843771 -#>
-fit <- cmdstanr_example("logistic", metric = "dense_e") -fit$inv_metric() -
#> $`1` -#> [,1] [,2] [,3] [,4] -#> [1,] 0.04674080 -0.003735660 0.002672980 0.00238423 -#> [2,] -0.00373566 0.068142800 -0.000262148 -0.01289230 -#> [3,] 0.00267298 -0.000262148 0.046002800 -0.01442680 -#> [4,] 0.00238423 -0.012892300 -0.014426800 0.07403270 -#> -#> $`2` -#> [,1] [,2] [,3] [,4] -#> [1,] 0.04818520 -0.00541596 0.00262377 0.00791809 -#> [2,] -0.00541596 0.06098370 -0.00895976 -0.00360963 -#> [3,] 0.00262377 -0.00895976 0.06049940 -0.01483090 -#> [4,] 0.00791809 -0.00360963 -0.01483090 0.06889970 -#> -#> $`3` -#> [,1] [,2] [,3] [,4] -#> [1,] 0.04188870 -0.003366470 0.002556630 0.00143941 -#> [2,] -0.00336647 0.072588600 -0.000749238 -0.01014960 -#> [3,] 0.00255663 -0.000749238 0.062633300 -0.01869750 -#> [4,] 0.00143941 -0.010149600 -0.018697500 0.06842820 -#> -#> $`4` -#> [,1] [,2] [,3] [,4] -#> [1,] 0.050144300 -0.00512010 -0.000121339 0.00550570 -#> [2,] -0.005120100 0.05424960 0.005528330 -0.00520478 -#> [3,] -0.000121339 0.00552833 0.047886100 -0.01343470 -#> [4,] 0.005505700 -0.00520478 -0.013434700 0.07104140 -#>
# } +

argument for details.

+
+
+

See also

+ +
-
+
+

Examples

+
# \dontrun{
+fit <- cmdstanr_example("logistic")
+fit$inv_metric()
+#> $`1`
+#>           [,1]      [,2]      [,3]      [,4]
+#> [1,] 0.0431002 0.0000000 0.0000000 0.0000000
+#> [2,] 0.0000000 0.0583438 0.0000000 0.0000000
+#> [3,] 0.0000000 0.0000000 0.0531465 0.0000000
+#> [4,] 0.0000000 0.0000000 0.0000000 0.0786797
+#> 
+#> $`2`
+#>           [,1]      [,2]      [,3]      [,4]
+#> [1,] 0.0454991 0.0000000 0.0000000 0.0000000
+#> [2,] 0.0000000 0.0809962 0.0000000 0.0000000
+#> [3,] 0.0000000 0.0000000 0.0496686 0.0000000
+#> [4,] 0.0000000 0.0000000 0.0000000 0.0688616
+#> 
+#> $`3`
+#>           [,1]     [,2]      [,3]      [,4]
+#> [1,] 0.0406769 0.000000 0.0000000 0.0000000
+#> [2,] 0.0000000 0.054686 0.0000000 0.0000000
+#> [3,] 0.0000000 0.000000 0.0544764 0.0000000
+#> [4,] 0.0000000 0.000000 0.0000000 0.0675343
+#> 
+#> $`4`
+#>           [,1]      [,2]      [,3]      [,4]
+#> [1,] 0.0434081 0.0000000 0.0000000 0.0000000
+#> [2,] 0.0000000 0.0669723 0.0000000 0.0000000
+#> [3,] 0.0000000 0.0000000 0.0466104 0.0000000
+#> [4,] 0.0000000 0.0000000 0.0000000 0.0654703
+#> 
+fit$inv_metric(matrix=FALSE)
+#> $`1`
+#> [1] 0.0431002 0.0583438 0.0531465 0.0786797
+#> 
+#> $`2`
+#> [1] 0.0454991 0.0809962 0.0496686 0.0688616
+#> 
+#> $`3`
+#> [1] 0.0406769 0.0546860 0.0544764 0.0675343
+#> 
+#> $`4`
+#> [1] 0.0434081 0.0669723 0.0466104 0.0654703
+#> 
+
+fit <- cmdstanr_example("logistic", metric = "dense_e")
+fit$inv_metric()
+#> $`1`
+#>             [,1]        [,2]        [,3]         [,4]
+#> [1,] 4.31917e-02  0.00404353  0.00504066  9.28594e-06
+#> [2,] 4.04353e-03  0.05741780 -0.00262368 -9.31332e-03
+#> [3,] 5.04066e-03 -0.00262368  0.04816930 -1.40772e-02
+#> [4,] 9.28594e-06 -0.00931332 -0.01407720  7.29028e-02
+#> 
+#> $`2`
+#>             [,1]        [,2]        [,3]        [,4]
+#> [1,]  0.05586860 -0.00758105  0.00327655  0.00186063
+#> [2,] -0.00758105  0.06515060 -0.00821290 -0.00560473
+#> [3,]  0.00327655 -0.00821290  0.05351870 -0.01152510
+#> [4,]  0.00186063 -0.00560473 -0.01152510  0.06850340
+#> 
+#> $`3`
+#>             [,1]        [,2]        [,3]        [,4]
+#> [1,]  0.05023130  0.00119935  0.00439778 -0.00486186
+#> [2,]  0.00119935  0.06410140 -0.00267351 -0.01118110
+#> [3,]  0.00439778 -0.00267351  0.04945990 -0.01316990
+#> [4,] -0.00486186 -0.01118110 -0.01316990  0.07295030
+#> 
+#> $`4`
+#>             [,1]        [,2]        [,3]        [,4]
+#> [1,]  0.05218850 -0.00108995  0.00814572  0.00609612
+#> [2,] -0.00108995  0.06646310 -0.00283644 -0.01047740
+#> [3,]  0.00814572 -0.00283644  0.05347060 -0.01085170
+#> [4,]  0.00609612 -0.01047740 -0.01085170  0.07278000
+#> 
+# }
+
+
+
+
-
- +
- - + + diff --git a/docs/reference/fit-method-log_prob.html b/docs/reference/fit-method-log_prob.html new file mode 100644 index 000000000..eb45ac2ab --- /dev/null +++ b/docs/reference/fit-method-log_prob.html @@ -0,0 +1,167 @@ + +Calculate the log-probability given a provided vector of unconstrained parameters. — fit-method-log_prob • cmdstanr + + +
+
+ + + +
+
+ + +
+

The $log_prob() method provides access to the Stan model's log_prob function

+
+ +
+
log_prob(unconstrained_variables, jacobian_adjustment = TRUE)
+
+ +
+

Arguments

+
unconstrained_variables
+

(numeric) A vector of unconstrained parameters to be passed to log_prob

+ + +
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$init_model_methods()
+#> Error: Model methods cannot be used with a pre-compiled Stan executable, the model must be compiled again
+fit_mcmc$log_prob(unconstrained_variables = c(0.5, 1.2, 1.1, 2.2))
+#> Error: The method has not been compiled, please call `init_model_methods()` first
+# }
+
+
+
+
+ +
+ + +
+ +
+

Site built with pkgdown 2.0.7.

+
+ +
+ + + + + + + + diff --git a/docs/reference/fit-method-loo.html b/docs/reference/fit-method-loo.html index 86fb957a4..30cfdd3db 100644 --- a/docs/reference/fit-method-loo.html +++ b/docs/reference/fit-method-loo.html @@ -1,79 +1,16 @@ - - - - - - - -Leave-one-out cross-validation (LOO-CV) — fit-method-loo • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Leave-one-out cross-validation (LOO-CV) — fit-method-loo • cmdstanr - - - - - - - - - - - - + + - - -
-
- -
- -
+

The $loo() method computes approximate LOO-CV using the -loo package. This is a simple wrapper around loo::loo.array() +loo package. This is a simple wrapper around loo::loo.array() provided for convenience and requires computing the pointwise log-likelihood in your Stan program. See the loo package -vignettes for details.

+vignettes for details.

-
loo(variables = "log_lik", r_eff = TRUE, ...)
+
+
loo(variables = "log_lik", r_eff = TRUE, moment_match = FALSE, ...)
+
-

Arguments

- - - - - - - - - - - - - - -
variables

(character vector) The name(s) of the variable(s) in the +

+

Arguments

+
variables
+

(character vector) The name(s) of the variable(s) in the Stan program containing the pointwise log-likelihood. The default is to look for "log_lik". This argument is passed to the -$draws() method.

r_eff

(multiple options) How to handle the r_eff argument for loo():

    -
  • TRUE (the default) will automatically call loo::relative_eff.array() -to compute the r_eff argument to pass to loo::loo.array().

  • +$draws() method.

    + + +
    r_eff
    +

    (multiple options) How to handle the r_eff argument for loo():

    • TRUE (the default) will automatically call loo::relative_eff.array() +to compute the r_eff argument to pass to loo::loo.array().

    • FALSE or NULL will avoid computing r_eff (which can sometimes be slow) but will result in a warning from the loo package.

    • If r_eff is anything else, that object will be passed as the r_eff -argument to loo::loo.array().

    • -
...

Other arguments (e.g., cores, save_psis, etc.) passed to -loo::loo.array().

+argument to loo::loo.array().

+ + -

Value

+
moment_match
+

(boolean) Whether to use a moment-matching correction for +for problematic observations.

-

The object returned by loo::loo.array().

-

See also

-

The loo package website with -documentation and -vignettes.

+
...
+

Other arguments (e.g., cores, save_psis, etc.) passed to +loo::loo.array() or loo::loo_moment_match.default() +(if moment_match = TRUE is set).

-

Examples

-
-# \dontrun{ -# the "logistic" example model has "log_lik" in generated quantities -fit <- cmdstanr_example("logistic") -loo_result <- fit$loo(cores = 2) -print(loo_result) -
#> -#> Computed from 4000 by 100 log-likelihood matrix -#> -#> Estimate SE -#> elpd_loo -63.6 4.1 -#> p_loo 3.9 0.5 -#> looic 127.2 8.3 -#> ------ -#> Monte Carlo SE of elpd_loo is 0.0. -#> -#> All Pareto k estimates are good (k < 0.5). -#> See help('pareto-k-diagnostic') for details.
# } +
+
+

Value

+ -
+

The object returned by loo::loo.array().

+
+
+

See also

+

The loo package website with +documentation and +vignettes.

+
+ +
+

Examples

+

+# \dontrun{
+# the "logistic" example model has "log_lik" in generated quantities
+fit <- cmdstanr_example("logistic")
+loo_result <- fit$loo(cores = 2)
+print(loo_result)
+#> 
+#> Computed from 4000 by 100 log-likelihood matrix
+#> 
+#>          Estimate  SE
+#> elpd_loo    -63.6 4.1
+#> p_loo         3.9 0.5
+#> looic       127.2 8.3
+#> ------
+#> Monte Carlo SE of elpd_loo is 0.0.
+#> 
+#> All Pareto k estimates are good (k < 0.5).
+#> See help('pareto-k-diagnostic') for details.
+# }
+
+
+
+
-
- +

- - + + diff --git a/docs/reference/fit-method-lp-1.png b/docs/reference/fit-method-lp-1.png index 6f1042311f3747822df57d6412754812fa258230..ca30aa56176b9b99fc0993043dce36dfb774ee2a 100644 GIT binary patch literal 86194 zcmeEt2Uk;D*Dk#yO}Z3OsRGhFh#)qKbO9-fh;)!nfKZewpi-qOT>^wAp@l>Na|G#z z2%!X!PDp485CWI?c;0*b?q9fHMl$xu&K}uo&OO&N=X&O|lJA?|Vr3FwqM)E)y>r{p zf`WoJjDmvtF$3M%8FbDE{Mmu-@x5DyXUDVGp+P6`?7--M+b)oTLMZV+AIglSZ8r)E zQHnc;`c`3un=_$#Pu$)Sw{h3ri%F-%ahN|Ev_mzB|FBkgALlh~ZDWhtcjIoZua;cC zexD^3p0dd#og^wIssDUPqvtihxWb!vYg-YgZNq^@Ri;HXnn=eP9hFEu)c!-q`Cm1{ ztIjjQdZKsUUjEbG1kpd zqGg^vle!c$E1N8l9<6LQeq-duD^N_2J4w_in-cugzGj+y$$#vsaN=+Le2Rim3?uv^ z%#zQ39Jph62>pG2tH9|xO;>&#>r)cNe~~uR6)y9SvoH0>*#3jSMp=~Lf38TAq;~q} z0s(Wnu7562E@cV3^82)hp^rM6UR0G*n9`e0JC9)oN6SN<8uJp~TPsxb`%lV)b0~3} zVd8j77YUbC-2qby2`U)X3B%Q*S%b{KFBwywVhGd08@YI4PT*L$6r2NoJgKF8hwM#R zc&?@LTDShO!L=HK*wCWonM-~TLTNJ%t`amHWkb=aG&MOadXk}z1HQvj^SjyLhYBSq zayexA-!fu2F&3C}E{xacrZb*R;w4L`h?A3=&U7I(PE=P5w&HXCzQ08sf>NGZn6;Lw zp4yb!Ce-ev8P1l1Msdt9(;9+?Bq+5g{3yDqx-NtXKGhr3bTz>6EN~?w;VVg;$L*}B zIf^hvykoyv&=AEk3;A|c3HNVDc{pz05cAUzZsSwuKhQAu=+w^*cA_gZjH2CA6zh$8 z;8sNB88)NPyDV)(q#u$Y9CI63^%a(cq8x8Nic4x^SZ4gi>Zzt}B3g3Sc! zYX>o)U;pi%{91QvAgwUtRr(Wp_4K^e%}4MM!{wca7;hI@e?g8h-9(1VFo##%a6M{g zn&Nz{D>J6|F}WRXkb)4oe{4*-9p6M+;U*m=dTVu3C7K?-x?(bk?Ui3|5O|^&vorqw z9bTzYRpH@`dPG9HWqdI; z)-`61lQtT;pTnyMrky=^eExx5^E6F^c<1TCS{wTYgUp$cOtbIa9M!*K^8gTe^s1(| zK70&}L5*~|`^!5}5#K^Jo1z7d9IG#>e1s6=;ebEgT>()VdmBX*(DY(|Pn`*VHmX^(J*ZF>V1E-Fi!gpJ!X`oW zGx>3O&D5n>7&j4s?ev{y@wWB`a$y`=Z0A&k)Hr2D#x9tW+=d-z@yE*)W^}W6ThhXW z8ti(4-BbS)E^EAd{s~H?`QcP7R^x@wpz=S{H|zVA8t3uLPiDRhXG%#F!Gyx1-Lwig zWqHys-9TM2lzB;=%=A;kFewkBf1o-l7#iqeM+k!~KDcQ`F;}cZsCs;g9?|_~4|^Y0 zx=gUglwhN;T#~@XbeElyVr_ejU&um4 z-945t6^oDxGB4qQi^OB2uYy7o#Ut#UhBlCVNGb83Z#RA%C(*MBpC}Z560e zgos8UoeU=XU1|?BMB0)F$F6aN_ss%yVC>FA(9e?@!zG{Y63Zsn2&y7vYbf`|e$BGb z@@-`Ay=KI+b$U4esFFI-1v9pAh)ynr_audI0VxUex_6)4Ub_IB*{=C6N9~lBr2*&V z8zQeE*>IU$eKbV=njm z@3UjD@Hwu`ULv#mc$-|O4rLeP&z!ugbpq2vy{i*ErE{wxg-9m!4|_4k&TO3=Gt^V` zW=Dy$-H9oN&5#>!5L1^l!6Mab`p%N6qvT7+=NMZ7{eQAmo!;0BR|uuNoG?Jnjcu~> z5^X*`kDgy8lnUbUTJzOtIcK0xJT?Zjtmhi|+Oc^cFd630oYq=Dv@5Kwns zbMGIcA1th*DxoCMMzd}*cBLK&oLW`f9h2uFs?pR-3TwSnH2#ie`(6cLu;+bIf3YT< zp7o&w`thU6TM(D9@THZTI;{b$`1A#pJnBuu$&`7nK3A!XI~R9s?bOav$fdu2XZ-Sc zbWC;i488h!^%O#PD>8tM&1Pd}3PKm@ zMp`tKd!3j?zJYe;K}=s}88R5*&L*3RKNEVYm8gJelN*+$9s0f{l8e5{@EI)!b=?pgHzV|bW`d2#{$+ksVKV_^qv=Q=tlSDP*%QWx(&g_f$l z95;_n7H;R|&2YB3Ffi>6V3sBcm4*H_1qNb;qKeHfhQQn^%icol&Cwg$^sKKyT*I>8 zd{-9Z4TFO^(&c5GGEuxld9j+7-QeP${}GfXv&=Cw$#;jeuW1W}UGRStaC#r(mG#-Z zd-IJU=!FD_b*F6Ub0TvK{a2GOC?32mri*TXRkH@6Sm3HD?he}E>MA6>KCr;Z_F)&3 zzKz?7=7Ot-%rvVVoN*Q|BJb`g?_(c#y;U zhKamjx75`E(%1rFY+=P@vNin*)uDn5vltxQc`mVW>yNvxbz>Ugg2|Y56T@Ka6KJvG zNGE;U+o$vMYw(<`i}nJ*n(*2+_3Rx#(s?5SlO^aPKFI2e4Z?zs*5 zP+@o;H#IkIHY&fF63X)7tC?STUMkyDq|-VldwFyJcxe)=^U-h4U#P(!PBsnM)0$QJ z0lCNbL@@rsEpYz|kxI~Qz>mWFZWsO6*uhv7^1`?-93m-G>yRbF^lKn0EjabhF_h6$ zz)D%hY$zny$-eScQE}ihNx*yEyaQ?SrDtr>A~zzly9EqYSq0drP5Za1itD7VI?-q| zADFj(r}1YW1nE1pm`&vvITdvWZa6I`9_V#n$6c1HQr@bZKHzpTD zZn)!(ol^#)(J+ciA85syz6!ks$*bl(-hT0NRFbT3;n`WA61~$CK`$Or^Hu#l`LK z0ohg_Jq9(AX}CA~2@?YzCc**GS6KY)R%E%413w z2n9*P5Lt|ki$gwboe6?|&50Zl5Wk-oe8B{vU8=X;0O?HlW-CSX@=`E;LD1W5^k({+ z%OOI?vRGI%e~gm^eF3C3$C8vH{&-6HCV^+wJFsAuva1yF{PgZ*DMkWbvBx$wL1orI zfzBZ`sHeS*Y7Nx(_l_qA3xbk8=PLCVf?i~L6sneEafTWnr#qB=u{#HAQT2gff6e`I zsKC$eHYmfv6}+0*U&Cnk3y5cme;BL^O+M%hlESyp4dAW=@TzPF()bMcS!tPquylw^ z-Xy4F^?h|??O`$dj~~CS?O6G`Dl}UUF0<82b1I9dv*nak$_cf5sz0cjWA3anBU24- zt@(@C*fh|HOmntO_)ETYFU9-a0KW-c*BHaujsH{B4Oaf(C62S^0yW$iLUoIryx!;}d=k<*i$nmd@islbtm;VM7OnQM z;|QZnN*ufQe-_$*FCCOG4^z$>?2Sd8H~$bW>#yw3HwqxS88);6gTYgMk z3DvVRHDSkZ`T_$rC(`MRoLTr*Dji{kP^4`be}8}3PI!XR<(=uD0O@= zhGK!dV~Oe0nHX?J_@X+G!W`uw=i9i#o)dn)gzu)Hfwp!hTMH|agt=_x(%RpKvZ5~~ zeXEYJemct%+1(c9+cEW9wl$~gW2^M$2%s*#A2j9O@(QGzek zC=~cY>P0rK;>P#gST-WRN<(&uUyh}`L3c(9?bXVox?hCpRjxSSd(j0O67EbMJwwm` zJNKJoaqQVCYE-sVK&lfF{0L?1?sbgC0`7ZYEP~6~dX6dVYJ&ovqEvtw7?c1!B!Al5 zO3u&GV`{5iZqJUIz;YW28@FVw@=n#~_3HAB3SS1}T$?EUV5sh!{6nfUw}Rh(`gQ^F z7{k?v?Mx{-OCNO?#ywt%Q~zIs$D&XM9$?K{LFU+uky^ja+|=NDx)AZ2=Nr;)xtteQ zK1C6r6za{0-IepC8OTnU@bMYU$z2wYyhrlkR6eITM0XPVdCK@zaC>_Ei|QWjj7N#% zpcGWcwDBGe+ZO#iBF?VLXRiKleYjO1Y_iAZ!{MxRDm97= z5yZTMo5H_keV)j8#umOZrrS7SltsP;uCg1k5elW!6BmEj*|GD`Q3dPU`^$DQ>!Q2L zW|wCSnN2arHr<2Iy4(a}4wal`XS#6<1uxBH;Rl+>7cQHgZ?QvpQZ9DCFy! znGS^US1}5P!QQhlWs#ElO~9$#Kt%xEsD0^8JB|Wd=lTjA42YRTSF{QGwi*)M!=Qqz z=%xyOpc9j*Qt2hubyjlq-x=CLwV=G(FSLCc4%zjQ-E2HIfd{}D`^Yk}Rc-^g!PP$i zW`=mIx8V0V9KOt&bE+oJ+dFtE4m_>8SC5AZAGnuRtyzKO<*TRlB4dJc6(2m)yuA@) z)mI=M;GopETbQn(fYBJ-Ypa-l4xMsfnaT|1#+#Hz2$g08rG}MMTqjwT;`XZlyc^^@ zrLX7-&oLD~3gZV~GQ7EY0(X!ysJ%snGEaE8`%E}#hEiJvO?2?U&1n{8x+2rmsP84T z)G6!U+7l2Cf<7V=im(c!_+U=~0kySnT67m~TV>Dv@IPI9P;dc3xO=po;+Krl(nTQ_pz%|Ng=;@B@*LqDB8)0 zM=WfY#TYcX)ep4-81R&(N5?+BI0UwD_pIn|IQb*7*Oj!E6KyAOwCUx|vNvXWA0sJt z=t@hlDmtxtTxInZpHLdZy?Ne#Gy38|1!?#YP3Pu!(<{6TXm%L&+BP>lHMx}qwi=i= zER*9X@&^Pwow#sT#?Mg?)2S9EM0wwKm;cfEkquRU=?H5h0;@W(E4u9&PH66c0-k|= z>vUm-)#tXjEh=O7GA0%F1c|B-eN}tDJ+dOVCe#LLww7A36M&(2K zc4k{;U4WQ@J}g)Aoew+Ly%mb)m+Je5*UK$BpKesWp|2%RiB9Lw)H54f-rPQy#nq*; zj(7sfmUs~QWj=b*>4^T|Fp>RUEciTxml|;%V#{IO;nA+p&!&IEd*zR(yGFc=k?Z&O zP%$sEuM2aeduV9I8l88vKC1yQi&5hlIA(5;#g8l;4z7{+cT!^^mUL0P!FF5FzTqp` zh&h(coEg31YHwqr-+CiXc}#<-IaH#c1NCtCJdRF63mEO=c63plzOSq&^dO%#ktw)G z#X#7GKgafovB<;7{OYHA-EF5Z_+%f}F-9mAeXH~jl0X@H##x29jDQd1X-?u9g4Jld z&rMIdO)8XXhUzbEdnJK$S2DnrETV|!#r_POmm}em8aA`Ih{D@;+ILF&QD~(E!v*D* z&HbNGjA~M5xY`2VqE`vR?Qw+l75%T$rLuonNtgOjMcYmf$vgt-B*LhUpZ^86gUuBv zH=_Nd^j@nA118Q@fFgwCQ{^lW% zd2*O1;n+NgaNfkZ8OIY{(Xh?h*BIH@26S`loQZ4k)!$K^l995d9G3N+8(9kb+T^x- z-S@S5-E1vrt7x^E>a7t?P>2v zT6o}Oz~6win0BH*evb&TwQY4^WyB2z%fp?}~No0$aue41XJkL3=VF?})MZb8>1!3hm> z2x7yfQ_tRQ?mvrrulN_h_|{vi6H|{y*qiKMPJ2x*1>vjcqnnA zM`|k@87g6e^!%awVOt2eYA-zp)TyU3gDr5{DO_k+I@*a^JI+)@cERbZ$A7f|#d?JV z;%J6v4pjb(!}~9lW0GNeKfzpnSXi$v%sV$fSlHNZJ6x?n9{XWp9}Y=&s)2CnM990f z#m+S#Qe$~3wMKOg1TWRRmJmE&Uph(SBAZWSG+n&<*rIdp++m0E$IH>oZeFoJ971Zi zKW_}&t~0WLlOFZ6pG1i94P%|OL!(>M?j_G@WdE_EfSzT7wCX%)OrH08BnFs7;Ttcv z5mj&i@CqRO?2!Vj=q54b7Mt!h%yd0i?(B=;3L?D4@`e%e+q~l#UPuU53z=E1pPL%k zC-;R%Jz^qlh0H1`n4?k2s*F89CuUfkde*~-pA^LVg0b%r4W+}ox6GcC!m~p@i5-Q* zU1N5e5JR-x^pOco3u^BITtR3f zCzw;EsE73tkk!q7?bYy;Zp4PVKAE1`<85;#NeJw%28#y8WKarn3g13HhtntF5Q-T7 z>OaR<#YJWr>`nIz6&kpML-;3Z4%5(R3vo?1 zC>@9zcHRx*`rsbmnVt|d&r*fpDfYt2fY?9%PQa^aqnS!w8n9)v5K0(;e`q0Ub{7z$ zf3E+rIPg?UWMFfEe>TL;Xg|z1v%0(N3^B{@zU7XdlmnauVe%G2n65%!== zgPI8U;nTG0uisJai45?3n?qH8F2jL@s%v4OmutfDrlk{J7nqL)*3tcM zw)7-wFW}1ivV3T4sOD&jU(1F9F@r$_*{F!^W9nyY`}Te0ODSlQ4WW~Dv_MT3AXB7| zbWe3#p)jL80X==^>LpyTxw^l9crU5=Gr6@!)^ zd1NSH>RTFzPL zCiNj&_(I`^S>)4Ce6~6bjHLIh7fFmx! z(yle!D3hLF&B?X%#&pbwxfE6VVbRWypMReI+M6g_a!EQ-&*0d}=LOv#)rMy-Rr>bh zU)f2+w7L|LoMC$S+J$Y_q?8FB1rPh@KrxKK7%bPq? zArTPsb(~~6@k{=S#X%Sw$9wA%*z2QjP#*3LV{!kPg6f>^vVq;qk4(j)Q$7!~9D6?P zv0Vir=44-CLyN=ZXVD&hR}{Xtazeij8uocbcaf(QF5I2e>OiTi2cK}U)(1`v9sVG4 zI#EZmo2dOUtvmHB67JG-a(9S)(Czi6M6o}@xl0<rA-q$qDAU7)J-aA)qpspKfK4$$gWnON zaBkBmYPB=&nf&$b4r5~DkF=nNyD~%xB^zp6r1q@*HK%)rAMQrzb^Q|Z>qwcar(u+c@E?jfUu zMo&be98Vr%8nckuQZ9mJO2@V7T|nQN-5KeC4XWv>J98EX(3+<2 zd^0j-yNwe55j|wn;NzzGU{LXZsB7F7a!l)fNA=D_FgpoI7im(}^bq2z|cE5d*D!L;{wzDC{H0B!cW9wl_C# zU}S^nz6M{~KjTghKi|w`qqTQTSHr;ys4!?r&|I!%!V>tsqbK0G_x7&K{}}iWomZ>2 zQ(`q@dgr`tv?2TrT%)EJt&Qs|m2Tf%rU04&-UqXAgamo*H(V*w@c~_Y#x$72m6^ET z6x!%rv+OhG9BLBpmQMq)RoZW5M^Twko^Yw>6Ye5ET0zeNjM=%%$zO0?(keoyZ#^_~ zaa_W;Xi$fNE5-rn-Q?~zq~~t5D|aUIK43r4bkP{&Vd&<|e4v9pcU9O7`R&$+wWt3g zYuVQA1zi5UWEU39JX|-3O&5_o+a~CS4%aREV6U4)>HKZtj_gGX_5$K!(R-FC5Hcf_ zG6NT&3&sVo96n$v?8D1=?!Ni5^hp_KqUEFkljqKub86S^QSbifyCQc4>Ec^n4ejz; ztG#VnhN20`EK;x6w2(<#i!iI$)hh@qsk$>R?5y2g_>7vWLCP)ltsl1@+x79mf0>e} zU*eNSf=ywx^n0EQe)(?jbVG+1yq2x}d7|B8Cn}Fi!6GBVZN-LGhusBD{UMb8Ix_|} z1u^l`16D9$AP>H0fiP>h@sixMVoO;fHl=@AkV}@mzTSHS{3G#+CI6x_8?EK-SwD-~ z$m8TyGZy^Prb@oI=;W_LTwZSoy->W(-LqB&(4?k80x;XdCp7|XTy6(EVSnOpo% zufY{2+gW0(J$GZTXh_fHj>v26%C^(Rg%c@5?kMI1hJ4?D>tba`Cu5oqhqj+^SEvSv zmUJa)Re*P4-us$6U}R;PoU%@F^_NX@r`K@mlBqj4wB4)!gr%rHXOjyn~zV}K? zV*YMwiI-$g&o`S?RUtk3`uQhu=*rAs6-K%h<+gf+JA|I`8oiJSY06YNEb1JklfmA= z;N0*cT>hvK@t*tpVdI{s^&3AmsK~~R*-w*!$lY4GlDX4!OSmbi$;Fb3;`hAG2@(@~ z|B_GTnhun66hoJeTu=0n|bi{OR0W_Jm5)zHAwWwZCR~Zo$|7YDgNb#)X8; ze5v$AE~}ff9&aw3K;dRm)R^6*5sgsq?dkbR)f%pfVCIgk>hMUGpT*A=tB1LqRfY}f zU-m5ySFq%TmO*j249WO8edHNRye|`)>47)WXL$_QAPh|foIN|+GjL$l7PBTXcB6f z!;8jlUqicIrRu(Os1+`^?U!0v@^9t7v`pn(1w_ZXR-bn4QTFZbCSgL<`Wrr?A24b+ zJ~)LnA;2=}Znwm=$>%vHDpxFNu@3^KVP!hn0|=&4+zKmvPLldpv&?`a{jtOn>I*MN ztOKNf{Co@c?jD~hckZz0(Z=$|AoZ4Q;mT~EtF!DDFlGph6Jec(Js+C+ifo~;M|$}S z7Rl0fq$y0rj~=%hG;h44f@U6h`%xBAu3R%ZY7hn1+J7!GiqJzr)xM@;m02t0FXwE*5rbAT;fA{!b)cf|ZR7ao5=A8J`j=93sdn9c!e-kXTuefwn z=89#4uKWk+>6$u6PVx1Pe}roZnSl- z3aJJQ-b)gdqXp^7)PGLSx@c{$`bjEG$?e)s?!trd%jV$^P8t{5hq;L>9M;v$AKAKc zMr)xxk2OL1yI7=kijBdsOzdtd8mY?R(Um{MxXLqT$De-#7MR4iwY;xRIDfM2BQCBr zw7ESU*+HMZ7?mEN=vw-mWZjE1XY#WAIq4;c7`ci8r(0*?Q0s|&!AMx9$3_6v_C+(5 z`}GbX!ApeHWK25>0MOn3V0v`lP^sr%e0}T30Tj7P=Y)1`zhzG6!OLM?$)4%-DXEn{ z95~&fkg=+CG_=`x{`LtVm#q7W;q})TwGn>lO3xmMMXLf|8ChnFD~Qg?f%kb3>{)Ru9}+)wsF zx_`?{s-O7`bZ0{vj21Ssi-O$S{%I1FaD9%l_41LsFKy)OruE=g2OUS)$sOChpDTnu zMG0Oatguealz+Mse<+U8Fnm2-vsrc1{UvUzFT~lw9<-YA85q%us;ne0vYa8Pb5ePqj&Se<41u%&H384~fb7nH0jAlvWs z73n#ze=9R4OvRjX7My*1CJ*H*a@a0c)BY6pe$%$-Yg(2_I*ZnQFu<|f{J7R;Uzl|> zQ^=r0m6xRQ~N%_|!|W_xQczI-*?x{cP8FPyw=d+tQAG%Ra0xTAlac%AojXhuNhNNTUmU_s+_F zqW)+5(skgyDYUjW|KJ}@q_|bs6qS<#Tr*G#DX*}X1~w#qg#WMM@mi0*l?>nn!P zT^|uM{;$X)+wu1yO=S-EbtZWzY%K`VTf7&XuM-I@^y8Da4#9?3_JSO9lXX|3_#32_ z0P4=Iww;OkaYvnNwXaM!oNoYvkM3eV21S?#IBpO+Qy6|&s+0S@p}_te!7`}Nw{I;# z_E9lul8B|oY|HR5@sY~*qg&lu)|1!_x0T(o&4-!i3G(I8IA^8d7~4x;1`AvZD9Y38 z%DN)G&8Z40f9ui8_j`DHdv60c>o^D$x)j=_pF0H2>D10zlN=v>!LQec;h9ZKH3J#E z=$c*A{QV>!&f1D?0StsSr?YUYjFIRG9T6u#1<}FARV;AJkV^<&QGO5Q9 zh$}Ue&JcxC$8U)p+NZFfsRYG5=%>%R6YShrup2&l2s$L;cWGyA;b#rn47EJ6xl)jV zmUyz#av9*%JaA^H`z1{CkJFwg0R_tITx*%N=D(#ZY4y46l;dI@^va-EXi`mYBFFs5 z(;%B~72pZj%O>m3cOQ#Y6FKKcI%7)A=^~h=WE{=@BD}lNBVj{O;5`U$o!0IzE)I6) z&^y!Ggq$*AP?O9(#|S2IpNW8ZPRk7hwAUMSc|pI|_iL zByM{treC&KynJioYM^TfS=iV((gro$s+nF%gfS;RMMb_kaO_U5Ru&0*+*x5batf6r zeV0fBh&O}=oC3~RNKJ>d&)pXWD}DcP;#QK*Xu6l2N3I z7OgpQ zJ25gFF>liQ!g!5u_civg_m^>a7|QP#G<>`@Vn0#{+@8+NUu%X}P{{}e$bvsKi+IgE zxMAg^#(0vS-r;qS+fN=yLHVBwqp(XsnjHg8mO3W^81x?7fJ72;ZZ3rc;RKRUw6$a- z$hEd_?N@14hw2C70fi{f4#*T=(5q45ued^?o(aq85P?JbYvCfZvXXkD5sc1 zb;L~9<7 z2ZrBA)t#>LVUhV&)WnUz3xQHF;b`Wi7apDFHcO^wa;#iSI^D%yRNv`clE!o%7RXWL ztmAAvxih~XM3(}SDF%Z^if%>TQv!N(bJWjRG)F>2alM--+u1AhSa&U($q>lWS3&Pn z_rBnd8wT3n1Ng{*OU@74VJbz%>d70(Cl_vs`F~$Rqj{6cy~lX2491_l8!MtY&=~)FMoF5O%Zf zj5z_l*%s>u8g}1p@%&4N;=rTzdtVSvi1xR(_376H!)%AtCe%_mT-@*z77;^E@|@m7 z5S*FKpj6L^>8kd<@w3XSEk2ebwNNreK&A`wgPaFJ{3jQONxQsH2#vC z)0w-)^)$+t0r94uB>(IbU+NL2YZUnakJLq7eOX*Wt7||?j7&j0&K$T-7GHlVhno#RMUc|4AgA*WUI_#r$N` zpvw+8;odG{dE&aeEj;jB1(MHrYIJ-`!W!nO&~?QepesG@tDDkT1MU;1&elg97oCu0 z$>3jAOQsbpgq@SJ_ykBijnNuG-lL=iw8keP9^s&x9BfOiX4VtVs>w5YqC$#}ikDd3 ze53X38np0${gHvD(1WYHB9mv`JjBFRW)8`%&n_gKsxV!l{^5}o=o27KVVxSSe6F%~ zIyx#~lSqHk*);8t;*|+QjA5yhj4z(zKg@kH8xX!jN>q_871O~bAMf=mdL_ZOLAbQk z=HTKYp&pZ#)A~w^Be7DboA0Im?s4c>rgab$@$5A8@fEypi<|-m`PXe{{xyO~{u6`# zNoz!su5IvdA@bmhd&#H3Q|s;BVYqcx>==jP>mRZ)#^eCKhu%2-79gPUrn@A76_0*g zQe~c?=M|elacVz(s@K2X7vMr)O7AE9B#rCCjujxXUTWykISwo967bfpe2|TaO~(BD zP5X(o_24_)B{H7Hf+3_>r%X2$p~J&-oLwux8o)damO3Bbz(hvvfgb` z3=X|~_Ll}d=NI?f+DdVsmu=Cjjr(G4ew4N>{>8}qkce8|ky+Q= zjee7N**9~+T@(D{u-?V*@cJW3SF;OcZ-~w_he&4tS3m)0>N}=dt*L|4BN2g&b`>t`@%bJcj)!E zKz2sW=Vpu4fw+RfF_1I6Zbm#OKSj+lK@aIv<54U6w8@Vn^D@?M+7#GaE)DHTaXr>> zTg|MA#a+3P&*RUq^vh0G4FB=&aFysTZgq}&U%Vr+O6rN0j#h5uo@d!esm>2i4$2>8 zk`nv<)b-hhO94*Mw)`gUuOC@p8Tj|}fipWjObwvVE)c94I}RI->_0Sg2a89j1M8cx zPOc&@#LW|?$7ArB)Di@%|5otIh?p+>S|}@uvraF>6;I$pQJYml?L*?KpP6uVonCcl zMUz4q_eJPxKXh|yr^!mq*oVup{UA!_Xmk&RI5}yb_AH!KWWfMc_X&?q?zllq-kZDs zC&_Rx3`W4u);bwGBDIb(!@nVxC_7wA1}z~2&NX0P6Ax4J$!C)IGM#6*!%4Aa;X|Jg zAg!Cp}Mcs&UL+m{%?T~*NaW95#RG8pxvbWu(yTg63#$aBMzGU$8>-#7l)KgM-mIyorU z^bME1nXJ;Uh(C>xvjnZrysmaK24<9l`@j`ZJF5^kL=I8Ohr>El>V;OZqB@%EfE7FM z$>fzj)CzUjesE;77%wT&pj&a!9&@lBJv9Vs-UpfjV)hF9$&CHqYS-gH`UvS#HqV+6 zr`u8QbG~Z8iEEoTH76Cm$FzBvO}rCcyWsb}+Xqgy5Q>S*U-28L4?ZDfIe{W4K}i$I zB^OT;aL7`ZvvTtecQtrz+rB&*v9nPCo9lR4X7Y6szL+#e0@iC(t^Y+Vm@>E=o-rRu z)xMp-f7<*&;*;qE^JXW_6%$ENl9{)^-4VFyzghrO-Vt5%*@?;EJ20Zwhri?KEpYIe zRD=9B+b9T7+syBFI?J=Y_V}o`L#2q`q45g-Gzr*Nr8&0Q0WAEyn0r>p8X*fLsne)q zZao>EVf*>=h#z~l{ium+P#lnO;IMelur2VCTUd5$b}Qh*sNnAPh{XGcPrPh-^ftuH zYv{uCq=&GSSw0s+Dnebd(|5xs4I2Pe7ey`x}&Cbi@%rT)opuVK-%`##w_80@uaW6+#XU zn9Xkq3IuY?C>1D2@JG2hHFokbqDT$8`j+=fgKdJtX zw=B{q6lE;$V6Io@3ENMQI?YEmd~H_>J3iYLIVL%krFdWC{DFLFK7P^g{aZ8DU}`t( z4H|46UHW?{Q@y8BDQDZAJ{Kl{1;wX?E#OLvWKVt98M%+8y@nX$cbcI%jy;;7yqC;a zyMAIi)!wE$SIQE!yL%Th9uQ1&0HF@cU43?}Pqy=;i1s0QT&4T#1)7$N{cS_a+n#O7jhmUY143u{?1?_+B0#ntCi zJ%w`|z^s)yZR1O90~W!{OYrm-;7y%RrfmhY*|mqkd{r!IV~vDP8|c@f-Z{^bt>$Uk zmQ$TjsZocpdtxzu=FzM$&7DAy@QP=@@IdCrW$2j@{vs-Esh3oW{uPlabVxWyoxXm? z<<>viKZ?pxyx?hWlVrx8NkiprY`0YGOkCGxTYrwFht`MRKh5Yn0p1UM$nL`(;RABO zXczl{kEZtxPrZ}wtPmuoEUj{(>YX|ngb5k;!#-T~oFCW;$pxQ>hfKQiK7kBht_iq! zVsf@esC5VEH`Z#|1`y$S&^_bm4@+UtuTQ*3A#9+adTB%gj0xJmfCDmVgM#FEv` z#E(908AbYNv*{D)Ri!7;m0_F03l1;LKGa5%E@O9?<~#6L)0mU}FiROGgpCDvOOYlM zcAy}%fN))6#xyFd#Kh`Sy7j~`_2*A;?riK{&G(1KR*Y2Im$bTflX&45e(<{avafqDNB|Sw6(go8P=&v7zAecNl2&e&d#uvLXmf2s8CkCQmGoz)+?vzmb+vp zhXSPo%+=AvZWO3yo>aO2?~cFn+13xo(z`U+C^wONFC@7PWAdaQ5i3}pj-lF1%%_1~ z0YFM~69$ePCw>0n3oKonVWRl)g~mC{R+|ULQSwOb!u<8#hwk@nbe;B2C$(_?S}8jj zKwk#N7f$83ZS#W;KEx^0-Yl17qAE=)Rp#KnuTQ&XQGUrW0_T{&C(f?V@Hg|Yl~ zaX~>ROm8;4ggB$oxl+iiaCw`oJFLC3wY9nVeRFd*uzR-%S0JR-yRT2bAgf(R6)RNS z@A#%EbgN+RDkdL1oSvlFA?>Vn(xuC4*sFW@e6;8{cOR?*Yka_M*KXg;vqDDNXW{l4}QuQ9lYA^P&k73{JU4ObCdj7ak|oA>Y- z7@09Ds!5-VuT^$rF@H3NG|~`J{n#nu9)E2CPuqWwOoYdUq}{SAvtC-d95wS(lD*=f zfFXGu?av!Gs~kZKOOy-; znSPgal5o%`olJ-bA#;y)hcJG2h@BIoDUp^$Uli(`cF(>$LH|M^=Jk+{`S>zQV25#d z|MJhIy+hBNj^g)Qjoadl3S#L$+Vn1;^ab}i2>aI$fgo~toBHEgi}s0%k6H0YgA8j? zmn9EBd7v{ZH13@8_}^#+&uj->xltP;>bZ1$@PW^UPA(XcUZxQl-d=&2<5<`*{}s-c zV%%1EbHhD|b0@v+9OIK#-;UYMyc;m)(q>Z2&e#^Udd=M)vJML`tDVTCc0 zNrCmQP8j*0mj}4B>i!Q~Z~YMEyLOKvA%iH)AP9)W(4~ZgG>mkOGzdt8v@}DFl!T;! zlz`F<-CaryEe%6TN)9y)&Ed1(?|1Kg-gEwe=ZE`>d#!b?>wXw2 zomTzUE|0)9^~|>(U2M7$OCEeXIIjXpxOrtx=c%DTKo?Ll5 zpUd76)IIaZUGLB*uqM!uYidoIR8snmkcMWlvd<*4`b&&Wo?G_gyEkvica7IXGG93t zR8q+-jGsItQ!GO`BNSJP{9NJ72;Xe{KW*V}U$yh}PJJuhRKw9#2p`40JL-jVk7>FP zeJOT797!mv$;Od8jvGTKKIZJngatI2hkir^oK;|r4mHs+D#l~VV!J1-SF>)h1{>e} zt1esH@@zecK(z7T2?WOrM}_GzpU*ynUT;o?S9<0x`%hwVdDydz(85H#TQNY8Fz)~( zVDX>A`lr5@;g6NAoq`QOs&dG9dQ-ZBWOL58q7;H(I$Os}293(<8Iky+<4ZJfwO*;% zqJ1aa7s_y{p!nyFf)L8=NO79uYaRHwF9>Rqb*tLX3>B77+_ot@8z5?y*+O5k&#C&! z9)C1*9#j0TcCSqR(ydCg{MTX`^knAE;MDSY>61jfJwc{R zzeVe77 z7e%@sZ^?A!)CFe}!Uo3EsRBichTPIH=Z=aWOLeXM2|DFwZvq9+lZ;I08}8H8H|OmX zK_p2vg{Y{D+abt4--XHuz#n7N$M;1V4e}tj645D-D_@@3BnaJ(uA2Z-8*C@hc${UE zy|vf^+bm9Ruiizmch60dBxPGZ#(r;9>(X9>UElQx97#ey+QYpY(W3yOEA(C3b#Q-X z@W%UBTffV`k^5YX_?l(986n)Ix2OVcctD7_CMG{WKAaQlSnte0)>SACsLcRoS4wO9 zDT~s7Nm@^i3NCb;lsYC(Ode?ujBC^anQwpIZ>i;5*|g{n8KzB4j)V4um+y?93+Fkq zh}?#r<7EZ0v$);P_5na|<(_V79?@!@J2zR7=K7<`mAy9*Qy_{}GBYS0zuk)NcYM*b3A*0r(C+>icQ8r1vxDU~^~&?DKtNo4gbDR`8UkOYZ3 zb`Ci(qB(rzWX-lhbV&$IYC$Re^`_DqHyL>&Pgp@JdQ=&8{wz@X@_(1L=|wgkk?zK%S8yO3s5?i`JTs!u#y9dg z2TyNixIW1QEXU~+yKn1Hv>CVQj38jtyIAbzNnK)wdmCBl-Qrt$z9UPacHm`sq$p3Y zKCu8(yF3GD-}u<+&DK1j5#3VxFCd0XQEGoDCfW;Ath~C=7*KRE3UJA9&r4*WjhJs% zU*2L}=hQg8cc2ndlJ>X1kobMREkFM!-5gZ9{$y*DL=&rt*D1{I^G;oQ4@0hBb=w~F z{2jgOY*wxGeq~I%zgD{kBi7{7PEt1Y?eD)#&5tS+?XsM2zn>I6e#SH2B4IqU_B!)j z;p{E1IfpBS`PPq1lLFO3bvbU~eHn68Z_~w=e%micE{;h;jrb+#Wxur=J%$%vEkIVC ztRLND3YSz<^3Ps%#36gHahP6ni)-nJ4wV>a1_4xQ?kYUR3WV?ce>x-sufGe`DeaY? zDWR<6*5t=b@8%32lOfLCwPAmp$~OnhhsxngMP$*&R7&H4-W_$1nRn#%tfh9tj@eZ+ ziZj!dHH(_CzgaQ2bkS=$oDa|{u!%BL;VvIYEL^n_PN=~eU)Q0CY>{a6!N9yS^~jg@ zQ1NUm)UiJSEw~0%0gMO6A?!Rrf-*?Nrc+1_7q8gIyM}4vW)(mU?jl7L{`%GNHYLo} z*e7Ho#As6gTUy4gX8Ptdrjkbtit2^lv(Ilg>Ao_$O}!`!wkw~BaW|sKQGT+Gaj*Kb zy*t0@^E=aM@`5kB?DTJf@vpg9fnzbcs3?loo;ydY$Bugm+qEP)5&J2;NWC-&v5sYP zF36IdeMUWfaWh5~$pvIwLUYZZG8#w~<@IMcEscz~jTY?%b`;0~TLKN9{1+A(r`us1 z*fx!7O&+Ajq*9O+ zex!^HEXp7>V@AD_eN-~TzDNH$RaLw_--(N%Uza7YE%+SvB>dt7ba32_caqtl&6yiA zFL-=C`25)--q+WF!*71ha=+IjM~1jA)pi{uF&W$6L*?yaPLrjequddenda}~8E(Y+gLLR&L($c{f}F#x60~UO?7%5(4U2RJ z;_i|3E6ZTojh|`c)xDNgFBc#Z(?U6A!# zR>Y($A;k)L_?4=~AlbJ7;;6zc>E-l^gwC{mg^8o$MWFanr?tTHPm;l!)xbl^x z(P(|3H1waE=6(Dh@Y8Y91xd*&V3QOD!573$6TVo})UxX(Z|{sagUZ&$Lr%8YL=;N8OF!M2m9Zse42~vaQ|hz zH~@rNEYLw$t1cDTeY4tPW<^gDsfH#SAKRbW`#jRfl#FDr9C5kkdsz8&h6K!f4YN1P zL`r~Z#i~cdjlWDz#!gnwHr_Pp+#u0frOzDM)F9dmnN-s|Fo=|M@2jUfy3ixr^qtf8G!q=Sr!{b{i9%1>yAoH1er6s8w z(d}cy+$QPTl}2e@+LBn+)A?_xzroU+25t77o4j5Q0{mtE2c0ZH!|*Vpw&^jOoB6HQ z0i~nv1qmX2$>(>O_y3}2DewM(N4Rpi{DdqcX1ep*=KCCR2J_{%h<~ z_}R{I#Eg)tOgMr9SX<6k`^n5Q{;gqQWM#s}y&gJ6E0Pjq&h)EcOaj@$$W-E`?bzI` zr%pyb16@aOmFL;SWVVx!1E-L#M1;u0L$eoE7K{1cV@?LkHIiH8x=etRe>V&3ejpRb ze$s2~5~!;*(5y1{FXbt1$nsEH zdfC>_mfLoOIE*NYrEqJk!^h3~SATp7{^vyhhq9^i?8>HgrAX)S>jjH0NHZyUen_Yi z&QXox)=NN-Y@N9{PBr3z8)`^+n6?`SK#=!15O(^|LYR!AA&W+P(y2f7;o@McPEyo7 z^ZHKk4By(#&!I8G6ch#$g0D@m`6Tf8(FaLKCIjknHW60?!gYcoyjug zoJMFDD4!@r*urmHBb(G=bD``!m==w2!u@>h%W9IG%o?<;V#hRBj3d5-e&y{_$I`t2 zaKu1ghhSn-KI&`ymS3wd8c(5_pXA50iXrUKE5zLIyJZy*JZyvS2chVjpXi1?@tLLM z_{|N!kyBzuh*#yxRfFHd^?_CqGeURRCGvRja_Ld=mk;d#R_YECI8IOlA+3B;v zFoIp0V0>45xy0BH{;!C93Ae5ttR~;Q$?SMzvewFL@eNftaOQSXi2l4)(_*)n{7G#mqL zBru2lrZI@w@2jA^>xb0+mYcJHPT~WKr`LW``FwAZ*)+qzcHOOGrx`^hXsgYZPx{~% zmCL&O3q>t2>Ls#=+~$7@`j(T-ccZ1rx~2+ zt*|SUFS5u=xC(aOziGDNJ@Vqu4$%7?c^n^+IK&|sr#i^fq(ZxyR zr|7xpB)GlF6(J+?tP|r68)#-UxA_j!?NCg6AuCwY)@~xL z-9DnpO1C77YpC-aO&`i0Hj-bWiP>sSslTJ|t)|@)Qs6?sYb|{I+SE9aXRP7cQH$N`gYYe)T(J0PgSEE6}YOdn&%` zUupLExDqmV=&3_B{69=-9M43)&1+lpW|iy6-E@1rNjvY&PDgk%&A1J1XS24bBni{_ zb_J0Y#z<#d7VzDR?M>^f)Lk{?H zMP?P$kYwVJ*<|bV>rK*4czlCBp1pN1_7|@49xk_%$M32p0lr#HY&hGoOXBlKPSW8f zI-5S_6WzS7JoUXPiV~o6PWj)rIKMarP^?CQ?8xIPI(Y}l2O&}T)Z@WpZO*2;_)MUm zUNEnlnx`sRtP4?vz8>b*xcsm~2B8FVIlcjF%#2^l2%2Dp2($H$8ukUTQK~7{Qr}zL`SV!lUX*5_Yyr7{Ol-u!WFabk15LD2ypq{ zZSr0?>ds2B@Arf!i0*!jS5vN0lW&ntC+JNJIlDTQQ!K@uVM>}MG(1|!=tn)%AfkJx zwfHr>eZ!fL#f%N|!k<>3nCW(cOLsCjJ#R;HrN0>;T-WMzD)Y3I-Y@NA+}i+?vai|% z>urF*dN}GME)#?bPC-n~evI z$$uYx#4Vqrc}n&)X|4WE568ZKhWRxIbKJME`>NVwr;h!R@Yu(inK>1gWn0pgyKDL& z-(J=Gx}_Xqz`q>-AA~@sAHNZj`UPSUm$%q-Ejl?+j#XZFiUzS?n#+#zt8G`s6!$t; zuCGPb8mCg4t);RlFUkA4CuwIy7K&ibuD6Z_2O}YP$VUnjQ4e&`9^;BJ5+6YcZa9<{ zvVW^=+kHOU9kA%oq7`5wmrO;a1J=_sAMMtc)wYh&TP-#Vl~)1p=e(3WL>U~j(&}Q} zVC6Zr3qh>Vt2<29&VcWd=|vcVlpuOV2_6zIP>mT1ERsn&5hp(rcZH{cx^>npicgq5 zp*9Lg1KMeZ(}&7Oi|fN;_n7D=$Itz}%FtN)f_6f%%%Jvyp`852$WqFLbL`Zb9`50D z<};JPxKW0Xe7#cir+GMiR0-RYhdP+?J+3i9%3lup5Be8dKI_d(Ju*LYpK61TQ5iw! zsyM8~(MP+Xs({^ysKYEAlia61QYIZGQo}ii{&+%-wU0LncE-a1Tb}s*Li+_*WevrZ zNa^LrOm~W&DXZ*V-}pbm-m_K^X@4zHCD^ud*GsP-e}E7`c{~ zpx>Y_jv7DxUy-#uuh-INN~*8nLR)twTr2^Uu3d*b{LWu%Ep4tgN^?_6vs$&u-&uU$ zBKl@U=hKIM9}+z)7#Ua>xc|9Dl2+{Du?AhRxNoNE@a2Bs36=sMcbw!O2=d<$k6l*= zpl-}sZu{y32^rOHf~msOKB7lYYM((`+${!%*%(8RNfev@im=9W@(^+{0F%phalUY9j+ob1KpX&uITxaaT~^2@GM2=6zs z^<&*f%9>Kq7~4Shx3?Q*E>?2%B{A_6OmPgFI5hR6dN3cVbcTZm%aoOsIt*j#ERQCS9G_r=!?kGCDgx{ZriS^!w9N;{M<8gUuV%rE)E`Q4Q#lZw6 zecqnVyhoz;?F)04LwzxNM)Lpb1yE~T2#<85o6b`H$diilwHs=bgjIRF>jo@{c$p(s z!p1jg1>U|ZT$y9SHkPVj&F>9c_I|A1r81i+ zDwJ#jo4;3D(RM+l0Yb-!V^LX>5(&dQ(yWB1ke=UxNZB!5WCM3aM6R^yTZaE#7VnV! z9?%QFkL>zk&HfqTW3_CYbu4`A8=yp`BsZXIoizFT>U)&=donYzgQD5R(m}T8(neCw z)$gu(iGzZA^8PG1WsyZs3v)pIMPpUxl-pWU>XMA!;(-mIa!CFKIFmWg^3Deqd2XIG zV`$$}788Dn^RL$c(B9?N+KC9RM*p^8%U%c@TWtyPyx?>>a!&n%l8jk7srzj~1k&}4 z1Ms5`D9_LqOi-lddNHFN8_G@yJ>K%~x7fuUY%&+H%5w^Y5tDjYk^E>mX(yHM*z)%$ z1<%nzdbSy4jc=4i+k(Yzcc_Z$$%T4GTw#gsQn)ZW57@0^IJBg0)6Q$S%?VDK{p1vO zd^jJ~a!sXGqdwG+u{>@!h9zkEl6dxJ<-R>!lCkK3+z$FDUU0zc-Aygry;1e>sju~M zI9}-tTm-J9bJlxPC(j^NzUJ6RYmK8x_X@OYh%NcI*=5zPfZ4c`_`Y@Y9x%Nh4&Ctu zMP)ZS_gEyXUvry2Sj!*-sB-d*Gz685NUaHJK>mN>}g z3)iLy>NtAn_^QYFxIk@~CWPB|>9agR!y*_K+XEz3h2-JSWAUzn1k+Qu+XxDdFc@a^ z*cB&o@US2GC9_d-K$$>N>z`Qti<|Q96Uz>n0&>_Z2yqn;T_hP8hi_;{@(UUH6yWGhleIXADG7;xfrJ19dh?64_p6 zDqm;oi`c{2$nbZKw|9K*?Ztj}8mvAK-kljOA~8{%%aqNEj5-Xn)!u)C%*9}qg>c)YwPP|vXcUpKre* zz`z&89I9WW zr6W)O`kc;((N7fFm<2M`d3D%sCug*+=Mzu1!p8 z8ew2$$)HM!1g0{yo3Yt!LI)=Lo%O~)3_4@c6xWsPR^>V-W#!o34k`B7bbH?H6RB{o z+La)>DKGD@HvG{cx%9+{3f-f(=uVSyjBr=a`80?)$nVNe^*rE3*6<|J_j=9?l|Oil zPXMrH!lAjsJ}9#XV}h!$=?!wv+`u7dRf=lV56|kxlF4CZnPV608HitHFV7Aq-l=!$ z>aj}Y9&ts^{675R>qCe;jw^F8EUi!X^6)ly%k!yCHC{E{za^Ozk9b4S)kpr$gKPI) ztHFFT{)%@A{FkQqJ)hK$N&_QQo8nBB(wRDggm7*EEfLo@RG}O=Y^HV-6vsi2Cwg5A zSUqsS);Ezrv0y%{ReZ|`%&9GW0nMnh1;gDpEuk0AbKn@|#3=Yh!Gj8c#fd+BO3j=u zUv(wdNhh}WkhUm$@E(Xvdph$RK83_!Wx{vntG*-Xj1_@}Qor9wS?DW{SrNu+d~i-v;YfpX7;8(JMNlSNo0e4wpa(XeLYctP& z5aRCLDYeu%#}+1oM*>vm3O<|%lxtZhS%Ht^lK&73ZW^nct3XVrApgd^)i3H4+IDmd zKsevxV{WOz540&Ro|>1xAv9)%dk-Cka`3?6b*v`z%aTzQGXSuxkC|-$JjLeoK%mjW z#I0^Bt%in>R<@7%j@6pi*eMnG+`L;PXF)JP-hfDi$e`(3ZX1uIHJaUC=At$7w^-xG zyoN!B1kuUU{78Iobd9?5L;B#e@oiYS&h`4?HRB1&n?#4lWO)^y9h#YWlsSMGWUL_X^MUY|fw?A|_`+yy;1ghaJ^BI?n z@`=JsDM`HL)ySESBq_0th+@Y8VlBE`a&YS8s;Br6TQ&I(gFi~0KIZk}XSar9y^{A9 zY_85%YrWcCTFsOYNfWsoj{&NXV}si0yCTUVmpKUd^jBJR5e|brG4QD%+vAb?8!Fp5 ze=h=O+k_duFC!9|O89TVZLsMLsCQAYH!1NV0JR@nG!$UuMiP#wmj3!l?+^V}!;8L5 z#aZDA3yoc`K~q_)rne}%xAENhmY@$9NTA zE!O0oTyYw+ZFQD*@k8(X>q}a&r#h9;0kH&mLHmWOOQ#U-x%eupp31V4q4{&v6P7O| z_8QQv#o@Z7nr(>U=r;!wvP1P@qE!iyeY6R9V5~i`@J*~-xKeHNU(d~$j*0%eELN9k z(a&WEo8Gn5_DVe+4PAL{mhDd5* zcuZlZ#}~dKIYt|fd;6r{^Fabf@i&k5`^U{x)X97EONWUR10sBWq^Fk}rNSi2nDJ%z z_QImuG<{PMsOyFY)#sV=Z{Zv>#oO5ybE_dWaH{Mtlag;juX(iEM0m~S3AM48&yXo4 zTANa_Eo^17;Q{__ncpvr3uI26^7($Ryt%W1xZW*@fz&tcw_XMn5#$pFEni1fke~8D z2fCs2@-=2ZYYA1t3D1rMIK_A^{=vroGvYLO%w;NTPRkMZxP@V$lQ@k~;s_tj82$x= zzbr26j|v6y7n=_hdpT=nekoI?%J_04DK#)ntg-$C&{qplgWXZ~p^Mo{dJR_9r1z~e z>#2__OSphX2TFSFd;sc_2UaX4i?1gFk8zgrH7X0*XI-=H9*lXtd%k-tuH;5cl=ZHQ zJR&yFzlr>YtxP>3KJP$yT+}-S8X(d-<)T=JW(iUBuVpOHx9&%$zc-HMbTt~64Ph@k zg16yR8|yy?s}bf}_%d$qaE?_=vrU;T2U$Q%v)=$iZ1*IkwNVL$=qzX&okF->>xTM_Ta6$;IM)L?Ij>^j$z89L zD3L0!xp1kh7vD?@UMny^*G?{)dD$+$ez>PIQ(eISAmsQ!pIW19^ZMFysvdpML~XMq zMuIr`Hz0%jm53wu^{&MRo5K^_mv^_yb=2<&rE|(F9%Bnh%f>Im6$I9_|GCk3%m|i6 z*L)Z8EmM!Kk%$%+V@VyNt9xj$=1Bs5cvT_WzbO-jA+(w#kI` zeE?aJG|(uk+mhT}+@A5tWo^&5w{>!^e0b2d6THMIb6+OBlZTP9yy-I6ZUsDhV_gSG zyN{z+&>m(QICN34L%-QCde2ufOF?mAHqe-lWgqA1bHcZI2%_*?2HEDYsr8=@w^9qR z^GlnInp+D8G6&e;6Ue1M?-NBez59Rhdt_Dd>pA5=Za!9N@5oG*HkDTZwq$|SrLFz* z2{+`w9^n7KVqi)VvTG|Ztu9NRSZyXV^-dZf9k=vE*_%UG?km+a3`QcS{lOP3TP1Z$ zo}cKObn)FbT`y7WK6qQ)O!Q&pv%=sPXsMD7Z$efh5zalasBLr?Z8(ablsCWVu|ZwH zTf2HThU1UgCO@@1+dIEHV40(3#jR_lT1IS4qAIdNKt70v#&pekJO%B&W+4;D05hX? zF{32b-wk&zr4Z!eL-1x&h*)>V=C$|8-FQ1(8uQAZOzm@M#Y^XVBzYchj%PtT z-MFdRMO9>f6=vsjcTz98c2eM}8|W~Ev{%~6`4W$Dvz}cT9r|ZxU|9*2F87(hZxggZ zh%D`A_K!=sqivn-c=yK|IAtzv#~s@5XVJeFbT_wU>hdzG4{N??k72Kv?(FGzn$ZuS ztoA-PL~ZVgNwbbVuzZG(`%?6ONrt@krgRPl0hCX)R!L+>FY#nK5X^ngkzaPa#_KM$ zI6<$N9nnEWe_72qRam+b!&5(Y9lfC+tga|TkC^AKFoysas5J0-BD{YrZuR?zRVkE_ z!Ql|?#O8vF_D?{_2v}vYz5{?@vAZaWLx6OAK~)jEuJ`081?=GN2x42R#WD^Q!oy~CzUgbUA(%#9EB^Ql#I@53ai2?(uRS*GKpQVP?8d;L zsHLWBJWY{|l-p9o$8wc(y^gkVd&Jv(xZ{N(QOgi7+>#}uE%8WQUJ(j3*BF@lB2Ts} zuoj^6gU5% zmM>mQUY+hNZmoBSucydVS>H{pySz8YXg4;na7YRwGkMPbKvtv7Vhb+{>A)8K8nBX3 zeI3lZw2upu@*a%EADjbG?@Z^qiB|f0zMN9{T(C3$nn~nJ(we|c;&k`SW_r%>@2fO= z*wUW-Y%jJuO;VR)pY{b>S~cR5JNryBx(Wh+kS)11pD`Z)MV)`^<;i4?MBrBag(&b$ z01$+I31K_RTWw!&FV?3zJ|!9y{jYfSenomUjiwMl2%p@$={2~)@LJ8iof*4vin@}( zVKP@QXnE-OV7+6QHr%K3!)8n7X|bz2H^jRnI?i>3v1@`byda;D`&v9o=~x)BRBNFJL|_+xq6ea2OGO;c6fo-$r&|-yiU+9eT}Q zm3@_&YhjQ2erEmkRzwnpQ`%jzX|3Khl|xPKFLhJ`tGd;7;Ad>NSwOxrBBB`?8dCtw zE(LOo_G+Pv_kI-Peqwse@HSshW+YmCWCx6`qU3MXV(?^>`mjkG7F|k&vdZe|B27fp~QBa zn&Y57qOa0lH~tC^f9qK%lr;R${eS#gsq?z}8qq@=6UR!&mS@p4cw_psm5;bzWkKf} z79dCKV|LT5+_sw%!;zZGbwjRVw%vf}c)!$*OvZa}L|1-bxhAIV`!(p?BPLsQe}V-X zdXLPK>T#0g1i_G1mQe=6u&)+h!0cCenQIHUi1ERnM}JX{f-#1iCeM@os)d1;)-;D3YRRGMQ(OI6Bf$&6~V zfx4x8LLYh)JE#KLUrmbDr}yBP(KA3upWCw`ejtP~(X9L6Z#+7#K!>g|lAhzT)OJ2-|6fGg-LvL(>`XwF{BA7Llxy&hOGzO0wfSjW7VO`3bS^j-B}J7lEJ@gz7VR<6?bfW60qJNTrM zOfv&;zC=S5S70$uxPnJ5rPpv;WOIJt-a_dKbu%O}=8MN}8O-=&uLfU+Oj?<4+>!V! zz6)G<-XT5OI2=B@flO`~VQS+!&L3fkGw3dj`%Vx$dgdw>wQY(Qm`eX2nwg^iRO9RwJ$9s}80auS>B&6Y$clPF`_aofa@O|3x%i^wqmJ-6e=WZSUMl z7gJW$Ckt~v67yw`t#YM6+<8}G(_c#jnS6iOxZ_e|UyS{NIVffz?I|I;(H+fv`Toj3 z@o_4Yp}n~!YnLT)vRwJT#B{be^!tX=; z_ce(Xsa_T<7n@&!CKngPVSdPFI74dU-|oLP5gASS=FVP4sK}L0^5g4}MZ= z(#SFEz{!)V2nrAFY*@w<$MbBiV#;hq9$+{8CGqDx%{D%y*npIR9@Aqjy6uEEzZLv@B*o6?*uXi{lpEP)Xdz0 z)YGq|fz-tR4#AaICFc>-txO0IcF*8#3*ovICKAJ294zhueo$#;bn|Ge@>ZbewModC zgZz=i=fe9kfOOnLJIrs20IBz`&!HDpNN3nSbb%8)2`eXcxXssp0c=_GAz-QMx_?& zK)KS1P*!A-4|}5)XPZU4eCki9g}=GQYI!8>pV-X1vLmB<=*JVicASBX9BT#gm@V7_ zCLfbM&{1oTh#s)AJ3`2H`fj(x**BFQ^!BcDCB0=S^YmqxsB zFBz~(eVxH+Co(VHO;^`&W%o))`h`-SccgKkn`UG~W1=x*OU`djE1nkyP^uRGeXOPv zNbEsovm=D!f3?2wFcmo(@x49{JGcPgXiF1AlX8qmP~C&`%1@EXTzGNG&bB_SI+~fD zD?Ss8Q+g=XnNv*hwPVrQj^jvV*Vq-;>WiL8^0<+)ww2T~gY`F<08)JG`}mz=!Dbw5 zS%wRgu}vqO=F08APs&}FUrPU5CcC8_BsNl&FwQD)i;TaYi#@`OjOOSJlKwX+@+qf7%;m*+QD8Re679`yS7Jl&tC>r;Gs=XOX^My7%TwE4j6?M#s%Yp2QHu3mWk+(55G83DH_%@TU8sm8?|NY z9QxXG!XFJ5G;+3v>(dXWmI)J_KWYlvNoeKTUZ81KXhd(VCMI{lGpZi=JUrzNNIT)< z7n;u2=oTjj7sV=MdO%Iv6kGWlsRiC-o(_2TkMy8<$3R^JqHMJ~mHu>3!Zi{W(X^F) zVMfMmwiUr%lkmzqb%lbs&? zn9>fM9r!>`&2e1P4^)Y`M_rv$T_uHJ_XVy;e3CY`{>Qog-`=bI=hnR|Z(CGzFdgQJ zNjVF%Haclhz|X|s+__oXThovz3EE5bY2|KW$go8Gut){#Na@xY*vW)Yp4?a^hpmj$ zPf-7@lxkqHV+*;))$=Ie^bUjFn@1l6!>iQ3-Iuyhr`bDdV9&rloXo6SD0;+Yu2O&d z(fc=oqQfz~cMnC?c`iGINd&Z#5-$o+7<_31WjnOK+LL;!C6&3DP3xvnmyi-?+EMi z25~NblDjSMJh1?E&bifMf&1?1QSl#g>&}!y#NsR4O6G*)dl-V!GG%%?=o0Z_>@RqY zp>rZ68t#|N8?BY5PCgmawoZB)1bd_zEgZnf<4;I$WBh87SL95U5)p{$r7}L`|Mdd2 zOJP)Q%0xJl*0V;zRE;kqdL$cOO+tzOPR}`vc(KRkBx_PH<%qujmam>>IN%OmwSAEr zi|y3Ll;d)NM;3)aWL|Y8?=DIZ&wmBYBi3C8Fs!v*?fm+JmckV%^*FZ*BPwtsX$?&IY$xmai#Y>o2gp^=C7Koa6ifg_sM*H35Z9C>6zx9BV*;qbWnbt>mMUS9)E!SE!GJsxO zjfL9Jvz6;t_Do%8p5faXeI=aGr4bE!?IEr+1TI@?Y^|13kA|RCM&eQN(E(Qb@v&RM z=`?|{R`wvFr0)~McbTg^93ziXVx5Jp(09|$9bQ-U9dF68rD`+TInHp>lfXox8Lz5~ zJtc$Aa~$(@7mj?@(=D~GST7z++^%GQJbqp5>%^X?s-@E5jwZv*AxI>;Q~3Qi@5BC~ za?A70E+m#zt64|Rhe#sWXTvUif;C6F=M)cV8D2hT-;qBHTS$y>SyH%sQ+IC*(zEU& zaEiI!M=zOkuA9`4er=nH41F1QnQx`0hzZC#dNne66KjUT&{B69T>7Z3^QFTDk*v8R=%WE9jU5f#JJbbHBbS(>q~t}ZZD#B2^n&WeVo;0 zzE%tWVxagj^<3LyaEFdr19xf{ddZEUt6AOiys0Hj_1XN^>Geb66D-iG`((Q;8fz+!%jvN!aaaYxj=ZqUNh*Y0udn#A3P@BB?0(lOnxM`$N5aiqmn2P6 zHo#t7`FPn@xq{Q>2&;|00o?Nvhg{Ky#Icj+c@}T(7MIa&7hEz=PT|q*H2dhp?{b-6 z*QuiFS>)ehpjoj@cYPI@JzZZ+!SR+Mcb_#eRJiHHFxcafT(|?2AzDFkpOevz-qOes z@JxQz*BxhL@|(pyRW*N7tFg=Dq73EvEeV?FLKXDAafih{l%V!PIX) zNhF_J$}{kC-4RpjhoVf4^n1my&7569@)XR!SJOIbf-f`|-?})&y6>_?sSYMD`nLB) zge&VsEYpMA3K7fm0H*t`?VHc7z?Ae9bq^J2_BdZgG-o1tuZRSdF%? zU+RO?jI>IfGQBR{f9_oiZ8yBI@;HIVMO3bWf>2zWv0w-4e=U_~bS~eXi-%r4cKU?= z-4MmXyYtVr^FOmRTSAtW7v--!@7=wXZ3pN5xwivBmVM@3+4^~cYBT)7Qh?c|*V^T3Gho(}C%eP=fkq7lV5{ZTiV0%x zX+&IsA=6^2@ecsq{@%__U3CVz1losOEIoM zL_Ki*6fY6aNkYY~dtKuNnq#(-X8b0dFVs16F<IM+1EM|WJMrcPet z!()5Jji+11g;vZO`j!lyG4c+lyO6fwb%pLb|;gO)A2z(yMT3{gA%* zJ0f#^>{NWF)%%eKq3>Tl4Jr0fXEB z0PkOQi9~Zn9Z=hEhiNnoX-A*!nfGqTi3aEY3wE0kM_Km&!86zknZ+u^Ap)ZK=W3&Y1guR|S}N+@E53tJ zrpELFQg)u}tdAVG8_Ltgk(T9Kk7W5!%Ek?%@|jx_VI9f3Q zE;oVbdu@q+#*7)&&M2(I5N1DLJSL3kG3eb;Gq1VX581Oz0IdG*f4IQP=rey*CZzSL zH^sChn$$R1Qa=WvKtqnCZ{-Q9KSTVU0c#+Mp@yjCgJ9dp2O7$xFx9^ znc*-l$T+Q0&H;UaOFqTp8xAulcoxLbKZhZo>iD$%%ij(~C%t-EL@5;EO3?!)N2b_+ zy3}fO&f8nm|Iq3Qc-L)&>>6{9=R0_*+DZqw;k3ppOjCq}49c@oO#Rcaw2ZY1UdX=tn4%H8%!NKmlG*Y05!0qP_0;DoC|bn! zRynb~y*;$>Rr|*{dm1L09PP<-(G~hxt@m+Em^N-8#S&9^+8EDf0F8!ZnNq5>7R%~p zd>aOTvl_sMrB!uF;rTJmasy?^)gmNg9x^nXC}PRV5p2BPOLOyY!UN|^=z8_?NNdBD zcWvixGmacTv6~hL1)Q7eDl2BCpZ-5weFa;TjTWsSNXL-UFf@X6Hw@j<-6bH>4T8kb zsi2f}H`3iA-90ptBi%E1zI)Dh?(^Kg@W$S2uf5jVRB;@-Azv1(HG@2B6e>9c`iW9c zf0*kvrzS&EH)dO;(k6zrT$i~SOpTQ;po=EZGS4SYK6UE2A7W>iHou-y4%cv1rvu1} zBN0opI!Wd|i%8e$z?2_v@7+3b8_xKU&4qBSchtV5M!+@=#> zR6eKljMAex@Wu#Z%GLpU;O=vyIJMTno2@p*%xnGjSb9KF)2nRb1|T%6dO{iIWHIpJ z`K7h|n7$E9)0~usozS1$DxWcy2#!0s`-GUssAZm%ul<=@b`&faChgL`6mAfD zQ06~SNiEA*Qf||mpqZ|~(PgOB8J1hkA=5pO1COyOeUno zB4CpoCi)#a1#)o>{eDFojaRN|d&UIEv%O0#_vxYs#2`RBM*czvI$669aI%EpPC|3l z|BSp_>9Jfa!G0M11X>g%k`VR6L+45(p_MDlpXb8F$y{S_WKV2Q`HD5|RE*E`+lnuZ zH7n~etBt8Iqh{rhv=nGdg}y~OE8$_iz{N-R;$>5x9Q{dH_P5c@D( zy*c_if<@&^hc17X5qC$loSXS*cJr%RG24_XU5499OQian_sNUa0H63w$F9B_&Zabf ze3Gf-5A2FMUExpS;n zpNhEseVhMBC!!Hg(c3cB>1r_TAUI_kDZJw}LJd2pc{`Ai>`N)iHx@05lw85qreTxU zhuhjP=XlwnzO}=SK?fa0jdGUZ#69Cr=JZEi>mdR%3l-^itu6}`yWe!&Ojx+veBihgU)N14s@kMlAsVaYZ)||ZCyi!U8Pf@;+dR_CaEFYgs!yc`R;e( zOoB3%xR~LAxy?$VdL_xb2;U0Pa88^J=OrA;OtE<-J2D;xf z*Ze3n)*+C|UUmb`Xm~mU|McK&O~sL@w5$diKO(-MlzD74$BU27_m2$lb%k~gh) zI4GLO@tT*R_B-<|W?Wog^38UnFY4I@@vx{v<6efM;rNkwu(=d+0V_bVH@m1=@@+^k~Qmw)$>0cSj~2%Jf}B zi2ajT3F?I^-{)62A${}qlrm>Q^LxgaTH23~MTc6WIkgpZUr|L~HJV1zE=0Coz~0(i zIB| z>?2#hM;PAG;{PE-jPOX)q_M$>0D}uTXX;(78p#`i(~v`~G4g*=R8J+i(}7|CgPbB( z_mv4oELBCUV-EqskDy0!-yNMCs_Td>Zy}M0PmFM1w-B5Isif%h1m98_=hTb*?YJtliDj-bmsM<42_1H9WLskXX|391{%DaY zu!7`ne!UjJmf&L{F^FmvUCUF9E{jRo=X>S!F8R4C-k!zP?C)VLNv2T!mpDA(R)FSYwB_QzvBpu2sc6kM`)i9S7z#Gn~ z*{hRs^>W0&4xJIDu#W3^-@v}>=!igp%;9Z%Dwt6>>^+TQX%RXM45ISKYDt`cd6{?`J@eNRupu*F3G_cP490B@L6k_Z`2| zewj1E8_oPHm9y8P*+Umk58j!+(%*f~xOq8LwKI|V&TWH}g-{ksuQH4ku6Y4k7=3M6 zWv%ka?`kdG2|YN#-*#5?uJ%toLkXm!XK>XxnEO)H+b2&q`rFR>$ZO!8)T94o4A0_^ zjf>5*G<(+3;M$e5RTjbzx`!@CsSDIA!{cJc2R#p$8Y8aD;*O1IuQNwi2^wO2;}@C; z6M>Tk3AiAys%JRvMV5K2uaID@M}xPBt5m8OwPc}csfNsuli6a3=5wIK$431mpYVMM z|IeLtK8ab0P8Fy661dVpk48NTbfTSDM7TuUD!g~%ND-{t>}guIv{_(h8)7_fHSn}U#A62HWr zu1B+t&rYQT)yjYs?4y2BTsmWaI?${i_`P~M!(x#j*P#8E?`|cY&O#&>N_lMCY$>DG zSaCm&i&fbXbMFnoTet)tL1qqDl}Z6X>(?ZJz}`BpamFb)=cwpvveDsl)T@qJh`hv< zq4`)&?<%pw`l8Cc2!0sswW`)q1b&Mtdg!0Y#VcGHp0{yp$JwkE5tp#hDv*e2=P<3x zaK38^mo35H+8fpJL>BR8X~kXbPqX;> zcg$(x?G-=tuxO@X120DyG(=C4wWOSKyS__k^mKG#4Qxy4GpvEWv7l-Vkc_lj1R=6< zt|ucZfkG7D3|fdW+*>&2kuKd!_r{OWhc(f3cVHBm&ZU`w55RZHm#iPBIN^4qt zhj@gQg6mH@BBn0)eEi&W)I1-#LE>L%`_~X*mO&e!O4I!erOiopx~dh6cMo|_;pbIW zOJL^I>=zGLxzB}KuJ<4d;1n5cwF<~EJlv6S((NkH*p#`4`WEf~d6A<$9P;OeGZa;S zG}?SHEQ3R;;R;0tcRV`D(7dlhzG7x>j!AcG{VUZYnan4)dtc<@7nFwD`@i{JO2Zz! zk6bA=)I&s1DL&zcD2wcYJk@zB-d|K*`AO8XcapW57QLsEwyv!~ru&1on5O-OdNBBr zN}*H4+dG_S;WEKx#KJHqYd3N?6P;zs z3GM`Sg+wQ{Jghx2zENPdt{!62!DPQ%Yy4E6Z(K!WK%!k*@hm(4Y>JK*CXC#g8zK|7 zc&fgn@(LNw@qagwz>CR-5*5OIg)R%U-pB6He=Y5SdIr(*nPKN?Up}vor0jT~^po_1 z$0AlnLb!@wyulAErwXLs3n?9cqDGj*_+214Bg*Yw`0%k@t(&F5hC&ww!VO~vp^6uRFFGCD2F_3N_7dz0nP?G5Ap4!d5A-yWO&atQhln!ZUYm~WDQe+(|S za!vG9N2?{4N!VvtVF?#9eL*LW8IGRyl5Xdy`drBB*I(Ziy}grR^y&P2YIUzA!gd<% zx=r2mcT5&P&%By&Qp;+zbJ_sNRiAmd&8EI5K~U-2FhK*`Zk8+1DlwhC(%m%<@LmsY zPYnRB=dy^RinJo=WF5-x(k<}(%vPV)P5SZOLP9b^RSRWi%3m-&-p}Y8H1pa(=v|TmBj1X`&&6zKh0P50?eibrTgU>Q;QUGZ@;t zuJfEwd(16-s?1J4@(Ngixs1Xy8=t8!#2h=HKvN|V52m*^w*41#Xz{b2f>yJLpp4@G zFWJ<>-%@>(b~Lm+kQ~gS)5+su%Kmqfm1A^qZyD~;AaMySj3anIZlzf&`4`h*v&Lnm zBVkx%iD$o!4~0JTMtQNbb5K~hGAA3>MWg+mL^0Pqy426Lgd4oD+7o#QU1WJ94(YAL z5s(|nV+A8qfDG~lUTJ@NGXp8d?5f)KKP?V2fmA8d3!5-2FE7k15!XtNTx5N@fv=nz zbDUCWcyS47^!WGP{dR=Vj?wEPB=;kkXjoGvj(qunIw?-H@@uS0Z8TOMdBNQ)P})L! z(aFeRwX+8_UCLaF_H>ErSPeW2(BXG5v24TR9nGfbYov0_3tZ4))+3&Nk;X;Gv*5XY zoQXJ!A^)a}x|#HeD57q8J|%$kkQ>ANp&Lo3=9B@P3GREO=w($l4^<7)H$O)2(eP8?=HQ4C{Sw_hM1oEtg2qt&)HOmHHlA#FUxn`l5>;73ZeaSi z*lR|$A}-Hm;-_p=f%g1GWM18%r~p;^#4RuBKJwI?EE~TtiSX57>xxM>ek0gAR5Nog zuChWi*A;Gh4TZOQ?vg@_zh-b-0Cu;Lqc= z#vmh+;CfLgjU$At%vINImEDVepe9F@fIfy9C|QXWZu5*RLqY)vxPy|xV(l=yaWP>W#A^%emmGuw2b!ekzbySo2g#&IhJ-a)1tT0K7-Pc6qm(|TUDu_vGZxx<>8qRq7m?p+GHHsGhCk^46H z;IRS+^8DJGW}dH*0`bz04ywo1qLS&0nCY~ZoxTfMBIQclWbF~0ZB?#xjYMS|^=w$0_zTTE-h*0Yn{>zO_xq&W6_5U zTTArUXrIDGJM*}m5^97u&=9RvE^V9HI_J0O?WRbSmd4*O{EZ{J4fUA=JN%o<14jax zCi94oD1^z6k2d8RyihA$_hwAWgE~)W8%nf*_78bx4& zDkJbrKv(@$4sriAmUVce#EZdSm%0m_M2)&#V@S;4gCKJKE~Zm4GdtdXa}< z%D-BGL}5Vv`O!(%o^fNqWtxTylG#w0WOf|>1ZsX93|FS@pm*Yf(xX>^y}o?46=h;v zM89dst|O(D!jI97_4h|zYyxDPvqYmHXunQsyJi>XLF=Z}41oJGN3vsiR@oz3;d>NbIXlFl_xA>@Y9wKVygK^^&V<&VC!^H30=9>6K`24nh?2kLSJ*@kQY)+8t`QLpXQX*9n z^p!RM)oDJ_H)*d0&kAKLkpEuq$H{Ve=#;yLQX)-}7}PR!et!@>w@oB8$r)8S5n~9QBnltlybHOR5LHbne}K47?wgW$hob%xw#Ohq`O2=G#6U~H zfB}?7BG%#|NXwFD2$D`>AYlAVo5JvUH;ebT^3r-4gytXz(rRj|Ysx>%JIfoeaZqMo zTya*_M%@13G5JghcxkQW&(3sKrT)zIx4)D|0QT;V0!tMxOVB2szA}7Uhi(vm)L#AL z*}p1SDhLE!RJ1uFAu@kM>+MC(7{r&diB~u)6LBl}NgS}HHF^C(F}(ilk%}*eMjTf( znacK_%)MjgHeuzhGvP`NpvIqS5E+U%?BSwz!@G}0#N2jVXcnF@IZcXsJ=3?%nM?;q z({kla(S(Gi2#SBoqOs*a5g`MKe@@<6Itgq>jxX#gvFh}b>GWZn`}Sr|iP`YCHTUkr zFXfMSoMU)*UhGyThA08Je;Rhjry{@As#BXD`0-Igw=!;T_=#dWtZOHJMmdO;B34d7R;@?EB*%3*OM3|!Gt{=DfW0L1r%7XShFcB+LfD1OWn)>Q16SNfJ4qjL(( zkk9CK6seq2lz>rqlzfeGt&OTZ=n}UV<+#fIhBZ6mL>FYS;O$9k_Jg!!^bdUTpi$qD zJ1u~+h4!gi^dlvc)cb)mynO!#c?2fY5U~+&vhgJ+q^*$!*2hMs4u>rVX5fE`!ki0H zn79-Jzt+7L9Mj97yLy=CO{LqBc6LuQ${&`=)$Te#cTdXE0##uc_?)zT zOM*#3A1CJdIxKr84gALMxaN;~JkPScl&T+* zxmZRMdP~eB_Ru}uL8{zn95tRx1fz}w$qq%25-^NGFhr8+ZY42t zcWlgfX_LPNAYP`3M>tPGe+Qhn(OeX76w_R;GJZPDFw zhnRQg)7$ToI1AtSB?>m^mTo^ks84?OQ{l{DtC{>2ZIjzCSEp#kam#RF5?|0mQ*=)K zk+KBp7TP@Cf+kM+P6mLvJB&0_{N#TAYKVkiyb!gOQWcpG>CX8kg0^YVlh=<1o;SbJG``+0G7a1CAN@WsY~OV=D~Am#7B=Lh)`16O zMl7?YGwEvQfW1o-_$rSrG+3t_GNXgo18ljjg^msP&8Zcgj<&voFF zM$~xk{U?!voM7{(x7K8eb7y8Y3cV1To3glg#KZ1P#OiQ~?Bc>Xm09o2J2U2RNuEt; z={ZJJGNG4Ihjpc8w}@Mu&{ZMqXbJ6eYv8pX>0GWGM!B0^X|uu*4{_#>qVCU^Epbl{ zjh|(|(I=yGtBp3=MR?=9@|GH4k2lMVqb%5QB+4NDu_394+SNGX2Z-NDX;0={$szoD z8gWt+V>^z_-8jxkN1c%kw%{iO_SpF)3`H;GIMfH@*Kw(T_2P*SF2jg#LeWk_|7GwI zhTVEb0CHG)iA8yjFH9qwY+W>bFTdNSV;qkr)6UmAha-HtK~1Rmo5AAIrUCNhW1FhxVSn^E-)n2}l=;01JyC%HC|aH>!gsFv zlP6fGP6=FQnLMT|-|_z4(C7A+b&j&cQrPP{eN}~=T|BCQ zS*k}$OSC!+^WDhfSIh}6>3k?lg8unCrZ`ut$;XeeYI$qjLKodAhuvP`F494c6Q}>w zz2?OxEBit#Gu~*~g^4QH-_bDjXQq;+hPSW&bH3lDMgF1duVC|e@RWFx182O*2`>FF z(o>RQF?m8zoG22&x=9w8lsK?a2UqJHkH8IqdknSlKb*;f))etoV(p-ZY+v773CAm% zb^Ms9DI@hC{jrgCenpn@;*gwyO^C#I)(RS{7*_8F#!oX#e7KWP@B9=jEI|2G>ad<^ z3A}tuc4|t|9_-EDn%EirpsFDcdKTrew7-E0@#f6lv>Y%bv-|9#9i_Ni}@P+|sjZ=Yaf~XIWrY^>YwF&b$+luwMe>M$e6eBR)#RuR&HcG94A{3K9Rp`IVF@9M8ojzZEuQe(Vj3Jhsg{&aJEcG)h}>QkibU?yIz2X0{wKibs1^7^<#8p-tr1konQGz0@>b1{>Gx; zhfNSW-Ae8se=Ze`zc@DFc5kB63;{|`i5tOYt#p?^Mj79Gh zje;u_jVAVqbP_NeJsB4EZ;KyI_S-S8{=h~$!@16t?--mMt{$&EPzcLP)YFtjStv?+ z%wH}wJq;J7wO+2aG}Jqov$Hf@u|j2VETNV}e99#MH0JN)&8n|<`HsHqQFpwg`S+3k zP^zmJv$)g*oU4JjgivEI-u&iLT{9H2zNfW$T^AF^ov9@`@aVT`H}A*I=dLsQ5KSO>Ztno+#HuCEuymcLL`6M&hL_v=o1#RMjSf6Z`c9`*b#3 z*0^}3?B=DpB?)OrA84F(M1!0UnZmLpOxx&BB^{vaXgUCoVEy$fd7xZS_>Cq*v<@YQ zC{na%e8dn9(CQc)jJID?s*%M{7Mq{L-MCZIqdvlQDwJ~bSM$J}>`~ZfZlX2+z94zm zwym>0iNPilDL{T0lsGBr*uf;yU*DYUvv~Sv*{Oi+4ZYUTN|#32t$zaQn44B7Ik2Uu zQ+wx7xBR|cK-Pt4h@Z7tV=hv=mIXeqy=PavF(WOCS`V~L?+f{1J!t5&B0b`2Yy z{TSoFX6L0pa8O=?edzH?esmw=f;$}*lnq-<|1tc zW=y_0LyE~Sc)WFVV61KF20e!~|LwQWxqu8QEw7Qbm=E7k)Cl?4<#v(|_$n-utK={e zrNU*1Lvv&z**N3DpWe{*mB(NZeo|vQQ_!EL8^K6%qy{aiCY8<$RRrRkW2MG)N{Vg7JfL($*i|aQ}ws*Vp%CDRFO3-#oDHZ?)kt=^d!C{k6xL zoUkTWCCcTrz8^FIS+MuuzQQdGb_nrrqqzh;<6a}bU${cP|4J;b6nHB631tX-s8Zsq zT%eI|Phf)laYx=r&@CD}@)Hw-P|1AXb++ZRr1QJ#NWWJVNg`y2L>U;uf(lmIxP+yW zG>Np+M+i&S6_tU_1(sqOoTmSvB55;U==&|>0OlU@E?FUBf?5w0U0z&&8gbodIsF}Z z!$ia^D4KZG9sSBWnzcsyY^Ocx@$Q@p%B+YimV}G3o=BKIb5kOnfPDx!5Tm4XNJ3UDC`(?wAh0h6 z_US)BbQbPd)FVp4R4%UUJ(FXpxQnpI<`}sfA6v-iZCr8IbD;ZUQVGD`^VLK?x7?H0 zeVy{z=`}#E^%d#by@>?MJ~Tw`FoS7ZNUxD0-j>TmNA#wb#r6O#CwYd@jg1k%U@E|V z4%TBc-Howjf6A%;TfFP~l&tX>Q`zR3jDh#qK#AN$j30!6P}3U7X&r9pa1w6Vz05jl zGCJs|+#NaLLBMCS+PvG4e3(fm#lBNYzabaijuX~GnO3=^tC#i50E=7C2HG6y9zwqE zi4QMffFN}rnE~K-G}!!dC1a`u%bg0LM*i55spZ21^dFvHlgpOmXF$qtvNsxd%OG8y zC)Nd6SysAav6qAXCM`|;sL_C8g_`U&sUa`_a?IF0Q}>>FA#WyHya6I3ws=kbXg=3v zT6X|JAx{-akPmn6>|Xtaw(6F(u!-!N$%DR>>&#hIdFVYFQl=K~kTxLIi)x1GvBPAq z8~gI54Z|NCW)uKO`-zG&Kk*7|OHy1_k_I(*(fapBYEJ}{K7IDUPi_?)44cld@OOH@ zYyoPFhor(|L7T-9rLv_PXX6DAcrUs^`4QIVE(`>yWqrS?6|YXdDi%7izYa>cyB^vo z%$*6$=w@m+Dztj^+BMHPxU64t`wljdG^X>$lYF5*oG&T)BN+WodC5;WD^S`U{UZUB zCWoOLOVydAL0@(zH`>Htz=I@M!cUT_l0`??(id{6?}weh*Z}oA<|5 zDxNmxlzS%oPq!UDWZjnr-o2H{Ux0<7JE)|Uu6|)~s)!W%Zo^?G!hp%=D)d~y*KF(H zGv^^hC#f}sITG;B%yU~|eJPk778sKSeF>@T*uuUhBfBnJ1F>{OZxfb&7w>`V0 zD7z>-KYWu5o*ySd&xO=d0u+`G^wbsVMhAF0DIyNy+GuD%wVcb`sA}=ugN`~D@d1GW zAWEUEAsZWv3(?(og$>M2j=mIxBTfePvx)e_}_{iG>HvHdp`}X zaAGA1S-{FJXD4jBBv|e)Sm+CfljYxISwDV}ADl)r zTA6VckOT4}zDRxgyK508<6B3CJ~&SCm7=wU4e5vi1fhal6Qc#rC@U@i(vFjTT`Bls7mxrU!dNJ5H#J$o9ucr z8%`&H_Yji&BZv0(q>|`zRrAJN`1IxBYZ1yrn^qc%Z*Ei>3TA$tpN@tv;)=G1Way+&P-B-5;QTGgW+V~?J#wvltSt_&E90g7s!9^w>|{7=lellp2F-g$7HYiy=+%SL7INiV;Z6W!i z^nG!{e0#)5>J; zuDWzKtjIhQ4PGB=cIbc!_T~$>17&DPk6@qO7f(Nq)o=N1L4QwQa4XuYK8aQm)=~UY z#uenWlFbu%U1IC(pIWA{c>&CMpnv;U1VNstL-H{4sf+HD7NwUyK2Ttd#uo&Sz->V2cbpfW%@4X|Zt(B* zcsQ9nJHye_=nMAflfo^J>h9?}IWHtAn}P^#a(uA1J1JtdWRrI-I4y_&+W4nm_Irnz z<*DNkhSwLv=^iWKt|qnBc?N|i3cCS`-e|;$g5?ITkDAc!ug#@7MYZU^fpzX~N8&2E zxFO86z#E0>dct2c@(@IJgx~DGp-K3vog3tBLQ;EdxYx~V7WZvPRM+cjcl{EmZgYz%$t^NVDJ%ZX`yAWog|l;vYCaw4q^6ffzx z_RGNZw+cR1Q4%2%3ccJMn5^}cz3bo0+UE+kIkE(=1s$ca&KLJq_JCR7fV8pa?MbTb)O{E}wZ&Av~K+^39D{ z0*9hNkI4GmTf1t9djiXiM+1ePl#%oMm?8TLqmd3nOLHQeFr!*5FREcOp?~O#f&LQe z64$`-hnH{OK|Tj_4T}Hy&zF}li`mEv`xY2r&y7?wrub`+OEiTyDcn1V^@l0p zO1;{k|3QR*fNp6)SM{yl8p%>nE5CQp(D3Oz7u>kaA4?lTcgYBBoQwh?`9%6bh66t^ zYg2aSMEM&WgQv(z_MUZgJ^)Vc1tK1Bn;QC_AeK}dZed;IOix1s68@(pgjBe_1RdjM zmgYm2`ED9MFGLb%H~yKlu;s2 zTzlId$9s-j+EeySY-|S1x6%W@lCLVePffrGH5+dENA1QZWzg$G96s(14c@QuvK#jE zZ}?r?UPYrMM$=Qfq9w>bsa|*9@^0EO^tF~$LF{_+fwAGs#B~l%#Fr9s`BeH+`E$CO znc)oVl(BakFv7Z*-@-v(%|1VYIVes=UlFds!a&XY+=3+cPm3wXP{%n@??EoANE2gy zAgs}t4$$a0SG<*hxoSi==huRDI(I2T(t;f8Zc1>7uZ+JX1`BE@VtO)5KtDRah9kvi zlR)V(NWb(ddfrU*1cRT4t!yL{-_IptK9d4JX~>7Kxg>$!pDV^JY9DLnc}JDTAG$b( z`#W>E>15ol#(A5@qjDlnHs+}(qbBVLX`}r^(CE_zOD)dc<=;wdN6a~YUs-w`5S<%# z-8b}KfTR9qO8u^Uy4)$!-{)tCT$MEu0fqnu!0IA{L`kMmgdoD_^}h5sTCK)gAVzPo zqvaz>Uu0%?#1hh2BKEzyvC+V+0+_a&db_(qtE+}KxWB465^T5{DR9K^p`c@jv70UV zJC;v6+?cAWSSyGVxuK|upOC4v3_K?d0bNjqWoK6Ih)|HM`-wJ%IJ$1rDee}_I~2PJ z%*^tpC61a=i{@wmlQ-+SuLSXXRptH+{~}R)41277@uS1~9K$LaKhar?f&GoB|BJ#M z>4>Fdwb7x{pZy9WL0mX?tUMTmG#k>D1Pf9?%WK#(>Aq8!*hh@7idqPRg`3Xg?~kCV zpu`jF3qGsIWX3C4%a0sbQwO?e)49mpsJ!UM`V`Xl%)M6A9p+JfA!95x$+Nj7N4s^j zB;spdK>q(yGc)3;rr(O??S2H8E^;Vxc5eTNnGvembSPIa2$gHqJD)sp(aG{-wZC5( z5!Fl1_-=Od_HQRiqYDbt*EQt=m%)xDJPP7hx-4q3^9|Pdv#ER!mIPL|U zM6k^#ckI9~L@CLdx<$Qb5H#n%T7XKpf?vp1QJF^DEwPo-1BvYhs9)_Aj=IRCibvUIZ5#_hf;V80dIN`@McGvp;yYMxa7>doB7Tt&d6TdvciWS3K zR3HlxVzO`!hU!{6D$9GB@@Z8d|1MmnRJ=1<+!SEvHCDf@m*fZS`LF_^lP=@Xv zrVnd&6{0?TXM4=fa_{F#TuuZyMetxNMDA9A%VyI@6i2TeIeVQ=PacA!p3on!xw$Xg zLHLW{Yq2-&Vsoxf92Q>*5cgJ_z95nc0CwQ>?#f*!ZU*MEgPU zh}{k*zv`L^O&t(S&(%OC0rPu5+VoeL%YCXQTQeg5nE&pUVUl5oPmu z_nsyPBZLO$coq1arokcuZY6k=_r;U;hG;S+2(h!iVbpM-NB}!wkTCiwr=B80lO9z_ zS41%n*D^lesD2bjJ`b4>;K~y!_Xe=P-p$>D@|!MwKx5*Qh`cjL%&-jGe9{9`z=R%T z-O-poB~c>jpv&zne#ej_J{4=N9Z>;RQ5-AcWZKDotfWHc6}n4NRTMpdK#=p-fl8?% zh0AN|;LL3&m)AgYQa=w3q=^B-3gHB6MES&4d}S>gzFo#ih7(A-REwI5OXD8<>K_<% z7<5IoBW&@&WE%zCsK8jh!R7^8^@QnMwmCEMt2$^&E6Cv!TW?4Y9QGP0v@v0 z0tJJJqk96r_;10)aH`oO3yr!Iiw_CtZ%93ko9UeTrE0Iv*`4M@~*x z4-gFP&4E-{n$6a6Lc^9EKCi1Z`AKiyj<7&{`mgY-#d$hq{v)=zG~JXgZY%OVA}FetW#vb=SDRrqBIJGwU0)< z$)a%jn+E9m2K^F7E#YJ@eInRypW$OjdYe~~cCM$Je0=g3ZpOF}V9D}`HP8i=2C`+k z1+laTeaZfVRw~pbdq=6@4=0WW(U5;tivp+CjVl;(b0^j*9_UO9=OAZAE;IAVR(&8~ z$TRzjcZ1KMRS+|b2KvpXwG6kN`(5zTS7Ods-1;7QL_Cd{e>Hk7m$1Okhfay;x_SS% z;)RrHFfT#8nXHI#qeth!*6syj%q@Ra`UCLIXJ8(QtT+i>GcndV?}p{JV8})gx9b z3Lcm(fP1euoBrN&gFsaAww>l&FKPe@bSX) zGN-*CZxhZn)ZyI+Vs=aqow@4gzIs#uor&BAu}r6M-vM5~Ju$Z+W-glL0^X`Og175q z8MD53vO#|?2fr2~!B7_lTpG_`UPcidFW6XCyp$|FCm-9XMTCA~K2Fn2SqtjlnY;{6 z@Ipi!pnJ~jWj2;lRnW>jV~zM_gT>m_e@L7g8s78_%-ts2513iPlrq#5kSS%K#cRG& z8tbkV$LydL?z=`tBdo-a_l;cZfS(?~8OuCxJU^@3AVua4M}vdZn07zdFGO)%AN+@d z#$T3g`L2dGZT9O$R!;waiH(3_Bp5i_z)bS_ zk~%M7YIjeVdj-tKy+xMoH9!)2KlX4rH73PJr|J5FB)S7AaB*5TBdHtt#`>q~a1T-% zY4RiCd!>{ni3}=$L~gH0RF@3OMQ5FLvo>BMYm?U@ZpDk+RQTgfw}HKU+=5~2_DwM0 zD4S^f@vZk0Ovan1O}N%67?U8h18v*o3EfKLf?%O6J!eBECyKiDSV&z1!3k01GhIBO zx&wIT92jkumbXW+?yA8wx=(v~v>^ZZ@+PAm?Rjp`3@j5e%S7N7ypkIsPM0K1^Ez856oP{d-} zC;}n-7$R6w8JAPEQRKB7>iG6O=w3t3AzXE45$6!;zoZaskTs)cQ7iumIis{yCbiyH zb8@t#6#A4y0+7=UocL~*uN4;nP`XQF>?s{Sp_>*{Q}wYSU9AcG!)p`E-5UH2` z-ldxMEMG?|SUHY_ITu1eKHdK-p#UIQU+Cl%K;-NkvI3^lk>c>nbbBOxovuT9fu zL-Y3jYf~xw-x=hzXVl=znRqVXCgQ_~kh0nwK`v=4b@sk%Ezn<8!qrGdaEs`xSZou? zf(ccF-8v?*Ris#%aRTdonM#WKj<{~AeAAHJ?;%w2R`-Egt9(X!1)eq7wvjI+`+?Sz zBMy`P1_Kwu8A8E=cI{fS1G;J~xBNhMW^npR7TNLoOF}wHTzJLDK$`gE5~pzQ0h!0& zV2wWlSMlI7CCJ8^jH!4+-P9xbM{4)r$sS;;HJy-jeqcieA)pU&)toTdLjphFFUlHY zIM_V@$;u$=UCym%h&|VWqbDe}-pEX$<2~q3b?dT3=W>WDjtb&Nd?bueck=x+^RCdF z*?|@R4^>~`5Oo){OG?LrbT6gLFwqN-o`T z*Y|zDd%yb^{LXLAnK{qQJkOjA%FD^k|2YwUH6(^qdHihCcTq>uQI15jXIICq5s*)m zheEu?IZ-}B9w@8e4qpB`e&rfXDVPw63368~R@aiXgSix}=#+)rE2*EvSuh{xPe%necD-Nq0@u4>lXFBsKxGYq$5Fzz=*x*}l9N-#s|WjMHnYy3F(rGAf89L{Nl- z6e4|SQ8sJ_?z>4{2$N_alY8H1co1u z-wlY?FiwV?Q|&$ESF?0)Ska#lAGG;Wx2BTH9!RCiR#-M@>}c%Cvior@p{6FAfb#Li9wtk?vr;vlkQ(r3ls;oJhTx>F{~k2^dNlh5=c_1fyXvI!FnnGKAMe2(bJ+yd0g!vw~g0R z?6SOO+0)WzPa1xH4yeo3G2EcW{2qVb)RcgdjmHJOAzX z<{6WZGX^SH?)D_f`?q5(&d~kGV$1TRAG7Ix|IxSqqmVT{Anw-44P(9X4Gs~-8}W7c zEfGkhf~3;=IWWo-nDbSyYT0IhbIpk_gwG&`j9%%_MT&n}u0C4b)yhHM~60A`woHMLI6kQFkUpQYBFp z8^-3a|3!5tgR^M{fvAfS9Yeecjv8kM(aBL?lb!Fru3SeGsTW*v(t+eObN}DvD?i|M z<(Lv(rH>iSsgdV_&CB#grGh*HQ;c#@K)d09%k=R^r@=OnoKJKe@z@^<1;m?3wq);| z9Ej@_jQOElgQIYU(3B@n@ACFSiiX6Q*ka&z8M69kbecuCJwyh%g@V#Y1Q*aW{HQuv z@+Uilm>Y1<$n;?Y8zxy$-DzU|9rh>x&+mdkGG|$2=ZHFMGn5DJ!YKxP^-@zB5?{qK z>M)7$WeC zt4aX5pT0{{Tqd7SSvDVOovdyu(WtLukb?Zb*zypa&TV??5G7sZQ~Ue=vq^7!kdc`% zO;4kmp{0a_dvcfcSXOX{8jCdc zNRWpO(gD>m*{nsGt#wi3Y8XcBG~3_Hq_*;{isD#L&wtQ9D5f7=i;GTn3$zUY}rPkoFb}Id?g;d zxLwOOOL5X4>KduWRpSNJqSq)9w=$-mSQbL)AcwH-XdoYDLv?(ErBR>Czz^iH(;dxb zok!fHClDi&TD4uc{K_pmKa=UIsY?_ekm!C}xXAp)U0BYjpo3oI(k*(ZwiEs9j$WMtt zIti$peb(xjuPasI6{S5}SSD>bTII3i)xmzkc8al*6KRA(^=R$s?C^v16 zA|llY(~`bttZ;k6_6U?6?|8C#|0fK>+R6zs$w9vtxPN-?8WR{Nof`Q3u^ZW&JUS`6 zw$JeZ|IGYw^lW-`U7t@zZ;l&q_a|w8fh8q~0vh-WslGuKAW&X!3aoLlGmH+mq+HOmuGY$(_RbO3o)E7wz;4Z&Xzg~Udz@>` z{okA(Oz-I7on(t~vAOxvHB2C!nB@b4dVS0A?`eKWHOGf&|b}%!-J*(&G2s2d{#|ziZV7>LA3=bM2U@4z zx*jnc3lS1>J8wfF?O};%4n9)9&7&jT!!7Y@#Y=!Aj)0*c@OZ3E2ff3FZq%Waom}L* z`hcg<9|5_GB@BR-a$q)|k356p=*T{Nyp6ABv2O~g1H!i;gq)VoQ(@53R_Mq)XA$sX#xn>1}H?=a@{ViX+ zkw?pwZOU2m;mcX%98mWtaYD(Tj*=BhP_V7~3zF#Zl6g|48c%H3m*pS7oeTsVCvyjo zL2KUoLC^%*8mmZnG9x=#yMkt6Rq$L*2RGf+ANjvCp?A^dSOw_#6_O@OMu3SE`Tvo79Mc^|>{|tIdCy2U<&uE?G}3 zLa>V;{>3c2T+@V!ym8*snB~`JOLBEwi1I7FaH|GIkpyopJOr0uHPm&&m>w&^^XF5LegOl1>opNVyw3q^77l8 z9!los1riza-iPjI${1R*p;T7bOJX<*{^$4~7?TK(ESM-8+OguN#pn-Tl}{7qU74(X zuQ|*NX|FArr;EI7BK9-CO1tguio+}sM|CPN>d6I})6|=*%?>S?t{jmp)ytO@qx?dH z;j}?Uxf#5Ar+F`?m4fX7Pe!r4RSZ}tD$#q!Z^yB|QYQMnOLmkOT#R#VqX8m)xO)?Z~0 ze1M-iX0x#lVL4>v!yXqBjmPZMTy2bC{QjkC$9(hdP7(Yw@Rgn?*@Ark7$yQ5`!F4P zD=Jnesg?_m;2uOU)wH1kOjV@7msSO%GQc^x6&L5%oiR+p`)u9J!tWX=aKe4LJj|Cw zKk5-N$t878q;*PDKd%FUiVP(-8Y_W&jT0h`TJw!&nXh5t_h_x-!!<#yPq?5pHgVXc zg7n5tX?#L9%Dq^D6T2FG*$PS+6c0^iOxQHU0=8KrrmTqpcD*V8RKyw5T_KgLtxE7y zQ%sZrZ>Xll2?+4dRLWWmFD{)xKZOzEG+_inU?|pjQg;O;#d9w~43zn)Ozk-vvj^=0fjny0M4@SQsWE z`C)7l#5P}x#}mWltTn{nUvmtxl$9|6t7yY=C&*nEL%?iyDO*x}zL{~7upKl&cypmz z4P`7Q3FV=$@8Ijyg~+cV*@>*Hq6q_w3@MppMw9Nz=moTxB|x9n@$|2WxHBpzVCtBZjox zizrhgirV`O)$N`mf%?jHWN3s+!j5Mmy*MdxKO7|$EQAdwIE(wT2#Hpb>a=HT{#&)~ z{7ZS%LGj~hg&h1=x3&7g3t)ltXaA3m#@4GyHsZFNyb#dp1IVV)iMYW@2-l{ZSvm-? zd824?kFg+@_6pd0d=aqw_$MfqHUI#%@Q3>H*x`ep&pKxPDij?W%e%LpW;q@*o2_|3 z6XY?!5d@F?^z4kpBqBphc;AwHGvE4)0#mDEak<1Xp+(ah zchONxbEa@&LJ467Lh5kunzE8k>psU|H03`h6=qi-{7bwH$eI?C4%sl@j7U>Tu|zwriKUyTgorXjXqrmh1!?&rkx1IAg%=p8e`y+29O^ z?5B9fB++24F@iHswvwv=j{L^<^KG8eq1u7K75P@1{q)2gJEQ)|{ef5QBm8BT40Es9 z{~#`e?Z1^F8_AGi_F1ZMi(KUdE;(zH|IXu)&G}JfTEfXN$YWbt0GT<$~ zFaSXFN@iey0H+zZxvRMMUT5$f$qLsjQE)$K~o275iQVmDRv z5N^b8;F8fF=@8~ZAi)sFif3{v#vR&m(()lLD87!J8HxgASGcLcMj7d_SxmH2KJ=>>-YGRy}bD8LZm535iew zs};#R&wL(ir~MiOVjadGuswpP8JWQ9-LmKRrxAl+^WNzJgY)JH{QSq@;rJu8f z=#7Z}Q=JBHhPzv0D&hGpcs_gmF917?i+ZCV^Tef=pMyWTNPdZK1 z!ylEJya(w-NHpUc0En^omn=iRqNL0BSB`#~)sr-mo!yAlvQ2BP6Q7QMmgzWxGN-W- zHQVW|cQlB;%}7l9^p<48S6VUc06SygNP%h3MMoyx+5GNNh*zWW zPIYq{olmObw|kE%8;qqj2rL^i6|i&mJAsV-e$mn)I4tcfO1Af-~^iO#0H zqIf0;Cixnum2b$iA=Md#uom_+^TFd&FdYrgCDv(|kT~yo7x9}p9|zjK<>f-WjQI8L zulg_DRk<$TTXKJ(^i=W>*D0cjXF~GlMNp(itJA9{Loh4aD!GF76T%IGzKZ=`W#rRS zw=rvTPMM#z+02=z-4EC8mJ}xFI}jiO8~9-ZhSzV38Rnuu^}boB-#8d+f8Py%LTI7> z*o1ivTrSZ@QYTj<9(Y8PADgWpma6_(|E|eg3EZF*{4f{~IYbJKmo^hP!-UJ9xBAN_ zyE4{>dr|@Kikj%y#>x`JC@6j(zpU5*Ei=@=p4DwO_wxFVFdyFE%i^bLkfBeAF88#f zb`V>!$G??`2H^}s2ULy_<@DcY+7Wf)G7*cQo}o9E{bo`g!-TRkWpbJHYOT@^R6~Xo zV!3o;WX!UYFjwhIB3*y3>Go2yPOUFeS-FhH!AsmJtvnfCMhKc!sKY7>|qqVpMcywY}C+Jn&545sg+lGb`2HGaBa91vMIFB#YOwcc-FprcJ zK!ka!7LJJ;weck_i~+9f<#94^SD~C*(1^ z>2i2a<-&Sucwz03cCzyvM{dfjE9x%1yE;+)mp?fu;?rP96(GaURICi^^idP6=l(u^ zeiUb~WM`X%d6C3TuEfi(&$n_-+jNPAEM@ z)m{Iy@ffAoNFpuSKk{)w{SV+=e#21xVVd&;NT?pqAlCAn9R*>LVoGj_L!F zXErm$@S8w^C%)u;WOeM&fkv%iz^Lm$yaS1{reX(O3n=4?mT2N$@R-bmeUqYwHuYC+ z)LeZWWl2&NAyX)SUYmd``^4B+mI3&eR-`*+9V9>HO>}{mkeH^lw+~lm)&nO-b^J8R!TK3Vrv>D>~ zmP0x!29!fN>iHG5|o|QEO=@R;jJuJHSm8 z!#jevkzZs2uRK|5IF1!Y#5Hq^tIa}Ph!&e1`#c+o`I#nt@xd*Igg8TknIP#Waj3V^ z=dChT=jf=zX}R65h8rsALY#q06W-A7{F!_Z>SuYGR{q%+{Nkc?P&fjpY5xUkFfJic zo;Rqd|1`aQa~EnY#03~~@^wdorELQ+N2b^-?N!WH2fY#pz%)^r^k)6(J*a$L^#<~9 z^6VMFBN>WrDhiF?C(%^fO?ro~21;MyMiV^(c)!2fe{C+tL3HDPde|&fBZ8|z7*aK( z7=|fc%m60{k`Bd~g~8s?h^;DycShbqx>qB{eV|{SnadA(a!$jdcwvw6C9!=jV*HGL zuHg1`?;OR|F*VlUkf0()6lX;W?ZR*1inA-_J`vyN7vUZ$bI^!czbgED)P>$?zRvX7 zFr?onOXRGkMlpy>{M{RI2c=*yMRqF0JcFr-zm`I{UdlhRv#gaJqRj3`E}1)Va6!Hf3|FW8^iNp@6A-POlkVRG!f$qSP8E9(hzs1JRy-5=+e@inoe zujA|ypjG%U{3y zUj@yn_K`3wJ-5_~GrW-1kuV5OxvCh?`w@C3pyu3-fQ8(( z|GeDFhy}_{qko_?G3dK|875t`t>lbE_1?hwRfKww z0qxs-CjqI5mvphrG<#^5=wo=f@GmWlQjrSwA0$&NVKH(jOfQ@5J~qvjT-gNxu2G4Q z?}=fYQU#@m=OW+hcnRmrqnCr`^ofXf>q{7DuKZ@~PGN)0sEM@3w#u_EQyC4lqgj_C_ zG*?{X65DeX81%zl%-2`5(@-FQ=>rzR!;0zt>5wbK>&Pw(>ac_GFK&5#l-hYP%y4RW zYKXQs77c}hQA@9m6;-k!n%{5J#^L&qo_4xeslE+cUf!&Z@%}i;CZof+;j^A~XLPM-?==C#M5&=~ABc~I!3cprcN2R-g4-w6plnjL-uncv{XEYtN9`rO zAE^A>+p5kFS^{NC3(zX8|Dv1D;jaU3UYSuBukkOc z5cJ?It)C&+Ka7HPSUYg;$xa4;g&g6T!tI@;sya~>Qmc`h!-X&yR;r!~b&!Iv0AZ2z zC4G8s593`Xx+8i(XWzsSz%t?@ z_y?t>B@QH{)J>fZ3}#J|#d`RX{CgpM)=1nr>LS@cq}|J&J0*RiEH=fMXuoTrHL63` zYV<@bHkXjMVhx-at7Zs6`^=C{V+ock7THLEoS{J{Iilj0@z2Cp^7{2>2Y#C_X(QAe zSa`X+iKLAz#SC{H)`O?~up%kxA*)mxDn_+)tQyxefhb@2A(q_EsBuD}pD}p&5&YB{ zkHJ97`I&xh`mU$G=hMK$gz?qiE?GGuDn}^BORKtD`Ziu=9-Q<3lj@yw+BJUA==0T% z@bzoxkd8|pZ%*7ldW^b|iSSJ(7o5d-h~27Tooh~z8}3WQTwWmLvTS@Kmw-9ZWui3# z_pMLb;(xIcCyJ=gZ_r!hKB?Aq`0@l%J{lS3kE!JyR8DkICfS^to<8`^u`hrSq}$@4 zzdh>-WD%9QzGbxek~#gu^M8}hbIuJy@!9Z$-*vhip)qCYiWiD!aZ@zYl$*Dl)7j*E zmzN1a{W?e|v7ElEPiXUBt0~E^eQbt555y04m_Fh#&az;w$BOcA;ph@9z>8U}!@h`* z(P0Gz>E@5Q54`zYd{*1NB$k12&n!BI$@amVsl>{#_+4iKHFF@(( zY?In%I`|=^d63k56>C`bToX0%b(!-AlwTjgJDg$e9~^^qkQA|p>12h5i$DEERc7v~nQT{b0nRhp1(xy1ZddZ`h~~QdJ;Q>ednh{G%Y~8p)17OqkxO#(yIoNVstf$tFbBN%mHH7Pu%d>W<>ZxMPMgb8p8V*$)-{ zS;SXwJ~vV?r(WH#+>_LEk@i#--ElEZSbb?2f|_{eBr=J`&j^h9+^A0;rt5KEhq1WG zHr5Lq9lqY@j6xIh0L~>NR1Z_sf0N}YRxt*)gVD5F2iDhx!~b_}7ct0AJ+Kk3#9z;v zHRv?2NovgL8f&>q7|f3JH(9>Yd_%I(yy2IxhHz9=!oO=F z;ZF3FqV$8s;|~)Im9)RH8iM0G{LAm8HfI7l?S42}2Bl>JE1 z!`ySz!_X6T?)c+2u>oFlx?*MAMhY$W5n6HZiQZcfbl5S3aWzu#uPv(XoYOkYy)Af_ z6)akQ^fs`9D<*4yCZWW!aoZam`sk!RE3tUDSb2Go}uKz|u@Qg`zkr@}Z{;U5QA@{8$&s9tY{3|M#AYZ&k==sP>G3EzwgM z%F%|k;pRS5tAyPro>sDjm1OTL1URSfTDD%gBF%lYfGUs8{s?=9*M zsj@;4^+<$0;}|&*?}}uEW3pQcqTkRy$g1!U4O&RAG4HJ!cE1aFL;(=q@s_nz|FqC0 z(5`64>vR(hB5cx_>Azi2b#6sya-Aul*DFQUyJ+4R@*pkHWGe)rY@Rcqh1pu80h(FxY#5IDV978X%u`%9ucZK(ssStQQ>6?+xaJz^hOB;v#e<06Y} zO5SjBEI-55D^+X~J)s)pJ(~XCK&)_4uAp znL-w)NA%n)H_ZG?u58Mw{_f>l#9rp|lAovvlgf`YiE_88=x?5b{;k)>ec(FHZVBx3 zozoE0=$sPWMi!HfyGnmfFthp`OHVF=VNZjqpYbk`&dhouhR(EizW>ss{TZWtolx(S zW=ne2azUjT(=q!R1tqG*kt|Sg%10$CjSkAD6wH$N5Vb#-(80#m5fsbxJyVY&#G~Zp z`@9@IIQ0^7?BCrC{u>b<5I*pCke94C`i*i$QZ@|-bRw|QNtIXzD7D8WDPy}#fFK?k zk1Y;6?!M&wwxT}-4swdd8_lW0Sel7LnhTjxk4L>ROUN2Wq#lw~q`m!M%2Kt7y) zqBxqd;KB<1wFFGM(@D9|>wtqV|1=!iql-h_mLD^qM|7wx{ z85W4BX?v}clI$-dKu0%1R$KV&9@$U8j~tNNkIK#noLbG_@m_EYS8C-L3)P#1nPc8k1U3I`Q<8n>T4~` zTj4XSINo}57X9FWZ}J4hBom2D!@-LO^|)H~(kUu_=VjinF_Oj8L)D!N&_3;-ifH%q z68;}vrSOpq8bQo!k(5@l*7(0nCD)c7;b4~#ueJZ^&X{+MtI(ioRcj*?US6~o0S=@~ zScjk&v+<@b1u><(rMJ0b!st7|6R0HFKBWsWZL8C1~YeECcb>QegeF6U5HON5nUBBaG2rKpHa)#GXUs%U^@X4ZGq8rHsm@n z9$ue{Kx60525U4u2y1`%kN+8iT7&j(17`>ic?{Q5JgbcF))C9RK;$?Sdn4dW(@2W9wm2*`BVoUO^l z&QkCL{>9v-1;_79WdbC(D~Y@9-Z9(saHAoPw4Z4tqT-}}WAC>@RK31(PSXr1M!O@8 zD0hn2A)>kl4I;JWMmVFvf45=*Y6~uL#u!R!A1r&KCshYFuifMO(y2FpS~gDX**zBY zQe#5yGmUiZF&_~{TNXWF=pp@M;=?t>PO9ocb|~ccS>o?A@j)^#WKXOuBd~}H@meJM z7RE;pP!E7)ac4mEl4WFHt8d(%Q00Ja-Hu&Xv|%fUbNV60A18v6)KFaIqX&MkP(TK= z3j*x8WL2&IfBW6pF9#EFK{k0$*W5Q~O$f|V{;?9$B@^B!Saz(bM<*?Sv0ZyZx2CU_ z*&zA~sXJQiscTROV<_Q>lC;zN!=R7?GGdTWBU26ac6+;La+@7p&CBED<0mDhy^07! zD%5XREnMX9?nLM={8yGfwz0wDMs=%b&%4d<5RxR zY9Dyz1bx4gGi9OWqvIj_EcntAyT&KE&W!=9@BIhO@nyjmQ<@NjD3-yLN+Tg}b%VQl zKHp{%U-4~DJM2;LaP*fBN+;X+?i;Dj@d2`1?WdrFWv?_Q&4rp1zt=Sf-|GsQ<(^@& znb5zWr!OgCh1}+0Mqx)qAxn&;dE>E0U3amT$UR3V8G!&pLxY(}2$^@7chFy7UiG`} zmE|n#@@Xv3%(y*Ol~-kyiWT3cALShF6)TGtSB*wE9=M^O&Yk%QL!^@mmDAT~OhDck zpRtVO_i`EsWT~x)xtHJh%U7$seh3@moYI6Vu_XDAa_-Vq8xANC#&lHpK{}=-0|Ms8 zCvJ&O59$M#UT=^CiQX>(7*p;J)sM%MpWyzP%nB-ssFy4%4OYXz(@8Qn*psa7a#Z<+Y{5C*CsA(GM-fb zpsY_SJmUQ(+@pAm&q>^oG)-fVd_@Sa^&-M5*7ax}M_W-A1MVZ6N#+J}V|nwq=-#qG z2P>QMI)u`QrC%>hlTrT4VfMZ(TWaDswpi?%Wew0`mWdu`G;$l|P?#?5gfg>uw5O6c zid4pS7c4~t#{+`2UsFD^t!ek5_YmX82hg6RRpC11HW^APhF{>FCSLTRPdd8 zW;---H;Kt38EXaED%9&k`r4<$btMp8>z%ett_9009KraGDzkLP`XVF@fP8o&Ru?4? z^5k7@A-LHqf-R}3IhB4*oB!m0ivk-M678GMtWfZ6K_QQC-96>qr zEBce`s>QWS3UE^AGivD^5uw+PcRwMQ)r@poLVDQ?Bcz+mI8|sy-;U8v)q8S!f;2KQ zpyAftY4Ryj^U17kC)B6?r?CYM-JU5+D+-To|8N1QY~Y>UE0;Z`n*|>A#Msuv7xmc< zDoNAq2)9VXTKQ%fs+|<&g?zH&`xYbM5~Nbo87o-RmPU@{|C-0QUcXVb7yvD&uzj2&j_d>kx0(7<&=H(=V#y#V6a8-Pm8*7^)*Y+llA@dCdEYT^QNZ$A+pI zUFT=LEJjq0KF_YP`&hK%>FHcV^l0XM?UUny5B}d=6y0@8<2n(qB{1G>ExAE?(fHQ{ z^W)&ur*k8TeAU@mO3ys_4`=4Gr4bLgcfVfz{M#GY)l2!S>$w{K*JlQDVw0x>4TlQ5 zSD&EjBp07YbJ4Tj8U#LBEIYCg7kJu(ZKDH~0`2{aP~f0F(>WH89Y8g7*`=_Osq_}% z+}y++VZ&(EOeE~(Gd_M80TICkgW}HB=wg@$Z>I?Ys7}PPmjjVU_uqP&F`o{fH9Oaj z$CW-1>y+im(J|1@iBAd1pBt>r@rhAJGNog-t0P<_2P@(DJqE)i##@5(b#zSi&W`;m%kw-70#<+L} zkidI>MHVAjdo`y+clo3!gyRMyLZ<=9o4HhnDuKm!@e}i99l&(l`KOcqDb~+GWgf=9 zONBe(>fS)I!oa)dgkj&YdwLs!pihdYXotqZ&Pb7j7oJN#jv~<=W7aIhJ1+@1fHI|5 z=IL?9lP!-khnW3{DfN{KOwpJjiuc2_Vkluj5HfCcZcxSv4(PeIg+YbG;*u z-}g5wbSMBHmVs$DDHAtoh9O6e>QA+bn5nUWj+&DNxc!8+0eP`ax{kZXwHDBnzD^lybRW}a9y*vRs~rl)Bh{Cp`^k+v>!-RNjUyjcvTh$Lg30-QX%EJCax%ShcTmj2 zosTQ&z1L}b;4~@VSs72=yzmnK6f0>M5OcMxgwVOShg`~n#*vPc9=eiet@&)lKmF#9 zWOfl5;jFt|cL$qVY7OE-hahroo}0N1Rm>K|4B#HffIIh_@pdsM;H z6LEO@fyZqs{;dUnL6E*G?s5$VU<0`B-JHm_haKIR)%kE_t?vtxncFDK&fFcn^>(7h1$+w-JSuS1N zhdThXq-xI!un|VfUTzriatQ3q`&FfECTaz;NZM^jRkRDq@3YM(V{2l0#P6P{_pk?x zPdDC}v>o1`-?0mIbdMJX8Y5PHWqY?I^vn2lTTmqaUFmHqvY4`1Qv2iG;!O_~t5uSc ze3FcLXfuHl2oz|OI#1(x!x0wrvj(WBakB1d z%(XP*VwSeo(p1kC1k2J0>mWHWS9@+-suQyV=kITLDKQZ7Em*Ez43lg&O0G_S6U&u; zym=2}ZqFq0(6NWjh)hv7=x22B^(Mn=!^@lvPqBU+fk4RRT+)rtK9Kt;tx<)1@}pXB zsZdt5x;Bn@dNM@y4`EKW@GDw+lDgxMm}632n}+n48)*eKPx%h&Dy@bI9~AE`#@%nO zYQjE6Tv+;P(Z36{s4ji_`S^(}iK%fI%{g}=<{s(t{bJ@vFU_@IZGrplFWX!#>)EZL z2Z`~cS{}_oSwAiaKZ9~p3S>kAHO&#Xudg-fvB>%>p*!`QnOB`zg2)ST=IXh*WaLXn zn^qvz-W4(Y+Cl6*RKfn)77i(W`srUlw}}Lhe>P9H-v8w4ZcbYN)OD zU4X20B7V+JFYz8cEYDZn-vzqaA2RorSD#QkzD(bMvTPR9TxKc;mTu2Q;g_jcd`=Cl z{dTx&c}{5;OP#%lcx2|M?-;@>KG{>O(VmVkYkltQ&Phvic}WcX*S`EIa!; z8Sj~nVph2Axt9v6vZ5m$bJ7T70N3*4NBpCpXUE=q%}y8(?+s;%#;=TRoj0$AHmeh9 z+Q~mN*{<_^Te7ZORN9ZtgWqm`Uc<|;Ak`~S$fz5()V6mEs@J#^j~8#qdG(E5erqYc zqiOvG_`6-^ z#3=I+mw&3^;Y$z~v6{G1`!`1Nk8Og{6S93y z1IKk{a}(aGy%{k1YmULCLAjMD*&J{C1_RkMn9Bn=Vh4Fj|JM#@Pv~@)+N4g{7CP)K zfIYjjS)Apfy_iZuJ_*D@+!3(tx{hV5WnPgeUkcCuC^Id71bpnGz;haxF>esIWA*FU zj{VQ>4;!sL&NfE0zcs%~YiGRx$4*lw4&36aU7BJi{?fq{Ody}hG`xNM&WoZsUinrm zUB5hunI+-L`Ikyeg`>rbQ>J|injd`0X^K}Oz{JbvYQ?uZ;DBGAab$BKmFLFa{#Yuf zg0=(Gau)*%dIdEN+lj|-;6eui>Gu``I$dY-Nqm%u<$~H9>^VG6U%w0J*0upZZ1lrc zuNI#*=O#I=mV7&8bWB(@7X0scU*tAIvA%X8UfdN-D{0ohP-{=GnB7F}iOy`$Pxa3) z6%O8Nr^|TfiFV>|{Pv8!be5h-A19>Tw%TDZW0MgkK(FjMFbJuu#UK+Nt*LaFcX`7&!r)xoUS9PgLKix1K&8?=?Sm0 zTah3!Uh>u?gy%8}k=v?sIlhfqGz9zgQ%numR|U34yOjD%^(evIIyIu3;7W&M&pegH zjhB7|Sg@Rkzuso;w?;R!I8BZbd-wG2nR!Z=(3$`GO?T{=@}{W3MSD9A4`L?~$!Nfz zuuYG2&-@FyV2|Kvja)hp{yJABlq#0TFNY_Rj>btni@)ZX=1M?8WgMli8*a9UP0GoawwAY}ERYTxrfBGuLw z$P+-QmTD@VUsVGtlHX(&F`AU<=2~a6PbyqbUwipB(O3_kKDWfu!^{n}C_UQOI@+2O2k?K%fqw@HSy7c5i+U(%Kq-6wv9)=V1Ptjs% zF@t)%aeU0YSKTuaK#7AYdtP30U489YzWbzB53@AJj8rnTJTes+Ct9Y{-L0>svM&q) ztc+Hq%@P0@zr&y9WM7`xBnJ`{Uc57psbw7}OonCayHf8FL_;$sbLroC9)LTlGIisx zb5M@Ms-!{kN$)-@{rp*JNytHPpK~HkT4~osa<~B_3%fz*h#s_GmQR{?j0fZjvp3lZ zeorr5UHK?GO~u7Bgf+q}9;kzRkLOL7c%1#G?hU<@Q^8?vsblI|oA5)IXLKOENL=Rl z9b+ZZ2!l~>@#MXzspDGP^kv0SBuGBPgc=e36px$W=$pjV9(4waifI$}xpYz$m8sq5 zrvwRzV6yP_{FU&*XBwL$ZEx^$BXweM>C;FjT}w18JjJm+#5L~4?I2>j>KV|)GrCDP z|59M{Oj$&FA6itm(JA$Vq;#5wiyrbg{427a4w8Y&HgFE(l>MK;{n?D6}nz`b>P-w2cuw?;FrGC=G}u;6?Xhsi*}pI7Y|&AG{Y6Lfftj{ zHgGidGG0PlT^0s&i=o7Cn~AHh9PV1(1DV5_^2E^p@OF}~EygL@3Z>)a8~%$Mm*&vDP%>hkab~;W zCSJU2zdemDs6)R!q@%E}vd2nk@#t;LdL?o^Ve+$hE2*`*=_60GB;iuFRF*1k13H~H z*{e6;EQcGO4|G1G$HLITwWeJ)>ZC%~w6&R@4Bcj2MDWUhSRqwE6GQTUK98Y;p+n+L zaw5@0RpTUoA|G}n0J9$7>UpQMhzIz*HwPJ%){p&jz`{c467)4pj7uqC8!5RB@Lqa^ zNo8ORBM#LQxKf~v>iMioCFj?uT`DKgNI#Mg{(stg?{KRB|8e-(NkkHv;n;i2Oj*Z# zo7qJ6CVQtsR*teqNra4KJDejTB-!(D63IM9_PU=(y+7aI_qy)yAHVy*`*+{2*Hza! z&)4hucsw6_@me9Frk=8|P4ay0eZ@rIglM0jU5!ErnxApgT!$cyhes8r9{@D8JGX;2 z%7g#n4)rKG4li{Ff>};o;+hY~1c74IvJ-4H?vf%hVwz2BpWvx>?w4|4r%01pf-kah z4cUpen4B*(uGrRB z+q#SD72FfUl+AbP-4)Ituz@-kh_#u+59jR$;vWKL9M<8lvz}R>%8I1SDVl7xVCf4w z(RO}Q;c?csg>2=p1Wey)7c-t9B%I{9*yCsjHM8(Y+QA^UW8PM#(maS_GXPof>m{#? z0cJ&6V31_UhsF!)JrUe85=jtyAFDff*ivJCQ90`~XKHfJnQT>XYF#!&s<_V4Ur`*U zpNyl&LWh#4)HNb%gnq62?Yws$0m| z*Pw4MQN~{nPLmthlGgialRH?z&|EUluErHGF2!g4UTr`LrcaH%k^k#`?!Y<&p6<8c zhj(E5J2+tw1>!vh-5NVEohO~FPt}dAako5@N=ZgcvAIt@3;m5v=}_k48=SiS?u}Bt zU=^8&k003_q2`M|))_I$^_TsWUIxp11s;SPFmeke#2%tNS|MLEEPV1sEEHxh(pDA) zszjv~U_*6NN%w3GtHmwL*S`-`o7MuB_9jpz{5L;(QRw}Ar9rJ&;;Tv3znP|drFw`e zGbGu==+@{1SYar z)VnX%tf{Kz%emXzR_8rNop#WsA9k$YVXqT_C`4O(5cj2Zye;IqetN8U3%WZdARubg zCOBXFc&Y?X_WHiT@^+tKCkKq(T?MgcA@QU&xv-UwmOceqqQx1==WucJUaPg4f5*gQ z1`sG2jiEbSk0<=5sx>bry9{F4o^b7aWo4N-VrR=d3bl3EedmGo&X{K+G>Ci+;LWNI z7v&q&yEAXJ`rI~DIZl#uu69ZFH;BYO%fGc1s0F;RF5=8W=1J>bQLByvH!K?Xauzx^ zm$6*61Uc7vl@9(6b|I+>s??BogJ@yCMOS6pMFxA4K_bpTiO)}B_de3MuLLpY*R>#F zv%cN4w2JWEou|K#4%jExiRE%VrjW5HqbyboSBLM-{J=BokdC$N6qet^k-EFmszzNs z^J0CocMyvF<^f0dG4`lW^OcS1JJPB!v*f_bP5A?rZZ7w)dBa0k(_W+$D%n1)zdsbI zC?;nro8>4LY#T8DWyC0_)+|@7txRc;Zj;`+#AB*{sO}E^@9S);10#{vqwWz*?XKIS zy`1jN$=^vCje29c6-nwn2mBSc2Bu^KZVDQWxm-fBVXkB7ZEwGhS+1KULDUq|acH~U znfIlxIb1DEXF9U@_BaCyTM%h8uNM1^gv#ZHv-DXnPoiO3w`vrsNH;t%-ycko2bOFq z+dRA*z3ww7ak|{(Zh8e}hSJ zIoWLqT_pLoeImaHywQ);1V7$0 zid>)Li=@4BmJIK7AhNwOK)-<$7aFM&_wsi+^5pNo0gLV=^o(m&m)no2a|)mfdbnq# zJ!$X9d07Z5vm=H>qzunDZtQ?zrOr{pUl(NH_V!!V6pmx=XO|8}$PE~#@9xeVEaJ}@ zV{ldmzS6b`Hs9^;vyHU_@w;wiFoqMi>orl*`)pQK28>qjJrD<7X( zW=_fx%N5tNYQTe00F7$RXX%~;>pEMR$n0F_+>}X6WAz8ijzCbU?z6k*6YuIwNpisP zBrw?>FD|d(-%aHrQ_u*_JhuB`ZuY|%z6bj1AP zKJ!7y@7tLCj*j%Rim6t*eg0hSYaBeQx2>uxiKhvVukFhp80AS|B;_*MV9`BwJ3k_8P`qKR3=I!WuQ5F*FZKw7k=0#f_j2FiW-X3msBKF zzzZeVzaXOb*{9>zbWH3Zc_oz7c#3sxQ5ciMx%UBPHf!p(znr3)npy`>^f0q9ya7)W zj?1u~+v!mDvnFo6gRpiSh0YW!s#}dUjEuO$pBzzp%WcEvz#qJ4T@VuVI2}JsR87 zw|;cTaKPX-P-+Cnq5LMsa~iW-(&4sYDspUWZ6O77@8{*cwIe`{7=&}C=w{T#{^W3n z)UoO+1m5)W>x1Si9hZaX2mUqnq@pRhs&eU$Tb-cR6aK!0u%X zV>c*{U?6+G&l#vG9!-~-ZTWQ9!G;Ob*g<%Ehh(r!VxnIIwYM@EoVkes)c^@e*GcxGM2< zsk@kI2?EC4BNDj%#Im;avn^#2*j4Bk?_6R5kZeYQxL{(mCXf496>(TU8u4Ljza1CPBMUL~crwHqaa+ zCK}Tq>ZXcbyVLQ=d9hG3K1wQ~I{)3(2@j^3vls*9*-BMD6gH^r0Lp@H>ftx!eGVuS zR|vkc4D3GQbeAvz5ZAJABl|P zMhelCUW5m6seWqH;TBD6sZ28wlJv*{2nismKsU%%L4Wk}5d@3pPn_mFu;@JJ^TRGK zbjNM0q}Mo z=Vjlm*r{Ep?$vtp#ZXR>tyW^U83z^s2jr8y-Gr5e1#TBCZg1-=?cs&Ipm|xC*R6^U z2f@lpYC5t+XrW46?+ig4`m!&KDRY~z06ey)9>&0bzTk>)^ z7bobnKCPk&N}M~2)Fm*dWVe>W-z5;_(ES~b$Pwn)`3zbaJLNK~0V>P&y|HT{Z`R0S ze~hbw_UTA%n0L&c5Mbv(CT7iGVxd}UFw}752Wm0Wbm376JOlGW+^P&8v~W3)glVqd zJYq9`b7vz~cjV)A^soQCa<-T_bD91?Z@GS!yFTp2al=kAN;9f^sm>Wy7P-ALi75W@ z7Uxqn&d1uql}2L0JvQ)4lkx< zdREx#b#+tmw1wgjA-ofG$)vPTVJKEqWX(eU2I%#SYHeJz(T_Tk5iZvynW2!IRLv)e zh4F{O!y_W1Hr3(8{ZE|3f?`fi6$+5xjW_sJbb+*0_6%#q__L)evdF%pOf{|5hL=MS zK)*r{9?`a=o|>-?S3K^LON*bloruEp#d-^OQkiypCxwP;UKEx#F-xaq5U$-tk!96b z(o0i~N2!m7H?9l-iGx`h-hUX-2g-vWoGaY%z4%lGE}pTjz2YakTK_fn6d*MG)7D-V37TYxg$)66L#f!gT$J6bb+k3YSh&U6cGz73|B`8`u&jIE zOv%6eFhH_5Q9UngeJ`%(^D11lhAZ+Y?h3_3U3M%z0wBPfE&+0Ak(#{64Jq3Cvn zQw~!=vFC>f;cc}ZVUjks@mrgpP z07^TgjgP;oZtCC*YJ^#jK5iJcK9?jZDlEG$!BnkNGn<#6%h_wet`W~7%80Z1YJwCE zaYBCG=k6K$pfLi4nZdz6zuD(tjh9Ty5_esnaRo%^Fg|jv0(vQKbq7@F_u!7PP1%~s zgFj!O5=+pDsEhIm@A=E{t??_^k&I!in=?nwYy*HVP}s>w;L|%r;ol+jx?lZW%{rj&B^Z&PbxY$^KaY&d6?j*bIjMg z0G;Ty(ps>=nY}5!O{!jc_qCDN5w!axUP4~nRbbAW6$bw}Tw?{)^xesD zQTaJ)VU?c=v0YKJ%i-2U(ia;@8ZM1fXINoQaCQ%!JIdfcF60^!Fl3B7c_FE@JVqEJ zSfIZ3dEved-%}R(cP?IV2^jC!){c)GvG@?6iC0^ z>sH3Hql%+ydoTX;2GnU_pE6ZK^F|}lQ>(rdVylh+ zm2Jj6pR*##G+a5`D6$ft%%B;&D|!n@Nf!|JKJJ59k>^B{&ct;RVt;{%LcyQ7jv&v- zLmJNOK)*q-)jvdpqCqvH6eB5BQD`XUMg9KoVlKEsD{dXZQPH&%EJk3pc<$yG#obQyUIUIm((&z9dA}i_&}P zEhjNGqS3OOORW?yfa;7d9bb3Y9f@!90c2A~Ll;q+kz){Z0Qh!w)}2DYq=r>n$E=U=~r>D3Z^~c$I{syr4h?q)rOwBNSeb zji6IA47Ks85s;6kg;ikirD?{f0j}AwA7Pnu4cLb&rp=%SR3a&6&0lp^a-UM*tVY(a zLy0y%^3tiHU@;j!NBGD}3$=-%lQQTgVojaHd}B^LU@IeJ2`b>;DyQ|ot~)W8v|3z+woS~_XLlVfe0V1_VBqM7_~g;rdDX1K@= zx(@2B>9xpOlnKxj=)H$`dD{n2?j7l9u}J&unlR=KbKCi$IFu2ZLI+;RDTv3+rK8|6 zp@a-5+_|Yjf_tV!ab&Qd&6j3#`m|v6mPXyp4em{oY5Y~)FIp6O*#YdBUexsP&nuG* zYkV;M`mn@(x2CHm%;V(JjQf%sDi{Ihke@~+CqpQD`9wp2@X5OPoQe0WF}aca`LN#1 zbSFw;zH*O#LpTU1ln#-@^Q*6+F!u5b(<-5=eUAH%#&uuVD@-P+1Nq&L9$as8`M7ld ziaD?n3e*UKFN9bOn5Ub*I#)fi9V^s6;d%y|*(gnocrAG0K)KdwP##B6Kf5aS^zsI6 z!OzgJk9%Dv^jc^ULIl1vQA2K^yaFso`HX&Jb?Y`Tr|!c4nKVk&#&;m-{r-y@rXOK; zai4F~G@QkYx}CZ)-o!^7`x@n9PgoXJFXQcVuSRcvq8cI%mo5>6!4H%FYZeY#(xjjg znlwxF4wjP>D&{4*0SO9vvJ&ZucemKRIGySp@njP!cb=nyf{XJko8k+;KfVr|;?jnz z)|Li*IQf4WBZ7^HM~6QAmM-Na_Tu~9SMLbqQV-n*M}CQ?Xc3&MASwijjhzSmLojW_ zyKiv~0k{l^Xa1e)ft41abkbBAml%iN04;`V z*nOg4o}xHB5iYm33olLsR><}eRH zS>S=Tp;UT`=K*tNq zgI%qdlWUZu-+7!ft?&N>urnKcsa-8e9hkMB{S(g`+Pb=$5pI>?5%TERQ}N+jYGcm} zDI}fyDPDZs)nE7Qu6f7>N zQ$6ZfRQzTvtjs22?o%*r)fRVszfQe<+|&oNRjg|X+L0^)ytIBp18!*9MV0>}y?UMz zpPd|!t9Y08J0m`C=OD^r&aYM}zHUb$=P(DI_!4A-86a5^+rEDEcFK)#<)uu_{*l#W zp|&LbD^T_MbZX3XR&6MO>pzxOOrX{}91n;(M7o{Qh;%g8e&T2E-H_B~oQR7ansQSl zYmnUuGN=dLXqX)+BK9Xpw8>_+@pTIiMt96gmBX@m=9AlpuN^UHtmW}Tn`S_58U{+> z;Foql<{`L2Ja>P`19dm*XvJf;JV#gpHOl3(F&cTtye3ykVSEnTLFfwD6p?`uK$&ov zPQBm|`p~=lXAYRABA^DyEiP?!ON;Kv-1fmdOXTaQ z+^U}yO<4DN_8?k(>%`g z^c?&tywzoweC=pTqE@!?*{@*SNFW%wt7g@Um(u(_DzrzCPvVe9lLNdVNUrfZ%?j?3 zq%pqmrqUZ)ep6#zaF5E1Ryd}uqAld&1|CLv4zta_C3@*j$AYbOnQH{T7wg6^?xQRf zEi-&CRa#qIoLM@jiYf1)@iNDAg>1)CA?^;H?p*=?y@%fQ;ohKLodDYv1Z|>xPL$tG zFF}#5-Ai-t57{@wQ~0fUYL8f}$f_v3{|Ua~rLaL*#kg^?UXu|D>hy z{lZ0{STt)eOusz|h$IdD@=21oWn&d2qtz3ncn!RDT|R`RO73V1ITk9s>C2EY6O*8V(Wv7M=+w%zxWMSiJKB2og0)A*sn0)H@p*F1U;yg^_nToNJJ^Q8$6s;N zs#7D4nSP3jdS+Mut{qOATtSriH(2I|#LAf}7&_eecVVosngAED;;zI#a94Km8}!=W z)j~l!&A2Cgv0HfTnk3?rzy|&y!^8Ipm@v`ubUsnazhCJ)c8WgS)4(jCW}~d}_V9F5 zbuZSjR0Sq%=E!u0|GS+e;`&=ZXT6Mmi~{Ffs)#Y69txb%1lJpx#Lv`g=KeQ~B*DoQ ziTsIY47~Vz!pJf#{3-uFemDiti;p6Rx(wk<#PWq!8y7L_h)`+rJ2!ccx;PmhPAs-}<{a3Fjls6_rPk2BO@>tAZ>M!w>^yu8T29dl1jmxC{*1GdIi3AF2D`9 zfXK-4f;8Q}kk<{7;JteoMN~A(4FkcK^O`VuVZ~a{5s=(C zvw<>((K8(Kh7tym4B!qh0qOe>NKC2>13m(9rE=5=qAFsX5)V&n#>EYJ5VfKm@_)om zB32;H4|s4)#-%A>`6J)pp(E;{IVVd=W9{JKEG~qrG_b)X+=Ie6 zTMRG!`DCzZ^d3@Y3P)5X+@um5DiNS&rdZq_-p};kw@`eulO4%}tJ|!;2v?}YMY!-n zkiecJ_88TNB1S2>?*>VU%MY2(6%@CId7L(Q*0=ZE4-{R`t)17)jNsx;#3;-j{s zQh`ZI4v-Q*CoB+FCu2N8VwWE#NsyvlnGJkPm18C(H;{yL624d#XVb0moQN{aWDg8+ zw8WSdK<_w+YzSfKZ74Rlt0+yLa!*vzi%bS=H!0-f%|H-zfdx}af33)%vJ_E6sx-UE zW$8=fkc?@EGZ;!0b+=n>>y(_1S8i|}S3x-kgrY)}K9i55U9m)I{FojqQieAWuZn&R zd(rlvI|w~lft;WS-`_RIY);E6oaIy;TLD| zpIjWDrBz$~D{zB^xP>Im75S(SQ8Zl*`Swv*Jghb{A|eNuvEr^$@QVU1-V7U=zqgrD zcR(h65=l$RLF)iXjiYK!jVw`Kn<0-Jqw1dSiVP?|2_zvAjQzitBJr3@5cmwOpK8d`g7X{ew@I7mmc8 zsDEg8kMadqeZ}+fD*>Ym0FpD0?MeR1g|l!5X07Ec?O&Tz*k(gM zGZTUzSh#xQ&taiP`J^*5U<}{nKkm4+{|fmZJmLS7(J_s#SL}OtbPzXK@E7v%7=Te4wt1ja?D8d8^b6L(%FtAD~8CF6f-!=6owxb>0;CvS+-&x^OnZ zl$RdEP{8HMV(>H<1XU-<3$iArNNTIrkMFS9$)S<|l zucrUy2b|PO`$4773JXDh&BP)pW|95yug1zdKDU>u7~LerrPf zl8k>J3Bx^dLL7K$Ja3mvYlqER%BefW)Q}*TX^ylYTs1QT zEp^;>(Vsy2gOkExH5XLnU^TH`asUSi6Y^0l3y(oP19ubXKURu2H4pubN_PafOhEvF zTlyc3&%fT_f79P<^TQDH)UepyQAoF}nk+iY_u zrlr+99V>x);B-I4c?6gpohY?fTh9)d{xM1?#~?D7nWQT9{2|dO!ph*a!JdD^gGF3tG~7>#IQx=^VobB!bw`pRSiA);0a3lksy z!9cf*p)?IiftH#^yG%CjHkUD-aJ%dAF;Pc76u0$v)?gN$Uj6`iqKrF;yt_iUlTmP4 z^{PE*iWS%4yHaVd+vH4n{3uX9r24i|J;A2gsV463hO|I=Pc#1;yfNu)|0ZVtFN(gt zM^U+!^e{ty;_03rv{lOWA31Wl$CdWv#IxBF+@S)l&*UJ(kukUot4Ex074n5wma+u0 z0ukbty-)(t#FHf$0&Bb|2UIY~gK2DT+Nd$|7q(RiRN*WrkqOgy>3@v>AL0E!iSr~N7f>)W|%4L z$rQc~c%T^;Gg#wuPz5dKY*gqDgGq8V@^lBm@>1>>og{y}C{=EuAlz*V^U(22_I8Bx zr6Sn6lMMD5zv-IqHS6m7F|E&U_rpU)y3JGHx!3o8yKCO)cImUeaG#tw1!3B|N@!;8 zhTmzV{uh5h-(0 ze>Etuw9@t~=RxO#Cere0Y-^qL=_H=}^8>`qZk^PC>xV9`s}BD~>csZJmSq&7_Iq-HTSP@af$3F^&^kM;<45@2qZskIi_`^axDyP4*At&FW`a z^IJ43UuN!1%Dj&a(P&0L8eI?Y)DGBLuUc7iR*~(`e~A=U|8J~KoM~~Opr;Hl4Le>> zIBmMq$dw;+SoJLHr*Gxg(>DQ}L3fUA9XBPq7yLeL#?#kKG$!?P2Hoasc{BiEd3@Te zOmM7)`L`0xB(=!x396l&p6c5cRxjq;WOnoXn=Zg6n`Z^i z_Wk=}#~1G(A6=t+Q*I$ie4i)7ftj8Jzqb=_$qMDsjj60ow=SQqx*;FEDbcs6-*{%Z z_~ah$EZ!1*3$MkjDy+;p6a!Atk5aOJZY`-y4>8n)*ij+aftgJA2eJ5F}1>7b1J;`!DE%cy| zXP5Sgb5=i-7_6e~N3T4qRELoNwXufA>5i|N&6VQ{0<~oA;(ZHcVpbmErLl_l^THk_ zNn!(p_$Px;A~RaxZY6f%FI-$nobLQ(RpPl8zF;3}2@G>qUgc3))q}NK9yiafG#Og! zMn4wSQ3yat_i0g%Qx8(U)K z-^5zx&R>T~Uh9fL?&!8_j2a6v5L92)V!xb75M}@7IQWNWLhOk$)s!jT?qfsi^l{b^ z>w#UEj{{YJS}B+Q$J=yV`KimaL0qT%d3FqQw6gJz(-zG3G0?^P>xq>#$^4JJeS!?A znwylSxM((!vdId!OV*CimZAY1p2)GVlHIUJlC>{-amwbtcurP15j5G@+ZaV?w^3$@ zSg;kbV#-zr+j{EuI!}V6heD;!j#186>%b7-bE))B$nJg32%j(d(h{y%`Pl#7b8p{F zG^UX;OEG&OuBIbc)AM>*yAF8t);>~v! zKjwY1_nJLqTW z4B=OiEo=%T4<`TMS(^O?dZ1T2V)@#Qr-yduxOuEH^;mlo+s;ta-y@N4q0`yFSj-s| zVHvJcszh6J@0D+3ekQb1XKS{^SQy%U2X@Lo0-e(3a!P&S{0b|!&fTM3=fq87zb6^% zxIoX9KGifUFFXTyid>b14V zP9#VNar`^wN`W3n@przCdZ!N2`zuekUXl0Xr2_E?(5kgIfLr9vZyPL8X*s}MeVr}g z5!zdOOA3X{)zB3Kc^mf?L@-I8HoRAnw@2GJY|Z@nS@HLqHqYzU17vKTWkuoY_g7HtgCI$boN)oPj&hczE@L_sAp}E5A!i+3h@kWf4*BI z;V%X(v&mbW`Klvx9c(dihxy&PnbbwQQ%SFXmcX{oL%nlVHQQ6+@()^BGG~Rx@`;k*{jwpXzeKr>79H7GS+l4Rx2$+b+ z;`tV>eC?H=+O5=Tz6EgCdRyjoPve;($H+@|e?&Wjh-B|EZ2kIxs^h07MH68G_e698 zuuVm|F`ZGUryoM#0fm!fi+4+mheIVstVi75UWR<>vNO>BeJVV1Ykl3&x;r%dozMO6 zHQvZ(nGt2|rxN2l#f+)U}0zo~k=I!Q7wa9jP=%WcQrsY)e5aIsWIg~D}mzhilUoi}lI%f8`=#S?U@T!ssN zgah6Y0dChXL(31i6g*+oYIV8u3=(ZqC1)f~u%w8W3cF8;mM`PB`1UYtFgHQY@!=t#_rtwsQ1g|#)-0Dd>&wvWRK|Q4 z_;G*yc9_7FM|<5jY6P~df3F*_YwS%keo#NrGBs`kVcnxQvQ$A^ggbX939(x6>=l0x zZHf0&?|HhjpGF{GNiS-KOqzZso!L=QWR{1n+xdMlBKyV#iL~##GYWy2TtZr`Qn-;& zXl^}fIzBZF8KdwqZ93D|&2cDJm99TM(1nG|K-bxK`tKGU=HLLLuI!{4T6aYV`|c&I z$q9qtcD3`cg&}@Vr+jwGY#41eJX`yzHP5)_sDgMC%RMJs_VlP66XsKDR5q)-b*q%7 zagi%%`B~lBTc^cmd3G&)fvGO=`t8}G>8Zf+i!-$818n z>)(5g?6#@PXPa(tP5O>=p2pAbUy6_(r&4i4#=OgwEC|o0M#NlOn;E=uTK9mfc_7`Pkpx^6GdGgxk4g0>ECB)u%%^4`W7#IMrPyV$+l-X>gyfn;KF}t{A z6yA!?3cHFssm*&iUNmV-{iWC?skW)jF9oNXMFVYSj)VS^Bc;Pi%$6NtrGdyC@ijzv zj*HRC*AnBg_54O^q;=1eF#57L6Ah10L>~FIB7y z^g$aNVng)$HznlPj#ZlY?25r3E6Sd)fHq%pDqdX~kndvFW0Wnqhcu@36LdEr!EI~; zo$4jT&U^}L6@#vG`F-gZ-TVHjCAElz+}UoAZM`cjDgWEhXc5%0c(Q+gUXP_v@+%=$ zyHB(a@jcbMHU9&XobZM&jv+0ZfCMYGw({kBh=GjXFn zgTJ2;FY?waj@K`aYyGUax*mqM%8wW~zM{<)SPz}Jr)(|6JGaL(Beb_3_Aypc!F~0$kHfjU`$Lix zMMs{_oM~+BKw~7NXK#!Z2b)X_FPt_d^YoBhUGO&kF{Af30U=f8uJK!> z@?8#aM6+Oo?8yA`4Mi8P3iJ3aB?8-ZjjePTbDoQ+pJu55TisQWew{6r5@Q+Nxguhb zh0#kSGz)6i7Oa!Jzc$Bjfj9sU@(&nOgg~Z(Z*<%H9bC_pJqT29qRw(mb}A0|g*A$o$D{zuLN;Z734YY2qy zGocU!@;e}0FC1J(dZ)*+l37|cX-6|2*Xc%PqhYN%^P8}6Gi1FZoW0A93wBzsq;)fV zT=b=!3(Ktj^`o-?!s`T`F;DAvuz$Fy1rHcm=uLHF9_VDJ&vC>S9H&OMiR{dV=tX$irDyv@WAK_XAS-2yJZHR_)9S4CS|e*i8FS zt{hsZdzQw#lHuDZk;<157<0ahZHNI}ife*nWb`7#N{05*I@PoYP+2#4<(n*&TK!vvYUlf*y<>FwOlwjOjx!JtcV?ERQz zED`P`CRfE^lF$P~c(Z=FOe;?}$)KAj8fu#EqJJ#r$B;YHCI!7I(4BH!Zc|3rB@C>k{LwBp(=hlvb@{%^;_KDX#^$C8YOb?sde)V8#>9z(u>Wf|h%i z(~rtzetrNzk%g}g&mEjE z8s|7`Z*X=u`ZXu>&dAn=W3LP31Jwtz@+tEtPG$c;^Yf1IjKl}R!}{G}9~e{!1g4^+ KTyfjx;r|8d1Hc3T literal 82170 zcmeFYhgVZuw?0hhMY@1=1w=Z6^ePxcq>1#7Akv$30s#~$f*?|*D$;umC6p*lL5P6V z5C|ZK7CNB>$S?2ly!V_tzCYo+jLq1|-Xm-8IoF!cY|lz~WS~t;%|T5>L`19e0Qi`Q zh%AJNh{TbSoNxt^`Ei$UB6rl)1`^JMztelrNWzKA_kpE95fOLXfBpd}t9#BwMAwOQ zfEp$td0WWf?5ED}kN14&?>q%)kg@>$HMPE%dyw`=4RySRdawre2ai0-kd30|d(B8v zR3w@WBYN@T#q}3LFRs6P31f(5kNpMZ=ZA2Y=zGTiC^|dN%L`NRx2W z7HpWlsQc&o%3%l}YLfJO&Nj{4zZLu@1yJ|*M_OSLyT1XL<1u;X-%u=5d?n=OpUZ9! zMhdoR7_0%u#1M*YjhOAKC}{L6m@RCr**5>rAjRy%QNdwbfKJvBZr>dVL^81pV34GT zG*fT8D;;a5{d#VIby&v||6 zSg9W}%W<}mxdN)9k4fl><<|Z1mau!#{I8vwqYk1|qwUv!Dd)6Z1{)r~`lC7hhLNZ; zKph|T36}49;a)aLII)Gsd$!3p(5O~@luFtQmLq)+j;0-L3>?>&_-BnMN>KQtLPBbf;WDvx@dDPX7i^7K#r?nfs^^Ah&}wri{L zikL;QLaHkv6fjm=(>6-W{!JiN9t`#uZNC zef`C_UDI1=bZ)|F)_5ZekP zbvIT+1wi6RwnJp`Sy^`5^4v!K!%B?^*q|ACudZ9G)12HW5XV)-7t&9Z{AYQ|u-uOt zWHRm8xhWDUW#f?K01;Na{aeWNA1irQB=7nUNovI!Li3H`V_{T z7`Seu>^xXV;c2J`!Ja#YGb?0Kf&glCTq&lVkL@ot&NX+GKCECYxOV0M+&&_xg0pzQT+I6!dxe6fJrq&uF4@Un6cYM(6nGL`XY+O3dA-KEcNG!7bft=vcd#R zGPxg*e~@&{rpR09bi0P9lpxz*BIF1^HuGmQiaC}U>Tc;ux|%&@xYAI)y9B~Q%9Y}&7X4ltRsjfF0`$XM= zcK~92!fB+6*o<*;J8yzxHt$P*+-rfI_G3smcn$<%N3&|W36QIIq6s6;$@Oi$j$_1d zcz-y*TB7wmGlXte3$+U5jH4yo{_~#hP0_8y@w&+gRwsYIsrN11bI{td5gB3|_8nbIg5qCB0e zh@;0kQ1Z6&wg@(7p;@0OgwHGQ9xvYRM+a>^wu)1lO0Cbc-N`#iZi6}`@BTr(4M!RW zc?W9;9^X5RR+^-lk~gfx<_jsW_y}sw---7<_Uqqgbf9p2-fTAl;IW@yC^#t%lyR2r2I6ebzGM%7U+>B#SUi#0?!!Me*0Dv^ z$rA$b<#k|X9ICxh=`24Cu?5WQn3Qaja^=-nliCoSUuh$od0B4O<+2)1&sS-kTj_qw zk(F^{RAjrXa+Y;uvV*xLS$feLc(|=Ee$88;GT+`nW#O1Xqg_CsV0(X_a|`t}tV*TE z>`N`C5n~uF8m5AMYQBfFloJt4nCa>|vewa=_W|JLJ)v9&4 ztJ=Mkoj(9PJFErN5@!a?dN+rhGgIYEleC&<+ERqm&6KoeInQ0&eR%I{l=*+;D}FPb zs#iUJL_T1)jAiOemapy#&BFzHw7g9r`$;j8KY)Z$MDIL`opD3rvFGl3>Ld$*?8yk` zKR&nOmVbQ0$c7cMCvB%PG?I4rM$wzQY0w0s+o5;;w!$r2sV1ycJtux$uFOm7Z$r{4 zi8#vw^{nAL z@&Q)bzoyXZ+Wjc}jW6?^Wm}Ku5LDIVmk&Wc$jKxx<=xgTto8bQPmro}RcwM@ftl*> z>&bWCuPng~VAD;`S*DOvgEBU+*aod$g1Zs@OX%Wx%3TIjD8WgoUdz4lhT+CaS;EE` zb5t2g3jd3_`BIo&hLh)z#VzMnbJjs0>BPpy)>>|$`eRdHbwx{RV~Qs_Sx1|%3y0$q z5WfLF{F=T|+HC4sZ0eHiKLT|gi;MmVigK)uNw5?Plw5aBqNiRJSu-&QBVjW`W6DuZ zgpfm<$mQy=Im;mVOjcu9FksgbbuFx}K0gcD&1^BT0>0x{On1^uW!ioq*Y3rGbFM znJ$J91}7X-+1S-HtkS*+y8X%`sR#ML3~E1#Xz}JH){g8vYHcJ(6Sf(>$T-=dU&A~# zS#7Opl456W2`2Nk>-FREb=~U-m$07F9ey1MRG4qRoEzGlBVHKZl|p62zWp0<)6lYg zi^$=Gq4}$q`Bzjb8!;0s6C-9&%v>J5T&_bSR5xcSO9VWACA?s=coRh!|4 zl{c>ge#md?k=f~JL8tD5P!bVb*t>`8Bt-&Yucwzo?#sV-hM^13*>AD7sMZ}N=AoRY zZ=-DsC}OKw`XyQQmya3u4HMgSMzLqCT9c%Rde@Oa_yny$B)j+d6y~K6;G6Yi`7{9Q zq#9x~m-W+mRs{iTy9fz5aRJR1xebX5k;RpHz2>=V0I+V%K0l1u0knLC&sx4_|I{;H zQYY=p-zKL&ubc1#qD2a}Cmj{qF1&{`KlR}g)Zz4jMpp@0t1EP*(8RkV>{{_VTY(oL z4W3fF*ezMG0c1q0ztOoL9?1Z>xZSArQYPl_P=_;-(Lvea0Kns~i&9NjeJ)8(Czcsm zX93Auz_kT&wwfl(7f7Z0w!3}*#q&8a>Ucs$(Kaw#7!=_GxMenlk1cOo$SI%8&#Hm4 zgfR3D|Kll(X=goAEkL2HN=fTJpv52)02#7na5!VD9r2*8^qHmXye&;9bBJD$evg-e z9f$C|t>NKmSM@NqD=8s%bh5!6HpuyN?Z{7p+)lIELE)MLbnwEPXnWX~5Iy~Ok-6PF zqC`EPyVvI2Y@VA;JV=y_4f)Qv?19@{7e5^CUFeANliH1TL@E_Y`bcW5Hbv>bz9>^x z;GRmgOX-I_X^td%bgaZp7yi!mTYdcuSR<%9{~GvTHsKYIExMwPW@dJ|NIyBd$c=I# zvHx&BcljQcHzajG3iK$phacugFu~_TmsN$Nc7XXWGeixAejs{8o}~>Ou%d7Yys!Qd zTc6aFKu=6$XBLXNG$1YT5fC)03X@)qBSTMD^WOjW16?7XK#w|DPvnfKK-vvk2SE6w zIY|$3<}<{iW=u#Z1C-zQi64Gk0=+30hM~`WF$IS3!rQ8z&3>>})a%cN&rnTG5o;5J zm_J5HYl4(xjZjrE?`8z!38^zExdkTSdF@I_$&IJ5zYurst*35egqt~_kpD|ZAdE$J zbMtI#+cs|pI|LDTw8)V?jD5SfLj2-ZuJDumgP(Gw$E3BTstPJ<&nqfEspoD@>SjzHe`?Z?ei<$5ksQi4HXMqU7`*nsv`g82A4HiIwp>e8 zU^k0>lK$CIk~yxXSXJPhX~Z<&c(T-C^=f|Ebi><(BMiocxHXh}ss>ZxaAl=(w}1?EvuQ+B3xkvux6l1a0_!*9xEy18gIo*h=E2 z*}2i+G-vKz)uJv9^%`0wcEgkW0=ObKg#BhM8z0QxX#SF|$aK&aWX+6(zkZb!5A zP)|>ug>_QQdeOO%Ga7BAwo_PorFc|_uygu7@25&Fl{kb+ zW*tQ`1z5-AOLy6@q8Wp@w4ft2$2qWlmT73SOI~X5Q4T4_bXKh@;Vu4<$}a0?#^271 zTZ;vK6|S6E%_5r6aXjQ-#p z=?TfM;c|FuG*wZ*d-*`8Yd6x;bL((mwlfx(>c*%cq zKqzMXM?2$>Kq|h{MqRT*1Foy!#O&%#W*8VqWMgYDKPo6Vb7qL*?ptiw1kDHEw!>D^X@n?c(g&840xesg{{)j%vY7@B ziop}22_yms{tI3;4!^6u!tQ#~I#rn&k^~81PZ^Of zp~DGwouLY?9gQOo324a(Gh7pgaXoeRHjZiwcsDu*&)%q90&5?&Y{`t)geF_3PeR1` zV1-)m&68ZjNEecqwnP3E_BWIGvg{o%@u4E4;}`(5lu|l#+Co(>btK)I?BzAr&z8Y0 zZIL&n0CSDYm-CL6vhh&LwwksJ!=iVG1Iw3=aD{vHDAdLxU$E zNADk17r#La$M?{nNuVZEUi4gA=nqGpd@&#kzevX0%E|+Bun}%7eDElpr87Ap7ioRBlF1<{b=0bF_}m*CE4IGHIUgIZH=fA&b;srB-CZWGMZ|9)nt8Vt=4_-2zoR}&AdHLIITi^+~$jr?c9LjS_sK@D$?HS+=kxM=sbqf z(;rU3lZM0t#^Mx11NQvAgRbZ>{YlWr2gHtKyQpTUPoyxW88ok*dv1!{rLbHIquC`z zSu?9_*S~22)~)QBEY%XJ86L~AqLWr;hNIv=>{gWvsAdKZ!ha&wV}k63G9$V51x5df z1~}{Dm?N1-$s~%eFj@l*7cj3e_g(26(M%Z5edo=D4Wz;61)+M1-4Y1|Eut;_T{5)x z*(^&2`VP`A580i)@M4aasFkhN7#Gtc>#3{`y~tAI9W06+9OwIjT)f)4_`uE3alhTn z&pPd2D^o^Aj=y^dtl+ESE4KRt<##yE=irZ0{b|^pLA+r26w%XVA(#4kv_y8e*2TBW zBhE{&nE;Umt?q`uI=};q6yBoVaLittE=R30J;?sv>1WtWO3*X(iC~WBzZT!U_U1q%B5ERn>WxuBU+;X4a{l!(yn;K zR7wiO%@P1?)hxbB7EyOoM9|zca}|JC5g80+asB|wru2n;>}vJ4 zdzCvUUo8f<`>}K;KOptc=f*RR&BkfRTLajS`r=o%i&RfKKc)BwP#fafr(`6qTM2|0 zJy)HiCo>~4XKOtOls5w3t|tmnAA5FVaho2tE{iVE?UX;(H2(Gv{K$mLkr-8x_Zf7?Sa@Z|AfjXQQD8qCMEdhBm{cIGRx{iw1Sd2n-Ez6 z?cReksXaWK(Kr_PDL@t>{?(hl=v`y@+eS`+^&;>meSmJ$+l_uEwihlaVMq8$sBZ^T(;3Pp^)pUD~0^*p*Dap;NuNGYD3z`|G>W;+F$L5 zJJaHh5NLVTQvdiLGU9axAI!S8H$rQxZ6;b^q8zoix+2wSJ++(p*Gsf_-TBf&#BvB7 zg#QV|(^l-`ds@widWt|lWUWpux$)Ou%+G&{?v1~FvXex+WyU-SJynEMajnEVBIy%$ zkF#i}-%46jeBWG>GChu@9OG>}YZK(Cr|W(2am~ez?s;xz%9YSXpZ{_Jg6HpB($33N zAYa5zL$_Oc8i$=c7;o%r#8?tq67s}5{DRcs&Jg6C_4!CEWB9)&PSJq>azQD%;mNE^ zLS6R``4&ldKK89xorpe5`_5=`ge2cv%*|gos~}wR)-`&v%iL{%M~k^TstaDFC z!`p1qT0{_%c<>2VplNroOG@CAy#t8nMV$z||GG$}G0RR^SXF%uNWYeEA?0-c2>2>! z?)S@|AcKa>@z|pryMNj6XG9LA+qAKPS>~Krc=MA&ZHBbRvSgtkHiRle+eZt?JIc7@ zTY|lFS=r&@i;{)&Uf>2VW67yN;LTlG+D+wGk!&Q>N9~19o+oD?hZ^lfOAd~|uQvCf z_q&JCMg}>M?m?&4MvVHyL*Lr&sU5z~)DZO~rYGK}?qhx-BTD+}|Kuj)DAmjp>&>va zd-c#LapkR6&XLKgLSnGysqAHF-&4<~#0Yv)Z?Bowi8g>jYvUHvvgpwTm&=cfFz))| zK}22w6sND3XfRv;Y|I&?0^*rtF-=FLQ z+1?@a{QjG6czHs|c?=Hgkl=TtdwR=0H72ULA~z#xzOOg#Ae-a7kpnESgxQOq{w=jF znj95H2M>mbwtGYnCbxb)|CwUcLD8Up;WN=us`E4R>1JhDfDdu4g!hgvjx=;r$XYGQ zY!uIr3Y`t=iv2p-K(3G(f^Q*o-twue88COPU@M8vl3#gx2Y=}OtAfh;(h^pc@NjZt zdR&rhK{w{{%Uuf;an8$z-1yz6#m^QMW#S@Evvm(qT{o;D1#1=7w9j&1EStjkmaDMp zy*qgKaxrv3M9LYy=L&s?0^qu@e1&LyR zpM@h>tFSs(=v~MKAL@~VBucrz(T6z$?S^MgSkxZ*S0K{-5y5^!;tXrfTuTIz)vH*8 z`Nsx>_~?qSSR6d6J!3h!8XG|y;ts*9$s$ZsQYn7kn&6>aw3|ggL*>g3x^iTZz{?d4 z)TYL)DQ)F1^N`-u*X4`Hd{PkJxbGBn#I<7EXjAC=={fmsmgi~CP=meI{HV2i@o_(W z!W0$FYh37N^3SYOfq^;plfbOO7N!%*Sm>Snf6eCCpyKN1U9=&hm@Z9ue&V{}*It>- zlX3j8uBbSsjMssa5L5W4E6 z>p-#?X6UMuMI{*5K1!HNdXvG8ScE@L0jy@mwB+6L1$%#p>dfxS*3Vrfxi^!r!33)F zaZ)cAh9};0zcKxA4_B;Mkyr0zI&Z*t(c~`OxC3O>=No!DBlz^T=P-sqWLXRQY9B zFiB5QH%C}$3g_Ud&1#Ad8RJGNx@i5Ha9>ZX>%m^8C%!b|egZvtGHHRXUQ*`So}G@R ze!&7o+*Nh9iQGCCL}d9OM)uCX-)cjvZ&8`h*CfQ5hRu8-mV5pbeDOmBO9CGG*uCj^ zM+vXom!lMR#ZiweS*dljh+H$oPie$_pb4A#ErY5BBJm#*}+Xz<>ki~7Wm&Z zZ~4INIkC1hTx92let452eQlm{^mK?*5bmzyb6DA9h~C%1BiIf*=XT0tyqYz9hMod! zVA4<~vSi#e_){b^xJhx9g2!;}3221t9|&vysPz5>geIA7L=(9f@kW`x>`04Ri8?01 z-^T%scx&@E&peS@eSOCH-F%BaT3aSbMtp5sWj)@N#Q9quP(a9okxiL`!IO|7Inot& z+|{~M#{P>=V)?G$Jw^UxM{i(D{g~mzl?X_jf1SWwQt@k~%G2$VoA-<}PBF0KXfz3) zOiV13fH@-X3%zjG9XN{y%wj!yyZ)cDZ87Z_rL+A{+i3lSZ)J}kw2+@L`%+6SSxJ6g z_y)rX-5Wr&q30y5A+eOfJ@)hV`pv;>H$(E090Dv;5VpGbh?nNlGatgZecj>$k+qWa zCdSq;d5I#cL&3N9!+9AcmFU1{)Jf_&er z!Xv3XjcpK-&ci(qUFwDl7SVyTX8#NS;vpqh2Jc7lvK^ZPct7U3dfmyn)v1(To_Vh3 zyxS6$4Xo5M!4v@51xp*=HdY=$VcML@>a(9}Uj(RpepVK7e=zjBM)LXjEmrjjkA2K? zAlR|Dn~exxZrL3>8WFQde%|%$6a!3*>4%>clZzJhKKm`x-CKzskU|$#}|_>wFF44!m## zA%hsAoz$IZce&@R9p``6W5$O(_9RfjvlkgK2_R9Zlk?(X@b0W^%5f^U9kjH8HN-IP zNchKvuAi#<&{X~-n_;mWYvuX-CIUUw3fUpN_I3wngnW_29AiM}%|yJJxb&geww@($ zJMco0x4=4}4`9wcXnL!!g+3{Y!{A?Q_{Na6Oz{udLa`d}ya%McZarkM%>F$&k_B3^ zidjkZ?Hhdp7RK(-PwNWs%OxKZs&^z(|Kg=!JTyGyb|Y>n=cS%BZ}(xx_YnScvPC7SjSf) zehz&+>$qSKxxwhIo=O=mIW!g7tT5md{~^?9wE+p>y4MUG+a**m{;m=i(@yFn(au~F zb*7#uoff16>?(6QQ?b{#OJMheMR}oQ>A@41vPT98EXV8GVF;dY3>U1C6*0y1#M%z2 z6c29CuWc{n>0UqeuB7XJ(=hoX5DkSsvqZKe--)XeoZSGGgh3JQ8){r9f<`s- zMG=i1onBwL)5W=-H@VUyjjx}-&hhdu6ocq8lgPCQeX~zApW1%P!Q^k@rk4 zA+B}Jokej@B@L7cooz@%!})NV2jOobFBPzuo8=db`3T1E>3)p6ux0G|^3g&{V-dCj zSe0}Uf4kE< z?X64T+*bZ&cN1Q^sJQg#2@%H^RTJ?&mirF-kCY-=!bxWmDK+39RmH3yvR5KC*yCHS zak~GWY{3hJ9TZs1*O|rDmW49aZ&_wHBOgvF6#q@ zcUe~v#UhxWPABlb9gQ@7SNbgD&9~^l8EsDbf8xv>gC=2XF0mVe(g;Fr$^d4RuCa!8 zPrjphNYxd)@TH|aDL=rI$Ed`b)@G5E3mB>T48$F5;IR13JKy&-YP8)k4_ybUrQ=(; z^NqH@qm1=9Sj?_R7AE%-Q4k_NO>8fT#S4!y{rU*B=#(@XnTHGbhMES3(budUT&wZK zIm0AqQvgNBUY9&dcc8Hy1?}H@Uwe%|eIdSlFG*i{>(iUKf1((Dh$YY?MxJDc#ExDi zlhRq;;9OriWsP?38#tXMOL8RB=i%Xy{*%dvXEZ+_zuKfOdc8OAi4<~1Nv(~^e6~P7 z`0TEZ0c>*&f`tK6z9$J|b)i%HwjlK&+@rhdZh3SptnXz45AW+{W=!3`ItKwlN&@I>kB(5|+8^EV6Q zzL(*}4qn{#x2@GC1g}Be-z6(sohqjK-5Y7tfF!hC2{GL}+sWj{-AccBdeBg6aZJev zgWn@~;ZcNaHJoSAYG`92Wz6n$j&CmETpS@MuAVe52t>q%_ms>k9-t$r#=sxhDsF03 zE~~z8%=o&o%n|e*(xdK#h~b)EX>azs{Xdx2yc8lfHiU94;=`Ju!uitY0$imrJ znslhqI_#~1IJ-*6N!Le6?@ABdtzEYXJ#wWc*{t=FVy02Z72MBpb+xK_%N?+$lBT)E z>5*B(|K-OG5953lflQeE1f zn&_2v0*i!PO~-`E0CM40m(heFM7-QkRc86bp)gwfL%!}3Q&OWv9Y9Z7KoU;bCT`vHu6)gF;|-2^uIlaL z{cC_r=u-L@RBXUrchsrw!i z9gXt9Q|DxUF;`wdPC_*y$YWRfX77@&9ar^ebjW=>(@t`Q<|j}M{RO!N54%ZUD8fSN z!)7h#6AY zoGu&ZaSZ10h@wwf;rcfabJ#Try&S2EjtiW@TBc9d+GiJUzSjrs9-aKBfeqSiCYmXV zI|#3DT(pGE_G1VXneR8O)J=M8n1xA_RQjwRkixpi{Z^=U&)%DO74g3sb~*G#dWhf- z!?su%m+|Fr4{M8ddkhuA(Q_?7PQT&>&Sb!DVt*M;2(!1C_?m0gu%f+5W_T!` zne&fZ;jp7%!WZ>o5Ffu@(AX62oS8NatQw!2#2( zt-N-g2V2XRZ?4p81_`FDyI1%Ed;O(@`{50td1n|eYV=L^In|r8$RovD{Z_tR3mwB&M6j){PK^7 z(5*Dwsb{OFsHfRmO8iMfVnsBojiby4Br0_0gIjHRQnu#!!>jc~@S5cyI=DYO#;Us!Z z4z&Q3M7GGLIMFY^j19p5Tvo7Vyzs3;8!)%Nxr+8;+zE_-cpl&t$FDC=c=dcmU>d$- z0EZsKO|y>U6=GBW>VC=O1qob=_b|;grd;qCZw2E7Y>e&RpMsV*(XGr+CQV_6(ZP?* zIDJ0Ps8tREa+&RWeR8-&-uwiko}=XZF$D6AT4h_Ipi=G-mh$vO^>%CT*|*Nx7Fo1~ zE~vzf$3YD+lZCw-C_V77$P~8o8khfN)rYMP9c^1M7+wtSFlWqYIUbtoN@xt;ZD}?P zgCsRNLcFD$ITKiU2~BCpd8leW_8ZA@@!>pyut9=g*|f6}v%U*z*fSdgk z8%~jWNSd*Z4G|3OjefAQ%kYljY+bvS zNtk^qvL`uvZHqo*#n!GJPom^P?E=VU>|yh%tX8gUt3?XofIV>yV6$qF`G}HRIbFh%>=M)KEY-Pt-u_2IRB+M9_P1}+YRoXAgV*(9*DK6N~o*k zy?0KVDfs2#=lK>OW!ACb$gSN<8b)p5p6-G;(Db9&T-;-@cx0$w^7|igt=k;qEBcc| z!VKHD2<7tf!wqbB$6WWb?uY1i*R`u)Ha61?X9b|!zxD!}+9%FVIU{?sdV0Qm_ z>=N*WIxN>_TL+jjZ^vVzvxuC z?wAVw{`gB|hF5RA`X^>E{ohz{ZmD=P}J&*xtqq zo*Z#Q=6a;w=@RU0$Vr{#gm+H#C7NmJIrTa|Rn_pc*cAD zGJOaleBE9*++Tk7MZ@Hm&}^^}V>6@?!zyEAxNzUe7INWApK_CzCi>XezCBl^YX_Xe)k z@@SlUwNULEnO0dDib4t5f4H=diN8OzIkr?1{WeEYtHpdKk*jf zZ>x0ijyFb1Lqx&^RelHL%ex#)l5W#EGJ%mIE4X&@M+;T zZZfcbc)WD(N&PQO-_E3Ue9#T`QOL#BUCrg(USu&V=Phh~jf@aEfhb-fg|GJJWWwKl zh+k6ce!}?|Z`5r?I*#(i_#(ADk-Y%%cY0#=kLOS);oWyS9mzQ3*mm^~7ow|dj8E3! zLZZAA*}8f}M`}Z;_1g}cLwm=iAVgHaC@-seWG?p|vRd;AHJwS>B-*jcl`AMU+7#TA zLvwM(E&f*>p$~E^OW|9MJNeD#b)`c;-LHX7N4i(2k`E5dvMyAi5u8pWa~<@8`v-Z{ zDp?CwmMU=}>N`4mZRYZ)Hf4hiZA%R$$GGRqFXQaaEXt@Zrx?8i!=yAVP4OK($EoC> zqs;H|U!>F<+aqljrqPVDo3#I7Nfy7+b;m)772?l&#Dj{isG5@)<`;XM2G5a{r(Hwv zEHlCi-RSGEpRSzRnflLX8DG};%Z`nI)Qag(5#R~tnYpMr3B7J)nv)rv`=F}!VUV~J z!oWne>RFG`(Cq+=fz~L|CUjA))|W6x?`(tUr>#cEDusq7?`t;>EKb{A{uaR+Ok2?U z4^Hr`7%abx+S`JbE-6|Pg(o+$jlbhM3b zHV%fQ@IbQ23EiH1D=Nz)9o8ubAFb1MTuD;Rx$Iw@7&#sSSkiXotfkI=qm(+X z=kKe&$F{$bRxw1B41&~BDTuag#BvRrL7g=OD#6|p9obtm`O-ojjA@XP#R~p)8{Z%z z=e5fLI)qNzUlV*3uT+~7v2WO~{@BvxFY1?<%H#TzC7#yBchV+j(u_alUMV*vydKIe zr|HmrRT?pR%obMaT;_sMzX1{peYFDVKT3HF?rn6l zA?|!b3A;|baaG~B{Q*8A=sZH%2K_X}yX)0NImEFo-?h%jydh^m9jEf!z3AN;Vavkh zhm&?S1mS@@FDYFoq{3g(BkuORpd8|{Q5^Mm#oKx_?x4@RI$p1( zAazA4+P8?qzbu%iMDjV*?KL6ZI^D&S~@)X?Csk1p}X}PFZ(+-iwsMC=oUHlMj?PVLn@UFytL?UintlS zg^FSdGE{ljNn*|~tmG3A+_phvUEl^^zXMi4`WNf`*kfzUSn^+RCXm`gT#wAq}9#BxF#PCY_w&#-tbj*z7}lN z3(;mvfhw`j0`K>vrHJ$X2sJD{*vxM=I=O*~a5*rdmFdam#zA3pKU<;YoWduzls03% z*i+E4Pex#{$+o@Lxf(KC-1?pgtX1gcWdxD#-3EZ)`fsukMLAab6XGl zD#-W8$7!*mY)^w$+7e+$Lhx`W@gx9aHHYV49FglYFRsMoGLBUz!;@Ika?D<#*)t(S+lN=}hVs?!eC>WerIuI8Sh#*X2XB8C~GY zXbyn|^QG)uG21$?N9&lVdoeYxd$lr-qS>B^eu{r&xyJM3f^IGrH-%4??3r37hrZ9Xo0ABs6h6thYb9X-EKiM zf>BSB|LC#)MV$7!YUlT!g@vL^(UW{0ZR3*}_z7C!IJYu2uJxdC`WXH*4gnXiVwO=g z%)eg;$Ey?_JqXL+8Mdg~*|SjR?{>4k6~XX4WTfK|+VPqaeDLzmvgS+r|ha65WWC!(YR>raN%%+JIO7iqeW=#FU z>fbU;s0Im9AnnBTkt7kFgtxtsB6_;%Vn^U?u9QKMEPvh4>|VDl5WWOw^b#;LffSn0 zcDofHbVij!R0wJK#+TuMeBCDW^U~v)8cua$JKFG)UODse1&{U#|MY?N^pC%1V=&Qh zGwdlHV{NIkZX^2CU;~7aAoAYu?UMhou(4~x_eekD1^#6N&$k(#uAW<8W`2SNY=`q< zX`;B4N8Oi&)ryy%%Ou$WTkSCUgi2Ji{Tb1UcTpXrS?Zt4ot#`Qv#RT&o?c$F`W~j! zU|WklipS_Y&(Nex5NZ@_+az?$Ij2y3F|%Qxm2%RzmZP>-;6?R_FiDHam~s~7yWC3S zLc6@33ZO%4fvaSyPq1`7h4and`bk|7u&C`$?X0Aax-X?OF3L0mGsO&WLMm?Zpbg`L zu1>DDPKo6vrPekXuX-Fc{8WXE;o%FR+OtMnJ~&IA2k}DE*;{v|1+@`R^$g_X$ekKL z|JJ@e-~e-YF3q0wjXlkOR53nJi|GL|6&0z_r#9%pg^{iO(P4i36B4VM4aG9}cK-VI z`uck)Xh(U{#|Q~;6^Agn`;BRqTnnRLb;^m-n(Iypxnroak<#Dy!!2GxRd6m+`u9au z1fGJ?<4)f~v9?UXsg(6QcgEF1C#oyj?^1ptlZ zKxh1r&{(b25YVYh(CKYV*s$Z+Z>`ljljortT}$!1R&tRm)DUObHq3wKX!I=z$e&E{ zgm`aihUE3ir#;v4&(p$Ky3wyaDMy!3(Pn$5M1kor3f8>VaT1F=NgA8>v|=_TZ&m`# zZBT(7;(Ku!+p#pA$twzkWAr<$1C}*|K9gqvpruhddIGuBTWoWOM9IZAUtbTa#>Z#e zNR7jjs=dalKX&#E);dalfJHJuJQ}50ya(U4x_!OFZAfRs9k}Hv3VyMqTj!L)C})=l(azc=016fj-7p+)&kw&mNpi)o#FPiEA0m3 zFYEg&Dv~xmzaK5*HgjF+y6^K0RL9M#xX!98;RhK~AEI}7@50|Hp0H<@@35=9&$)B3 z{GVmu7d`!-1wc5S*_eGP+ApB0GiLo#M1H5Q`-UB)HnlB|n3I?SAZaWX*01%+SyGrC zvGq%<5&R9z;vPJ(MZ?n}d-cUr z&~VuU;K7@Cg=1&VvvRpwpYlb1g-?(*KxhA#t-UvSf?H~V) z3M#;HJ^)s~MkiiR#dP4Ge^(DSa*))snWCUt%si~YSiJ@P3K7$=w<#d{O@$6NX^tRT ze$^%Q&ePZB7kDBR#BA~5X#tnZGZ>j&8G<0|Uz41?@;&?T%ND>}v&gKfIldlx zQ_$U;d(unu-Mxx8pNaJH!pL=iK_MX#8sGMUZb?401svW#e|`*8d7kn`MXxStpv>{N z@lV!Y_xTy$u``K7O`27c-G7!ZcD)t)y=Qus_X2pg4B@0p#gep{5VKubq9;@E03)=L zkS$d44O@A-xnWb`8cMz#!MWq3L3+yf`;+u@%l--7Phk1kfix{k|h+Y^6YJM z^W>u$fbo)zN~ffuKW@|b`p*PuD=c8fX6^_W*~C&#TsOixC#(dF(rNJw*Z@PD{b+oz zW$YYb8U*6CN)!*3LEk!+M!&zH=`?8VC$sx&nz;twOU=@pb}BP4Hg7B$>FrwbdqNdF zl{-FkOGx>UU-E3wYM(3D(bnP3o{PQt@kaN(^WDfw?J~%9;yo+a#29ug+qMs=_v^6~ z4s$zmGWEfVlu=}%lTovHeBhUUqs7S2p8U<7h70mXf}ZQRF4F<~0JVxXuEI!hk5_Hp zTrD`A=Sf8n-U%$_)X!Fn{`t>KXFrv};=RJjPcJzb9UT3-CHEiQU{OC(Q6DIZh+{cq z&ti+>)sDa`D)rLvxy9n-ET%6AqJiKR8C)aXk8T6#4eGxPqc?cnOSJN63rwA5m6 z_rP(@(91kE*bW0I(}iI;8N|3rZdm+V;s2uwqlTaz@;McjIX#Ucx6hgNk#`&7%BX|0 zo=}x8d@eFG_M>)C)cd8&oT9Ih*}P~NVMgf`^+vM?aUW53Bar_J< zjGWq!5OOz=cuKy?iZ=O@V&rT(g0XM4Y4^ZPFGgQ$@`|Nvk^WE>9@7{kf@1FNrd#|brRyd~j5{@>_ES zJJBPa%m?3usB1s6re^Vi)O*nn%0Y_8d@H47zcl7U9OR#Yyzp(-7W7wU#%Y7C)T%{n z2}5tp9LPN%*GOihy9J|`N=q|M{=B76h!$jBv-(g|Zb$pai7GvXsi}rAHtMTvQYKbK29qFM8&w9^aij zobBtx#UvZj^z|E0l8f&LyG@Iq9IIv&)8ZGY&BJ5Zd!&g2X(z~geL6V;&-oX>sKo|SeYc3SSZ`q?8p-*fQoM5PkCJGXXQ9n>`l{+o{ryAN3(B~I$W@`taOtq`%!0usYq*WU2Xxp zPG`K(1N9<#XZm9_`#X@HAkS^^p~jq9G=H%Xs}I+j-%It9n}=$sX@*%`itM~+NcWV( zXemR@*F`gb^dL2+f;UUl<6j&TD?0~CPLJJ1IjB7FSrzl*^XcE+&Wj_Sd_PEP`fT2R zmI3c?yXg>bNQUkUM&JSN=N~nDtP@yJ`DUeV8P*RNzm?I15oDWZt*5ROJpw4plXfKI zOha3<4Jg|w)s!<>;ZtkvjS0Oa*e<-DxIJ=H4|r`ZrUzGBV>x|}Ur$=ZLfoof{ahC5 zSIXeqaS*BUlF$nFjBF$pVL;`tJ>MhsFriD3sh@`$+IYFRZMn8l$MQrJ_7B*1s zJ`6J33mC0TS9xX;18@34o{9He!D^mPm%;33J2tgj`BDoV=&z-h-mM5eD4>OYwRCOW z7DbIW+<&o{FLpgHQe`=hZ?H3CDxiE&8Pu!e(aabicXKDET`K@D^lMZqs2rTrP`cwt4?OMN zT1FhF%g;J0@EM7A2R;H(N+Tv-zgpSHK2^HOkH0%2!8&*rQjK`{SVd!gR8dZ+P4DM{ z_|B-r?oa@x!~8u%Bi4PXiCMcfc*&d51RQhw+C>rbG=QPgmVTx5gxaJ}gOgdQY+7~; z>c21YRh&<6U7Qo%XoFIlxn*l$y-fYVYX~SvL*-{?++KtyA{4NCP)>iwX$3mB(FJ<2 z78DY>G=jq_NyUURf(FUr_l19Yb6O{-vZhwfOpX5~He^TdWM-((a`$EAS}NSdO1BS+ zy_wqihGb|!x^t(~X<*?Mb=4H3KF!8@Fp7L5GIGg6nkDtibuQOey$68mv;3h!81SfB z)w|^j*V&S4`kjHQ{ywj2-M*EoNL|qO8^WPw)@74w$Y}y`#Jv(OSG{9qESr`uV{vFx zr!(5G5Kt-bISAMG1DDA#3M9Zo-P?Ugql)Vs3(NO!**_o`Bxiu$li=7W6vd7n7Eas#@4 zOi6s9N2dO^aUh{CNPCaMEQ@2Mgl9dN`O-lD{<7xQdqZw2xQ$*`Dd&-KvGU@`CqYly zs}p*x5XB{Yv^rmN_PWIWcf6%-Dap8k+cAw~mYaGSHd0bvs0hd-f@LZCASVM1qt74t=RwE4aR{TdMcU8fjG&fY?0eI>+6 zZguBW63)?+4Lq0E@@v5pT2NHP4w)(*AI2p46AQuQmGwn+5AKxb zJ;zJMr=kOG8BtgmAwfxfI9Y7yna%?T{=$@C?gmIeQbRT49rvFEGyT6nheaaE7JXh) zG?+f(@DTYADJ%XuW_L<&^)2*ExET`Lk_E)9`HVcI4Y;#RA9h#GWaHS4thRHRTzoRg z@L=doWkxnT&rMt(o5cmCQK1 zmFyf{(+2dEu7`?gB3=hd_vJH}J4}_#;8SQ$J-uj-3X-bYuh}xBdeq3Z9sIsz$=0&D zCX|WKxt19Nh-3)pAkEuQo5EZEeuumIw_a}go{6QZzB^AhLSYj&<{wwEmS~Zty&+B==y@a@sCz4n{Ik-})5jbk)2a$iP(XT9UF7kW>LJUF zPftnoG)sQg6!DM&sOsM2KMPK(fhszpGW0Z)>f6D$FtICOu{X6RNP40VLPEofu+=`9D6|k zir%$QQdYolX~31p8DYU$`n*t92L~VMYsQ#Vt)*$|*sp$x_-G6MiHOSYhi_9HN2rLd z;eAs;fTmt8`ghbFFn<=YLaV`LU{%LHdHWDxt^#%I1q0^MSe&fl0DLS4PzH0*f*zMW zHN;UKcc9XTz&dBF<#U+WAKbeb$nW0GsYJGi8qj%jn96Zm{u0ZI!z8sEP3NDjr+$g$ z_~%RQ-w=13eXViHRfXZ0gY%dspqS#qGQ3VuITz{2mSFus@5#pZxQS5Df0V3k4QlN6 zZrrZ--wzM5)m6@@yJXBeuwNr_M}nm-8F>m25Zp=;Ls)M)=wRDQCJPKQXFMyhVZ_4R z0@hZgKjy(F;S8#_hzV^I9+#$;-aR|vCs$eb<|gM3;jlkB0(iT9>^GHlyrKl~kFw<% zyLqFe1P)oL@y-yu{LpCzP@CbEaBRcQU!b2RO!?4 z1>s5H_M9$XB4k(~nV`c?)M|XVl+#1(j(%>zNM(^g336}U}bdQgyrEN)OQex zVe%vt(<4a@@-c+-UTiM(tEL`K?BU_I#=b{(om#6GDyfc#O}Q_bPZgst3rf}+((8b2 zr0WE~$MMjEKL$eXu|3*u2wKi%ohOq_XfZj<5zXb%zNZr6p_Vm)Z}u7coTLSgv>dKk z)Zed#gZTTuyzOAUzsyjQ@kL|##N;J_O!yifA_}~@6Yc=+gDA4%-SvM|KfMHV7{Lbt zhZz(*Xx0!ta+DSI+NqfWz~WK%0z>?QM;YB@k|#(O%L$u0el%0QYl*ZI zI$U|#y&<~dwDK;k`RBPX<}vZ}8u9on*>I1DjD#_%Q+Xg%Ih4H~G{Z)&3g82ddIfxs5twVrjY zZ}ceLUdgQeA|fw&lGN);CSu7L=wZu0gB9M{YEaHD6wEaHM5;Qd)!$S-Opu|FsEs#v zS-yLZzfKfK9{vZT1VF zeU%ewr7KQSQhD}@E-xKX?xrI1l3IxCuh&BNXe5pJ(E8j?(8m?2H+bOw- z^ADM`m%#|V(bR-aMlTlqzcSk^WUM==lGo;xyy{-Wb&X?Z431f=xNwQSebXPjkdbtc zDgkN=hy%&pF6B7H1!qTmDtZe#yI`<8A`bhzr+aAeR%U2X_2ErswG$&8jrWJYY;Dy; zDa%iI^~w2b&7LuvNOo?m-i!?Dl`@@1%>G`1R!Q5n9p9i-oJV9YTV@G$5r>|)z7uHGmr=C%6vK*oqzH(pl?P3!OR^GXkuT-iO-IBWjCy2d(hZh z*>WQl`rn>2q;9x2vY0==kCQQQKg56L(EI(r{WhB}A>3wdQXQl6(yOMgzlPP6D{i!G zygz;VV>~|(ut8Bkb&SJjGDC-lo*_nGgLM(%P~^G?*|;XO&7O^wB7ccgSlHBvW+aBt zIp0ubba=&w5ii5Y$0k(Av~acd{xk3Wv}Df~>i&i8T>FYC2nh-JsUx#02KFA;%{Mhe=`)>Up(uDqo*aR*S@!abm$Q6z*$c$(-%vmpwYfhD%uvtnn z25encY4`pmS8b>EQ{UBs#Q5EFT_1epwbg^Em>~t@?$RK<5oNq_*328#_qaYjo6XI&=C}!iIU-CQW#^tCaXrQi-9j*>=*DO<^Wj{9H{rX1VP6?LYFe8b)%lmdWl*mfIb-*0@vGuz1XC_lv|^UJX6wtT zlF-;!!OzrPb5gM0V{KZlxtet7ksUu#0;Oi9?3Pt8tIg#xh5gn3BPBUEk8Dl@itH=; zem+V($4wd|l>`}}t`+)1-#8~Dr?`~WL>($Tn2cYNi}VzBU1Bb1kj2SI$VoIa1(F)r z=;BnK(UmY``WHzaAr#~qWoMr;P&vux%K&x&ayq-dlTZiQnJJv;PdX2_^B7;o6iR<_9CM~c<4qrp4gxb(1DrC8<=Om}dO-mU zAF7o%CHPfTPHK#3=Pe3urSMIoPvUO_Xu4*3zcC+=eie!gnAT||1w}c)R8T6b{%23j z`JDX)dWI0M-W$&4(t2VIkzNHNIr3pwWGxS=0vX^NW)FjPK3z-;@$3sT7rDWI&3ymk zMh=<;Mnh2dZ*P`iG%2<*i2n@n^F3q5&f$f3j!Vsv!L{-wS{Hr)f-VjffeRt?S8P*O z^&LSa(6NZ+;lpHqC&!C$l7@M)x)#Z~X&SYcMNw~w;{CDYdvS}5I}>9X_W@SuAXN8f zfnVX(UBWyGAi(=tPlG|lPgH=b7s1gpDO&^11rFgz0Wh_3F_t>px^s7dd0xfOJY~}i z!nI;ZsJrp{g0gal#p4P%VGjfQ=6n?4S`f2^4g8x3(xsVez@)8+>T75K=Uls?XdK;| zq_l(RG`DWstT?D%Y#VFg1EZi4pZLo(2nj(=f4HJWaK$lc?Nqk=($a zM8FjX9$(1?HYNb>pM<`2P9Ox*qh(8aqG(S-bVgYSZ|<18bYp}&dQ ztlfcZ^fmP1q;6Gio)!09(NBLz)wq$7`!&f13eJ2Hd3YK4^PXN`dA{NIS66wB2aMR+ zz_a40Z5P#a&s0Y=m#3$`|BEeuc+G9EXFDCa8d`lrN{+dqjUfzCY+QkMo0SJ7&}t4U zZ1jv8M-2BTT=!8;@_vPmZMoFr1tR9UFCa+J%CMuUR6`%xV6?GLD1gF&w2K+{QL%B8 zVdQOhNpf{1rVrtk zlek)RYsEog@74@>`g5KKrZ0GB>KGoTp_+vwO(@d&;V`Sp%x4eDw@uYIaukb-`BnAp z__Y2aT-;d=(zromfx35EZDBf+rX?-hfypLRZ1-7lfv4tzSiLCjL_RJ>0Sa|dw{ncQdlFr$5yn4LbdTDiYSLG8W!W$-nA*r!XycT&)c zQPLFHZqUx%)0--_Qv^x1MJMDa91IwT4y@H7!&)0-15Md>lr}x&Hx#0$L&@P~)3^87 zh8!Mt`Qjvh3y``)fwQuIxh<=JMzo)i)9;+u!f1o(-i6iCp>%#fV0#hFzk#LfignEB z86=wAryH_d75mF71m{M`b>?%NN_w_Bopju5f6>3k$`2TUt3@cw`cC7Tbqx!3pArkc zhh=~GU(GmV2de8PM%})rluTEq_7BYt`iVg-U!-c_E%qtqwbg8>d)NT7wRPweh`vzD zAZqxCakrEBJ{Z;VA!J%PUGJ3w+T=Kd@)8N0f)MoEmju*SS*(MH?;q`Fk>yPq%VZbY zzOpOH3^ds~q(Bu|kEh+qWztr{cSTUkUt?LzSM-uddJN+M9&ww_P zBVG-bd-j^3q}pUfK3-;J$guui2SZ?gt#+MeTaJHX)y!z*`+ke>m;O|R@0c^~Vy5XR zhtKd~(B2AFw)1lKbzs86vc>zo(G+}s2TSH)`&nrvSTpzYk99%&~! zUapHm_Gh`W6o9Ic&H{Sv?-}hb`bF_!7hr5BUEdudyptIm_{c3D`KqLU-66L|`VAq+ zT-nV2F5YbYzn|=*2>u6c=KST=_^?A>Eo^#f8EzN$Pju(Q-6N z4LMY1q_TG>H=mw~GRH%-1@rc@V35%9bm4f@}$V&`&_e|-vlZn2SDmT}}EL2kDvfq1)y znOcfzzO*)pwtxXWEkuq9jeK|41 z11yIp5xlv_Jy(S6R4TTS)}YsLG=#Dl;6Fm5*O0bQAGApmNAh$@^+`V9OAw+~2)JD6 z1HO1cOfFe<;^%iMTc52usE^8RGi4>jGN=e43f3OhG>^`utr~ni`5q~#L|(|xnAAZ^ ze*9_!d;_ZC_`jjID|5xggBHc)XIcO&zBr~nA=~$V7=ST zInyi65{SRsawGA{lQK?YN31)=P@r7SLCimL6_biKWbYbC-c@Q{AppIXx4o(t;RMlV z@P7v;5QKI-OOp{}4Xfk1ahzOh*|=4#zsXt~z1)qtt!7!qsk_5PVXp?D28QYq6$=8F zA8&pG|1Nk>6dcF8^p}+RKJWPx{^uMS%B*2<_Usp|o~51@Oao}DRS z(MM<;RZ4rA44i&bqim}4oM=A3nQw7y>&t*@^=~+AAYkxl(ARsmB%BB0p zZmN4NXys#x8^3}K{|soUY95r@aNMq@f4$O9H>?>_K^@PJlbf`YsDwM$sNO5W3}6&1 z2wW7>J{H!mnRE%zrbTCL#4NOZ4`E_VItk^w3hKEuwH~tQE;z6pmR@4@1VEw8IescFe zSDGae6K#JN{3rggR{VXWmcrfmklLM+T5QOXTGDOKLDD~^-*{BiUl$OF9OP2l^^rF{w4te9}mt!HsPpz0sc+7WZbCDS(MmC%p z3onk+l~_p_SksTYU0JGk^A<|G4lH!LV0}&DW!)6kxw;|iL#hl}dQ=NA zj(whg^@Oc?Aj=Trx^_Q%m##Z;c= z&nMULpyfnmke-33OmZs~MEC0PY}E50tEEvo@~#lIpRYl`&#}IJJDs!*_GzNFTc?9T zntQ{V3jw;V@}5M?qyCHSn9ZDtHPQ(tShb`Me489$7{q!}+|WW5419#FkhDIPJrY~X z!)%t?^KC0ytPY_TQ<#m=oG7-yxkU9U1A43@0xl z+1GpN^Nqp)gSsRc(8Ga3;e51DSwdq_GLz8^9cB=H@;5C6hwaEy z1%CXc|H5BuMGJL*qZ~qN(B{`~-D5JtdT!_gZ&87ufyYo{RSZr|6b`2QRYf zDPtLiI9#&|INYt+I&Zlh=lnawT1fYJRIE4D*f-muz$c(WxkXQC^*MA?jBM1D%C0^n zE~L*G|Ac7TJ8-KSU&NxepN80S`GqX&EG0z01>D-sLBEUIsAQ=#o3jY#qdQ|#Rpi|d zwn2)lII^K$;>}VC*P6F^8U(a300u>n%k?nxOh0JQ2(*YQ;hZ@JRwmV(2L^1!v5-{1fcvJrbM0oLBZ4IY?FY0w zp|oL-p%qMPSK-uv>E!M|%A4V2J%j`{lgrI~wVyB(ED$rn3hS?gKD^Q~A)QaXnDzel zzv3owu&wIxDdv!!^T+U2c8~xpnLGCg*M1)h#)bu1>DDDH`~4xfElrUogUhwDx86OX zI2G?I&>t-mIat~_@wwr?4t+zvDHBdRuaCqR0|SjwBu9_msc#EDtb&<`)9fI12Py{+ z?Zk1t+O)~EC+s1!FG%ObYDyNmtnR40{sd{FqD~+1NuARU@dogK4$26w*w@U^o&l9^ zu{P%I9#)FWh6aDW5FUTj1d<``D6Kte*fUW?##jM^$uPXDanIhGd?zKUHzF@s(R6RAP)rBd~+&OYjr;0>g>|@)I9G0sV z;@QF3qvpG>tS1yIzI}G|*1RGXcJHZ%lG->2vAZz_+vdM1mN4N}=hzl-JFK6agC@Y? z@xO?{kj0u;XwB*s21!YHpZ%VSs^c-Tz!)DqI3uQb-neSqCZymkhBSPJXGO(e1Dqcf zN{CMP=_f9tZ+ltYS*WBM@x z-v0%2Y3Xa+mlzVi%=A2{E%#YL{Q5o)z$NaNP?sjSbQdst7Z0BbO7c)fs%xhB>&}L$ zNgzhHyVWeRV)wnqM&_;Zf=EbvTHj6aSQB|ldvb7Sc`)==pOXf&_kF}~xhQ*Q&z7=v zbrkd_Eif~$bqZNFd+|c{BJ)?j$`>u{u%uVThHR2A0fWkYYWyVYBGeLTsEtTrAFG+0 z_w0TMws4QVd6^&5T7@bFI6W%H>VjuoH9`xr&;|oGtZrL&qF~rcMfAI!hr3* zHQyx02TvIcm0TqKhj-2OiuG@DnW4husHbM5AioYG*>vWZ0aniJR?;+Ad||2qw+}%F z*so#;yDbf|ftCd>d=eJQ=AJnu@TExtc`84H^wy4%6GMzdoiFGzY4P4#&>#sH(U_Dk zPq6!``ZyE`l|GCz z;oi%boRBI9ciY7VEdC`!an1xahnYVDphSO$ROxgO*7}W!Tc#G2$IPHD755b~w^}hq z;hB%cGbySjNl{BhKSCI3>-FYILXEwx^*zjyT5QxB+Qewl{P_-b1R&2Rb~bG1?peW6EjkxhJbv~{1@raGZZ(ceg#|&H{mUd&;ZyFvkB+Xh)9#)=Mq5+} zPp1Q;Ul%gCZc1of{A~sQSIy2IvBzQySP^1-apq6y5Ro^olZ8X|=JX8Rsr~kw&kH(0 z8EB=(7H!a9CUq9lMh2KdkXCCGg^onQn~RnA{kX$pA=wA9FbjGnDLj+w-0SuXLThd> za&D^rG60&i99EuNAobU3W}j;;bfVXW@p+iJ-#`md_xo5$T|nrt&LKW#Z(=zM1SnK@ zA(8p8cNh;rDHwp&+E3%p2)cAruia{V6gYkzXYi+p^tEv$o5_fuE3HTJs;;#>0>lMF{j?IVgD7f2<6ARcRyRRRa*An4 zlBBuTh^u3B13Rsc1(IV01*gD>cYt|P)M zyCF+B3Q?}>;l%eXi2MkXv%*3?33`fJ^Kq>&m|4M%|A7CM#|dd}T|MUE{CyP@C&9?Y zPacG({03&Rnk$)t?~%JEQX9V7|HXmguf|wciMnj*^(?xXQ1!PCl%l9J!o5~ZOwW9j ze2Pxf4q2jHh)B9_r2?Sz`C1uH3~yB?FQnBhwDlI5t%b-}FRkm`R4+~Vqx_j61mEyl za)Yv+yT=;xwfKS_D;LOH#5dG)*gOXZucJWLW~o7^?Gb#*MyYL2L9J9!(!Sr|A@}uq z$GxwycVWqwy;V`r>Zp*$IcmVlp%U`jpyGIYUSUA<%}ypsAMHk{kRWJ8>@CgKbxaUN z_wMi7V1E1WTOkK*d9H3k@pFQ74J5oenU$YbX3!PS2tQ8g(EP|IB%AwRVaAHOCxiIiI|Wr#@52`B z?m0?`gp^=0tCqYwqV{PUN1u%Nf1ttxiF9| zUguWPz_<-4!2qBVbN+(&)!mpLFu>deB1?!j2U4wZ=sKND5577w0N`#PMVJbhWqNFLmS; z3aT3kHjgOwS}IUB8k1U*6fN?nOD11GnGcQ6-ug43B34Z{Ufuy}e@XC8N`6tcumnte zuerEmTUkH4W`Rs5n>+-xW|cB$*NdNDSPs&!J9h8!$rUx^z%YLRDQ2$Foy=}q5O!pP@rIoS-;b1{4ek>w_5P=d5UM1{ zNrIkYp-49cwihq(R!vfiHZSyUpWJX5^fqIII?WIPt+@%awl`!HL}FI+^_iDXi35+X zNqE36HXRG<11e2bWDVgIBkb-M*wn^f@B>+m2Gz$GNC?+IFkL$ME?gAU_HE`9Zni%N zGZ*6Ajae^sq$Y+(OJ4F`eYSwwQGW3a!)N<=A+*=7inntrJ@cVcFk-hPap&$4;P|ZV zBw)7PA)wNtUF>*vF7sU%C4_B(O)@MbmnP1~wY$}{UdxqK7a5^*;lFzJ5EdXy2Jlt^ zU&M2)1`~c2YN876Jbq~1O!kD~{7$Dl$tyh}+3U1+`j@b4@V8HQeOAj4F#>K+dA5rn zCbTyvd&JHWByU_)-K1U5H6H!CSie-B*nZwKkm)v$az{%kBsc-PiTb+?f)jj^j4AQo zl*AT{x(_jj$VJ>x&oU0!2R%ToUblR9ujKrob%Dt{{U_)nm4+vzyO&Atmz83-&XYbo z(X6!ViBRdi6ZoxIer+lTF!xX`61t|Q9`Gl)>Yu43OEubmbf5xqPVNNB*_cKu|DvG4 z5<8w#gXsi^1;|n#UmA3|S&E()rU*vR=Lf!;yvXYor-B<;>Ze{>A>%)BUJ+O<%8N=q z?w3W0a#-4Bu1E-%<*_QRYZHwGYHC1aNM>c7p9p26#l{=@0DvGWjlBfue03_9TRnr5 zB69Q+J!P6dk_&5^eLCdCa~Gy$u74*mRLvoUCTIp`^d0243AIE{3xy9_XAm^%FuL6k z{)wzOF`FH`XuIa#8D?mwHka1H9yy*0n*?{<+r z6#dvh`WkqL-O~5d(caE*FSPWx?Z#@SvQ=w!8qnp**{=~-#XFBqDfY8#*70>Z?*Nlz$Yww$J$cJhKaym97&QB&$RDqEyVDw|<4DWJU8Gh#{ z^a(-CZ~_OOki0m4m-|O27yEI1>Z4@A(dS2_8;l~hfi3Y?wGp?392z7&px2F^X_(8C zffPGARA=v4XG|%4lN1YR{1FJpy0e+N{Pw-y%k?- zCJ~}KChQbFhR{VDlj5Z5s zK&U?JlVD?g=U1^R9pUCR7KMF-Y5qMGz@7H^MX*gO+E0wF;B^>;t35a5w8lK^SL&`e z^Y3#;3Nl@bWqDHYvQa{lsB__k3b8lS`fdly>(NrrVCpnmHy;ROnF8Q}W=Wl*^R8}Z z4qKLye68n5vHVq#b-AZ}9K7>Hsr?Nw`i8`m2=Ga}vucwI>Cpse$iI}E@aDC4SpBbD zrzFqT2Dy^|4hpi-207@!rq1QG8u;geQ@U?AK<{YSO|64`?+$3%q4bPQ`lg*CtLb;rucZ^5eWltRbYW zq>lPVju~FEk5vK4Sw4Y1^K%Ti1!@EgM%)4by8}FZT^&=L~j!7liRKN)Ydj>V7$4U*KDR93_r0;$IiOj5^9T!rBz{B&0UC5iD| zI$5%#Qa{%J@PurbQ=;38XI2T!0z%N$-Q@NB z@r%+%so{=aA5d4C8Y+X$r#1W05R6z!*8avi)#NblFy$iWp+cphcdm3w$NA`sJO5%J zsLJ_%sx|w`Mt*1V^XoDw1Ga%CCj*vfeZ#g<0=of*Y!a1Thl@)%Vw$k*%7t@z5@&K^VZi?{+;{N73y2O9H00}*G=j|Bn zdP+=n@_1f1htSyfmhA_{_sGEb<^Ul~omHE0KXOkp$T!NrV3Q$Na8DK}nalJ1Gal6OM;Wjais#KF3{I? z;iT>YM@+~1$phC)YwR>WIPvaVzxU) zVzyPHV_JnRoR-)QA&1%8XR2s1F2o4pu!~xw&h2qu2p_%2xKcz`X^84i!O5xiGpPjy zziGlVxju5ijCY)=9om=ynti`FP zMw5C^ckMuf;flp-K*E@@dD8hO&=L(Lv2J)DWUAxEytU#W?NGcG=3_Yx8@FR=;>q9! z05M2+v>YT?V3QUE1g(XF+uIMp*b9@k=m5T7r|tSgqj_NFCP7`Nwpw+^;(;zicWaWK z;GCLjRLca}ZUS$2NNyw{@@0JV@5u4P3(8lV-8b%}*$KuEO57rqlRIAgtV$eCySjWj z)$`+51b*6y<7nstPB3j9#c#E)P2~|Z3o_i0;-iyqeFkyKDf1F#*7D`Idkd!Zi8$H= zFU&BI_V6k&jW*e+#4;zb zxyQS*_4itCv>9)d`sFeU@UtXFNvgEHi$_%3NXo*hb@Z6frP zqC`;br65YK&S83-!yY|$V5i~Rp7#R-zqYx)H-)v5Wq)i;6Q*hc-8b52*c_!iIF;Aw zVgdy2Nsjf}Q*Rc^p52Bd*$l;-NKc-8`hm%-mj9=D#LdbVS%{6f)9ro#X`dq`Q0($A za~O!tTsi$JwNo7%dj6^yaeXYZrEFLxW;I^8f7U+f*vU_Heun#)_0a2MhH+C4iQ13oOE)+*?VH&X1Y81V0p2cVsGYE%mT?$_j{C;$0 z-9!uGaBi95&P%QfiGt`>MdMbs#=_E;V?vEs#yehi^p_jJ@m@W|YD)H9m8_jVv&&%GQxO_1XTE|UipLjt8!}+{lu)6=Q-`2hOm_&I&y`N$`}jPC|T+&T?H3PAyR9HFFs)GjO%`RD~c%eu;Gvs?? z3vC$Ut6tZu9zL?E@G|8^(6wa-qr7tTL_$g3&{!ZHPHP2MYdk6bFrqQU9I-vOp$_v8o0PJiwU!TqyO8UVXtuKRebLn7qd^w zs!dzWhVEN!S9n7F-wndV_-T*an+A}2Zlj7}Jbwb;`*u9^-WAtx^N-vf?ePA}Mu`?y?a=dt;v zBs~B%#lccv)lbG7$$_#yF&jVJ)cv4Q!+FF2(U}Qy856G}-1mrY7>;VKK9l+JLzTw} zey)sMtM49lK7TkL9hU3rIV7LddlbZU_P+1n?XoU9f27vx{;9zZhOrNEHFeHIx8ZC) zT*27c8Jycqd)-ggzGeYw-~rdf_OkHt>(2M zrCOOCV~r^nkke*r+2C1dsAW)Vh>(Ka_#=LCI zENpAnH0{K2wMutYg82|+C1ZE{s1wp%NCxn-+c4MMbv`}OQiW8x&wTbO2X!CTMK!z; zmWHi60b8KAOHqXVq}JWLQpS@vv}|)XxUO33S7Wf=I_5k#GCic+&|Y~YZ2ZvTJ;e5;@UxY={GBm zMd7-v`G1)D%D5=ly1SMRm5@?UNnuyIYYC;LTb6F= zSmM8&=Q-znzwUn7o!{Iu*UVgV&GpB4+{EkaPg@O{AepA^+lxn5fWoS?fjwUKRg@AZ zi2xUYgtGV48;Y$leQ8<}GbBg6cOa{jAA)ZgIV46D z#S>VTMnZ9jAJr+4C4JpfH49>n1+SrOSIV_iNmm=lGl$Y`I~3pOgXG05;cR09g752r z0L0{0B$k-1%36!e)>Zm7Q&5G{nI0}JSzhZKBODYo6=Hc9#$`ND=jRr0#X)#E{yLIs z;UgWQyMF0poz|Wib4RR*wJ8*aNh&ah!Vb+V|Cts4-V(F@-{X6W#zDBR(8zzK<7{+4 zKEc;>;&@6A&d;HZQ8&6^ZGxnE_5Ub~UHN~}9HDV^}96M+?28f5+M zvuV*e89}U%x#*0hxNyxqi5)eR6BxhUQudO{lcy&FrIygDnQYch(_5-`!K{S!w_%8= zUm;wm$i@AAl`E3QD4^ZDCX^dk_a+Y*h`aBWz>nIzXmnV1QC$QgBfXZdvS=iQOLg97 zX-4-Oa^JF)3Sq0hD(Mo=GQ2X~-GdA;GkC&%eW@YP?bC4ZO3&NybMke9mD)T? zxlybdXr;-MG7-C-%hpA28Ta)Yx)uv?O%<{jb}$g8L#q8Ey5-%DR4?7k)#B8j%MIdv z4&fQivBy6Nx<}lzMr-kWl7!&jEM08QEOuh& z(jFj4*lIKccqrpBn`-k zAv_{Kh*U(NknFN;+I290LcD60*sWcXHAXJoj=ox19Tt%Lo)NGss?3BoX{Es?e;dp; z7pO}!zFotE{sqM~^zA^UK_wFI?nBATcghd4Gyi&!aNO?)vSjuzL^vHp*Ht%UIHYx8l;`Vb={hXn>X&jO=c8*{*>VSOb!eUW!28% zWW_LIXl=A|s8St@$3ptUwieviqKA<`2|h;tRGu^@7{Cp1$y znE#&UaB}Gf<8OK8#iQHbmVM4Xq%WDYyHl}DPyU7kb-$y1diA8j>TS$yxs(j53A8pYe`dg5S45vsu$V z*;_{Jac51+)&5RD^(IMwzSH*ix=W(34vmAumCWTZ8vMG9KQqG-q9PqC)^3;>Qod&R z^uy@|eSDF=-bD|cIejY+KL9yO$!6yV?q42A0~h=p@I&9YrG$dVO0bJ zW=Oem{(6_3#4A?S(84&mOTA&LI0W2{<10J;z?wm{eKhvI|+0Q z#8hMbIVuc1o*J!WT3*^7V#w+!>Dp6w zO7@kB!QYn4duKK<@`=2eQ?9pgq^KBI8Nuqe^yzDR?%ZVFxK^D|%q#Z~JXhv)syBLS z9Wu-bzx0kSx+4OZK_RV1Sq1GJ$SUxjsIEFTVC-HFwiu4zok?-}41ESb{%swObhQb~^tbg`i z^5sWT?uaeXem*EAN*+h4;W^SjWa{6KBkCyrA1$6SNy(EJ;If+pMzn_E`Z!wEp!XkN zBo1E;x$sq64czsy;B_Lvni?uy0va#A+6qH8RYS`$jnOwPfryW)t&v4-yz*GxSsd`C zKanr(#Sn)CWZR{P1A`6`UEcjeq6(ar^qO`ti30+Pz?{lh#qM4oY_6@+l5*`5Oo5#6 z>Y}Dwfb0Zef>&_T3%AAce&tWSCv&2?%Xp~WiY2GbD9?j})33H~vU2=x=FWAF$2z7# z7=D8#U)t^9-w-YQvA3mpr2LFp47Ab!*yYyaI>K9-xtKb4iW;+an2NA3t#MR901wWD zd#({Q(7szF@jrGz>1j37Q~|Zp=5_w(2q(9K)PIfPC#QvfJvrIR1AXOMUtJJXiLx=* z8kKu_C&VPAx`!y8fz>q(UsVuZ>g3&)_anXJLUAksUxrZSC?**z1E)=3K}+TlYgR+E zS4}W0o8WO|iOW+ey&D$bk41|8f-tr#3F-!n6Prm7dMfARXHXVk-Oe2+AkB}D3wy+y zlmua4(!$4-*qezewmydKejnxKNaAXvKiV9E;?4(vrzKM#pG2mw+V=lX?8Onkf+v$B~*JPSbGq0OY*!TnpNM}CbgKZ&?I%Ft}m7QP6;BNnrNcIMoAT3o3 z9$rP?!@ko0HsY2^szFw|X`CfWPw(iDjPu53F~y6uQn6IsPuJPN9XC&YNFl>e9+lwO zVdo-tAk|?B5xZmuz9PnO#i}a~{#o+g7SQ>f*6?fcH5a}e zd_2~9Bo41Cj%l0h7NL57*b8hgP-=3s%|{B2K|X=>o{^R-TtYLRY@l3*2)30;UR?hG2>*$8?v$^NDy z6R{1%TS*x&FCj{%U7;|4*LJ8R4<9Y~rz{ptGMlR;Bdo_S^Ot`Utk>PA=OE98j-~)L zuN;>_q1;?r(tpxM@relX$mFg^SIf8V* zJ#RL_`n{Ir&M0ll#+2mqWdi3Y@J@u`vzz!J-5pxUdao?Z=^5=6w?Fw?^bKS=5+UG_ z1Jr&!khxZ5?PN6Eu_%c^u?$}=kE!iSWyDv~rnBt& zLP}&rQF;YpWZES_oxmVaV~eKUfciwVWZAi7$|>b}olBO;j=$HN?5okOQ)=; zMeHI8JYGV@|Id7a(i@BpVzk^ z$xV4LO2+EPgNVHL{G=?2tc>+8p}1pG0Lp2B+oa%lUo;iSKJ-Ma`BHG6#$SOrSjsI# z2#&8V(7+bgLS$!tz9o{mzp!l2jup48<6cu@a_ucKg)r&bH?Jz(<_NIvxqws0AOCq* zN};Fw zOs+*QQ>{sRpnEW$UA|#GB4>NduE5PeB_9;+?aE7J?S~(Sl^=!MWX=Ei9Qrod)4Jyi@VFUt_;aVs)7j?4D?^=4@IOTo3)Px_>`4(Y84 zZzi0gm^xNJFQ=F4qdS7osxOn6RW~=T`>1DVfKk_Dr7CNl;Iwi z?Z<2833vwWrp1MmIe2d>5b@@C`B_eCqp`@%>EUOTO~xMOktFr;h;*0XFfw#6&;I@5 z#AHl?WaW&7bAV{;^e85tG-*H;9{c;3@>{8B=;Rpa@`sF=c&wzaOU$=YN67=+zV)2G z!K}Ov*{hzG`K@yCLddhvw-;%oHo&B+EWzcgbTJvYl!RCO4uE4*{qkKn@wz$g3{#xV zr8HFZSn4CCX9(@oG{cDL&YtxMbhxPhuZQ=*4$M3eH^U&E>33Cxl`{U^Hvdi1i^@jQVz5C?_!&*-ddJVPyS=+75sinuT&yL0_|H?%plsS0zv*tV{zwcq^=lj*db50g_ zG&NSM0ET7$M}gUIRkAL)5k5Fi$u5NVtJ9IJw8MCapgYT&eX(@8DzymkcW3NDs&fHm zkI?e|%FRvNHCsiHaOM@$m;R-0h|mqLge<=2>pvbl=0dG}O9}_HjClOyh^gVqd$PAU z+lBtrKy9Lj{Jx7COeDZ4&SOvC{E`+PjJNT0Y+ljW%^TrP3#fnOdCoDs^xKvBfqk31cl<8M?06}tg}goClpC0G?aIXwZlz2$&1Vhpg@8r zq#0j{0Q{@C5S|z3Pwc=B$jnE(lcWM#(PJ&!0^IK!nGuFO9um8!qzEsDScrSI?fKOq z)GYVAWYoFhh}l;^=2;n&@VIRQ@cd#<%}XO&x&*LfZd9Yk>Nc*0x%z10m2FMFlCXMj z{0tFFs8jc{mGVmFJ&V<5lONm)T3(MG{-dwvucjL0uX3#<; z{0%qmU^0!1Dg$WdWBCeNbDqjvjEEkM+& zH`>lgTHN>$5w208!pbDdBz5;`-EO3`P2TUxJdf8Xm7a$pvDn`v5TM}j(n{92osP5lQ(uK8RKDHwskhGdyzdslVfuO-zE^@PvqHgC**7&U1Cn> z=wVq?K!>Oa;qPE2=l(AjfSX>qNySRG!f%;tMlDVuZI`rNy+pKU`VAhOHHiHjVzw(|Vn8>rW98@*sE23V@<%w>=RUzHH`OACo!1@|DG5Ld% zsAT;L3jI?XCZ}y{RD6NbaYuc#Dx9L0+Fp&+cP<_yHlX4zz#H(=NM&8-a=s-YZ{q-E z*Z3oxi4wLXNXTLF-#AP8XzaD+UKXg1JQ@2IBZlK$ung2304~AdqjADi1r(G~eWMK! zW2WM$bLRAd??J2^RIQlg9^_yK8A|sT`Kp1PdiPbtTjYiN!z$Mji+RBVE(<-p^VLbq9f1m)2{f4x0+a72q?17qBCKcSEJ0#J$lMk(&;Q1g!XuR~!C7l)|R z3@K?_aVIb-(>#3wWQDKEJN#?3W3uO-(dM75k3fny$=B^E$B>@GA6KgnuiFW=W|Huk z3Jg(>^Z(#0S3h-~*GCtZ-t0h)=|`1s`hs{G2;O zrr7sGZU|`w+nJ!k2vR9x@{V2%`V6TUT9t(8)zqNbfEx;OIdVE>-J7R#cjjv61iuv_ zq9vo6+p*%V?Fw-1XL?)Wj49%YoGidiqc7OaV}<~Uyk4|iyMY{LJyuUnnZ8qFe=1@~iQ6FRHW{1U)&ZyTdBiZ&PX&tH1RCZA z+lwcjo{jFxl3neYhcQ-bj=VAna>v~$8IIq}lLOt<4H```5AY8c!l>F0y4oHXokOTG z2$ezt+L~UU3)t8JX_k53@2L1s>pFJ>#=?OytoLJRZzkbdO1Z2l!n`{wpV?x#HS4>; zio=k^ty-$(wF1GlFb#QLAIrhGU}6Wn1#&%S>pSCR3Mjc1ATweUG2@6A-U&LHANjCrBP* z;Df+!&uIPWQ?F0^U7z=ROy@ww|D{arjH4#cK!&t_u^V1b<@2vG5UZvF!R(e>z}PFrGAvqP=wlAFbH(E@YfCRd zVD7VD^2dtrOo-@oD%!av2ylAHnH9gTGo(N7(0zX-{LGUn?;be%;@>=dHHe=p7r63<3`y(FvV(gV$g;O5cez_$t!H07wXibG=rlaoiWs}OQeif@Ki8NSAWWd> z-^ig7kmlI3RqTd+A+TK+ryfycC{Zj)_^Uxj&?Va$wehs8o$(2mi9&9CCQtz(tAM5G zEg_@rAsMW~d@q_E?BFb)pLM~kPGQP1Xv`#DwThw;c%K=PujSrDY93#Zy+zx&8EmGq zPQ6UYQdTk7x((%)VWzw_7nd1qezMbduo5&#HmuOHj1>oOAoh&xLryw1F$xA~gVc%p z#odt6wwbmYq8%9{Z z2W3|t#hF_AFXYc3QXz3hVVXfFj&W@+-$#UYEHRUf$S*;ETYpC0hXw7N7uRrAVg1W9g zLuR~1Iq2HrAZGq16fUb87Dc(YTCrl;dg@Y?abHxzq+c+24oYRc)jKo{(Y7+ibU2Ji z1d&d4nsGVjIhONbow6`KK6G0_CYo?K}>2^R#TFY zW}$>$9e5YA`Lk9g>!z?zFsi`RT_r^?iyy6J+vvR`d;+bN-69BB3+hIx2k8wt8YSQeDj;rXecSER}Cq6o{J`*yV^i6V}7bI zfYTI0aXFy(B<@HO<=mEcVYUQwwqs6W5}r~8Kt2|))8{wA2Xqx-2seVdKw_UZgvqYo z$Hbs;xA&ez>8cg`$06-D+2nyne_zI(p#W&^R2M3D740d!RxZvT{Fs+Dp$OF+{*e#) zr<}FshQx*Uy^@Wv6g!UyvWX7nPQeYYXB981XH|sgbB*cuG_8AN+>(-4=?`#^v(CpV zpP)kC2zhh-j95)`Y)yi0bcr+7KB$I|zgXdPnZvv$i8jhMY$J)^2{WH~fcZ;nNy)fE z|KIaA!$&S==+!_JwkVB<_`?9zmh#_Z5)P*=Tg?WLoLFu8r{%88vgIM0$e;>ayBk^kqF4>+4aUz< zLyD@`ICCKOyv<@nJ|U*L?z<&iDmCZKY4KE zC#ZQOPw%Nlet;nFUli@>Kikp#(#MJXaW#KMaox{aHIePNZq^6C$0Zw&$rB#Gs`pX*JO^Cq63K#PyOiH5JQ=rcCLeq z7x9WbVFlL7!_%ajTlf&%20BE){^ok7?o$paG*2xNF5Y@p4#6^lGXw7_gH9ni!HjBm z=4Wt$9G2<7KmXplLptg}`iW27u0=g6W|0?FDz1l0S!hh2-gzz?8s^$Te1x4QUnS^V zb8^q-NZmz^{SJ}2CxwHF3u;ZSCZAlm5oVJG1z&>L`Yhn30XWCmS6J@DX2dt|t#Eb| zzsQah0EuVH!vh6i!aq-4h9dS$aRWJzuVw|`R4dvot{D1U8pbOcf8{%lP?k;c?-Qmz zZ^m64xU-*Vr_NVUqIJms`24|fb@~jP zbq%pX-_Qdy=n6O|r3ahgd!~g%u#+rOwV#;nBOE!Vjk&OLi%rA-+iLk?eWV&bSPwZ4{A=hjNC*aD1=6aio|a+PCw zS)`(XCs_K2EmDc#)SioVzqRa(_Y(VN9S4&nq??yk9Vw|u+t*-jY0PHdUeFPS6KG_8 zfR&H$j^4!};q!KIi&mbe4B8V9eKx5OJOcwW)N!vLH&HXoC!1Eo`gHa@@~Dxf zCurLd_OJb_9yvds^S(Jr56+XByK533*d!TP8mbXzJKa=Zo3f)gjzFMSKngT{qgNk} z%mh4oux)&ZVWnP#6y&{s^Pb`q>SKmt-$MC0+m+28{;_?3cr7(ay{iHi%${GHhmXD< zB5RS{OYR^mUlwEY{tfFlZHTcupZeeVvf*?4=UCLi*};;C4O8lYO9ntjdn{pXWglS{ zh)>Rn>DP~7hZA9s5WT(cT@qRSdMP26q0=nW8>TihH$DAV6`AEGQ4+-oRzyDt!SOcR zjn~9tgzn}CVT9h(4NG|OXaKGp%xgE1Cu)w%pg?OHyst2Nw zism?uO7n|n`qqLTcR#X!-77@>WE6A!j*@6<@>?!@_6wV_G`U#Z7@>_#x&xp$5?;7ItvQCd^kbANw^+|By9H zzc)6NgLv;)T+<6x%_rd+)6jn`@=HN}bTVY_AkKd22EXA({i$9c{!&%7nJ+(Xqlf_u-|M?1v6G8Ve1fI$Q*YK1p8{M~D@js+D%Ihhh{ecClwyW&w6 z9e&?~%3^jJ6?1RKgaJ>MQZK^h=4lftyHrwR2MY^PQ{aa{t9b~HU6G9jGq6Ea=1N%J z)ge)}v_o8QX^BLk&GH5u>-PtkykXM_(DLA!#nq$ve7v8hlOlY;p1EWttRX+tMc zkr(HZO7%sBn~aq61>|#iqv656RE$)iBnaIJ46~zCd_?5|eXX%HcObpH@*U=rARj>} zRnNBwIx@FUMwRxK#HOj4q<9-5BZb4G3Z&CM5shBv@z+vR|@KqcOAywm~~ z0Fdi)DFXNR+{UA|J1Mc;l$OG`hd_5w(u`IF~-tr_5v%{&4Cd+osf5ucR_8LvrC-)_Q580X0wJ-(NLst z%5B$irfPdfnWZ*e70Wcn8g_PkS6`IBr*#n{)0dCkGbr4m_DZN?U5^-$NMXGN{*hVB&ke76dr2&qd$;ef#ALaY;%MTa)-!Vt%&smfx*~r(oT`7C8%lmI zF2w zQ8h3@p~4?sXbW9wMl+XSi=!%hv6=cfj8qoPFn_z~f`@oBf_FU1L@oVqAehrpD11~2 zW{4;Nc9*&-<_kS~=FraamI=t!Gs3IIGW%68YIOLmcFp|}`+2kA?-4u|yDBQ4a#1Y* zVyNb1N%*r8zOIR_pect?Ho-rnZ1X4lV7T^$gZY{vC#cZL=-L8t^p=f8R1RJi?mZVS zcB?DZUfd-!@KPc9@QuymD>1N22>ws@NfRr|VKO!+ksN~sYIozZ=hyhaww=`LNr{kq*xVRmL%rZ+-2kPv-GEMLTz)AS+_kjKGCNT}^ zBg$q|gNecQI^iLugFerSuNA?BnyG~A{&c6tBlDBqQ%3m6+jFdAq{?D*EbFu{`(8dH z&JDl4I+CVvL1^!*tw)7j>e8i3b_4h|U>fdK3A8)w}GmoFo3`d<=_9wl^(HA8&LxR8N;RNC#H*~Oua!6Oa*5BN;p&5 zH#YlM`{6Bvr-!c67!P=%9!dvnDRnqC{)5v`dZq{f@DIPe^`5AU>7iH0;8iZ`DTfH* z{+!aaUqPiGJ0|t#jCFW_g`w<@ILGpkW<4Q|!=5M$p20esynUy-Ek#OXt%JiwK#$Ka zI>^>J1F)kdDN$D<^^NO-sl2R`w&tg}6S0(}4ZdhfawIVTx1Qt{)#6wh+ls7Gp$6^Z zo&blZoB$Wa__5{~%B<7Q{D|S!v2M4^%GsOK#|#|95zqg8*@j_&ut zOX<*g>j=b4@Qh^Yjns-?69s_U`(AB)sZ^5A^GDysUDKEhNk79o{D^uHF&s(Dk>wN? zzWCFV8R{!WFPDi-AYm{I#RDoh{Q0+ z1-*0!tGZhRRC>;U*DQr{5s76_a^~l>AEo+GlsDXK1iA5my-=BmrVq~9?U4o2ULgM{n?fv0Y%pI2ZFI3Ci%MVGugDP+5`4LIa%^v|B+ zjwELRcFy+OMq`r&r4bI_IcM(Z-Aze|?x(Mg2IAU*7z@;6E$$G|SO31mfm!Tj05Qk@uNL0x`(=;1&_Kg;hW!gqcT|0d+I%7G z;9A+VhmH&k_7tO$D!-jdx)I-Yx|RlJ`6x1`QKmY?8IxvSXsA3oi-(N9)}jbaL^!W; zk6Ug&SKPY?0xw(o?VZrsHk8aCYkX=O_n}+!Rl{gOlcK+C53y^NGhFGyqmXn>Fr*2L zg9!k|s40mC3xnV2qWwmt$85oe;hDpfzB1SQDJY*%GE{0?bg~tDhq~eZ>+zJUI53PJLV1>5NPGo4etsdgy)a%D2l@; z_+$T6?N)uX0)Vsh!}qbk7CDSRrI*m3u6>QL&38DHLVVLdaz?M{pHhQ_(JW)SsIXQl z3mmz8khnF$Xq0uuxQlL((870-0L=_VHkNS$Bfe7opu^5hQhXAWAWhvGJ5e!{QRC#H z39eyMz4L#Odg9@Kd9RbV)$H+nW@@@)$8t%wt7TPa_ds1@4s5>0OnbK7l^eWAUmIuc zx|e6<=DKH+D~GfmiHF1|6EEa=!K2#zX1@L1O4?4PR@6%8CA)Zpkk4y|i_pPXwi}uP z#`F4XXX*UK$@q}z$H|^NGJd!l4ppKqudQ-CK?MU?&CI+CKSD*ZHQ^zAi8wyov(s6f z+DIkZU4dYjHglePy(G%*hfv)LDuwF5zx1_|9lM!a8H;53b+Q8f-4tT9v~yND$6%j7 z?O{l!WA{c~02xlkjeh6Y#t+5*-JSx#K@qaKbK`}pif0eGGv~F zwNfTemJXoSoYR>#e(4X#W}ps4x*NJlsNd+Kn=5xPLgFBJh-AH*)L8?S%41gu+B`M6 zys~enJDg9n7vy?Aq)M=J}ysuURA+7 z*YZ2=_5m;tJ)r7Um9>b9(eOHnH4e9|597`MAd+odI_kIfJw9}kpRntE%4f`CWA9t6 zn#(5mr&ok1sL?S2n$N7y-G343K>aGdIsaa=%@Bu>ek5eS(q& zMPf>pQzgthOg9l;9B!fTXB7%?zE1E#IAk5W4pa@(sf#h8R@ra zt3zkb6Z#J$luoUP*?aFr{ zH>i|atI#a4vRp=+_%UIb5z#T2<$2->&P|RD9|^||q+2;y-d@h%TTix>U~*B=}1V5G3%x`DVbxc^c`b&i*sGYM|xfEW&Xi?$C_Yo*IsAl zjpYjO zU1QSI)&VIWgDq1>{3GC2TbquL$@^7?$r-byG69lgUILgUu7V_b{w>t5M>T6iY> z#*$!7vb#?^2WVI94iHxK>@TOV&y}4EX|32x7DV$mN@sDs4@ll=Q|XjxHOLubez33; zYCMNMR$q3HIrRlrWFvO2f6b?{Z!`j|q*(Z$iRlF1`t|titm%BNEFlX5z&hUdk%X<1 z0`^?ts=l~DFR!RqzwKbU=-U*sM{WE1v`Mc|kTqSw$gJH6R&#RT2 z*}*ztE(;sGHYJY|awBCJk^Hfpck?o^$CXb$22rl#$<5)hq46$_22x2@dkv}_|Bz;~ z?tIklcMb7kZN^F43ODNZi2>36a8ulsdJSDRk69N5UUk79=d-wOOZjwxH?bPssBvBT z1Z*`Z1}qA8TddsZ%mK@41T2Viwn4cNL&HM>IR8oP-;+k~^Y4{=IWJB<@wn}*x5;*= z`Nu+R;?5+03C^_M(^!%IYFahuA_T8y38wKp;0^zO#ve<+``j-3ST$4MrSai6vy$v= zf=FzRy8m3Mz!Fdckben}szp}4{*?1Bk>af6WwxRbVtnM_)Oe$;>z*_YR@dge(Otm_ zQqE1H8K@uSnJcB)?%thzG~NYFcj9qM_9mi~<3IJbPn{++5lZYbdP-g9l~ zr3m2(^RGSSYTGlW0JhgYt~IRz{@?Ik3GdnL-OUgKifXGye!~KxfbK4V8*I-W4#>Ev z;yR(f&y-H9OBvTXfu=1Y@$exDy2J(x)bf%}Sz?=O##znjuurP9Y>VH+D^k zv)_N<>4cA;VThewThnqa>0(WmC(;kznB!aZgx>l>XVxm=qp3`MP;Bk*7{!_(1tj-+ zrJdq$KI0|DHqRy1>$%Xx6jD_0Z5!_)V89D)gua#H{X@dx9D38goKpWJQ@q?n^|i_X z@rSBDuPhw_s{E<=jnL?pFG~RTrTrLOJ&E@>8pl1uKPE^8Tps=At^JxNui}sK=K=z% zc@d<*q!zoMf=T5DtxQJzroNoss3?;EqgCi%9pzszIeV`6CHlMF7|u@;&D02!*J6Go zdkbdC;*Xz&SdwkyCXfiMxITg_N`%)Kdy=cqXpqMK_yKgx+}VeOwetWa`lhc528a9% zYmyXUPVOXmBQh>g_(>P`8ze-x0W^)h?@~`ZC4DNb(M9DDvaSk+oH8jJDN4h)EOU}` zeIVM}Wt)wHa7g>dRwVnY7HBg~Jfvy1W#zJgkJB{u?-wX{j(LUR`Ec^a_mn(Ip1O0Z zZ>FI(y5Z-a0^hvg6Whr>K8+PjSn4T zFX@Ns1+^Ez_-|L}ql{tx2H%T1BP{x<7LMZ!Z^5Jlf+t)xH48QwwmSuIRR)J^kiXOQi!|Sq9GRM(Joo9y1T6>(hPc^eb?L$OgoXz zKkpefBiZGq8yd$=s(4IUq%flVeoNW@Wv34X5EyZ)S1=IrVO(jkZs*rTmph4NM2m#- zNZi~|blg#sj0&%NUD$%Lif(6$fWYCi-vVTz#lcZM3t4}gtQ&PkEknr9zUHf$AsblF zJ>*w)4nVTI7mE&yi?EsZ#o-1XQ`4Sac?+;(UY}2}3=|yX{ zu!9baW&-9|m*aqy5wuy!#ah73`YFOMrkE7)Js(}ZXV4i2^9Q79 z$zockQIiFZ)TX(-1|LNd7(B*w)gTfv)o zwY$LKT|;%$_)WBLtdTl3}4XZ z9`CpOkgP)}uME+E-P2jwB#Y7Zvso2vO0`KmNpcaa&^(EGJ=U81=e5#T3bod9Z`t-! z1eBs@S5`K+`9Hs{EL1|#jq~h|%oy*I2ypKub_V<*{Ox+eZf@X-38yo>SCC4+zn<{h z(g6+-;;bOG%bRWtD(sO`Aa|SQU7*d~;S;m+g`mBah#}5ozBX;-_wLv+>VB5U-V#lU z4SwHj%`^DtEAWQclAIYwi;4t-wQVB>9S5k5x%g8&OC^VA>zg(~D3L4)o2gd-nh)Q1 z>e}X51Yf%X6nWtc4-TdB7&iFg1d@0J>^lA3AG~1NL-H_VTS6JKHSw-rq2k{IH53A9 z^&VN{)T2z=(74nsF^nITV-qJKU+0(XU6QW zt>r|ex$ zn43Upwng{HeIZEg0p8I3ZXBv+nKsG1e>`50(0xNLaB;deYG*vC7=nKu0g{V{dDn`G zQm0FrvhnsI+=9%{dUEF^lH^U6-6?wf))c!ov%UL3*qc*|2RxL0lHC?yFIhkX;nl*S zVla%Etw?{>B4f}Xf>cG7p#vNs|SO$@P3jDpZ$wE&s9zz*GpbMpc*=G#gB+>1vtAXR1=w$x-edGa_9suG3GB`+_%gd z;yS-*7(F1NobNg9#&71CvoIyCcju;)(Y0U12CzP1%|n(Z|Kw`?$_Yl^2mwo;Vx~z= zVqG%(e2>Sf4$qRTQ_)=}B44{GGF*5~lOXAr7_?b$*I71jVV^bbfxXrvzemOtDdtpw zC+n6BnQRJrr5TzbC;09peznKyCPc-n(_D4)cSw$>vt+7F@nL#$=V(JRkwU0XV)B`2 zqkXw&4J&|iB<(IpL;gp+@7GI-?~pY-`)WT~d93Xf%hom(ik~T|o*%t``ox6v`;Uzn z`+Q7nQRixM^Cj6`)V5~^!Klfu5%TQ|Oz{iI9TVp0U{}qb&i49$IQD!EvQYpR6&)Q> z3Lq|)k5~^NKi;){$QNdp*!6n)PtGy@3GC2RS?F@@;L?2x6~auvYUCAM6MK5oQz9w2 z`^g!8_j&OOWjb!gx+A5ZXOpG=k2u1n=)bi}Ww4iPn)A5&*w!r7K*GE+5tS3U^8m=- zmdB0)&V+BDrt<`1bLg`7ryjH8UkibNQDq$;3h z(Rph3_6ef{URQT5OMKRXsh#7&EnBGH(g1r)bxsJ@7~EoW+gmWKB^Ie_2b6*<$iH8R z@0)8nu>M#t^3RF!N1X|)p*>a1ZPH_`#Y|l_MBg^|r5vJrB=sD*d!fd5@P}iN=nim< z`)H}nCi<)sKW<(8`Mr7|&Q|Hz zkx5iT=|vybJWl`padmLbe#P6?=UMkez>mFKX9r~%VbXbRhQs>~YeJcQEn@)%piMEQ zk=-BChBOQL0-D{Ck`{DA^|O7Q@&=Tz*cy=~@d<^%V=ME~&@ zY09C1)=yTFjBi>MInP^P&-AXcPw8>~IfIavCU+P1qg0j#4th9RI#82F_LTwn_YNAN0FWD#Ffl)0u#q4Dp1m*Mgai*k%J7#H@~% zn73gNeMO$C?IrM$AV_cc?ld3uTV-|VU*jHv=$bzwt@wftK({~sEb!m|Awx36*pN_D z_8_VJR|H5rv~p9xh9=2k@zhUY4=l?*NACv{==U)xErDZR9H22U56LpRQ|+Zl4LShg zQ&K-0Yaae1YEoQWh~3@`>@FVo3sPsvtLtn!%c3L?`sN5d5U^Y%4`1)PU*?0Quy;4{ zDW6=YF>!=&Zev)CvjD%{1y4KA#yU!|g_4qef9pBZhqRR3WR-slGH{&)zWtT-d9hA> zAem)fFrV};IQ;Z1hh!iugph`AYRr>A|6Fl@M}We8k4ikm9GqX^ZFq01;@s)1ZC)_s z>{-PhDs@FX(q=jT?nu7x7K(H{Nq32{>{&w0Q2ifOUm4b9-1bc)ATd%JMoELDq%=s0 zNGT0c(p?)RFhE-A5JW;yx@*V~kdp2Y5F|&}7`zwW_jA0@a~%7!Z|C(tyMCuE^0u_< zmNq$O7bhlC64WeTQdvcO_sLsjcTrSn_nPb6rY$3F8d^xCllc)2zrxXR&eDJ2r*w2T zs0Ztf1S@F}0hhkUA<8tnD2>>~BH>Qro!oHA8}jvlau5$*uZo+!YSg*CO0OW9g0G?| z5`wt=GQ1$Gxmzm|%zUPAAlVtddTfj>(3P;oICzM^bL?=k$PYSKd!(+3UD*Uv~~eB<;1kH;(0$3C`*6^?7LC-@zhMB3$n{s zXJmWF5+4kN8~>zw4~Yzu%=DG)3f*?Wjt_J*{+BPXBK6F(Nj@jB?YlkBgwPPcDGFaxgjr0^o?BbBYxLD#u&G0LM;w?>f6YIB@R(-P zz_}z~fYffoLhEt_D$kz4uCPjTH~L`j^so3B{qRq-$p*ndf}lgIuW<*&t7W5(?7ym- z`$s5!8)w~Zj#d3^PtRDm0tYl~H?sKDXRc~hrxLsmmxG68sAovT7v`*#&L=yUYCuKZvwWA8yBfKfikI&GtmVc6@=1UA{a+khhYbn2*#&xeH1(1yQ;R_%hxtT#W6tZv>> zp#okxG@A7I8qDB%@ubU+u=V+w{T;cwrV7dX6p^I`$Q#D0h&Wg+s|6hYH^Xx9pry*l9xyba~)_F`R^LQ%hcb0uj1VIlCoq!jqF5Lrz2mo zyD;qSuwpoeQif@gh3PtWC1dlUo_5z)HO<+!Jt&kVLKeV;@-!6TweUMfi1T#S6MqqVCh7j~lybDL0 z@#q#0JawjEnr&pcI<7uPl*T-2{C9Az;Fl{J_^28j!-u=BmIXOJcq||~9^<^&b>ih1 z$+StUOYkZpm%d+7Td}p~uRD5#n+w(%-JCPoV^X=O3e41Cy228oe;HAQBr1W&yqQ~* zI_$lr<-gR*`%on+;H)hTie~(64~!H?MvK#n8T-kxKec6FJ?bC?oefZ1dHrJ)0LaJx z<7tL^E5T6@t7`cmQ|h?yPStL`o$oJ4g8wcr4C{3>v{xW1MvHEw=hu3ssumj@&G@tP%@Ew=_`|>FV0mZea5jy zx;SHD|MTDOkIu+zLxhj7e9GQqy32MbULNyoE??|5Kl+`g&Zq(`=owMymM9_jLj9B6 z25BpkN^H$DWMaXPJbi_P$Pr5jpEZsoS#zRP%B2*SJ9kfJ{Rnoa3c^KxBXlr2o`9(n6o>WYmHl zwToiatNsDw@$1sL$HvSQ!a>pzVfM*u5CAeGY#cM)N)X#{H*M*zovwqtYZKT$G`vva z`iyrSw;DYZ^WIBcQuaR^I)O}LD?)rF^$u6`LqmB!IE+pq`aQlp_d6pH)b9%fH>f+Z z&e-Z|oZr6g`u4nPSjOs=N^_AQ_N({17HL-S2DlrUQkR^%_jgm{Z~F!l@;C9-!LQw9D0RWVzqhvN(!2Pm+U0i07kIz1ak^crv$CEE>v-$ECW$H zOvfnk`v-2QGg3%Q|1FQD8_}q0n(xKh^JN%;Q*FeJwDgwx0qtwY9pfU@}XRXPlBxpo-Y^Z{jRGq4R4OMNe*NIuPnk~ zr2rUa)5ZjKCixP^Qo;r#l5+dYcdE?21jU?sFR;q?Hr2)z^<#SicSrwGjo$25w)%mECR^o!-RUz0d5Xac{sn1=t#v_nc;Na}p6?i{N zKMDWbEU7?ecp~iI2(>KH(24W=*~iS{ZI^mKRq!PlZPeCfZriO}BZXM2dEQv+jK{#+ z)ra?x$9XOoM zSc3l#%SC6z%3RC;$}#5Dz6+;TwWl*Dp_bA!LB7z#R&kK2VDT&C0@4&VWBlF=C0eDR zFfRuuT33^;z`t&_%qB<~dG$xK)|si{*j*F}K%nHS6y6{Hftbp!R!=#ElPb1eCNnq< zjkLE#K*q4l+>}x3RXK}XWC~C_cCN>|E81k~NWtx0H4$$M()m)ln6u+w<~vT#%%=d) z!RFY;bj@caHk%u42=v~28!7fgDFMRL@$NqF&tZtz}?W>36lkWFYnqMk25Bf9*ah=O!r+Ec2fD;6CAV!}y@H*qE z-t6G#=t}vnxGH0G5XYg_lN=%wHl&#;8$5h30+je}RvKaR{+P-bx$kTb!X*uSZjn~A ztt{b{XKwMa=orSHI7~K;xPWCWUd)}O;gLzl;NiAf2WIu;w_HgznnnVI_NLoNFj80N<2K{t)1t8(1g+j)Jb zX6<)11>q~QwUawY2_XJ`+@|h>SuU7X-SSLCN{mVbSdlG@hGd2#nEW5IdhLG zq6hTCifAlhmChHkt<7u;mHSXvE0Iw9H~O`GNNCd`(zOb`89G@gmm9GtGS1SokRsFx z!cNMW!vQ7bT5qTo%8{=#R4Sm-Il8L_I|;}aSN=&G?j8AnCILfnchu8P2zj_X>uI>X zzxNX%CHW@<#BE+aqE5;tu!VDhbs^8Ud`48X!rxafEi#yYuVVgdyZ90t{}u9Wvw;z> z)7zMoZClxTY}8anSave&0l^XZs@94TEC~h8=nS6FStHI<&1qjt#xnh>1tap45ps#V zVW4XWvJ-U^IL& zPF@#=mgG;~41+{^rFoZ@7JZIP5VuwxG1z}dIPyv_P2AQvNN;o&+V?DwY6i-%L5j=t zJujO{*))R(!;Ih^a2nMtYaIRDA?=t2@kf^Dx=k&@m#sUn*T!}EG4Fnmq$8-#;R?9! z_}t4=7cqQ1mFZGG0LdgoKbESyv=K!v2q9UD9#qFJ>#|K>b7<{C6HnZ4aJa)ur%g8F zRdLWp-$xSJbe8l*c1&X_^@Bz2v$Jil{7fU)*tct?b&hB8yi7>BtD(dfynBlqcP4&3 z6}YPRzrQa+m4DEndND+?mDwjCar>AJF`B`(E=%I9iq4tYFA{vtuwy<}xWENBfX9xu z;9FWREM)GTs3AtG>*Vcn^KcAZ#ysBtN&S`nm@G^RbE(MVur6E3%HXy$WRcqOiUouj zC@|3#$oZUauhMwE#}=_iSS1AJ)KxvwyQQ4Ebg@Hie=+~0nD0yKazj0&Ke}&kT&L)3 zL2tRg*9A{rr&*_qU!WLg!`&uVzDP9tL2t9_y>ueB3OAVGHhrO730o5iTXGy3>bt!3 zi4><}d=!8=_I{FjZMPg@uWQRtNEv_ zXVT!h)+%19+yY{d=(HLbgSyybS=8?gsx>I{QGuSZgRph z`ND2ojEjegby|!of|k{^>FXx}VM0h=goYU|l~y95JdzgLK{c?F%UvrN-)zj2b(=1P zd^T8iU0&s^KiF;_xoj=?fD$sB8ei&wa4bq37Z$~{2T$6#yArrG{@vEOi?W6(0sJ;| zARKQ05B6Um2}J1kj+;8Qv#f6qP8?6dkKvEFbsar5j&a5eyi=#GoaelWTf%valM>x9?$)7*E%sHqX_aN7)ZP)pKn<0CSQnd|3tE( z$?IGa^>}i+d?vaqOq}nL?USAc^S-;esx9q1cL?a~`F~xzH9+1D)?F0APXeg{E7!3vSjfT*%?HZPDBR1;uTt>} zZ;@@L3zLsrg1}S4Ca1t!8KoMW5@y(`ICE2#-=Q z)^A3ympfUejfg6@s?Zc$GXw8FE4HS83W$piSZ0fy`&p&pa4bB@IIK_P_Dt5Pfb^{J z%ct{y33(kk;9;x*2ZK&|J zo&CgKY;3xT*uz0CPKBE9<*&+R6;viA)SS_niS{N$Y{My-+KcMEM|nBW1QEMLe>-e) zCNbDm{(Z{|-l4brgDtXBE`DP#5&>a|Ab{h4_^SzWF$O(a+-%IuKfO(46|f+)M|O5! zpNGzd=D*FC|1L*_9~nUNVt4v#hA8&|Kh8PMR=5j*Mw8phqjFd*KCCc2szNpAa1y1O z{?Cf(0!!=vOX!cb;v~f-6rvUdRNp`X@^K}z>oBNv{Zg4amKaMVeVuxIQIWnzfE|xD z$xDcNgo^fE<7v=u-1$8742?{F5MQ`g5f}3-(6zW5Oe;_V^*t0d7XPbBsTSz0jSBZP zIp0+&Qc)g?gnSzIwP_&QSx%~T*39G{+Qktl18B_Ke`adY}%#_8vg=gZ|aMxrQp#BLlt`GwC9q z%TIeh6(U|en5PFlXz0p`T#Tpgm@5Ga;t!X`0q<(ZJ9mrDrkJ7j7~hX+(y1LKR;or> zMWmpz@CGW;xM|}p0Wl2&7&hHkJC+Iaz1&oY-UR z%e?O=atMZ3-BNn(?qHSkeP34#41pgEA5M!)9CeC!2m1zc(N%+sZH|wG$S)U#Ne}Xc zZfV!&cp*s-<8ioK&h^(hp11Ev5>bPaY3QrSR{f_sWD@RuSHs@4nU+%^oF(QC*wq)| zDGdpS9jOe4KW@zb6zKX72cwSX|46>gH4sIiTF>#op6FC>_V3y1)ZbE7ZSYA-XLO<^ zmzRLgR%QGgq6Q{mVzFpL(Mi${#50od2jPQGxAnSXLx2{a8P^M5oMPA6*6Me^c*2YA z_T&~U+v9}~FAdnStmM`+?9~v+=;}533Pt9PAIb}ou7!ezyDnnvuD>;pDtqYrny)FI zyYpeXenRD(@?4jVUs$bBuB*VW`p}i&%WU;gvCpJcB8C%!c^%3Lyynd7ZOd_w-QpgE z+v3qQU#hVQnk_WHO6cfAf_*A2NGihC`ALc00j_ zvF=?BX3MGI9DOOR^+7r;5n3(18Ew0PIkb=(KHGC1Q~X9vi~5L-{(FBu6*`+LVHQpK zLEjFODK>2fnR#fupc=01`VHu*=J_Xhpr1n&_BXt z6pmcjTq*Lw5S0}Tt(ghQuuiKGrAdt|-lCP6k>uZpfx7Vu2`*%uBu4#~k##fIl;maZ z@;%?jdkf@SnB(#KT9l9fM%!X9N5L{Fl7DZLvVx&%(U)#YsC2ehZvz@PDk?LFDUvJJ z?a6viT?rET}3dBbuqrVYQkCwTtNM#+hwLckcihf{q3pP z?KwKfMGCli53{)rVCQ*_wYtzrNP9T?w0Za6=NkN94hM(nCI$a`^nKntgW`B|XvZ+| zQ&da>O}g`^L+naD0sV$@W7?pOfSfDEp(iT>WBUX3psq7ft%t+e``Bss=Q9~8EXt3b z)D7twQ^INBui+iAg8+sUjq;tP2Uh@8Q!|@u_c!utr@rH;*xYiq@Fv3bpM1c1)RD(! z0&^O5XPRl9V03WUNi#CSw01@T804mHNKNnB@n#k?{dL!bD+cbI{(l>kQC1l{aQf!}N+TL~Vgc-8qlB9*P%%o#!oPJn4eNcyFVKz!a1pF}`8yK3~ zkWQ9aypVf9HWd?RV>TTFDHk~{p_&_{p9_wN+4LK`fSTdOME`=`ezI&g2-63hpB}3( zz#|J1hngBu*j$zZ>urt<;H*tOHpp$=c6wqh0Dm!R*)CSSa|K={&%ZZFmL?e57Wxb9 zbk4R}l{pv_EPzx2zgSX4T-Ydu+$CPUTmL-0>_33TEde~N+Oa^~kf|RzZw>VP76;Ad zJ}q?x77?lU9O6}@JfA9?I=}1T`a5Ewf)1qd$dpR}&KBPW@QKuaVu)XKdu{R16xM9A zCO7<|a1T~GgqQjH80%K81O8<^1hnZal0odT-T`}TCe~rqAhk!`g&4-^$KQ7la2E+6 z*;?NAnaU*Y_cc`W4dF|$86RvJur&E;@8@ChL9S0$UpF{E6gG`brgkmDjz}gc2&|gS1iu_ZcW=z%})v?mr?b6Hnb#j#{j2o9~`?S!y-NjM_c>Vs{I|H8f`O4#&XIspw}G% ztJFtX_5RW;?!{@hd0J5!+0SV;isxo^zFXllHyllM@$~!1&m)*n7BKGU2*YUOI~rRv zW(PlsoE{orFvX{hB}gYYjoaggQT@@^6UKxtB5r)%k0f!^md;db&F3p&MPq!kWGmHR3J@$#DYo`+G%9 zGh1wN3|yrzqE_VeUu}2jBOU|6JFdN}tNZjM`54TsANoqzy`nmTwd<`$h$4OS*CPFX zJ_?~eOgHA}Tu0lj*%v!ul4xa}6-6Jgw4jc>jeYgQLr;2-b!OoYB z&x=(LAftaN{U)$JRJiub1>e5T}SobkL({EpUyfjhWpa-9(&WA=$QyOd&yKi zjqpiihsf59GXIpy==QTsKeFS;$tw2M{l&PG>@yq> zsAM~kYclq3Ih`R8#oF5y(@~TpV?ODnwXU_Z^z>JGo5h1Q4>l}ceT_kTW+~Bge*9)s zu;@}SG-@`H_$LW$s3N$Kk2{q(H7z&72>r&IUrnzL%%}omj&CAQU5SqypS=C80rP+9 zJ26$4(bu9{uf#WWV}+u@Mp+4ldeg^?gr10ZZ0vwku@3-6MbW~JfLkX0Q^v^t`Rh;P?Lf(kF(XmVTlf=e}d^tY(Ah4}w^oVq$)STD;a^Gt9 z!|%@@)O@aR#jyc^q#N}ISK{ZXEX~gGeRae<&h};*v&zm7hr5I!Vf+pY=UrS9 zktd|b7n1a4jNnM6`#}Mli(+Y~RhJgmkfhN1eBR7Y$9hhci1#FzhH10&c@+wHyl_eJ>^*JN= zthsotTG2?#OhpXz(@}e)7pJ^3ES2og+1C=2o&G9+#z#J#8+G)W%#h)$mKH*>PY5Wm z@!{KH%rt(7reiO$plL5C16UskXPxup#=RUJoLf#a4Y~LHKmb#G8v)JMU|yjvN~B1- zsAFd7oG(#f=tvEdsCI}_troP8@)_9&K8>c~+&tp6n0N=0h;|8-83b~YhLOnAER)ia ze_HqLZsJF2@fjls->F~^A+VP`9((667DwI{c}Xm*5&Gm3U&nhZ6l9mlpVUu23oCXK z*n|DrzxcNQ48N4sdep~w;jMXzX4r>f)9D;eA>OpFuS6k{$`9+pYoTn)WE07TLpL}xOk31bvbcXxU-Leq0OSvwo4@qLvMW>i1Zzxr$a44l#Y(54=daRZnCel^5* zGevcRtHXvabO3LKdlDSb#g8n0hr#DQSZ{r-YWJ8(T*#pCdJvIwJZiOsMSONhme;*= zCx@~?k@(d+u4JOIN^F<;hv%HjTbKX7XyAz!4w|e#cd!Gt6QL~b;JRUEWv;uzT{OaL z**&*~ER_X|5ny^|!HdtEDjb&Pc3@0xgJF_Zd}B zrB>y5H0cj49a;k^uKxT36VW*rCNeB_oJ?^M|8D9uE?#C~)*m*LbWn5udm))r>hhMP zKD`S(3l?#Xgfqfl_uUH({I=GeJTmW4)MPT4V*EZ-j?`(QTONcdr2C91kAqpPa+x{o z3Gk)Y*9tm2!B*O6j)GR7S$fU28ohzHz^T+J;f-*6I0f7TZkoHR<|izYGKs?6J5FF$ z&FL7rW^5+$<*#H5dEXyyjOUK!ylk00Z&OVY=WU{UXT5qIIq&A}gD^U=ekA$IEa2wc z-zDCSq9lII%)Lt{ua%d0e~&jSXX&mHISw%m3toa6ROb?YEb$FU%<3k{kaj=B+i^`K z);?R6){%9B@%qSF9#HOUx>*9&cqu)UsLFX!@#?nz^Sgmf#X36|6vhHk8 zw~h+Gfy$T8GWz|K_kp`EJ}lZx%*HbiA27K(=N?=~0rN%Ht!95sx?iEJzK>4Bc3iIp zrH;XmkyjFb{1$=ZBlgvlN1i}v{fH0rk@8@*Ar*V%9kj6B9XT0keMmODki|v z-~ntXuW}kR?rioARJ~4W3Ns-KGhytPlKNT#Ytv7`4Sk~_UAu<*?aN;4$8Z*O^Rnos z7X<%Pge91c7>TiG{vXU3NR%Az!7PodS_-%AU z`7p`W>w(VH&w?qqU$AV#ZQpl96KE2UvsHCbZrivOFt2`Oj>#EMPo9aAEVOEr+Iy2x z>-DvCs6~6H`Z^(idv}wSed!~Nm<;qtA*W6D1Kk1kibS7!D^c>A$%l=5(;^tJu<@~@ zF{LqTRR+>k3Z-H@cxAM`keGLJ;E@Fo_z(N&f0&&E3trMGpV|NUYyX!3QqQZ5m81o~ zs!&@h9`hR}b?)?d< z8Zvy~u%cm?+-9fiOI?+9EwW^Z?EdUtJS#M^eiUqSgGzudkx3%i$Yel2hz6O4=^9^kIQX=)@{QOu3?L9K_c+zd; zWb0t6?A(7vC#9(6Q5WxI5`lSHkh$W!#t=+Rs@+=ff$>=7aR0AAp?jfbFcS-rK>7rp zI!58~vrWYA?lKuO;W?{aRKwcC)yKE@l4qRk2u+4IOG4x4+vFp~`bgk|EYeLUqIx?G znT)BvjUasQv7)se##k@H>QHy=nP%nAlZxe1i^27Adh|=6Friq7- z*gSA9oW^cy$j?O>XWnMiw-8tV&8Qi{#iw|UF?RdME#`K}zazP>IfhR-KcB#~o<9}6 ztkP_|Az=F%dwcas&23k&v3Hm>jCMjTnInu8`O+Jpfh=?7gHs<)<%HRM@+2u5N6+3{ zCN7m<@$A8{mT8!}cW~6hJ$G@Brw1?F?>oWTL!CX!dqYKHQV6oiPM?r+*?ATJp;*$h zUPkI(nVA%h@Ysr38aa;o%36a;MF}#^smW?}&uyFRpX_U1%Q9hfWGp}>n>(UQds=P3 zq2Kh~K#8r1VQi`MMt%=}NN}QVUHhQ}$&;SnA`DDQ57u9dJli~J1BN^m@K-F?j} z9ON}=jw|^#jl*uESVT0N<3$N3R|>~%?C^R!c+2Zaf72M00zxMHel+gal7>u_d`f&j zo;yL$K1qjilwid#X)Jyh{>K01EP7<xO4y zwkgGaD6esuxn-eq75teEq>)l&Wf|V6c4YD5ONYY&@X~=cBqk}&g(_YRdwRiWOX3>+ z4tj*so*H?7?m2dPN<01yv&US66w-Uu?MC{CyjgICXnzoXkJHi3W5-UF{w5vGD@alQ zS$AKaCJh#S!mJ#xi3kZa9&GHZ1&x}`#_mZEuk!c(k=H;JcYNEudI5fuGMY`tMI$51!d{zs)>;bvV z?SYxZrjy6%%i=6Nov00_5UTepI9*6Vpq@os%sVd@Ew;dQ`|U`-&3^bBHJyT}IKmsc z<+9OcyNM=Vr93ip)tGZNeAJN0fli>epC_^9z*$-L+04#%p={VG!Ou>bh1?Uf&h3xv8e`9d z{;SdTpF^jynYnaA(3Bou&bI*}g@5jEnU877q%gUEAw1cU7LP%XS;=8{AE`Ql$>dwf zc{AL}H;at06|sNSoVD7&(x#aTbpy!LO>rrqS(x@!wmvqo%uVsQpJmp+9W}yXXKbM} z@ped1OG0t5!Xm@e7wK-gtZjW|+I2QS?h{E5FPEZv5jn+WjaH+FgruH8^gdt$oG-8n zH~PX#(e~Uc4pb6UQsSIwbbE?rSr16!$2815_M0Ell)JS&v)0P5?V%gm*d(mdJu)FC zPu|Bo*eL1;A(mJ5IZ*8nx6XI4T*h%*I?SwZYh!wr=-_iU4PTYS=e-SMAW)I5^WWqU zyh(Fgjiq@Qw&@PJn2Qni8Kx@>J#VxhYq54r4}uQf#Xl!NaQzUtI&@mv*@|Uy8CP?7 zBfHhAH>q$(sO5hM9lJ>5a&j*wh_k@DRbdxTV5e@^*y&vAb)WwE^<@kB^@!#fN^uN% zA&&IpP`w>tW~bh7ff>ViEsk$&RrAy2_;fg#ZV5P0E{bUk&abs=Y**um_HV~EP&+?n zeV^6rrG%rNwkKDd)q*vazqnpRyw4Air9}=cp3fp44AWzpKjkZ&X0ba+kj3~_sR}z! zt2r&5X5rlv`h@KPPzlImqg^qGAO<^iU?7w#h%Py>3#YQKw5M;oWeIzCqG&PDwgf5< zEAceq;2&{U?1ws9U$nX`Y>pvT^?*(ns>)$;;C1TE*voJE&TG)^eF(zl_IW?Fl@kp$ ztU~wpljJ#%74EgBHjD`0gr%*e>@oBDFPCYjLL1-jO7u~)J+(B&T+qB8VrDVN2khRm z-}t@cb#412IW>l&$IML`qXb*hp)}r)JNmC=K&SwYt6;#kII4kD*fqN0IBv`jSam+3 zK!>c2nO|W&!9TJg9=LJCp}$rD*TlcAglK9?&ma~{-hvxwpvt8frmNKLS36p5J0IJY zSf-zH)X)}}H#oFPSHtxqhNo%wB<4YhD1o2+*YAg`(8^tB<1w>M#Dyo{N8f!5lTm!X zdOFK4w_t>_Btk&DH>fN?{ zNKeUitkT9`11OFd!f{LFCovuQOIp8Xl7C3idO0Ao?M0Z)*^5&tI=2e%jPa;e>yqP5 zn%r9KQ1T#7^*-D1;6QyYnXoVfaE1^S3zzU8xG07X3)9S7`Rqm#T9`NK{=07cGxk&~ zhef)X&p9>8{sB4xb~pNs~xP=)0(8gPY|$2}XX%XrA(c4a?7WHBz3nzO!|Gq2SY&2k zUf%yht=z`hoPVD7&gje7y#te)O*Au1>L7@`f44jIw%?@__OP2%BV|GWaA0+;v-quz zzbmh zo-?)2EG`n7a}uQ852fKmFB#NWEXHFjv-9R3h=U92B=k1xW@ij)J%QQp;3)3QK>N}|MTw{+4IV_$cOY3&cU+E4DZ}Mqu4dF_yEeh!H2!KmT|sn zNf5FHmvCQcE|-L_>{6#9cW+lhVYAu|X!nPc)-r&s@l4y0ka$yxyWdvWT^&zWAFhif07RU@`H~Jv z!!^uE(enu%gw4aF=BL}mnTSlkO>(j2O4ebSnZ$iTcP@<-ymW#krYqvZ-qicP?EfWHB+P2!hk&YDwDw6u`cnMt8nRyK+9b&1ANgUyVTsd+n|+8?YXa7 z?8ve8-&ZaRMpshCz8h{WFVVt)gc}%@x0B&b{)!jEeAx3P^Mq(B4UyhB5y`QZTGZ0~xOu7CwzCdx!Sn8QhOFX5Mq8}E z;1$sUqqX=3M42|4F-(HuPZSfUPWkOC`g0$9Pv%z?_*!vuJkuc$#6m+rBKVuwn`9jH z8=(G6W{Q5(&}L=DQ)_Fy)zf$RGVQ67K@W2oO@Fw;8)Imfy<%|o1Yw(FPVjI25M9=r z>2%QRCpW}=+7kv*#)Eq{%16!4_W_kpc`=8!jVly`nQ)DWH?P}&Q7W-07t`57yF1t%wC zI}bvrkyf^~e!4Ezl_2o!GzQ5xA=OhZini`I8rBNcLB=QV&(&h|i;a*b-tCP{vs&Gk zh?K5CCi;Z=fyAuGZ!ZV9JS=KM<70Z( zwzDi{-d?=QnJ!$+vpo$=*AdtPI}Zi3I3D+6d0hLAo!Q{dZJ-}*ozJD9C-P?D+_sh3 zmjmO7H_p;=>`wuLUvdI$<(%c2YQ#oiyulX47`8l#{%gQFGjfFBPIjDsElpE%^_F1i zcO60X1A~sU^$&U&LQt$E;5(pIU_IOx#Xb`r}ut8`s|Yy=<|G6F+O0 zJTPBrv^hIxsQx=6XB(Gu76DpOQGUKZkI-5q3iZP(#{yvOob!)UeS6vED>JWymvJD} zT)gs=&UldRmZHUP{B!XiI8WrC*W~}4PZctukkY?=&#YoZzu1gvUuHtb|u2&rLosTasuc(ECxg4i?exFAdEs6u=``C^l zfw-|OCm8+5f&!oT$IEQ>v*M9TNGo+Npj1B|bAwU{@W)mW|}-7sEHU`24YaMdFI@T^-0cx`79rfN=U7NbAFB<)=XD?j%FH zdhN*>nFjWp{?VFQ6%eBsxoj>7Q(?RQ_-CuMVfD6{(OTbZlMfZP&l`6vbUAoS4oqHh zWf)nVfa4pn1sO^fsrt{{k|%4SUU87bB#s}w(x2ts0DgW_4u}W)YFrKC+EMO`{GGxu zC)`zjzg1SqbV3@_c`W_(WL9YF_+B-<03fVo0LP8ELOED3P^9|m6cf%+cs5)0!PYpT z!qp#+e1q~w~$uJ9(b;ht9IH$o8VAC&ABCA_PkfkQjWJu zmVt2%<>dClqA;9mp==$#taE#6wDYmxigzs6Q19`BKg(Viu9{aavN5PMc8%vj0H@19 zmZUX;nL`4{p=&XSjgQ%c3xj`qL%K7><$t;a5lW_Cd~YH0`1!lpwxqgPEMdoChN5je z3_ENfM*rO=MeQc^DZ5GRd*RZ!*Rb2u)c3l!7D|`wA4GSjIDZUva;Ft(eN8(F3g2h) zZV_r;wj-)Z;L1nbFnywVN00P`hCu{$4W|km_;ykzuh7C(I;p=P4$}9X`6RS$K7GaMVM#LYdqy%%ch)|b&SC{)250R8*DoTQ$9dV68)F2DoC&>uT%e9xO-#VEW}r@#=3COJ@8v0O2(=~<+M-wH|ApUhYDn2?|ASjUH5+vkE- z1Kjy%2X|}gV`&CX`MpB1@0`$26?MR;au$zJ%_oV`rek zeNWmguP<6gnoQcb=1Bl#Y_pOvMxD-d zFU`UD!`VQYmg*Jsmy=#?_1N?WFp=Y)#u<~$(reZOgII`NW?vTK-RcM#eyhC3;B&^J z8tJ{KJDl>$6+^#%Qr4sp*neoNJPEy=<+y6&-tv0Wj{@SZ=VHL)XV%7q^r^f@g-c=u zM^prNu>{8Y2M^r{Y@IzSsg{5R#`uW5BUnO`Ctkjyq^Iv?-@8@a=?S`8oI=$?yI_C@hWH5h@%e*LfKbq&}AJrx$zpdT;u$vD3 z#;5O!X-(}D;cwpQAMRU@*~wYnX?l+R1$bhg*WryLbs|J!l?oHz>6N$c|FJ6<2@#vU zxeiAKnUCF+q>_H!iQ?}<>8u`_Kd)I<>w79Sv3TG5_otJOh!E^~GJ=IN1XvBInquB0 zZt#w2=89sqQ8guQl$_kg87r4(f4=|IIK???=d*Gy(#{a9>5hK8FJH{9Z2eUsxb)5G zrIlIDbPV_pE#6Q9JTXQE@k359MDu;)R^#TMRpsD4zJ^SJIn;Ivx;XWNzwwjzCmBlb z`(LI=X0I!+j1~>a|Gi~z27Dt6P@c1Q<+x$p<6}=5R)V}DCFbC(tRW3vYPuYBN(j?Lu zBZP%Srj2ffNHS&jv|M5E@7^?RQ8q zd9R;?c^uTf27xkoFYVH~U!2VUEsN=XXPBhBKjZAOp!T-lWVTSRSiJwDh5F^~tXQ2z zB2-Ebg?^mHT;WJ2a)R%J#s>^&ixBWhWBRK%7W5E_r&oDKj>>2oLKCcDfkPFs{0A9N zCvcoG@(V8=!v`=dbmwH%WNF-J8*q>&h&A++eyB81ywM9#?$P4-`PKR9`?OM?IIFhmONWjE`Y~2O(VB@*|lDD3C$CV5De+*mi&V) z*}+%$|QdWwtqIWo__w?T2+=T;BWWpq)P@a2;xI#;!}%FO0X zbg-r;FYis)cqV>Kvg*CU3u{S>aHTuEw#a@UZ6WZ>o*s;O!&m)rNtQ8A;2l}L+Ooog z#x?lBan*a@811 z&h=+De^#|TiQqf-Bdae&bs51#^lvmKCfYx1w0@3BkqsiVf9s;kUJl5RXj6x3PP6Y5 z&sSzge3K&^T7unnQXWnR^f6Kq7A$tI<{A^FviOqk)T2nB4s}_TcM*9U6k^H{v^A;B z*TV$i#D!XF5^eF$zLT!}a~+Y+1$Aap4CxcZmt#$@k7bj=E3$E-3(yV9-n3CTksTlqw9kCXh8|7hW}d zAUcerw=Pq)En_ji4#n}ws2%w})7B?>`DN8ewFXLlRQ^=@vu}HnzZ^|&bN2cFYwtUw znrxy51EJU`ilBgsNB}{qbV3nDF;t}^RX`BwJqUzEUKK<^Lhrsvk=}cNpa>#OY9y58 z6$AxBKqZtA*eAgI?f%&xyXV`p7=CVn{)Z#I`d@?!UdY4zkgHpUI5x{6MfeJ6k^j(dYG>CxmI!EF2I zDa#EO!{pDOg^IgkqBzz#0K-q+ATe1P`RFqc6^9gQ=&wF2j=r@|-V!!n^WH{kc<^HJi#l6Rj6vk}Lz9oVJldwu*2 z3npQLS>k!Xt>u#N5q&(O{}}MH@_oU()N{le!rSNLZ6c&6o}1Q{pqDJTVn96c$yC&C zR!7Fh*$I6+VE(XhqLm}}+8{&5tjEiqPdJqe@*gxJ8wfVA9Zfr6e_PN9TJ`l7d0zLE zg;7dTPnoPIG~K8tDh(IjqZ^aq<>6_LIVBpIwe69Y*#N5wvJQ0x%#^B_ifN9p*YCXF z0lCX!>jB|i0iERKVDn+}*Uv)e$3p54t6pDLzdFM!76b0)tXbyAh60Y~voV*>>&|RM zc@e39ej9$oTmmA~5(As%v^&e+Ftglqc(RI`cBaIb8`y zmFJJk&s1{7Aj}mTb17M|#q9Sm2 zXC}DD+Jh}E9$NLfr~?7$4G3`d@{y?Sz0*E2vx7)mM&-0+l}h{PPJDu=EZvN^YOpL$ z_1=b*+{ue*TeNAHE;bhHjywa_3;uy%hwxza>_-snnXERq!)9*VcdxvidEmnH;i@2j zuo!SH6%>FZnF<3ubtu~IsS(H(lA^JL!Y(baTX{N7DJCEEIqMUI)j?7PSMO}%)brmnCOzv4A$GY8Wm{)7^`kk-^ z+%xR}N9F+>IQ~^X_t`&5sl@Y&A2NxpFX78Mmw`JL8&!Y$I~G3SbK-JLp0v3Y*H1+a zf|mls*kS8RT#c#Afpc!eTSV5*_pw`GT~XPs^ci<9R~>mINBu+S`AwH$ilPG^LIyGm z`(EmJ-&O3ArF>C_o!7GM!^K=c97x@SDDg0sB>rfSn|N(kI)hoi*Uyg{u5j5qy^l7Of&xRR>pW*F=p>>0qlM;zJaM{QAx_dppu$rztAOJ z8%`F==ozX6cp{q-a64%4gUX8yY>* zV}BwnWjQ8AzI2{J^HSGTMDmYdOFwlFxoqJv++xo5Y1eQsO*HFo`mGH9`^~0g`RBUg>0oeMG@#+V$R(`5t^& z7S9>7JP|lb_sZ3^CeNduqw8JkLn8KJ4lh*BRjZbB--m0{JM7T>^g@ALXM#O!si0|1Tb zp*R^XOe7G4a)CL{uc!d;#Ry}0u>+m@^04BP)@a=Jmb1X93j;rcd%Un&A*ZX9JhBkg zf2EQ90OdWh1G*Rajw|d~6*isD#WS)UP%HouNS2}H&l!q@YUXtRU|KT4R-mjCa?XIL z=3#r2;2h>%Mm0vYBRee0M=cw^(Oqfu=mjnexQ~fUPpZN`{F9G;E1?=11SHQwHx}={ zr1y9XOp*D86yg$Kl#iBU1A+1gRIB$XIkz*M3c(9pfsb>8Ad#diIZWKrnDG6L6G^ zKgXbikpzYa$szJm&-y@;4t+i_@W4Uiy`FV@T}q2^lU>bwOL~jjkV;CYH_-EDxZJKGM=bLP~yMTp5U^jr&IUR{K(iQ26TuA!SVB|-e1vEGS zD~|!F`~a-G??;Il+C|Ss#LTPja}hanfqcRF7=3yVmc*lgg<+aMi|R(<7;_xH4e~94 z39JQNJ=2*Z(#=-KRcx;9ow$#_!X?7K0K;HD(VHv-z?}}p2IXv>B9>YFIHo-Co zAh{MkdiXLAv8wP5+7ajw-;tXFK-RP?AgSmWI>C#s1N}z0E4uw}W>9zTXVB;mfsfl|Gpoqpt1C=1xTTAS&x#E3 zSsg7xG06`bQMb>wCw>#=;{k1O7J4Y+U*6mw1w%hGZaF$*AN#w7S^EiaL*NI%h1qZ6 z9`kw7UX2W+HH-cRu!q-}893AH*vh^aggE)JLSjP6V7EFMx#;)f$*M$7Xyv+g0|C@W|-<6MEhsKm10zz*i>HNMwqhc{YCLONJL~zQqP6Ksza3DsVbRQBiQ)gJv=x za3;M(f?GyqjF8Nt2(AZ@WA`jXG3UN=ZrT$Qn5mgeJIB8s`&xekC<*$D?|SvWwE+8| zCDUY<+kRrNAU~k?n1UExUb@ws_7RlfXgs>f?W42`T2;(7MHW|C`_b4O5FHvuj43aF z9v+9l=~_Eh8RvOW3YVP!?`#%3u+0sLAM0lv%6zw_IWk$7jU=|s>GNM`1~ta_7F zhJ?|iwE2BNn(R||`^zxaM0@CmE0PP90+QDA(oFHl$gok0QmruQUUp?tmchBSN_E=R zA*`KA{@Q9fNz1{y!{pgRg#hSB8)t($Uzs)MR#waVnWQTslf#{);CsttE?CQ~_{%Em zZOM)nrIUjdVs?}8V?KJrgM5b^3>cp!_(n9mx-H-d@Kbwwt6o!%5hWrduXm8<75e@d zVdZORzJqQ42BKNwhhnF~|=s-4qlJYVFYT#Q5q^ez+$)Oi zW$8xD_Bo)w)nB_52a158fBvjDs{X+UKOnL=UF{b9QAG;++WOJ9kK)gzx3rqX(DLiT zygi_oUMUE`l~%73?|u9DK+nO|!T(YR6`cFmhm)iJl-dLQd5Ru-=EnEEb7#CBF?~(( z2znU#ZUWlU)8@jk0c19R+`(jxR>;A-)0sUumJN6Il2<&H4{(ElAW3mj$=UGjy(Db# zCmsiPkUh(8{8Y9cB+}v{kE`{`uhLuLV0h|yOx60^X2_vP8MP9DUy&&b80i2sjj>F^mgBF!jLfU z064j)4jRx$sY;1#K64e6<8{&qn$p{{edJ(aqu!YvCHJgPS;o%Syu*P9F6k<&G3+n^ z7F8L4$17RJ(qpA|9p7U*vFfEIan}x(1QaRJt(Y%RBS?zN3Pe{CQvv-)|D9Ii>v!*G zxk)+)z4#uRjhY@xLdZH&4o)>eFjRLx=6QNZ(l(bT4VpCm)aUkGS%>X$~0LOuUqgYW_kPQy+57l}CP(-`<@+6UlC7_&8 zlBl$vdTyjT5S!ElTmQLq?SSpZa)4J59t!~>A0sZY+N_4SH5?r+8&RX27;0MEI5pm>$qa( ze#?&*094#kdAaHj7eIfvVXRrH31QcR_}NFGivMfs(tQ}yvK(Pth1ig*NTr@1wQ%g2 z&;gCLT!2#Kaiyq_W9&?d;$IhzI4G{V6JrluBfvEQUX~~xm&9&i1BflyVo7{EyRuYM zcmNQyJebWzz~nL`)3E)3h$Jvl8Akwh!k`RpOg#Hs6pRa$-S->-#|~Kq6NM#goUP>Y zIl5|0T*6LhAAJ^rO$RQ$9L=NYpyC2G^$+(f3)nNc3m`kK(QoRf;2M?gUQ~Z9@Y6*o zLZG_pA!(Ta;w-4KhN(1pfIN;!uuXC7T!7~V|9#Nx#tArQ&9kv{hxUS5*MDPH|L0nc zBahD`pN$V;|88Z!UMItC$?*_$JoH>lUQY(vCVMIHB3fMb6+D8Xey_OwJv)l2XK|sZ9vSO0$KsIINTGdfQ1-9v%11ZN;+*2;RooeKgj`r!OS-FW zr(-@Kvyet$%|%}cw1}(Xn)>#A;@-M)@}&zbD*#Az-oRD_5G>~hBI0?vVL4|Z}*_y3SgUJT}lZAv!v zj&*bMQ9B{gxhBDOjPN$UV~uH5KGqdxED$1F=~xl@+BA9stA~oWW4%;#YLc;JUG)eo z$?{lgBv(hCR+UO+5YXii?;#Nm&)@&;4~qj8Ry{IO{6)W#f1~0+n&1n}*&r{*0mgdP zTg4HV(LbhA?f8|s8+qZ!8aW!z!i8j7!ErZ+a|=K%AOdJbuAg5%|KcFB=kBF_)(&A zKTR|q*W;_q)~Mc)V`0u&0df0eAn3B0=Pl(9ys&fCg=&EeL>9paV^O>}eo`iV=W|B& z%DUvStp1bILN31y1-n+*vC}>EqDV7Ufol0gz{ccq@{|IyQ6g(?P=4iXkIdcZvu~XY z7!dKbRv^r))G{ce1Uu$04>cv9XRk+LW-ot=ZwM8IXI*$+D64wc18_a%-E>~JR-IEA zpy0mO=O}g{Vga+T`P*4xZrmgNimXY5%4~|cRje{|8N*Js+ah0C0dsNL$X{;t_%_-(v%> zOr*Szc9}N>Ul4_Ik6K}jH@JC62%qY#?mr1XpY7fdQU@Rb67XwvR3?(kJf7x}Ns187 zXoU_@SA3gj%Tu>7Xc68{LVb>fL(Z9bytgqd z5&c5^YC+0p&-U_NVAug|#S%t&3$wOMN)vz+j{Or46dP^|I4*o5?j7ie7rA zcvnCYHGZ_sF!n=$Z3YzymIeIv;%f-SLDr1g2?^Xhk&&tb?CnQN$qq|JpS9I} zFaV**DKz9X>8tf#jsQJOflU?W-854uD8a|&Q34;Gn_v2;FnU&n9{4jD9s^)Y7eCC2 zk!z0q@|l}tVeAe-{hrAG)_$PQ-Wx5ed#pm3-@=_MdSV)RJSx4}NEl}is&}ud@b{;x zzJX zUh2~hY?6!qg8LsSD+fa19NrrmeOCBEtjnLq?Hel#Yf?C_?`OMe*MA`R z?5q6ha?k65Kj&L=RGM~y=#bl|%4>x4Z{#0lGsE-oqH+g}@ zPAAdxENt70DGZ96_i{+12;|Dkf5zxo0Gtu#`C9&-^vqi$eZ=1Bs!w=Jf4^{pRZ7z( zIVVWb%c4$xSWU0CxnSES!_KSJ5bN;NJZJFBD~1=89@TPXDxqci*5>KkL9C4dc5)!FOJd0{up=qsWYLC+&F_zzq!E zjE1-IWvCij-lfAS0nB6jdnkGf-h9VSK{fQaQF>Nv7h6vj?wDqRRr3J5c&0uPl{?7L` zXJY&uW#%;W#x-MEvsXWhDS*^7d->s~_Ou`Prl~DE&pF9ht#ep8p6F=V8-YaE+SfMPnLI$+{u)3UUhDUvy>TLEYiu)8JBW#vUr0dWXp6y?gi7hyV&jA5j1g|1Lu zGLnS3O%5fW#kz9l_21Q;Ch4_Tstun(+-{%O3JUPqLx)R$S`QEY=nH#f)Z+Ab%clMK zy;@sM90jZBm?+=&;8WN5M`nCZ|E64E#MsvJehj$kg+-iKw`-@0V#oQRBFY-GPa<`N<#Bg4}Whc#hJTtmG?XPbP)~V-_ z-U%z1{Hs>Wd>;bJ%=ELOv-dfR#AWKb4PoJ--9-c@=6K`nEZH>KtZlfLzyf;gtaYYx zWx~L%Mm9^2s~x(J7C$)8uIlDW=&IHPF%w@-QR0*)x*3`jIT%~OdLomzqV7#^ts&G0 zW|CC%|J7{#vtNKnZBb%m&y4bnNi~_))b>Ey+KjU$@1}u^e&MaNw2lBwZ$*@w#~YW1LZNF66s>Qj zwOPK&Iir%jAhPhIUG*D%Z}!AwL*M;)A~_PJO}2O@HVy)@^) z{}MBhk=HLsdUshc>8JQ@`FmX2RTddV*0J%H<(}hizyEZHYpUTwD440iAUpiP0+?d~ zA5JSzSy&dJ`H`9#K>rv2xxAb%2nB;c*e~Od5V0Pvk=BzSPyw#==M1nYxzDAL1re)w z@i*rT{B(!f3lQ~>78?}r&lha7zlBMq=P9@pZry*Sv(#Felh^vk&%1Ty$+roG^%|i9 zxHO$8Sf)nV9?R~9(cB1I+VYx|laUcrS>4sIq3Ona0c~0;`;E$m;jd^22V_e}ed8gz z8y%+J;~U;pUbG49`J_Aj80}4}FP2 zK)VJzksI$I)=N!@q{Y0IWk?2E0>+JwXtN~8dxWx0nzCZ-i*Z!1xZUs(4U}5M3knl` z{PLTpZmjVZ9^IR1Jgc#gkm79Dz+#7n2TthYFEn%POSg7oLkg}EZSO44u4)7-jVc5i zb!3A;L2h={EFf&aSG8&WuSd^i%>C6&OEL|{QT%l9?IXP+{w83Fl89aTp5Nh% z8H=HebaZ=#Qu^zIYYomjSyg3c3bKqx%ZqZ##Iq&Kay%uwyd=8@)3B{}R(+wc$n8O% z^)i!>(}t_riHoC)0%#0+QG3MzX1F4^p%W7lyZB>Cts}!!(0eJ^WX5xf43xh+?wuJM zEN*eD)OXjb>fmUD`OCpj11m$%o3%Js$1YNscX{GD<=%jtfx8I-QDm=*^PnD<5TDGrW?HWvOi)* zpB;st*+_FW#BW^QYkEtT{CLh)Y0ARbHc~cu?z>3>`+X=4ORKC*nx4Gc~Is{Afk_mG=;r6e=*xeh( zSwCpjXq|*}lMbzR7Yx^{8xfzWfpKE^=iH?GhO@xczzZC*>>y-1@(c)6UzhvPehRpd zVs5yZ1~2xhOKF$4bPpV|8-42%j+Pb;u`QMflpo_h`Sxai8f-UlG4D48o~vaLqVOR% zH~jX{j9O=UgfyPY{$C-k>!P8H6kc8djSERZZ$e1O5LKh8Ad_tPwCgp`rF+lzM7Hh~ zyR*$Ci7$JG$c!EDd$x{aQQ&_O)P(!>(W8RB%7yn1d8XzV2${`<0fD|u8{DL3-K2iF zNfiapKRi{NyfG6?DP8o^LqA8K%bDBSp4fpDvZ)xMcUrUzw)QyQs^cS9)+Cea_IMr7 zfj|ljfJ6&u5btSUq@cGKZlm=UDI5tNd@|h(Y~vH{4>fT$#qIrW_Wbb>@2OZ7ir1YQ z`yo5)S{wkfVe45_%b7z`HBY8HTTR<#F6usUGHzX!fO&bybRT7VG;^o6*Zq`Yo+>YO zmc<`37LJAH!Y zEn5Aoi#ZtyYSwD@35#}kIsU$QNQD@_B-DJpzER7-y`rK3Z{M46Gjxd4J==0`Dv{#m z1_C|1NMr^%xZZ8UxEJq2DL-qC#t>4ZCEjwQnw03Q#JNfh8a4kh>>hgRi|oRU^}#K- zps^1bF%&ZYXt3(lvEy@(tzOS%Hn*zHlKa8|cW=t4HQuy62eNhZgDjnavGP`_&ZWCH zU*5XdP7_GYsK^&kq2)o*2S5$6pX@c|6r^XVK?=#L+LE`d``MBmEON!I4&i&Ee+-=u;F>LSxaLF^z z`fKx{1VJl~?ncg%EuudCmB_ zV)+(pB^bqk`vt*za7gt$=4ww8%utU^tjoDd^vvp0moxj?QZTc$2qEYOqJv+5U$@cZ zzZ2|G>(WPPP=|3{f%oyl5qGKCEI)&rY@RJqnU}YcMwXoB`x;RiWv< z!NI+t@W|s!#AUg1(L&g)@MV(E*<5x+24~!7Wd6xfc-% zV}V@sS%W;DN4Mqv{eATD069P{Ct-1gcm|DeVZ`l|Db-ix3ef=lU>) - - - - - - -Extract log probability (target) — fit-method-lp • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Extract log probability (target) — fit-method-lp • cmdstanr - - - - - - - - - - - - - - + + - -
- +
-
- -
- -
+
@@ -186,26 +114,30 @@

Extract log probability (target)

(target) accumulated in the model block of the Stan program. For variational inference the log density of the variational approximation to the posterior is also available via the $lp_approx() method.

-

See the Log Probability Increment vs. Sampling Statement +

See the Log Probability Increment vs. Sampling Statement section of the Stan Reference Manual for details on when normalizing constants are dropped from log probability calculations.

-
lp()
-
-lp_approx()
- +
+
lp()
+
+lp_approx()
+
-

Value

+
+

Value

+ -

A numeric vector with length equal to the number of (post-warmup) +

A numeric vector with length equal to the number of (post-warmup) draws for MCMC and variational inference, and length equal to 1 for optimization.

-

Details

- +
+
+

Details

-

lp__ is the unnormalized log density on Stan's unconstrained space. +

lp__ is the unnormalized log density on Stan's unconstrained space. This will in general be different than the unnormalized model log density evaluated at a posterior draw (which is on the constrained space). lp__ is intended to diagnose sampling efficiency and evaluate approximations.

@@ -213,53 +145,57 @@

Details (also on the unconstrained space). It is exposed in the variational method for performing the checks described in Yao et al. (2018) and implemented in the loo package.

-

References

- +
+
+

References

Yao, Y., Vehtari, A., Simpson, D., and Gelman, A. (2018). Yes, but did it work?: Evaluating variational inference. Proceedings of the 35th International Conference on Machine Learning, PMLR 80:5581–5590.

-

See also

- - - -

Examples

-
# \dontrun{ -fit_mcmc <- cmdstanr_example("logistic") -head(fit_mcmc$lp()) -
#> [1] -68.9225 -69.2427 -70.5110 -65.5960 -65.2714 -64.1837
-fit_mle <- cmdstanr_example("logistic", method = "optimize") -fit_mle$lp() -
#> [1] -63.9218
-fit_vb <- cmdstanr_example("logistic", method = "variational") -plot(fit_vb$lp(), fit_vb$lp_approx()) -
# } +
+
+

See also

+ +
-
+
+

Examples

+
# \dontrun{
+fit_mcmc <- cmdstanr_example("logistic")
+head(fit_mcmc$lp())
+#> [1] -66.8230 -66.2198 -66.0794 -65.9100 -66.1692 -66.3888
+
+fit_mle <- cmdstanr_example("logistic", method = "optimize")
+fit_mle$lp()
+#> [1] -63.9218
+
+fit_vb <- cmdstanr_example("logistic", method = "variational")
+plot(fit_vb$lp(), fit_vb$lp_approx())
+
+# }
+
+
+
+
- - + + diff --git a/docs/reference/fit-method-metadata.html b/docs/reference/fit-method-metadata.html index ebf454d11..88674bf7b 100644 --- a/docs/reference/fit-method-metadata.html +++ b/docs/reference/fit-method-metadata.html @@ -1,77 +1,14 @@ - - - - - - - -Extract metadata from CmdStan CSV files — fit-method-metadata • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Extract metadata from CmdStan CSV files — fit-method-metadata • cmdstanr - - - - - - - - - - - - - - + + -
-
- -
- -
+

The $metadata() method returns a list of information gathered from the CSV output files, including the CmdStan configuration used when -fitting the model. See Examples and read_cmdstan_csv().

+fitting the model. See Examples and read_cmdstan_csv().

-
metadata()
- - -

See also

- - +
+
metadata()
+
-

Examples

-
# \dontrun{ -fit_mcmc <- cmdstanr_example("logistic", method = "sample") -str(fit_mcmc$metadata()) -
#> List of 40 -#> $ stan_version_major : num 2 -#> $ stan_version_minor : num 29 -#> $ stan_version_patch : num 1 -#> $ start_datetime : chr "2022-03-18 18:25:53 UTC" -#> $ method : chr "sample" -#> $ save_warmup : num 0 -#> $ thin : num 1 -#> $ gamma : num 0.05 -#> $ kappa : num 0.75 -#> $ t0 : num 10 -#> $ init_buffer : num 75 -#> $ term_buffer : num 50 -#> $ window : num 25 -#> $ algorithm : chr "hmc" -#> $ engine : chr "nuts" -#> $ metric : chr "diag_e" -#> $ stepsize_jitter : num 0 -#> $ num_chains : num 1 -#> $ id : num [1:4] 1 2 3 4 -#> $ init : num [1:4] 2 2 2 2 -#> $ seed : num 1.35e+09 -#> $ refresh : num 100 -#> $ sig_figs : num -1 -#> $ profile_file : chr "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/logistic-profile-202203181225-1-94bdc7.csv" -#> $ stanc_version : chr "stanc3 v2.29.1" -#> $ sampler_diagnostics : chr [1:6] "accept_stat__" "stepsize__" "treedepth__" "n_leapfrog__" ... -#> $ variables : chr [1:105] "lp__" "alpha" "beta[1]" "beta[2]" ... -#> $ step_size_adaptation: num [1:4] 0.763 0.761 0.699 0.761 -#> $ model_name : chr "logistic_model" -#> $ adapt_engaged : num 1 -#> $ adapt_delta : num 0.8 -#> $ max_treedepth : num 10 -#> $ step_size : num [1:4] 1 1 1 1 -#> $ iter_warmup : num 1000 -#> $ iter_sampling : num 1000 -#> $ threads_per_chain : num 1 -#> $ time :'data.frame': 4 obs. of 4 variables: -#> ..$ chain_id: num [1:4] 1 2 3 4 -#> ..$ warmup : num [1:4] 0.026 0.032 0.058 0.028 -#> ..$ sampling: num [1:4] 0.094 0.104 0.173 0.098 -#> ..$ total : num [1:4] 0.12 0.136 0.231 0.126 -#> $ stan_variable_sizes :List of 4 -#> ..$ lp__ : num 1 -#> ..$ alpha : num 1 -#> ..$ beta : num 3 -#> ..$ log_lik: num 100 -#> $ stan_variables : chr [1:4] "lp__" "alpha" "beta" "log_lik" -#> $ model_params : chr [1:105] "lp__" "alpha" "beta[1]" "beta[2]" ...
-fit_mle <- cmdstanr_example("logistic", method = "optimize") -str(fit_mle$metadata()) -
#> List of 30 -#> $ stan_version_major : num 2 -#> $ stan_version_minor : num 29 -#> $ stan_version_patch : num 1 -#> $ start_datetime : chr "2022-03-18 18:25:55 UTC" -#> $ method : chr "optimize" -#> $ algorithm : chr "lbfgs" -#> $ init_alpha : num 0.001 -#> $ tol_obj : num 1e-12 -#> $ tol_rel_obj : num 10000 -#> $ tol_grad : num 1e-08 -#> $ tol_rel_grad : num 1e+07 -#> $ tol_param : num 1e-08 -#> $ history_size : num 5 -#> $ iter : num 2000 -#> $ save_iterations : num 0 -#> $ id : num 1 -#> $ init : num 2 -#> $ seed : num 4.24e+08 -#> $ refresh : num 100 -#> $ sig_figs : num -1 -#> $ profile_file : chr "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/logistic-profile-202203181225-1-85709d.csv" -#> $ stanc_version : chr "stanc3 v2.29.1" -#> $ sampler_diagnostics: chr(0) -#> $ variables : chr [1:105] "lp__" "alpha" "beta[1]" "beta[2]" ... -#> $ model_name : chr "logistic_model" -#> $ threads : num 1 -#> $ time :'data.frame': 0 obs. of 0 variables -#> $ stan_variable_sizes:List of 4 -#> ..$ lp__ : num 1 -#> ..$ alpha : num 1 -#> ..$ beta : num 3 -#> ..$ log_lik: num 100 -#> $ stan_variables : chr [1:4] "lp__" "alpha" "beta" "log_lik" -#> $ model_params : chr [1:105] "lp__" "alpha" "beta[1]" "beta[2]" ...
-fit_vb <- cmdstanr_example("logistic", method = "variational") -str(fit_vb$metadata()) -
#> List of 29 -#> $ stan_version_major : num 2 -#> $ stan_version_minor : num 29 -#> $ stan_version_patch : num 1 -#> $ start_datetime : chr "2022-03-18 18:25:55 UTC" -#> $ method : chr "variational" -#> $ algorithm : chr "meanfield" -#> $ iter : num 50 -#> $ grad_samples : num 1 -#> $ elbo_samples : num 100 -#> $ eta : num 1 -#> $ tol_rel_obj : num 0.01 -#> $ eval_elbo : num 100 -#> $ output_samples : num 1000 -#> $ id : num 1 -#> $ init : num 2 -#> $ seed : num 5.22e+08 -#> $ refresh : num 100 -#> $ sig_figs : num -1 -#> $ profile_file : chr "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/logistic-profile-202203181225-1-18f1e4.csv" -#> $ stanc_version : chr "stanc3 v2.29.1" -#> $ sampler_diagnostics: chr(0) -#> $ variables : chr [1:106] "lp__" "lp_approx__" "alpha" "beta[1]" ... -#> $ model_name : chr "logistic_model" -#> $ adapt_engaged : num 1 -#> $ threads : num 1 -#> $ time :'data.frame': 0 obs. of 0 variables -#> $ stan_variable_sizes:List of 5 -#> ..$ lp__ : num 1 -#> ..$ lp_approx__: num 1 -#> ..$ alpha : num 1 -#> ..$ beta : num 3 -#> ..$ log_lik : num 100 -#> $ stan_variables : chr [1:5] "lp__" "lp_approx__" "alpha" "beta" ... -#> $ model_params : chr [1:106] "lp__" "lp_approx__" "alpha" "beta[1]" ...
# } + -
+
+

Examples

+
# \dontrun{
+fit_mcmc <- cmdstanr_example("logistic", method = "sample")
+str(fit_mcmc$metadata())
+#> List of 40
+#>  $ stan_version_major  : num 2
+#>  $ stan_version_minor  : num 32
+#>  $ stan_version_patch  : num 2
+#>  $ start_datetime      : chr "2023-07-25 20:36:00 UTC"
+#>  $ method              : chr "sample"
+#>  $ save_warmup         : num 0
+#>  $ thin                : num 1
+#>  $ gamma               : num 0.05
+#>  $ kappa               : num 0.75
+#>  $ t0                  : num 10
+#>  $ init_buffer         : num 75
+#>  $ term_buffer         : num 50
+#>  $ window              : num 25
+#>  $ algorithm           : chr "hmc"
+#>  $ engine              : chr "nuts"
+#>  $ metric              : chr "diag_e"
+#>  $ stepsize_jitter     : num 0
+#>  $ num_chains          : num 1
+#>  $ id                  : num [1:4] 1 2 3 4
+#>  $ init                : num [1:4] 2 2 2 2
+#>  $ seed                : num 49669263
+#>  $ refresh             : num 100
+#>  $ sig_figs            : num -1
+#>  $ profile_file        : chr "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/logistic-profile-202307251436-1-352ddc.csv"
+#>  $ stanc_version       : chr "stanc3 v2.32.2"
+#>  $ sampler_diagnostics : chr [1:6] "accept_stat__" "stepsize__" "treedepth__" "n_leapfrog__" ...
+#>  $ variables           : chr [1:105] "lp__" "alpha" "beta[1]" "beta[2]" ...
+#>  $ step_size_adaptation: num [1:4] 0.702 0.797 0.751 0.804
+#>  $ model_name          : chr "logistic_model"
+#>  $ adapt_engaged       : num 1
+#>  $ adapt_delta         : num 0.8
+#>  $ max_treedepth       : num 10
+#>  $ step_size           : num [1:4] 1 1 1 1
+#>  $ iter_warmup         : num 1000
+#>  $ iter_sampling       : num 1000
+#>  $ threads_per_chain   : num 1
+#>  $ time                :'data.frame':	4 obs. of  4 variables:
+#>   ..$ chain_id: num [1:4] 1 2 3 4
+#>   ..$ warmup  : num [1:4] 0.022 0.022 0.021 0.022
+#>   ..$ sampling: num [1:4] 0.068 0.065 0.073 0.067
+#>   ..$ total   : num [1:4] 0.09 0.087 0.094 0.089
+#>  $ stan_variable_sizes :List of 4
+#>   ..$ lp__   : num 1
+#>   ..$ alpha  : num 1
+#>   ..$ beta   : num 3
+#>   ..$ log_lik: num 100
+#>  $ stan_variables      : chr [1:4] "lp__" "alpha" "beta" "log_lik"
+#>  $ model_params        : chr [1:105] "lp__" "alpha" "beta[1]" "beta[2]" ...
+
+fit_mle <- cmdstanr_example("logistic", method = "optimize")
+str(fit_mle$metadata())
+#> List of 31
+#>  $ stan_version_major : num 2
+#>  $ stan_version_minor : num 32
+#>  $ stan_version_patch : num 2
+#>  $ start_datetime     : chr "2023-07-25 20:36:01 UTC"
+#>  $ method             : chr "optimize"
+#>  $ algorithm          : chr "lbfgs"
+#>  $ init_alpha         : num 0.001
+#>  $ tol_obj            : num 1e-12
+#>  $ tol_rel_obj        : num 10000
+#>  $ tol_grad           : num 1e-08
+#>  $ tol_rel_grad       : num 1e+07
+#>  $ tol_param          : num 1e-08
+#>  $ history_size       : num 5
+#>  $ jacobian           : num 0
+#>  $ iter               : num 2000
+#>  $ save_iterations    : num 0
+#>  $ id                 : num 1
+#>  $ init               : num 2
+#>  $ seed               : num 1.74e+09
+#>  $ refresh            : num 100
+#>  $ sig_figs           : num -1
+#>  $ profile_file       : chr "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/logistic-profile-202307251436-1-4f11df.csv"
+#>  $ stanc_version      : chr "stanc3 v2.32.2"
+#>  $ sampler_diagnostics: chr(0) 
+#>  $ variables          : chr [1:105] "lp__" "alpha" "beta[1]" "beta[2]" ...
+#>  $ model_name         : chr "logistic_model"
+#>  $ threads            : num 1
+#>  $ time               :'data.frame':	0 obs. of  0 variables
+#>  $ stan_variable_sizes:List of 4
+#>   ..$ lp__   : num 1
+#>   ..$ alpha  : num 1
+#>   ..$ beta   : num 3
+#>   ..$ log_lik: num 100
+#>  $ stan_variables     : chr [1:4] "lp__" "alpha" "beta" "log_lik"
+#>  $ model_params       : chr [1:105] "lp__" "alpha" "beta[1]" "beta[2]" ...
+
+fit_vb <- cmdstanr_example("logistic", method = "variational")
+str(fit_vb$metadata())
+#> List of 29
+#>  $ stan_version_major : num 2
+#>  $ stan_version_minor : num 32
+#>  $ stan_version_patch : num 2
+#>  $ start_datetime     : chr "2023-07-25 20:36:01 UTC"
+#>  $ method             : chr "variational"
+#>  $ algorithm          : chr "meanfield"
+#>  $ iter               : num 50
+#>  $ grad_samples       : num 1
+#>  $ elbo_samples       : num 100
+#>  $ eta                : num 1
+#>  $ tol_rel_obj        : num 0.01
+#>  $ eval_elbo          : num 100
+#>  $ output_samples     : num 1000
+#>  $ id                 : num 1
+#>  $ init               : num 2
+#>  $ seed               : num 2.97e+08
+#>  $ refresh            : num 100
+#>  $ sig_figs           : num -1
+#>  $ profile_file       : chr "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/logistic-profile-202307251436-1-5bbf54.csv"
+#>  $ stanc_version      : chr "stanc3 v2.32.2"
+#>  $ sampler_diagnostics: chr(0) 
+#>  $ variables          : chr [1:106] "lp__" "lp_approx__" "alpha" "beta[1]" ...
+#>  $ model_name         : chr "logistic_model"
+#>  $ adapt_engaged      : num 1
+#>  $ threads            : num 1
+#>  $ time               :'data.frame':	0 obs. of  0 variables
+#>  $ stan_variable_sizes:List of 5
+#>   ..$ lp__       : num 1
+#>   ..$ lp_approx__: num 1
+#>   ..$ alpha      : num 1
+#>   ..$ beta       : num 3
+#>   ..$ log_lik    : num 100
+#>  $ stan_variables     : chr [1:5] "lp__" "lp_approx__" "alpha" "beta" ...
+#>  $ model_params       : chr [1:106] "lp__" "lp_approx__" "alpha" "beta[1]" ...
+# }
+
+
+
+
-
- +
- - + + diff --git a/docs/reference/fit-method-mle.html b/docs/reference/fit-method-mle.html index f191e2ad6..a6544a893 100644 --- a/docs/reference/fit-method-mle.html +++ b/docs/reference/fit-method-mle.html @@ -1,81 +1,18 @@ - - - - - - - -Extract (penalized) maximum likelihood estimate after optimization — fit-method-mle • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Extract (penalized) maximum likelihood estimate after optimization — fit-method-mle • cmdstanr - - - - - - - - - - - - - - + + -
-
- -
- -
+
-

The $mle() method is only available for CmdStanMLE objects. +

The $mle() method is only available for CmdStanMLE objects. It returns the penalized maximum likelihood estimate (posterior mode) as a numeric vector with one element per variable. The returned vector does not include lp__, the total log probability (target) accumulated in the model block of the Stan program, which is available via the -$lp() method and also included in the -$draws() method.

+$lp() method and also included in the +$draws() method.

-
mle(variables = NULL)
+
+
mle(variables = NULL)
+
-

Arguments

- - - - - - -
variables

(character vector) The variables (parameters, transformed +

+

Arguments

+
variables
+

(character vector) The variables (parameters, transformed parameters, and generated quantities) to include. If NULL (the default) -then all variables are included.

- -

Value

+then all variables are included.

-

A numeric vector. See Examples.

-

See also

+
+
+

Value

+ - - -

Examples

-
# \dontrun{ -fit <- cmdstanr_example("logistic", method = "optimize") -fit$mle("alpha") -
#> alpha -#> 0.364475
fit$mle("beta") -
#> beta[1] beta[2] beta[3] -#> -0.631555 -0.258975 0.648491
fit$mle("beta[2]") -
#> beta[2] -#> -0.258975
# } +

A numeric vector. See Examples.

+
+
+

See also

+ +
-
+
+

Examples

+
# \dontrun{
+fit <- cmdstanr_example("logistic", method = "optimize")
+fit$mle("alpha")
+#>    alpha 
+#> 0.364457 
+fit$mle("beta")
+#>   beta[1]   beta[2]   beta[3] 
+#> -0.631547 -0.258967  0.648495 
+fit$mle("beta[2]")
+#>   beta[2] 
+#> -0.258967 
+# }
+
+
+
+
-
- +
- - + + diff --git a/docs/reference/fit-method-num_chains.html b/docs/reference/fit-method-num_chains.html index 2f9483247..9c1066025 100644 --- a/docs/reference/fit-method-num_chains.html +++ b/docs/reference/fit-method-num_chains.html @@ -1,75 +1,12 @@ - - - - - - - -Extract number of chains after MCMC — fit-method-num_chains • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Extract number of chains after MCMC — fit-method-num_chains • cmdstanr - - + + - - -
-
- -
- -
+
@@ -179,48 +107,52 @@

Extract number of chains after MCMC

The $num_chains() method returns the number of MCMC chains.

-
num_chains()
- - -

Value

- -

An integer.

-

See also

+
+
num_chains()
+
- +
+

Value

+ -

Examples

-
# \dontrun{ -fit_mcmc <- cmdstanr_example(chains = 2) -fit_mcmc$num_chains() -
#> [1] 2
# } +

An integer.

+
+
+

See also

+ +
-
+
+

Examples

+
# \dontrun{
+fit_mcmc <- cmdstanr_example(chains = 2)
+fit_mcmc$num_chains()
+#> [1] 2
+# }
+
+
+
+
-
- +

- - + + diff --git a/docs/reference/fit-method-output.html b/docs/reference/fit-method-output.html index 395a5186d..f83b9096e 100644 --- a/docs/reference/fit-method-output.html +++ b/docs/reference/fit-method-output.html @@ -1,80 +1,17 @@ - - - - - - - -Access console output — fit-method-output • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Access console output — fit-method-output • cmdstanr - - - - - - - - - - - - + + - - -
-
- -
- -
+
@@ -189,226 +117,233 @@

Access console output

the console output.

-
output(id = NULL)
- -

Arguments

- - - - - - -
id

(integer) The chain id. Ignored if the model was not fit using -MCMC.

- -

See also

+
+
output(id = NULL)
+
- +
+

Arguments

+
id
+

(integer) The chain id. Ignored if the model was not fit using +MCMC.

-

Examples

-
# \dontrun{ -fit_mcmc <- cmdstanr_example("logistic", method = "sample") -fit_mcmc$output(1) -
#> -#> method = sample (Default) -#> sample -#> num_samples = 1000 (Default) -#> num_warmup = 1000 (Default) -#> save_warmup = 0 (Default) -#> thin = 1 (Default) -#> adapt -#> engaged = 1 (Default) -#> gamma = 0.050000000000000003 (Default) -#> delta = 0.80000000000000004 (Default) -#> kappa = 0.75 (Default) -#> t0 = 10 (Default) -#> init_buffer = 75 (Default) -#> term_buffer = 50 (Default) -#> window = 25 (Default) -#> algorithm = hmc (Default) -#> hmc -#> engine = nuts (Default) -#> nuts -#> max_depth = 10 (Default) -#> metric = diag_e (Default) -#> metric_file = (Default) -#> stepsize = 1 (Default) -#> stepsize_jitter = 0 (Default) -#> num_chains = 1 (Default) -#> id = 1 (Default) -#> data -#> file = /private/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpBlSxPc/temp_libpathbc8d32dd446a/cmdstanr/logistic.data.json -#> init = 2 (Default) -#> random -#> seed = 1354164569 -#> output -#> file = /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/logistic-202203181225-1-827a18.csv -#> diagnostic_file = (Default) -#> refresh = 100 (Default) -#> sig_figs = -1 (Default) -#> profile_file = /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/logistic-profile-202203181225-1-987172.csv -#> num_threads = 1 (Default) -#> -#> -#> Gradient evaluation took 2.4e-05 seconds -#> 1000 transitions using 10 leapfrog steps per transition would take 0.24 seconds. -#> Adjust your expectations accordingly! -#> -#> -#> Iteration: 1 / 2000 [ 0%] (Warmup) -#> Iteration: 100 / 2000 [ 5%] (Warmup) -#> Iteration: 200 / 2000 [ 10%] (Warmup) -#> Iteration: 300 / 2000 [ 15%] (Warmup) -#> Iteration: 400 / 2000 [ 20%] (Warmup) -#> Iteration: 500 / 2000 [ 25%] (Warmup) -#> Iteration: 600 / 2000 [ 30%] (Warmup) -#> Iteration: 700 / 2000 [ 35%] (Warmup) -#> Iteration: 800 / 2000 [ 40%] (Warmup) -#> Iteration: 900 / 2000 [ 45%] (Warmup) -#> Iteration: 1000 / 2000 [ 50%] (Warmup) -#> Iteration: 1001 / 2000 [ 50%] (Sampling) -#> Iteration: 1100 / 2000 [ 55%] (Sampling) -#> Iteration: 1200 / 2000 [ 60%] (Sampling) -#> Iteration: 1300 / 2000 [ 65%] (Sampling) -#> Iteration: 1400 / 2000 [ 70%] (Sampling) -#> Iteration: 1500 / 2000 [ 75%] (Sampling) -#> Iteration: 1600 / 2000 [ 80%] (Sampling) -#> Iteration: 1700 / 2000 [ 85%] (Sampling) -#> Iteration: 1800 / 2000 [ 90%] (Sampling) -#> Iteration: 1900 / 2000 [ 95%] (Sampling) -#> Iteration: 2000 / 2000 [100%] (Sampling) -#> -#> Elapsed Time: 0.026 seconds (Warm-up) -#> 0.088 seconds (Sampling) -#> 0.114 seconds (Total)
out <- fit_mcmc$output() -str(out) -
#> List of 4 -#> $ : chr [1:73] "" "method = sample (Default)" " sample" " num_samples = 1000 (Default)" ... -#> $ : chr [1:73] "" "method = sample (Default)" " sample" " num_samples = 1000 (Default)" ... -#> $ : chr [1:73] "" "method = sample (Default)" " sample" " num_samples = 1000 (Default)" ... -#> $ : chr [1:73] "" "method = sample (Default)" " sample" " num_samples = 1000 (Default)" ...
-fit_mle <- cmdstanr_example("logistic", method = "optimize") -fit_mle$output() -
#> -#> method = optimize -#> optimize -#> algorithm = lbfgs (Default) -#> lbfgs -#> init_alpha = 0.001 (Default) -#> tol_obj = 9.9999999999999998e-13 (Default) -#> tol_rel_obj = 10000 (Default) -#> tol_grad = 1e-08 (Default) -#> tol_rel_grad = 10000000 (Default) -#> tol_param = 1e-08 (Default) -#> history_size = 5 (Default) -#> iter = 2000 (Default) -#> save_iterations = 0 (Default) -#> id = 1 (Default) -#> data -#> file = /private/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpBlSxPc/temp_libpathbc8d32dd446a/cmdstanr/logistic.data.json -#> init = 2 (Default) -#> random -#> seed = 780877759 -#> output -#> file = /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/logistic-202203181225-1-1e7746.csv -#> diagnostic_file = (Default) -#> refresh = 100 (Default) -#> sig_figs = -1 (Default) -#> profile_file = /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/logistic-profile-202203181225-1-71b1d7.csv -#> num_threads = 1 (Default) -#> -#> Initial log joint probability = -137.575 -#> Iter log prob ||dx|| ||grad|| alpha alpha0 # evals Notes -#> 7 -63.9218 9.27364e-05 0.000115205 0.9521 0.9521 11 -#> Optimization terminated normally: -#> Convergence detected: relative gradient magnitude is below tolerance
-fit_vb <- cmdstanr_example("logistic", method = "variational") -fit_vb$output() -
#> -#> method = variational -#> variational -#> algorithm = meanfield (Default) -#> meanfield -#> iter = 10000 (Default) -#> grad_samples = 1 (Default) -#> elbo_samples = 100 (Default) -#> eta = 1 (Default) -#> adapt -#> engaged = 1 (Default) -#> iter = 50 (Default) -#> tol_rel_obj = 0.01 (Default) -#> eval_elbo = 100 (Default) -#> output_samples = 1000 (Default) -#> id = 1 (Default) -#> data -#> file = /private/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpBlSxPc/temp_libpathbc8d32dd446a/cmdstanr/logistic.data.json -#> init = 2 (Default) -#> random -#> seed = 655253804 -#> output -#> file = /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/logistic-202203181225-1-7c6411.csv -#> diagnostic_file = (Default) -#> refresh = 100 (Default) -#> sig_figs = -1 (Default) -#> profile_file = /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/logistic-profile-202203181225-1-8abe62.csv -#> num_threads = 1 (Default) -#> -#> ------------------------------------------------------------ -#> EXPERIMENTAL ALGORITHM: -#> This procedure has not been thoroughly tested and may be unstable -#> or buggy. The interface is subject to change. -#> ------------------------------------------------------------ -#> -#> -#> -#> Gradient evaluation took 2.6e-05 seconds -#> 1000 transitions using 10 leapfrog steps per transition would take 0.26 seconds. -#> Adjust your expectations accordingly! -#> -#> -#> Begin eta adaptation. -#> Iteration: 1 / 250 [ 0%] (Adaptation) -#> Iteration: 50 / 250 [ 20%] (Adaptation) -#> Iteration: 100 / 250 [ 40%] (Adaptation) -#> Iteration: 150 / 250 [ 60%] (Adaptation) -#> Iteration: 200 / 250 [ 80%] (Adaptation) -#> Success! Found best value [eta = 1] earlier than expected. -#> -#> Begin stochastic gradient ascent. -#> iter ELBO delta_ELBO_mean delta_ELBO_med notes -#> 100 -66.196 1.000 1.000 -#> 200 -66.407 0.502 1.000 -#> 300 -66.643 0.336 0.004 MEDIAN ELBO CONVERGED -#> -#> Drawing a sample of size 1000 from the approximate posterior... -#> COMPLETED.
# } +
+ -
+
+

Examples

+
# \dontrun{
+fit_mcmc <- cmdstanr_example("logistic", method = "sample")
+fit_mcmc$output(1)
+#> 
+#> method = sample (Default)
+#>   sample
+#>     num_samples = 1000 (Default)
+#>     num_warmup = 1000 (Default)
+#>     save_warmup = 0 (Default)
+#>     thin = 1 (Default)
+#>     adapt
+#>       engaged = 1 (Default)
+#>       gamma = 0.050000000000000003 (Default)
+#>       delta = 0.80000000000000004 (Default)
+#>       kappa = 0.75 (Default)
+#>       t0 = 10 (Default)
+#>       init_buffer = 75 (Default)
+#>       term_buffer = 50 (Default)
+#>       window = 25 (Default)
+#>     algorithm = hmc (Default)
+#>       hmc
+#>         engine = nuts (Default)
+#>           nuts
+#>             max_depth = 10 (Default)
+#>         metric = diag_e (Default)
+#>         metric_file =  (Default)
+#>         stepsize = 1 (Default)
+#>         stepsize_jitter = 0 (Default)
+#>     num_chains = 1 (Default)
+#> id = 1 (Default)
+#> data
+#>   file = /private/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpKFjP9Y/temp_libpath15d4242e55c52/cmdstanr/logistic.data.json
+#> init = 2 (Default)
+#> random
+#>   seed = 810297768
+#> output
+#>   file = /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/logistic-202307251436-1-71373e.csv
+#>   diagnostic_file =  (Default)
+#>   refresh = 100 (Default)
+#>   sig_figs = -1 (Default)
+#>   profile_file = /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/logistic-profile-202307251436-1-09f0a3.csv
+#> num_threads = 1 (Default)
+#> 
+#> 
+#> Gradient evaluation took 2e-05 seconds
+#> 1000 transitions using 10 leapfrog steps per transition would take 0.2 seconds.
+#> Adjust your expectations accordingly!
+#> 
+#> 
+#> Iteration:    1 / 2000 [  0%]  (Warmup)
+#> Iteration:  100 / 2000 [  5%]  (Warmup)
+#> Iteration:  200 / 2000 [ 10%]  (Warmup)
+#> Iteration:  300 / 2000 [ 15%]  (Warmup)
+#> Iteration:  400 / 2000 [ 20%]  (Warmup)
+#> Iteration:  500 / 2000 [ 25%]  (Warmup)
+#> Iteration:  600 / 2000 [ 30%]  (Warmup)
+#> Iteration:  700 / 2000 [ 35%]  (Warmup)
+#> Iteration:  800 / 2000 [ 40%]  (Warmup)
+#> Iteration:  900 / 2000 [ 45%]  (Warmup)
+#> Iteration: 1000 / 2000 [ 50%]  (Warmup)
+#> Iteration: 1001 / 2000 [ 50%]  (Sampling)
+#> Iteration: 1100 / 2000 [ 55%]  (Sampling)
+#> Iteration: 1200 / 2000 [ 60%]  (Sampling)
+#> Iteration: 1300 / 2000 [ 65%]  (Sampling)
+#> Iteration: 1400 / 2000 [ 70%]  (Sampling)
+#> Iteration: 1500 / 2000 [ 75%]  (Sampling)
+#> Iteration: 1600 / 2000 [ 80%]  (Sampling)
+#> Iteration: 1700 / 2000 [ 85%]  (Sampling)
+#> Iteration: 1800 / 2000 [ 90%]  (Sampling)
+#> Iteration: 1900 / 2000 [ 95%]  (Sampling)
+#> Iteration: 2000 / 2000 [100%]  (Sampling)
+#> 
+#>  Elapsed Time: 0.022 seconds (Warm-up)
+#>                0.067 seconds (Sampling)
+#>                0.089 seconds (Total)
+out <- fit_mcmc$output()
+str(out)
+#> List of 4
+#>  $ : chr [1:73] "" "method = sample (Default)" "  sample" "    num_samples = 1000 (Default)" ...
+#>  $ : chr [1:73] "" "method = sample (Default)" "  sample" "    num_samples = 1000 (Default)" ...
+#>  $ : chr [1:73] "" "method = sample (Default)" "  sample" "    num_samples = 1000 (Default)" ...
+#>  $ : chr [1:73] "" "method = sample (Default)" "  sample" "    num_samples = 1000 (Default)" ...
+
+fit_mle <- cmdstanr_example("logistic", method = "optimize")
+fit_mle$output()
+#> 
+#> method = optimize
+#>   optimize
+#>     algorithm = lbfgs (Default)
+#>       lbfgs
+#>         init_alpha = 0.001 (Default)
+#>         tol_obj = 9.9999999999999998e-13 (Default)
+#>         tol_rel_obj = 10000 (Default)
+#>         tol_grad = 1e-08 (Default)
+#>         tol_rel_grad = 10000000 (Default)
+#>         tol_param = 1e-08 (Default)
+#>         history_size = 5 (Default)
+#>     jacobian = 0 (Default)
+#>     iter = 2000 (Default)
+#>     save_iterations = 0 (Default)
+#> id = 1 (Default)
+#> data
+#>   file = /private/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpKFjP9Y/temp_libpath15d4242e55c52/cmdstanr/logistic.data.json
+#> init = 2 (Default)
+#> random
+#>   seed = 311070905
+#> output
+#>   file = /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/logistic-202307251436-1-656287.csv
+#>   diagnostic_file =  (Default)
+#>   refresh = 100 (Default)
+#>   sig_figs = -1 (Default)
+#>   profile_file = /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/logistic-profile-202307251436-1-75d1fd.csv
+#> num_threads = 1 (Default)
+#> 
+#> Initial log joint probability = -109.352
+#>     Iter      log prob        ||dx||      ||grad||       alpha      alpha0  # evals  Notes 
+#>        7      -63.9218   0.000676152    0.00167181       0.941       0.941        9   
+#> Optimization terminated normally: 
+#>   Convergence detected: relative gradient magnitude is below tolerance
+
+fit_vb <- cmdstanr_example("logistic", method = "variational")
+fit_vb$output()
+#> 
+#> method = variational
+#>   variational
+#>     algorithm = meanfield (Default)
+#>       meanfield
+#>     iter = 10000 (Default)
+#>     grad_samples = 1 (Default)
+#>     elbo_samples = 100 (Default)
+#>     eta = 1 (Default)
+#>     adapt
+#>       engaged = 1 (Default)
+#>       iter = 50 (Default)
+#>     tol_rel_obj = 0.01 (Default)
+#>     eval_elbo = 100 (Default)
+#>     output_samples = 1000 (Default)
+#> id = 1 (Default)
+#> data
+#>   file = /private/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpKFjP9Y/temp_libpath15d4242e55c52/cmdstanr/logistic.data.json
+#> init = 2 (Default)
+#> random
+#>   seed = 296025410
+#> output
+#>   file = /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/logistic-202307251436-1-7927e8.csv
+#>   diagnostic_file =  (Default)
+#>   refresh = 100 (Default)
+#>   sig_figs = -1 (Default)
+#>   profile_file = /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/logistic-profile-202307251436-1-2bb650.csv
+#> num_threads = 1 (Default)
+#> 
+#> ------------------------------------------------------------
+#> EXPERIMENTAL ALGORITHM:
+#>   This procedure has not been thoroughly tested and may be unstable
+#>   or buggy. The interface is subject to change.
+#> ------------------------------------------------------------
+#> 
+#> 
+#> 
+#> Gradient evaluation took 2.1e-05 seconds
+#> 1000 transitions using 10 leapfrog steps per transition would take 0.21 seconds.
+#> Adjust your expectations accordingly!
+#> 
+#> 
+#> Begin eta adaptation.
+#> Iteration:   1 / 250 [  0%]  (Adaptation)
+#> Iteration:  50 / 250 [ 20%]  (Adaptation)
+#> Iteration: 100 / 250 [ 40%]  (Adaptation)
+#> Iteration: 150 / 250 [ 60%]  (Adaptation)
+#> Iteration: 200 / 250 [ 80%]  (Adaptation)
+#> Success! Found best value [eta = 1] earlier than expected.
+#> 
+#> Begin stochastic gradient ascent.
+#>   iter             ELBO   delta_ELBO_mean   delta_ELBO_med   notes 
+#>    100          -66.992             1.000            1.000
+#>    200          -66.023             0.507            1.000
+#>    300          -66.735             0.342            0.015
+#>    400          -66.204             0.258            0.015
+#>    500          -66.470             0.207            0.011
+#>    600          -66.254             0.173            0.011
+#>    700          -66.213             0.149            0.008   MEDIAN ELBO CONVERGED
+#> 
+#> Drawing a sample of size 1000 from the approximate posterior... 
+#> COMPLETED.
+# }
+
+
+
+
-
- +
- - + + diff --git a/docs/reference/fit-method-profiles.html b/docs/reference/fit-method-profiles.html index 2a17e670a..48a8cbe07 100644 --- a/docs/reference/fit-method-profiles.html +++ b/docs/reference/fit-method-profiles.html @@ -1,79 +1,16 @@ - - - - - - - -Return profiling data — fit-method-profiles • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Return profiling data — fit-method-profiles • cmdstanr - - - - - - - - - - - - + + - - -
-
- -
- -
+

The $profiles() method returns a list of data frames with profiling data if any profiling data was written to the profile CSV files. -See save_profile_files() to control where the files are saved.

+See save_profile_files() to control where the files are saved.

Support for profiling Stan programs is available with CmdStan >= 2.26 and requires adding profiling statements to the Stan program.

-
profiles()
- +
+
profiles()
+
-

Value

+
+

Value

+ -

A list of data frames with profiling data if the profiling CSV files +

A list of data frames with profiling data if the profiling CSV files were created.

-

See also

- - - -

Examples

-
-# \dontrun{ -# first fit a model using MCMC -mcmc_program <- write_stan_file( - 'data { - int<lower=0> N; - int<lower=0,upper=1> y[N]; - } - parameters { - real<lower=0,upper=1> theta; - } - model { - profile("likelihood") { - y ~ bernoulli(theta); - } - } - generated quantities { - int y_rep[N]; - profile("gq") { - y_rep = bernoulli_rng(rep_vector(theta, N)); - } - } -' -) -mod_mcmc <- cmdstan_model(mcmc_program) -
#> Warning in '/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/model-d65431ed4576.stan', line 3, column 4: Declaration -#> of arrays by placing brackets after a variable name is deprecated and -#> will be removed in Stan 2.32.0. Instead use the array keyword before the -#> type. This can be changed automatically using the auto-format flag to -#> stanc -#> Warning in '/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/model-d65431ed4576.stan', line 14, column 4: Declaration -#> of arrays by placing brackets after a variable name is deprecated and -#> will be removed in Stan 2.32.0. Instead use the array keyword before the -#> type. This can be changed automatically using the auto-format flag to -#> stanc
-data <- list(N = 10, y = c(1,1,0,0,0,1,0,1,0,0)) -fit <- mod_mcmc$sample(data = data, seed = 123, refresh = 0) -
#> Running MCMC with 4 sequential chains... -#> -#> Chain 1 finished in 0.0 seconds. -#> Chain 2 finished in 0.0 seconds. -#> Chain 3 finished in 0.0 seconds. -#> Chain 4 finished in 0.0 seconds. -#> -#> All 4 chains finished successfully. -#> Mean chain execution time: 0.0 seconds. -#> Total execution time: 0.5 seconds. -#>
-fit$profiles() -
#> [[1]] -#> name thread_id total_time forward_time reverse_time chain_stack -#> 1 gq 0x10f232e00 0.000386068 0.000386068 0.000000000 0 -#> 2 likelihood 0x10f232e00 0.001285670 0.000903227 0.000382445 7169 -#> no_chain_stack autodiff_calls no_autodiff_calls -#> 1 0 0 1000 -#> 2 0 7169 1 -#> -#> [[2]] -#> name thread_id total_time forward_time reverse_time chain_stack -#> 1 gq 0x101daee00 0.000393415 0.000393415 0.000000000 0 -#> 2 likelihood 0x101daee00 0.001305930 0.000932404 0.000373525 7155 -#> no_chain_stack autodiff_calls no_autodiff_calls -#> 1 0 0 1000 -#> 2 0 7155 1 -#> -#> [[3]] -#> name thread_id total_time forward_time reverse_time chain_stack -#> 1 gq 0x1121b1e00 0.000534289 0.000534289 0.000000000 0 -#> 2 likelihood 0x1121b1e00 0.001384640 0.000993686 0.000390953 6879 -#> no_chain_stack autodiff_calls no_autodiff_calls -#> 1 0 0 1000 -#> 2 0 6879 1 -#> -#> [[4]] -#> name thread_id total_time forward_time reverse_time chain_stack -#> 1 gq 0x113ecce00 0.000356809 0.000356809 0.000000000 0 -#> 2 likelihood 0x113ecce00 0.001137030 0.000803924 0.000333102 6892 -#> no_chain_stack autodiff_calls no_autodiff_calls -#> 1 0 0 1000 -#> 2 0 6892 1 -#>
# } +
+ -
+
+

Examples

+

+# \dontrun{
+# first fit a model using MCMC
+mcmc_program <- write_stan_file(
+  'data {
+    int<lower=0> N;
+    int<lower=0,upper=1> y[N];
+  }
+  parameters {
+    real<lower=0,upper=1> theta;
+  }
+  model {
+    profile("likelihood") {
+      y ~ bernoulli(theta);
+    }
+  }
+  generated quantities {
+    int y_rep[N];
+    profile("gq") {
+      y_rep = bernoulli_rng(rep_vector(theta, N));
+    }
+  }
+'
+)
+mod_mcmc <- cmdstan_model(mcmc_program)
+#> Warning in '/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/model-16218658ea62a.stan', line 3, column 4: Declaration
+#>     of arrays by placing brackets after a variable name is deprecated and
+#>     will be removed in Stan 2.33.0. Instead use the array keyword before the
+#>     type. This can be changed automatically using the auto-format flag to
+#>     stanc
+#> Warning in '/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/model-16218658ea62a.stan', line 14, column 4: Declaration
+#>     of arrays by placing brackets after a variable name is deprecated and
+#>     will be removed in Stan 2.33.0. Instead use the array keyword before the
+#>     type. This can be changed automatically using the auto-format flag to
+#>     stanc
+
+data <- list(N = 10, y = c(1,1,0,0,0,1,0,1,0,0))
+fit <- mod_mcmc$sample(data = data, seed = 123, refresh = 0)
+#> Running MCMC with 4 sequential chains...
+#> 
+#> Chain 1 finished in 0.0 seconds.
+#> Chain 2 finished in 0.0 seconds.
+#> Chain 3 finished in 0.0 seconds.
+#> Chain 4 finished in 0.0 seconds.
+#> 
+#> All 4 chains finished successfully.
+#> Mean chain execution time: 0.0 seconds.
+#> Total execution time: 0.5 seconds.
+#> 
+
+fit$profiles()
+#> [[1]]
+#>         name   thread_id total_time forward_time reverse_time chain_stack
+#> 1         gq 0x10afd5e00 0.00037530  0.000375300  0.000000000           0
+#> 2 likelihood 0x10afd5e00 0.00114227  0.000802925  0.000339345        7169
+#>   no_chain_stack autodiff_calls no_autodiff_calls
+#> 1              0              0              1000
+#> 2              0           7169                 1
+#> 
+#> [[2]]
+#>         name   thread_id total_time forward_time reverse_time chain_stack
+#> 1         gq 0x11a045e00 0.00043389  0.000433890  0.000000000           0
+#> 2 likelihood 0x11a045e00 0.00111438  0.000786092  0.000328286        7155
+#>   no_chain_stack autodiff_calls no_autodiff_calls
+#> 1              0              0              1000
+#> 2              0           7155                 1
+#> 
+#> [[3]]
+#>         name   thread_id  total_time forward_time reverse_time chain_stack
+#> 1         gq 0x10c67be00 0.000330582  0.000330582  0.000000000           0
+#> 2 likelihood 0x10c67be00 0.001059290  0.000746087  0.000313204        6879
+#>   no_chain_stack autodiff_calls no_autodiff_calls
+#> 1              0              0              1000
+#> 2              0           6879                 1
+#> 
+#> [[4]]
+#>         name   thread_id  total_time forward_time reverse_time chain_stack
+#> 1         gq 0x108f13e00 0.000365107  0.000365107  0.000000000           0
+#> 2 likelihood 0x108f13e00 0.001159310  0.000815756  0.000343553        6892
+#>   no_chain_stack autodiff_calls no_autodiff_calls
+#> 1              0              0              1000
+#> 2              0           6892                 1
+#> 
+# }
+
+
+
+
-
- +
- - + + diff --git a/docs/reference/fit-method-return_codes.html b/docs/reference/fit-method-return_codes.html index 6a82b3484..9ccd42588 100644 --- a/docs/reference/fit-method-return_codes.html +++ b/docs/reference/fit-method-return_codes.html @@ -1,76 +1,13 @@ - - - - - - - -Extract return codes from CmdStan — fit-method-return_codes • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Extract return codes from CmdStan — fit-method-return_codes • cmdstanr - - - - + + -
-
- -
- -
+
@@ -181,55 +109,65 @@

Extract return codes from CmdStan

from the CmdStan run(s). A return code of 0 indicates a successful run.

-
return_codes()
- +
+
return_codes()
+
-

Value

+
+

Value

+ -

An integer vector of return codes with length equal to the number of +

An integer vector of return codes with length equal to the number of CmdStan runs (number of chains for MCMC and one otherwise).

-

See also

- - - -

Examples

-
# \dontrun{ -# example with return codes all zero -fit_mcmc <- cmdstanr_example("schools", method = "sample") -
#> Warning: 138 of 4000 (3.0%) transitions ended with a divergence. -#> See https://mc-stan.org/misc/warnings for details.
fit_mcmc$return_codes() # should be all zero -
#> [1] 0 0 0 0
-# example of non-zero return code (optimization fails for hierarchical model) -fit_opt <- cmdstanr_example("schools", method = "optimize") -
#> Optimization terminated with error:
#> Line search failed to achieve a sufficient decrease, no more progress can be made
fit_opt$return_codes() # should be non-zero -
#> [1] 1
# } - -
+
+ + +
+

Examples

+
# \dontrun{
+# example with return codes all zero
+fit_mcmc <- cmdstanr_example("schools", method = "sample")
+#> Warning: 258 of 4000 (6.0%) transitions ended with a divergence.
+#> See https://mc-stan.org/misc/warnings for details.
+#> Warning: 2 of 4 chains had an E-BFMI less than 0.2.
+#> See https://mc-stan.org/misc/warnings for details.
+fit_mcmc$return_codes() # should be all zero
+#> [1] 0 0 0 0
+
+# example of non-zero return code (optimization fails for hierarchical model)
+fit_opt <- cmdstanr_example("schools", method = "optimize")
+#> Optimization terminated with error: 
+#>   Line search failed to achieve a sufficient decrease, no more progress can be made
+fit_opt$return_codes() # should be non-zero
+#> [1] 1
+# }
+
+
+
+
-
- +
- - + + diff --git a/docs/reference/fit-method-sampler_diagnostics.html b/docs/reference/fit-method-sampler_diagnostics.html index f2c07e2cd..f36572b42 100644 --- a/docs/reference/fit-method-sampler_diagnostics.html +++ b/docs/reference/fit-method-sampler_diagnostics.html @@ -1,78 +1,15 @@ - - - - - - - -Extract sampler diagnostics after MCMC — fit-method-sampler_diagnostics • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Extract sampler diagnostics after MCMC — fit-method-sampler_diagnostics • cmdstanr - - - - - - - - - - - - + + - - -
-
- -
- -
+
@@ -182,108 +110,112 @@

Extract sampler diagnostics after MCMC

Extract the values of sampler diagnostics for each iteration and chain of MCMC. To instead get summaries of these diagnostics and associated warning messages use the -$diagnostic_summary() method.

+$diagnostic_summary() method.

+
+ +
+
sampler_diagnostics(
+  inc_warmup = FALSE,
+  format = getOption("cmdstanr_draws_format", "draws_array")
+)
-
sampler_diagnostics(
-  inc_warmup = FALSE,
-  format = getOption("cmdstanr_draws_format", "draws_array")
-)
+
+

Arguments

+
inc_warmup
+

(logical) Should warmup draws be included? Defaults to FALSE.

+ -

Arguments

- - - - - - - - - - -
inc_warmup

(logical) Should warmup draws be included? Defaults to FALSE.

format

(string) The draws format to return. See -draws for details.

+
format
+

(string) The draws format to return. See +draws for details.

-

Value

+
+
+

Value

+ -

Depends on format, but the default is a 3-D -draws_array object (iteration x chain x +

Depends on format, but the default is a 3-D +draws_array object (iteration x chain x variable). The variables for Stan's default MCMC algorithm are "accept_stat__", "stepsize__", "treedepth__", "n_leapfrog__", "divergent__", "energy__".

-

See also

- - - -

Examples

-
# \dontrun{ -fit <- cmdstanr_example("logistic") -sampler_diagnostics <- fit$sampler_diagnostics() -str(sampler_diagnostics) -
#> 'draws_array' num [1:1000, 1:4, 1:6] 3 2 2 2 3 1 1 2 2 2 ... -#> - attr(*, "dimnames")=List of 3 -#> ..$ iteration: chr [1:1000] "1" "2" "3" "4" ... -#> ..$ chain : chr [1:4] "1" "2" "3" "4" -#> ..$ variable : chr [1:6] "treedepth__" "divergent__" "energy__" "accept_stat__" ...
-library(posterior) -as_draws_df(sampler_diagnostics) -
#> # A draws_df: 1000 iterations, 4 chains, and 6 variables -#> treedepth__ divergent__ energy__ accept_stat__ stepsize__ n_leapfrog__ -#> 1 3 0 68 1.00 0.87 7 -#> 2 2 0 73 0.60 0.87 7 -#> 3 2 0 72 1.00 0.87 3 -#> 4 2 0 67 0.97 0.87 3 -#> 5 3 0 68 1.00 0.87 7 -#> 6 1 0 68 0.82 0.87 3 -#> 7 1 0 70 0.57 0.87 3 -#> 8 2 0 67 1.00 0.87 3 -#> 9 2 0 67 0.82 0.87 3 -#> 10 2 0 67 0.98 0.87 3 -#> # ... with 3990 more draws -#> # ... hidden reserved variables {'.chain', '.iteration', '.draw'}
-# or specify format to get a data frame instead of calling as_draws_df -fit$sampler_diagnostics(format = "df") -
#> # A draws_df: 1000 iterations, 4 chains, and 6 variables -#> treedepth__ divergent__ energy__ accept_stat__ stepsize__ n_leapfrog__ -#> 1 3 0 68 1.00 0.87 7 -#> 2 2 0 73 0.60 0.87 7 -#> 3 2 0 72 1.00 0.87 3 -#> 4 2 0 67 0.97 0.87 3 -#> 5 3 0 68 1.00 0.87 7 -#> 6 1 0 68 0.82 0.87 3 -#> 7 1 0 70 0.57 0.87 3 -#> 8 2 0 67 1.00 0.87 3 -#> 9 2 0 67 0.82 0.87 3 -#> 10 2 0 67 0.98 0.87 3 -#> # ... with 3990 more draws -#> # ... hidden reserved variables {'.chain', '.iteration', '.draw'}
# } +
+
+

See also

+ +
-
+
+

Examples

+
# \dontrun{
+fit <- cmdstanr_example("logistic")
+sampler_diagnostics <- fit$sampler_diagnostics()
+str(sampler_diagnostics)
+#>  'draws_array' num [1:1000, 1:4, 1:6] 1 3 2 2 2 3 2 2 3 2 ...
+#>  - attr(*, "dimnames")=List of 3
+#>   ..$ iteration: chr [1:1000] "1" "2" "3" "4" ...
+#>   ..$ chain    : chr [1:4] "1" "2" "3" "4"
+#>   ..$ variable : chr [1:6] "treedepth__" "divergent__" "energy__" "accept_stat__" ...
+
+library(posterior)
+as_draws_df(sampler_diagnostics)
+#> # A draws_df: 1000 iterations, 4 chains, and 6 variables
+#>    treedepth__ divergent__ energy__ accept_stat__ stepsize__ n_leapfrog__
+#> 1            1           0       66          0.91       0.67            3
+#> 2            3           0       66          0.87       0.67            7
+#> 3            2           0       72          0.65       0.67            3
+#> 4            2           0       70          1.00       0.67            3
+#> 5            2           0       66          1.00       0.67            3
+#> 6            3           0       65          0.93       0.67            7
+#> 7            2           0       69          0.70       0.67            3
+#> 8            2           0       70          0.99       0.67            3
+#> 9            3           0       66          0.98       0.67            7
+#> 10           2           0       67          0.90       0.67            3
+#> # ... with 3990 more draws
+#> # ... hidden reserved variables {'.chain', '.iteration', '.draw'}
+
+# or specify format to get a data frame instead of calling as_draws_df
+fit$sampler_diagnostics(format = "df")
+#> # A draws_df: 1000 iterations, 4 chains, and 6 variables
+#>    treedepth__ divergent__ energy__ accept_stat__ stepsize__ n_leapfrog__
+#> 1            1           0       66          0.91       0.67            3
+#> 2            3           0       66          0.87       0.67            7
+#> 3            2           0       72          0.65       0.67            3
+#> 4            2           0       70          1.00       0.67            3
+#> 5            2           0       66          1.00       0.67            3
+#> 6            3           0       65          0.93       0.67            7
+#> 7            2           0       69          0.70       0.67            3
+#> 8            2           0       70          0.99       0.67            3
+#> 9            3           0       66          0.98       0.67            7
+#> 10           2           0       67          0.90       0.67            3
+#> # ... with 3990 more draws
+#> # ... hidden reserved variables {'.chain', '.iteration', '.draw'}
+# }
+
+
+
+
-
- +
- - + + diff --git a/docs/reference/fit-method-save_object.html b/docs/reference/fit-method-save_object.html index ef36b1b08..e721424a6 100644 --- a/docs/reference/fit-method-save_object.html +++ b/docs/reference/fit-method-save_object.html @@ -1,79 +1,16 @@ - - - - - - - -Save fitted model object to a file — fit-method-save_object • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Save fitted model object to a file — fit-method-save_object • cmdstanr - - - - - - - - - - - - + + - - -
-
- -
- -
+
-

This method is a wrapper around base::saveRDS() that ensures +

This method is a wrapper around base::saveRDS() that ensures that all posterior draws and diagnostics are saved when saving a fitted model object. Because the contents of the CmdStan output CSV files are only read into R lazily (i.e., as needed), the $save_object() method is the safest way to guarantee that everything has been read in before saving.

-
save_object(file, ...)
- -

Arguments

- - - - - - - - - - -
file

(string) Path where the file should be saved.

...

Other arguments to pass to base::saveRDS() besides object and file.

- -

See also

+
+
save_object(file, ...)
+
- +
+

Arguments

+
file
+

(string) Path where the file should be saved.

-

Examples

-
# \dontrun{ -fit <- cmdstanr_example("logistic") -temp_rds_file <- tempfile(fileext = ".RDS") -fit$save_object(file = temp_rds_file) -rm(fit) +
...
+

Other arguments to pass to base::saveRDS() besides object and file.

-fit <- readRDS(temp_rds_file) -fit$summary() -
#> # A tibble: 105 × 10 -#> variable mean median sd mad q5 q95 rhat ess_bulk -#> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> -#> 1 lp__ -65.9 -65.6 1.43 1.20 -68.8 -64.3 1.00 2291. -#> 2 alpha 0.379 0.380 0.216 0.220 0.0214 0.735 1.00 4664. -#> 3 beta[1] -0.668 -0.663 0.252 0.250 -1.09 -0.259 1.00 4187. -#> 4 beta[2] -0.273 -0.265 0.225 0.224 -0.646 0.0856 1.00 3736. -#> 5 beta[3] 0.682 0.679 0.261 0.258 0.260 1.10 1.00 3626. -#> 6 log_lik[1] -0.515 -0.509 0.0979 0.0970 -0.683 -0.366 1.00 4695. -#> 7 log_lik[2] -0.401 -0.380 0.144 0.136 -0.666 -0.200 1.00 4367. -#> 8 log_lik[3] -0.496 -0.462 0.218 0.200 -0.899 -0.206 1.00 4031. -#> 9 log_lik[4] -0.449 -0.432 0.150 0.144 -0.722 -0.237 1.00 3885. -#> 10 log_lik[5] -1.18 -1.17 0.276 0.276 -1.68 -0.769 1.00 4020. -#> # … with 95 more rows, and 1 more variable: ess_tail <dbl>
# } +
+ -
+
+

Examples

+
# \dontrun{
+fit <- cmdstanr_example("logistic")
+
+temp_rds_file <- tempfile(fileext = ".RDS")
+fit$save_object(file = temp_rds_file)
+rm(fit)
+
+fit <- readRDS(temp_rds_file)
+fit$summary()
+#> # A tibble: 105 × 10
+#>    variable      mean  median     sd    mad       q5      q95  rhat ess_bulk
+#>    <chr>        <num>   <num>  <num>  <num>    <num>    <num> <num>    <num>
+#>  1 lp__       -66.0   -65.6   1.45   1.24   -68.8    -64.3     1.00    2217.
+#>  2 alpha        0.386   0.382 0.217  0.215    0.0345   0.754   1.00    4227.
+#>  3 beta[1]     -0.659  -0.650 0.246  0.246   -1.07    -0.268   1.00    3920.
+#>  4 beta[2]     -0.275  -0.277 0.226  0.226   -0.654    0.0937  1.00    4340.
+#>  5 beta[3]      0.675   0.665 0.275  0.267    0.236    1.15    1.00    3661.
+#>  6 log_lik[1]  -0.514  -0.508 0.0974 0.0967  -0.683   -0.365   1.00    4222.
+#>  7 log_lik[2]  -0.410  -0.389 0.154  0.150   -0.690   -0.198   1.00    4320.
+#>  8 log_lik[3]  -0.500  -0.469 0.218  0.206   -0.908   -0.207   1.00    4270.
+#>  9 log_lik[4]  -0.453  -0.436 0.152  0.146   -0.729   -0.238   1.00    3898.
+#> 10 log_lik[5]  -1.18   -1.16  0.287  0.285   -1.68    -0.760   1.00    3941.
+#> # ℹ 95 more rows
+#> # ℹ 1 more variable: ess_tail <num>
+# }
+
+
+
+
-
- +
- - + + diff --git a/docs/reference/fit-method-save_output_files.html b/docs/reference/fit-method-save_output_files.html index 196500301..9f5eee91a 100644 --- a/docs/reference/fit-method-save_output_files.html +++ b/docs/reference/fit-method-save_output_files.html @@ -1,82 +1,19 @@ - - - - - - - -Save output and data files — fit-method-save_output_files • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Save output and data files — fit-method-save_output_files • cmdstanr - - - - - - - - - - - - - - + + -
-
- -
- -
+
@@ -193,76 +121,77 @@

Save output and data files

the current file paths without moving any files.

-
save_output_files(dir = ".", basename = NULL, timestamp = TRUE, random = TRUE)
+    
+
save_output_files(dir = ".", basename = NULL, timestamp = TRUE, random = TRUE)
+
+save_latent_dynamics_files(
+  dir = ".",
+  basename = NULL,
+  timestamp = TRUE,
+  random = TRUE
+)
+
+save_profile_files(dir = ".", basename = NULL, timestamp = TRUE, random = TRUE)
+
+save_data_file(dir = ".", basename = NULL, timestamp = TRUE, random = TRUE)
+
+output_files(include_failed = FALSE)
+
+profile_files(include_failed = FALSE)
+
+latent_dynamics_files(include_failed = FALSE)
+
+data_file()
+
+ +
+

Arguments

+
dir
+

(string) Path to directory where the files should be saved.

-save_latent_dynamics_files( - dir = ".", - basename = NULL, - timestamp = TRUE, - random = TRUE -) -save_profile_files(dir = ".", basename = NULL, timestamp = TRUE, random = TRUE) +
basename
+

(string) Base filename to use. See Details.

-save_data_file(dir = ".", basename = NULL, timestamp = TRUE, random = TRUE) -output_files(include_failed = FALSE) +
timestamp
+

(logical) Should a timestamp be added to the file name(s)? +Defaults to TRUE. See Details.

-profile_files(include_failed = FALSE) -latent_dynamics_files(include_failed = FALSE) +
random
+

(logical) Should random alphanumeric characters be added to the +end of the file name(s)? Defaults to TRUE. See Details.

-data_file()
-

Arguments

- - - - - - - - - - - - - - - - - - - - - - -
dir

(string) Path to directory where the files should be saved.

basename

(string) Base filename to use. See Details.

timestamp

(logical) Should a timestamp be added to the file name(s)? -Defaults to TRUE. See Details.

random

(logical) Should random alphanumeric characters be added to the -end of the file name(s)? Defaults to TRUE. See Details.

include_failed

(logical) Should CmdStan runs that failed also be -included? The default is FALSE.

+
include_failed
+

(logical) Should CmdStan runs that failed also be +included? The default is FALSE.

-

Value

+
+
+

Value

+ -

The $save_* methods print a message with the new file paths and (invisibly) +

The $save_* methods print a message with the new file paths and (invisibly) return a character vector of the new paths (or NA for any that couldn't be copied). They also have the side effect of setting the internal paths in the fitted model object to the new paths.

+ +

The methods without the save_ prefix return character vectors of file paths without moving any files.

-

Details

- +
+
+

Details

For $save_output_files() the files moved to dir will have names of -the form basename-timestamp-id-random, where

    -
  • basename is the user's provided basename argument;

  • -
  • timestamp is of the form format(Sys.time(), "%Y%m%d%H%M");

  • +the form basename-timestamp-id-random, where

    • basename is the user's provided basename argument;

    • +
    • timestamp is of the form format(Sys.time(), "%Y%m%d%H%M");

    • id is the MCMC chain id (or 1 for non MCMC);

    • random contains six random alphanumeric characters;

    • -
    - -

    For $save_latent_dynamics_files() everything is the same as for +

For $save_latent_dynamics_files() everything is the same as for $save_output_files() except "-diagnostic-" is included in the new file name after basename.

For $save_profile_files() everything is the same as for @@ -270,64 +199,69 @@

Details file name after basename.

For $save_data_file() no id is included in the file name because even with multiple MCMC chains the data file is the same.

-

See also

- - - -

Examples

-
# \dontrun{ -fit <- cmdstanr_example() -fit$output_files() -
#> [1] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/logistic-202203181226-1-549ffb.csv" -#> [2] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/logistic-202203181226-2-549ffb.csv" -#> [3] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/logistic-202203181226-3-549ffb.csv" -#> [4] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/logistic-202203181226-4-549ffb.csv"
fit$data_file() -
#> [1] "/private/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpBlSxPc/temp_libpathbc8d32dd446a/cmdstanr/logistic.data.json"
-# just using tempdir for the example -my_dir <- tempdir() -fit$save_output_files(dir = my_dir, basename = "banana") -
#> Moved 4 files and set internal paths to new locations: -#> - /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/banana-202203181226-1-89ddc2.csv -#> - /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/banana-202203181226-2-89ddc2.csv -#> - /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/banana-202203181226-3-89ddc2.csv -#> - /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/banana-202203181226-4-89ddc2.csv
fit$save_output_files(dir = my_dir, basename = "tomato", timestamp = FALSE) -
#> Moved 4 files and set internal paths to new locations: -#> - /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/tomato-1-07c277.csv -#> - /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/tomato-2-07c277.csv -#> - /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/tomato-3-07c277.csv -#> - /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/tomato-4-07c277.csv
fit$save_output_files(dir = my_dir, basename = "lettuce", timestamp = FALSE, random = FALSE) -
#> Moved 4 files and set internal paths to new locations: -#> - /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/lettuce-1.csv -#> - /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/lettuce-2.csv -#> - /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/lettuce-3.csv -#> - /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/lettuce-4.csv
# } +
+ -
+
+

Examples

+
# \dontrun{
+fit <- cmdstanr_example()
+fit$output_files()
+#> [1] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/logistic-202307251436-1-3f09a2.csv"
+#> [2] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/logistic-202307251436-2-3f09a2.csv"
+#> [3] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/logistic-202307251436-3-3f09a2.csv"
+#> [4] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/logistic-202307251436-4-3f09a2.csv"
+fit$data_file()
+#> [1] "/private/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpKFjP9Y/temp_libpath15d4242e55c52/cmdstanr/logistic.data.json"
+
+# just using tempdir for the example
+my_dir <- tempdir()
+fit$save_output_files(dir = my_dir, basename = "banana")
+#> Moved 4 files and set internal paths to new locations:
+#> - /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/banana-202307251436-1-1e5555.csv
+#> - /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/banana-202307251436-2-1e5555.csv
+#> - /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/banana-202307251436-3-1e5555.csv
+#> - /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/banana-202307251436-4-1e5555.csv
+fit$save_output_files(dir = my_dir, basename = "tomato", timestamp = FALSE)
+#> Moved 4 files and set internal paths to new locations:
+#> - /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/tomato-1-092670.csv
+#> - /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/tomato-2-092670.csv
+#> - /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/tomato-3-092670.csv
+#> - /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/tomato-4-092670.csv
+fit$save_output_files(dir = my_dir, basename = "lettuce", timestamp = FALSE, random = FALSE)
+#> Moved 4 files and set internal paths to new locations:
+#> - /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/lettuce-1.csv
+#> - /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/lettuce-2.csv
+#> - /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/lettuce-3.csv
+#> - /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/lettuce-4.csv
+# }
+
+
+
+
-
- +
- - + + diff --git a/docs/reference/fit-method-summary.html b/docs/reference/fit-method-summary.html index faf9864f2..5713a8b11 100644 --- a/docs/reference/fit-method-summary.html +++ b/docs/reference/fit-method-summary.html @@ -1,53 +1,5 @@ - - - - - - - -Compute a summary table of estimates and diagnostics — fit-method-summary • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Compute a summary table of estimates and diagnostics — fit-method-summary • cmdstanr - - - - - - - - - - + + - - - - -
-
- -
- -
+

The $summary() method runs -summarise_draws() from the posterior +summarise_draws() from the posterior package and returns the output. For MCMC, only post-warmup draws are included in the summary.

There is also a $print() method that prints the same summary stats but @@ -199,130 +127,174 @@

Compute a summary table of estimates and diagnostics

to be able to return them to the user. See Examples.

-
summary(variables = NULL, ...)
+
+
summary(variables = NULL, ...)
+
-

Arguments

- - - - - - - - - - -
variables

(character vector) The variables to include.

...

Optional arguments to pass to posterior::summarise_draws().

+
+

Arguments

+
variables
+

(character vector) The variables to include.

-

Value

-

The $summary() method returns the tibble data frame created by -posterior::summarise_draws().

-

The $print() method returns the fitted model object itself (invisibly), -which is the standard behavior for print methods in R.

-

See also

+
...
+

Optional arguments to pass to posterior::summarise_draws().

- +
+
+

Value

+ -

Examples

-
# \dontrun{ -fit <- cmdstanr_example("logistic") -fit$summary() -
#> # A tibble: 105 × 10 -#> variable mean median sd mad q5 q95 rhat ess_bulk -#> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> -#> 1 lp__ -65.9 -65.6 1.41 1.24 -68.7 -64.3 1.00 2184. -#> 2 alpha 0.376 0.378 0.218 0.220 0.00751 0.730 1.00 3633. -#> 3 beta[1] -0.663 -0.653 0.246 0.245 -1.09 -0.263 1.00 4022. -#> 4 beta[2] -0.269 -0.263 0.228 0.226 -0.649 0.107 1.00 3949. -#> 5 beta[3] 0.676 0.673 0.265 0.271 0.244 1.12 1.00 3975. -#> 6 log_lik[1] -0.517 -0.511 0.0992 0.0990 -0.692 -0.367 1.00 3507. -#> 7 log_lik[2] -0.404 -0.384 0.147 0.140 -0.665 -0.196 1.00 4695. -#> 8 log_lik[3] -0.498 -0.466 0.219 0.205 -0.906 -0.205 1.00 3889. -#> 9 log_lik[4] -0.453 -0.432 0.156 0.151 -0.746 -0.230 1.00 3814. -#> 10 log_lik[5] -1.18 -1.16 0.278 0.281 -1.66 -0.756 1.00 4117. -#> # … with 95 more rows, and 1 more variable: ess_tail <dbl>
fit$print() -
#> variable mean median sd mad q5 q95 rhat ess_bulk ess_tail -#> lp__ -65.95 -65.64 1.41 1.24 -68.75 -64.27 1.00 2184 3071 -#> alpha 0.38 0.38 0.22 0.22 0.01 0.73 1.00 3633 3074 -#> beta[1] -0.66 -0.65 0.25 0.25 -1.09 -0.26 1.00 4021 2815 -#> beta[2] -0.27 -0.26 0.23 0.23 -0.65 0.11 1.00 3948 3214 -#> beta[3] 0.68 0.67 0.27 0.27 0.24 1.12 1.00 3974 3343 -#> log_lik[1] -0.52 -0.51 0.10 0.10 -0.69 -0.37 1.00 3506 2773 -#> log_lik[2] -0.40 -0.38 0.15 0.14 -0.67 -0.20 1.00 4694 3405 -#> log_lik[3] -0.50 -0.47 0.22 0.20 -0.91 -0.21 1.00 3889 3133 -#> log_lik[4] -0.45 -0.43 0.16 0.15 -0.75 -0.23 1.00 3814 3282 -#> log_lik[5] -1.18 -1.16 0.28 0.28 -1.66 -0.76 1.00 4117 3034 -#> -#> # showing 10 of 105 rows (change via 'max_rows' argument or 'cmdstanr_max_rows' option)
fit$print(max_rows = 2) # same as print(fit, max_rows = 2) -
#> variable mean median sd mad q5 q95 rhat ess_bulk ess_tail -#> lp__ -65.95 -65.64 1.41 1.24 -68.75 -64.27 1.00 2184 3071 -#> alpha 0.38 0.38 0.22 0.22 0.01 0.73 1.00 3633 3074 -#> -#> # showing 2 of 105 rows (change via 'max_rows' argument or 'cmdstanr_max_rows' option)
-# include only certain variables -fit$summary("beta") -
#> # A tibble: 3 × 10 -#> variable mean median sd mad q5 q95 rhat ess_bulk ess_tail -#> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> -#> 1 beta[1] -0.663 -0.653 0.246 0.245 -1.09 -0.263 1.00 4022. 2815. -#> 2 beta[2] -0.269 -0.263 0.228 0.226 -0.649 0.107 1.00 3949. 3215. -#> 3 beta[3] 0.676 0.673 0.265 0.271 0.244 1.12 1.00 3975. 3343.
fit$print(c("alpha", "beta[2]")) -
#> variable mean median sd mad q5 q95 rhat ess_bulk ess_tail -#> alpha 0.38 0.38 0.22 0.22 0.01 0.73 1.00 3633 3074 -#> beta[2] -0.27 -0.26 0.23 0.23 -0.65 0.11 1.00 3948 3214
-# include all variables but only certain summaries -fit$summary(NULL, c("mean", "sd")) -
#> # A tibble: 105 × 3 -#> variable mean sd -#> <chr> <dbl> <dbl> -#> 1 lp__ -65.9 1.41 -#> 2 alpha 0.376 0.218 -#> 3 beta[1] -0.663 0.246 -#> 4 beta[2] -0.269 0.228 -#> 5 beta[3] 0.676 0.265 -#> 6 log_lik[1] -0.517 0.0992 -#> 7 log_lik[2] -0.404 0.147 -#> 8 log_lik[3] -0.498 0.219 -#> 9 log_lik[4] -0.453 0.156 -#> 10 log_lik[5] -1.18 0.278 -#> # … with 95 more rows
-# can use functions created from formulas -# for example, calculate Pr(beta > 0) -fit$summary("beta", prob_gt_0 = ~ mean(. > 0)) -
#> # A tibble: 3 × 2 -#> variable prob_gt_0 -#> <chr> <dbl> -#> 1 beta[1] 0.00175 -#> 2 beta[2] 0.116 -#> 3 beta[3] 0.997
# } +

The $summary() method returns the tibble data frame created by +posterior::summarise_draws().

-
+ +

The $print() method returns the fitted model object itself (invisibly), +which is the standard behavior for print methods in R.

+
+ + +
+

Examples

+
# \dontrun{
+fit <- cmdstanr_example("logistic")
+fit$summary()
+#> # A tibble: 105 × 10
+#>    variable      mean  median     sd    mad       q5      q95  rhat ess_bulk
+#>    <chr>        <num>   <num>  <num>  <num>    <num>    <num> <num>    <num>
+#>  1 lp__       -66.0   -65.7   1.45   1.26   -68.9    -64.3     1.00    1950.
+#>  2 alpha        0.380   0.376 0.218  0.214    0.0316   0.747   1.00    4585.
+#>  3 beta[1]     -0.669  -0.662 0.254  0.252   -1.09    -0.248   1.00    4669.
+#>  4 beta[2]     -0.277  -0.273 0.231  0.232   -0.665    0.0927  1.00    4400.
+#>  5 beta[3]      0.676   0.677 0.268  0.267    0.242    1.12    1.00    4179.
+#>  6 log_lik[1]  -0.515  -0.508 0.0986 0.0967  -0.686   -0.365   1.00    4439.
+#>  7 log_lik[2]  -0.405  -0.387 0.146  0.140   -0.676   -0.197   1.00    4528.
+#>  8 log_lik[3]  -0.501  -0.464 0.221  0.207   -0.917   -0.210   1.00    4266.
+#>  9 log_lik[4]  -0.450  -0.429 0.155  0.148   -0.729   -0.229   1.00    4175.
+#> 10 log_lik[5]  -1.18   -1.16  0.281  0.278   -1.67    -0.750   1.00    4417.
+#> # ℹ 95 more rows
+#> # ℹ 1 more variable: ess_tail <num>
+fit$print()
+#>    variable   mean median   sd  mad     q5    q95 rhat ess_bulk ess_tail
+#>  lp__       -66.00 -65.68 1.45 1.26 -68.86 -64.27 1.00     1950     2912
+#>  alpha        0.38   0.38 0.22 0.21   0.03   0.75 1.00     4584     2789
+#>  beta[1]     -0.67  -0.66 0.25 0.25  -1.09  -0.25 1.00     4669     3265
+#>  beta[2]     -0.28  -0.27 0.23 0.23  -0.67   0.09 1.00     4399     2567
+#>  beta[3]      0.68   0.68 0.27 0.27   0.24   1.12 1.00     4179     3160
+#>  log_lik[1]  -0.52  -0.51 0.10 0.10  -0.69  -0.37 1.00     4439     2680
+#>  log_lik[2]  -0.40  -0.39 0.15 0.14  -0.68  -0.20 1.00     4528     3426
+#>  log_lik[3]  -0.50  -0.46 0.22 0.21  -0.92  -0.21 1.00     4265     2821
+#>  log_lik[4]  -0.45  -0.43 0.15 0.15  -0.73  -0.23 1.00     4175     2970
+#>  log_lik[5]  -1.18  -1.16 0.28 0.28  -1.67  -0.75 1.00     4417     3002
+#> 
+#>  # showing 10 of 105 rows (change via 'max_rows' argument or 'cmdstanr_max_rows' option)
+fit$print(max_rows = 2) # same as print(fit, max_rows = 2)
+#>  variable   mean median   sd  mad     q5    q95 rhat ess_bulk ess_tail
+#>     lp__  -66.00 -65.68 1.45 1.26 -68.86 -64.27 1.00     1950     2912
+#>     alpha   0.38   0.38 0.22 0.21   0.03   0.75 1.00     4584     2789
+#> 
+#>  # showing 2 of 105 rows (change via 'max_rows' argument or 'cmdstanr_max_rows' option)
+
+# include only certain variables
+fit$summary("beta")
+#> # A tibble: 3 × 10
+#>   variable   mean median    sd   mad     q5     q95  rhat ess_bulk ess_tail
+#>   <chr>     <num>  <num> <num> <num>  <num>   <num> <num>    <num>    <num>
+#> 1 beta[1]  -0.669 -0.662 0.254 0.252 -1.09  -0.248   1.00    4669.    3265.
+#> 2 beta[2]  -0.277 -0.273 0.231 0.232 -0.665  0.0927  1.00    4400.    2568.
+#> 3 beta[3]   0.676  0.677 0.268 0.267  0.242  1.12    1.00    4179.    3161.
+fit$print(c("alpha", "beta[2]"))
+#>  variable  mean median   sd  mad    q5  q95 rhat ess_bulk ess_tail
+#>   alpha    0.38   0.38 0.22 0.21  0.03 0.75 1.00     4584     2789
+#>   beta[2] -0.28  -0.27 0.23 0.23 -0.67 0.09 1.00     4399     2567
+
+# include all variables but only certain summaries
+fit$summary(NULL, c("mean", "sd"))
+#> # A tibble: 105 × 3
+#>    variable      mean     sd
+#>    <chr>        <num>  <num>
+#>  1 lp__       -66.0   1.45  
+#>  2 alpha        0.380 0.218 
+#>  3 beta[1]     -0.669 0.254 
+#>  4 beta[2]     -0.277 0.231 
+#>  5 beta[3]      0.676 0.268 
+#>  6 log_lik[1]  -0.515 0.0986
+#>  7 log_lik[2]  -0.405 0.146 
+#>  8 log_lik[3]  -0.501 0.221 
+#>  9 log_lik[4]  -0.450 0.155 
+#> 10 log_lik[5]  -1.18  0.281 
+#> # ℹ 95 more rows
+
+# can use functions created from formulas
+# for example, calculate Pr(beta > 0)
+fit$summary("beta", prob_gt_0 = ~ mean(. > 0))
+#> # A tibble: 3 × 2
+#>   variable prob_gt_0
+#>   <chr>        <num>
+#> 1 beta[1]     0.0035
+#> 2 beta[2]     0.112 
+#> 3 beta[3]     0.995 
+
+# can combine user-specified functions with
+# the default summary functions
+fit$summary(variables = c("alpha", "beta"),
+  posterior::default_summary_measures()[1:4],
+  quantiles = ~ quantile2(., probs = c(0.025, 0.975)),
+  posterior::default_convergence_measures()
+  )
+#> # A tibble: 4 × 10
+#>   variable   mean median    sd   mad    q2.5  q97.5  rhat ess_bulk ess_tail
+#>   <chr>     <num>  <num> <num> <num>   <num>  <num> <num>    <num>    <num>
+#> 1 alpha     0.380  0.376 0.218 0.214 -0.0392  0.823  1.00    4585.    2790.
+#> 2 beta[1]  -0.669 -0.662 0.254 0.252 -1.18   -0.180  1.00    4669.    3265.
+#> 3 beta[2]  -0.277 -0.273 0.231 0.232 -0.736   0.165  1.00    4400.    2568.
+#> 4 beta[3]   0.676  0.677 0.268 0.267  0.157   1.20   1.00    4179.    3161.
+
+# the functions need to calculate the appropriate
+# value for a matrix input
+fit$summary(variables = "alpha", dim)
+#> # A tibble: 1 × 3
+#>   variable dim.1 dim.2
+#>   <chr>    <num> <num>
+#> 1 alpha     1000     4
+
+# the usual [stats::var()] is therefore not directly suitable as it
+# will produce a covariance matrix unless the data is converted to a vector
+fit$print(c("alpha", "beta"), var2 = ~var(as.vector(.x)))
+#>  variable var2
+#>   alpha   0.05
+#>   beta[1] 0.06
+#>   beta[2] 0.05
+#>   beta[3] 0.07
+
+# }
+
+
+
+
-
- +
- - + + diff --git a/docs/reference/fit-method-time.html b/docs/reference/fit-method-time.html index dfba38e72..0f3ead7d4 100644 --- a/docs/reference/fit-method-time.html +++ b/docs/reference/fit-method-time.html @@ -1,77 +1,14 @@ - - - - - - - -Report timing of CmdStan runs — fit-method-time • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Report timing of CmdStan runs — fit-method-time • cmdstanr - - - - - - - - - - - - + + - - -
-
- -
- -
+
@@ -183,74 +111,77 @@

Report timing of CmdStan runs

sampling phases.

-
time()
- +
+
time()
+
-

Value

+
+

Value

+ -

A list with elements

    -
  • total: (scalar) The total run time. For MCMC this may be different than +

    A list with elements

    • total: (scalar) The total run time. For MCMC this may be different than the sum of the chain run times if parallelization was used.

    • chains: (data frame) For MCMC only, timing info for the individual chains. The data frame has columns "chain_id", "warmup", "sampling", and "total".

    • -
    - -

    See also

    - - - -

    Examples

    -
    # \dontrun{ -fit_mcmc <- cmdstanr_example("logistic", method = "sample") -fit_mcmc$time() -
    #> $total -#> [1] 0.8284969 -#> -#> $chains -#> chain_id warmup sampling total -#> 1 1 0.030 0.099 0.129 -#> 2 2 0.023 0.082 0.105 -#> 3 3 0.024 0.091 0.115 -#> 4 4 0.054 0.165 0.219 -#>
    -fit_mle <- cmdstanr_example("logistic", method = "optimize") -fit_mle$time() -
    #> $total -#> [1] 0.125402 -#>
    -fit_vb <- cmdstanr_example("logistic", method = "variational") -fit_vb$time() -
    #> $total -#> [1] 0.128371 -#>
    # } +
+ -
+
+

Examples

+
# \dontrun{
+fit_mcmc <- cmdstanr_example("logistic", method = "sample")
+fit_mcmc$time()
+#> $total
+#> [1] 0.553201
+#> 
+#> $chains
+#>   chain_id warmup sampling total
+#> 1        1  0.021    0.068 0.089
+#> 2        2  0.022    0.070 0.092
+#> 3        3  0.022    0.076 0.098
+#> 4        4  0.023    0.071 0.094
+#> 
+
+fit_mle <- cmdstanr_example("logistic", method = "optimize")
+fit_mle$time()
+#> $total
+#> [1] 0.1247039
+#> 
+
+fit_vb <- cmdstanr_example("logistic", method = "variational")
+fit_vb$time()
+#> $total
+#> [1] 0.1268399
+#> 
+# }
+
+
+
+
-
- +
- - + + diff --git a/docs/reference/fit-method-unconstrain_draws.html b/docs/reference/fit-method-unconstrain_draws.html new file mode 100644 index 000000000..1a27f650d --- /dev/null +++ b/docs/reference/fit-method-unconstrain_draws.html @@ -0,0 +1,185 @@ + +Transform all parameter draws to the unconstrained scale — fit-method-unconstrain_draws • cmdstanr + + +
+
+ + + +
+
+ + +
+

The $unconstrain_draws() method transforms all parameter draws to the +unconstrained scale. The method returns a list for each chain, containing the parameter +values from each iteration on the unconstrained scale. If called with no arguments, then +the draws within the fit object are unconstrained. Alternatively, either an existing +draws object or a character vector of paths to CSV files can be passed.

+
+ +
+
unconstrain_draws(files = NULL, draws = NULL)
+
+ +
+

Arguments

+
files
+

(character vector) The paths to the CmdStan CSV files. These can +be files generated by running CmdStanR or running CmdStan directly.

+ + +
draws
+

A posterior::draws_* object.

+ +
+ + +
+

Examples

+
# \dontrun{
+fit_mcmc <- cmdstanr_example("logistic", method = "sample")
+fit_mcmc$init_model_methods()
+#> Error: Model methods cannot be used with a pre-compiled Stan executable, the model must be compiled again
+
+# Unconstrain all internal draws
+unconstrained_internal_draws <- fit_mcmc$unconstrain_draws()
+#> Error: The method has not been compiled, please call `init_model_methods()` first
+
+# Unconstrain external CmdStan CSV files
+unconstrained_csv <- fit_mcmc$unconstrain_draws(files = fit_mcmc$output_files())
+#> Error: The method has not been compiled, please call `init_model_methods()` first
+
+# Unconstrain existing draws object
+unconstrained_draws <- fit_mcmc$unconstrain_draws(draws = fit_mcmc$draws())
+#> Error: The method has not been compiled, please call `init_model_methods()` first
+# }
+
+
+
+
+ +
+ + +
+ +
+

Site built with pkgdown 2.0.7.

+
+ +
+ + + + + + + + diff --git a/docs/reference/fit-method-unconstrain_variables.html b/docs/reference/fit-method-unconstrain_variables.html new file mode 100644 index 000000000..558713b7c --- /dev/null +++ b/docs/reference/fit-method-unconstrain_variables.html @@ -0,0 +1,165 @@ + +Transform a set of parameter values to the unconstrained scale — fit-method-unconstrain_variables • cmdstanr + + +
+
+ + + +
+
+ + +
+

The $unconstrain_variables() method transforms input parameters to +the unconstrained scale

+
+ +
+
unconstrain_variables(variables)
+
+ +
+

Arguments

+
variables
+

(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$init_model_methods()
+#> Error: Model methods cannot be used with a pre-compiled Stan executable, the model must be compiled again
+fit_mcmc$unconstrain_variables(list(alpha = 0.5, beta = c(0.7, 1.1, 0.2)))
+#> Error: The method has not been compiled, please call `init_model_methods()` first
+# }
+
+
+
+
+ +
+ + +
+ +
+

Site built with pkgdown 2.0.7.

+
+ +
+ + + + + + + + diff --git a/docs/reference/fit-method-variable_skeleton.html b/docs/reference/fit-method-variable_skeleton.html new file mode 100644 index 000000000..0bc3100e1 --- /dev/null +++ b/docs/reference/fit-method-variable_skeleton.html @@ -0,0 +1,171 @@ + +Return the variable skeleton needed by the utils::relist function to re-structure a +vector of constrained parameter values to a named list — fit-method-variable_skeleton • cmdstanr + + +
+
+ + + +
+
+ + +
+

The $variable_skeleton() method returns the variable skeleton

+
+ +
+
variable_skeleton(transformed_parameters = TRUE, generated_quantities = TRUE)
+
+ +
+

Arguments

+
transformed_parameters
+

(boolean) Whether to include transformed parameters +in the skeleton (defaults to TRUE)

+ + +
generated_quantities
+

(boolean) Whether to include generated quantities +in the skeleton (defaults to TRUE)

+ +
+ + +
+

Examples

+
# \dontrun{
+fit_mcmc <- cmdstanr_example("logistic", method = "sample")
+fit_mcmc$init_model_methods()
+#> Error: Model methods cannot be used with a pre-compiled Stan executable, the model must be compiled again
+fit_mcmc$variable_skeleton()
+#> Error: The method has not been compiled, please call `init_model_methods()` first
+# }
+
+
+
+
+ +
+ + +
+ +
+

Site built with pkgdown 2.0.7.

+
+ +
+ + + + + + + + diff --git a/docs/reference/index.html b/docs/reference/index.html index cbf3081a9..7c5bfb855 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -1,74 +1,12 @@ - - - - - - - -Function reference • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Function reference • cmdstanr - - + + - - -
-
- -
- -
+
- - - - - - - - - - -
-

Package description

-

An overview of the package and how it differs from RStan.

+ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + - - - - - - + + - - - + + - - - + + - - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - + + + + - - - - - - - - - - - - - - -
+

Package description

+

An overview of the package and how it differs from RStan.

-

cmdstanr-package

+
+

cmdstanr-package cmdstanr CmdStanR

CmdStanR: the R interface to CmdStan

-

Installing and setting the path to CmdStan

-

Install CmdStan, assuming the necessary C++ toolchain.

+
+

Installing and setting the path to CmdStan

+

Install CmdStan, assuming the necessary C++ toolchain.

+

install_cmdstan() rebuild_cmdstan() cmdstan_make_local() check_cmdstan_toolchain()

Install CmdStan or clean and rebuild an existing installation

+

set_cmdstan_path() cmdstan_path() cmdstan_version()

Get or set the file path to the CmdStan installation

-

Running CmdStan from R

-

Run CmdStan from R.

+
+

Running CmdStan from R

+

Run CmdStan from R.

+

cmdstan_model()

Create a new CmdStanModel object

+

CmdStanModel

CmdStanModel objects

+

check_syntax()

Check syntax of a Stan program

+

compile()

Compile a Stan program

+

diagnose()

Run Stan's diagnose method

+
+

expose_functions()

+

Expose Stan functions to R

format()

Run stanc's auto-formatter on the model code.

+

generate_quantities()

Run Stan's standalone generated quantities method

+

optimize()

Run Stan's optimization algorithms

+

sample()

Run Stan's MCMC algorithms

+

sample_mpi()

Run Stan's MCMC algorithms with MPI

+

variables()

Input and output variables of a Stan program

+

variational()

Run Stan's variational approximation algorithms

+

cmdstanr_example() print_example_program()

Fit models for use in examples

-

Fitted model objects and methods

+
+

Fitted model objects and methods

+

CmdStanMCMC

CmdStanMCMC objects

+

CmdStanMLE

CmdStanMLE objects

+

CmdStanVB

CmdStanVB objects

+

CmdStanGQ

CmdStanGQ objects

+

CmdStanDiagnose

CmdStanDiagnose objects

+

cmdstan_summary() cmdstan_diagnose()

Run CmdStan's stansummary and diagnose utilities

+

code()

Return Stan code

+
+

constrain_variables()

+

Transform a set of unconstrained parameter values to the constrained scale

diagnostic_summary()

Sampler diagnostic summaries and warnings

+

draws()

Extract posterior draws

+
+

grad_log_prob()

+

Calculate the log-probability and the gradient w.r.t. each input for a +given vector of unconstrained parameters

gradients()

Extract gradients after diagnostic mode

+
+

hessian()

+

Calculate the log-probability , the gradient w.r.t. each input, and the hessian +for a given vector of unconstrained parameters

init()

Extract user-specified initial values

+
+

init_model_methods()

+

Compile additional methods for accessing the model log-probability function +and parameter constraining and unconstraining.

inv_metric()

Extract inverse metric (mass matrix) after MCMC

+
+

log_prob()

+

Calculate the log-probability given a provided vector of unconstrained parameters.

loo()

Leave-one-out cross-validation (LOO-CV)

+

lp() lp_approx()

Extract log probability (target)

+

metadata()

Extract metadata from CmdStan CSV files

+

mle()

Extract (penalized) maximum likelihood estimate after optimization

+

num_chains()

Extract number of chains after MCMC

+

output()

Access console output

+

profiles()

Return profiling data

+

return_codes()

Extract return codes from CmdStan

+

sampler_diagnostics()

Extract sampler diagnostics after MCMC

+

save_object()

Save fitted model object to a file

+

save_output_files() save_latent_dynamics_files() save_profile_files() save_data_file() output_files() profile_files() latent_dynamics_files() data_file()

Save output and data files

+

summary()

Compute a summary table of estimates and diagnostics

+

time()

Report timing of CmdStan runs

-

Other tools for working with CmdStan

+
+

unconstrain_draws()

+

Transform all parameter draws to the unconstrained scale

+

unconstrain_variables()

+

Transform a set of parameter values to the unconstrained scale

+

variable_skeleton()

+

Return the variable skeleton needed by the utils::relist function to re-structure a +vector of constrained parameter values to a named list

+

expose_functions()

+

Expose Stan functions to R

+

Other tools for working with CmdStan

+

read_cmdstan_csv() as_cmdstan_fit()

Read CmdStan CSV files into R

+

write_stan_json()

Write data to a JSON file readable by CmdStan

+

write_stan_file()

Write Stan code to a file

+

draws_to_csv()

Write posterior draws objects to CSV files suitable for running standalone generated quantities with CmdStan.

-

Using CmdStanR with knitr and R Markdown

+
+

as_mcmc.list()

+

Convert CmdStanMCMC to mcmc.list

+

as_draws(<CmdStanMCMC>) as_draws(<CmdStanMLE>) as_draws(<CmdStanVB>) as_draws(<CmdStanGQ>)

+

Create a draws object from a CmdStanR fitted model object

+

Using CmdStanR with knitr and R Markdown

+

register_knitr_engine()

Register CmdStanR's knitr engine for Stan

+

eng_cmdstan()

CmdStan knitr engine for Stan

- +
+
-
- +
- - + + diff --git a/docs/reference/install_cmdstan.html b/docs/reference/install_cmdstan.html index 85948b739..5995ec079 100644 --- a/docs/reference/install_cmdstan.html +++ b/docs/reference/install_cmdstan.html @@ -1,53 +1,5 @@ - - - - - - - -Install CmdStan or clean and rebuild an existing installation — install_cmdstan • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Install CmdStan or clean and rebuild an existing installation — install_cmdstan • cmdstanr - - - - - - - - - - - - + + - - -
-
- -
- -
+

The install_cmdstan() function attempts to download and -install the latest release of CmdStan. +install the latest release of CmdStan. Installing a previous release or a new release candidate is also possible by specifying the version or release_url argument. See the first few sections of the CmdStan -installation guide +installation guide for details on the C++ toolchain required for installing CmdStan.

The rebuild_cmdstan() function cleans and rebuilds the CmdStan installation. Use this function in case of any issues when compiling models.

@@ -213,154 +141,161 @@

Install CmdStan or clean and rebuild an existing installation

be called directly by the user.

-
install_cmdstan(
-  dir = NULL,
-  cores = getOption("mc.cores", 2),
-  quiet = FALSE,
-  overwrite = FALSE,
-  timeout = 1200,
-  version = NULL,
-  release_url = NULL,
-  cpp_options = list(),
-  check_toolchain = TRUE
-)
-
-rebuild_cmdstan(
-  dir = cmdstan_path(),
-  cores = getOption("mc.cores", 2),
-  quiet = FALSE,
-  timeout = 600
-)
-
-cmdstan_make_local(dir = cmdstan_path(), cpp_options = NULL, append = TRUE)
-
-check_cmdstan_toolchain(fix = FALSE, quiet = FALSE)
- -

Arguments

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
dir

(string) The path to the directory in which to install CmdStan. +

+
install_cmdstan(
+  dir = NULL,
+  cores = getOption("mc.cores", 2),
+  quiet = FALSE,
+  overwrite = FALSE,
+  timeout = 1200,
+  version = NULL,
+  release_url = NULL,
+  cpp_options = list(),
+  check_toolchain = TRUE,
+  wsl = FALSE
+)
+
+rebuild_cmdstan(
+  dir = cmdstan_path(),
+  cores = getOption("mc.cores", 2),
+  quiet = FALSE,
+  timeout = 600
+)
+
+cmdstan_make_local(dir = cmdstan_path(), cpp_options = NULL, append = TRUE)
+
+check_cmdstan_toolchain(fix = FALSE, quiet = FALSE)
+
+ +
+

Arguments

+
dir
+

(string) The path to the directory in which to install CmdStan. The default is to install it in a directory called .cmdstan within the -user's home directory (i.e, file.path(Sys.getenv("HOME"), ".cmdstan")).

cores

(integer) The number of CPU cores to use to parallelize building +user's home directory (i.e, file.path(Sys.getenv("HOME"), ".cmdstan")).

+ + +
cores
+

(integer) The number of CPU cores to use to parallelize building CmdStan and speed up installation. If cores is not specified then the default is to look for the option "mc.cores", which can be set for an -entire R session by options(mc.cores=value). If the "mc.cores" option -has not been set then the default is 2.

quiet

(logical) For install_cmdstan(), should the verbose output +entire R session by options(mc.cores=value). If the "mc.cores" option +has not been set then the default is 2.

+ + +
quiet
+

(logical) For install_cmdstan(), should the verbose output from the system processes be suppressed when building the CmdStan binaries? The default is FALSE. For check_cmdstan_toolchain(), should the function suppress printing informational messages? The default is FALSE. -If TRUE only errors will be printed.

overwrite

(logical) Should CmdStan still be downloaded and installed +If TRUE only errors will be printed.

+ + +
overwrite
+

(logical) Should CmdStan still be downloaded and installed even if an installation of the same version is found in dir? The default is FALSE, in which case an informative error is thrown instead of -overwriting the user's installation.

timeout

(positive real) Timeout (in seconds) for the build stage of -the installation.

version

(string) The CmdStan release version to install. The default +overwriting the user's installation.

+ + +
timeout
+

(positive real) Timeout (in seconds) for the build stage of +the installation.

+ + +
version
+

(string) The CmdStan release version to install. The default is NULL, which downloads the latest stable release from -https://github.com/stan-dev/cmdstan/releases.

release_url

(string) The URL for the specific CmdStan release or -release candidate to install. See https://github.com/stan-dev/cmdstan/releases. +https://github.com/stan-dev/cmdstan/releases.

+ + +
release_url
+

(string) The URL for the specific CmdStan release or +release candidate to install. See https://github.com/stan-dev/cmdstan/releases. The URL should point to the tarball (.tar.gz. file) itself, e.g., release_url="https://github.com/stan-dev/cmdstan/releases/download/v2.25.0/cmdstan-2.25.0.tar.gz". -If both version and release_url are specified then version will be used.

cpp_options

(list) Any makefile flags/variables to be written to -the make/local file. For example, list("CXX" = "clang++") will force -the use of clang for compilation.

check_toolchain

(logical) Should install_cmdstan() attempt to check +If both version and release_url are specified then version will be used.

+ + +
cpp_options
+

(list) Any makefile flags/variables to be written to +the make/local file. For example, list("CXX" = "clang++") will force +the use of clang for compilation.

+ + +
check_toolchain
+

(logical) Should install_cmdstan() attempt to check that the required toolchain is installed and properly configured. The -default is TRUE.

append

(logical) For cmdstan_make_local(), should the listed +default is TRUE.

+ + +
wsl
+

(logical) Should CmdStan be installed and run through the Windows +Subsystem for Linux (WSL). The default is FALSE.

+ + +
append
+

(logical) For cmdstan_make_local(), should the listed makefile flags be appended to the end of the existing make/local file? -The default is TRUE. If FALSE the file is overwritten.

fix

For check_cmdstan_toolchain(), should CmdStanR attempt to fix +The default is TRUE. If FALSE the file is overwritten.

+ + +
fix
+

For check_cmdstan_toolchain(), should CmdStanR attempt to fix any detected toolchain problems? Currently this option is only available on Windows. The default is FALSE, in which case problems are only reported -along with suggested fixes.

+along with suggested fixes.

-

Value

+
+
+

Value

+ -

For cmdstan_make_local(), if cpp_options=NULL then the existing +

For cmdstan_make_local(), if cpp_options=NULL then the existing contents of make/local are returned without writing anything, otherwise the updated contents are returned.

+
-

Examples

-
# \dontrun{ -check_cmdstan_toolchain() -
#> The C++ toolchain required for CmdStan is setup properly!
-# install_cmdstan(cores = 4) - -cpp_options <- list( - "CXX" = "clang++", - "CXXFLAGS+= -march=native", - PRECOMPILED_HEADERS = TRUE -) -# cmdstan_make_local(cpp_options = cpp_options) -# rebuild_cmdstan() -# } - -
+
+

Examples

+
# \dontrun{
+check_cmdstan_toolchain()
+#> The C++ toolchain required for CmdStan is setup properly!
+
+# install_cmdstan(cores = 4)
+
+cpp_options <- list(
+  "CXX" = "clang++",
+  "CXXFLAGS+= -march=native",
+  PRECOMPILED_HEADERS = TRUE
+)
+# cmdstan_make_local(cpp_options = cpp_options)
+# rebuild_cmdstan()
+# }
+
+
+
+
-
- +
- - + + diff --git a/docs/reference/model-method-check_syntax.html b/docs/reference/model-method-check_syntax.html index 933874799..1d321677e 100644 --- a/docs/reference/model-method-check_syntax.html +++ b/docs/reference/model-method-check_syntax.html @@ -1,77 +1,14 @@ - - - - - - - -Check syntax of a Stan program — model-method-check_syntax • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Check syntax of a Stan program — model-method-check_syntax • cmdstanr - - - - - - - - - - - - + + - - -
-
- -
- -
+
-

The $check_syntax() method of a CmdStanModel object +

The $check_syntax() method of a CmdStanModel object checks the Stan program for syntax errors and returns TRUE (invisibly) if parsing succeeds. If invalid syntax in found an error is thrown.

-
check_syntax(
-  pedantic = FALSE,
-  include_paths = NULL,
-  stanc_options = list(),
-  quiet = FALSE
-)
+
+
check_syntax(
+  pedantic = FALSE,
+  include_paths = NULL,
+  stanc_options = list(),
+  quiet = FALSE
+)
+
-

Arguments

- - - - - - - - - - - - - - - - - - -
pedantic

(logical) Should pedantic mode be turned on? The default is +

+

Arguments

+
pedantic
+

(logical) Should pedantic mode be turned on? The default is FALSE. Pedantic mode attempts to warn you about potential issues in your -Stan program beyond syntax errors. For details see the Pedantic mode chapter in -the Stan Reference Manual.

include_paths

(character vector) Paths to directories where Stan +Stan program beyond syntax errors. For details see the Pedantic mode chapter in +the Stan Reference Manual.

+ + +
include_paths
+

(character vector) Paths to directories where Stan should look for files specified in #include directives in the Stan -program.

stanc_options

(list) Any other Stan-to-C++ transpiler options to be +program.

+ + +
stanc_options
+

(list) Any other Stan-to-C++ transpiler options to be used when compiling the model. See the documentation for the -$compile() method for details.

quiet

(logical) Should informational messages be suppressed? The +$compile() method for details.

+ + +
quiet
+

(logical) Should informational messages be suppressed? The default is FALSE, which will print a message if the Stan program is valid or the compiler error message if there are syntax errors. If TRUE, only -the error message will be printed.

+the error message will be printed.

-

Value

+
+
+

Value

+ -

The $check_syntax() method returns TRUE (invisibly) if the model +

The $check_syntax() method returns TRUE (invisibly) if the model is valid.

-

See also

- -

The CmdStanR website -(mc-stan.org/cmdstanr) for online +

+
+

See also

+

The CmdStanR website +(mc-stan.org/cmdstanr) for online documentation and tutorials.

-

The Stan and CmdStan documentation:

- -

Other CmdStanModel methods: -model-method-compile, -model-method-diagnose, -model-method-format, -model-method-generate-quantities, -model-method-optimize, -model-method-sample_mpi, -model-method-sample, -model-method-variables, -model-method-variational

- -

Examples

-
# \dontrun{ -file <- write_stan_file(" -data { - int N; - int y[N]; -} -parameters { - // should have <lower=0> but omitting to demonstrate pedantic mode - real lambda; -} -model { - y ~ poisson(lambda); -} -") -mod <- cmdstan_model(file, compile = FALSE) - -# the program is syntactically correct, however... -mod$check_syntax() -
#> Warning in '/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/model_74b584fd23ea8c78eceda86d1d425fe8.stan', line 4, column 2: Declaration -#> of arrays by placing brackets after a variable name is deprecated and -#> will be removed in Stan 2.32.0. Instead use the array keyword before the -#> type. This can be changed automatically using the auto-format flag to -#> stanc
#> Stan program is syntactically correct
-# pedantic mode will warn that lambda should be constrained to be positive -# and that lambda has no prior distribution -mod$check_syntax(pedantic = TRUE) -
#> Warning in '/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/model_74b584fd23ea8c78eceda86d1d425fe8.stan', line 4, column 2: Declaration -#> of arrays by placing brackets after a variable name is deprecated and -#> will be removed in Stan 2.32.0. Instead use the array keyword before the -#> type. This can be changed automatically using the auto-format flag to -#> stanc -#> Warning in '/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/model_74b584fd23ea8c78eceda86d1d425fe8.stan', line 11, column 14: A -#> poisson distribution is given parameter lambda as a rate parameter -#> (argument 1), but lambda was not constrained to be strictly positive. -#> Warning: The parameter lambda has no priors.
#> Stan program is syntactically correct
+
-
+
+

Examples

+
# \dontrun{
+file <- write_stan_file("
+data {
+  int N;
+  int y[N];
+}
+parameters {
+  // should have <lower=0> but omitting to demonstrate pedantic mode
+  real lambda;
+}
+model {
+  y ~ poisson(lambda);
+}
+")
+mod <- cmdstan_model(file, compile = FALSE)
+
+# the program is syntactically correct, however...
+mod$check_syntax()
+#> Warning in '/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/model_74b584fd23ea8c78eceda86d1d425fe8.stan', line 4, column 2: Declaration
+#>     of arrays by placing brackets after a variable name is deprecated and
+#>     will be removed in Stan 2.33.0. Instead use the array keyword before the
+#>     type. This can be changed automatically using the auto-format flag to
+#>     stanc
+#> Stan program is syntactically correct
+
+# pedantic mode will warn that lambda should be constrained to be positive
+# and that lambda has no prior distribution
+mod$check_syntax(pedantic = TRUE)
+#> Warning in '/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/model_74b584fd23ea8c78eceda86d1d425fe8.stan', line 4, column 2: Declaration
+#>     of arrays by placing brackets after a variable name is deprecated and
+#>     will be removed in Stan 2.33.0. Instead use the array keyword before the
+#>     type. This can be changed automatically using the auto-format flag to
+#>     stanc
+#> Warning in '/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/model_74b584fd23ea8c78eceda86d1d425fe8.stan', line 11, column 14: A
+#>     poisson distribution is given parameter lambda as a rate parameter
+#>     (argument 1), but lambda was not constrained to be strictly positive.
+#> Warning: The parameter lambda has no priors. This means either no prior is
+#>     provided, or the prior(s) depend on data variables. In the later case,
+#>     this may be a false positive.
+#> Stan program is syntactically correct
+# }
+
+
+
+
-
- +
- - + + diff --git a/docs/reference/model-method-compile.html b/docs/reference/model-method-compile.html index b0c7f4429..63b0fa515 100644 --- a/docs/reference/model-method-compile.html +++ b/docs/reference/model-method-compile.html @@ -1,53 +1,5 @@ - - - - - - - -Compile a Stan program — model-method-compile • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Compile a Stan program — model-method-compile • cmdstanr - - - - - - - - - - - + + - - - -
-
- -
- -
+
-

The $compile() method of a CmdStanModel object checks the +

The $compile() method of a CmdStanModel object checks the syntax of the Stan program, translates the program to C++, and creates a compiled executable. To just check the syntax of a Stan program without -compiling it use the $check_syntax() method +compiling it use the $check_syntax() method instead.

In most cases the user does not need to explicitly call the $compile() -method as compilation will occur when calling cmdstan_model(). However it -is possible to set compile=FALSE in the call to cmdstan_model() and +method as compilation will occur when calling cmdstan_model(). However it +is possible to set compile=FALSE in the call to cmdstan_model() and subsequently call the $compile() method directly.

After compilation, the paths to the executable and the .hpp file containing the generated C++ code are available via the $exe_file() and @@ -207,167 +135,195 @@

Compile a Stan program

$save_hpp_file(dir).

-
compile(
-  quiet = TRUE,
-  dir = NULL,
-  pedantic = FALSE,
-  include_paths = NULL,
-  user_header = NULL,
-  cpp_options = list(),
-  stanc_options = list(),
-  force_recompile = getOption("cmdstanr_force_recompile", default = FALSE),
-  threads = FALSE
-)
- -

Arguments

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
quiet

(logical) Should the verbose output from CmdStan during +

+
compile(
+  quiet = TRUE,
+  dir = NULL,
+  pedantic = FALSE,
+  include_paths = NULL,
+  user_header = NULL,
+  cpp_options = list(),
+  stanc_options = list(),
+  force_recompile = getOption("cmdstanr_force_recompile", default = FALSE),
+  compile_model_methods = FALSE,
+  compile_hessian_method = FALSE,
+  compile_standalone = FALSE,
+  threads = FALSE
+)
+
+ +
+

Arguments

+
quiet
+

(logical) Should the verbose output from CmdStan during compilation be suppressed? The default is TRUE, but if you encounter an error we recommend trying again with quiet=FALSE to see more of the -output.

dir

(string) The path to the directory in which to store the CmdStan +output.

+ + +
dir
+

(string) The path to the directory in which to store the CmdStan executable (or .hpp file if using $save_hpp_file()). The default is the -same location as the Stan program.

pedantic

(logical) Should pedantic mode be turned on? The default is +same location as the Stan program.

+ + +
pedantic
+

(logical) Should pedantic mode be turned on? The default is FALSE. Pedantic mode attempts to warn you about potential issues in your -Stan program beyond syntax errors. For details see the Pedantic mode chapter in +Stan program beyond syntax errors. For details see the Pedantic mode chapter in the Stan Reference Manual. Note: to do a pedantic check for a model without compiling it or for a model that is already compiled the -$check_syntax() method can be used instead.

include_paths

(character vector) Paths to directories where Stan +$check_syntax() method can be used instead.

+ + +
include_paths
+

(character vector) Paths to directories where Stan should look for files specified in #include directives in the Stan -program.

user_header

(string) The path to a C++ file (with a .hpp extension) -to compile with the Stan model.

cpp_options

(list) Any makefile options to be used when compiling the +program.

+ + +
user_header
+

(string) The path to a C++ file (with a .hpp extension) +to compile with the Stan model.

+ + +
cpp_options
+

(list) Any makefile options to be used when compiling the model (STAN_THREADS, STAN_MPI, STAN_OPENCL, etc.). Anything you would otherwise write in the make/local file. For an example of using threading see the Stan case study -Reduce Sum: A Minimal Example.

stanc_options

(list) Any Stan-to-C++ transpiler options to be used +Reduce Sum: A Minimal Example.

+ + +
stanc_options
+

(list) Any Stan-to-C++ transpiler options to be used when compiling the model. See the Examples section below as well as the stanc chapter of the CmdStan Guide for more details on available options: -https://mc-stan.org/docs/cmdstan-guide/stanc.html.

force_recompile

(logical) Should the model be recompiled even if was +https://mc-stan.org/docs/cmdstan-guide/stanc.html.

+ + +
force_recompile
+

(logical) Should the model be recompiled even if was not modified since last compiled. The default is FALSE. Can also be set -via a global cmdstanr_force_recompile option.

threads

Deprecated and will be removed in a future release. Please -turn on threading via cpp_options = list(stan_threads = TRUE) instead.

- -

Value

- -

The $compile() method is called for its side effect of creating the -executable and adding its path to the CmdStanModel object, but it also -returns the CmdStanModel object invisibly.

-

After compilation, the $exe_file(), $hpp_file(), and $save_hpp_file() -methods can be used and return file paths.

-

See also

- -

The $check_syntax() method to check +via a global cmdstanr_force_recompile option.

+ + +
compile_model_methods
+

(logical) Compile additional model methods +(log_prob(), grad_log_prob(), constrain_variables(), +unconstrain_variables()).

+ + +
compile_hessian_method
+

(logical) Should the (experimental) hessian() method be +be compiled with the model methods?

+ + +
compile_standalone
+

(logical) Should functions in the Stan model be +compiled for use in R? If TRUE the functions will be available via the +functions field in the compiled model object. This can also be done after +compilation using the +$expose_functions() method.

+ + +
threads
+

Deprecated and will be removed in a future release. Please +turn on threading via cpp_options = list(stan_threads = TRUE) instead.

+ +
+
+

Value

+ + +

The $compile() method is called for its side effect of creating the +executable and adding its path to the CmdStanModel object, but it also +returns the CmdStanModel object invisibly.

+ + +

After compilation, the $exe_file(), $hpp_file(), and $save_hpp_file()

+ + +

methods can be used and return file paths.

+
+
+

See also

+

The $check_syntax() method to check Stan syntax or enable pedantic model without compiling.

The CmdStanR website -(mc-stan.org/cmdstanr) for online +(mc-stan.org/cmdstanr) for online documentation and tutorials.

-

The Stan and CmdStan documentation:

- -

Other CmdStanModel methods: -model-method-check_syntax, -model-method-diagnose, -model-method-format, -model-method-generate-quantities, -model-method-optimize, -model-method-sample_mpi, -model-method-sample, -model-method-variables, -model-method-variational

- -

Examples

-
# \dontrun{ -file <- file.path(cmdstan_path(), "examples/bernoulli/bernoulli.stan") - -# by default compilation happens when cmdstan_model() is called. -# to delay compilation until calling the $compile() method set compile=FALSE -mod <- cmdstan_model(file, compile = FALSE) -mod$compile() -mod$exe_file() -
#> [1] "/Users/jgabry/.cmdstan/cmdstan-2.29.1/examples/bernoulli/bernoulli"
-# turn on threading support (for using functions that support within-chain parallelization) -mod$compile(force_recompile = TRUE, cpp_options = list(stan_threads = TRUE)) -mod$exe_file() -
#> [1] "/Users/jgabry/.cmdstan/cmdstan-2.29.1/examples/bernoulli/bernoulli"
-# turn on pedantic mode (new in Stan v2.24) -file_pedantic <- write_stan_file(" -parameters { - real sigma; // pedantic mode will warn about missing <lower=0> -} -model { - sigma ~ exponential(1); -} -") -mod <- cmdstan_model(file_pedantic, pedantic = TRUE) -
#> Warning in '/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/model-d65457acfdf5.stan', line 6, column 2: Parameter -#> sigma is given a exponential distribution, which has strictly positive -#> support, but sigma was not constrained to be strictly positive.
-# } - -
+

The Stan and CmdStan documentation:

Other CmdStanModel methods: +model-method-check_syntax, +model-method-diagnose, +model-method-expose_functions, +model-method-format, +model-method-generate-quantities, +model-method-optimize, +model-method-sample_mpi, +model-method-sample, +model-method-variables, +model-method-variational

+
+ +
+

Examples

+
# \dontrun{
+file <- file.path(cmdstan_path(), "examples/bernoulli/bernoulli.stan")
+
+# by default compilation happens when cmdstan_model() is called.
+# to delay compilation until calling the $compile() method set compile=FALSE
+mod <- cmdstan_model(file, compile = FALSE)
+mod$compile()
+mod$exe_file()
+#> [1] "/Users/jgabry/.cmdstan/cmdstan-2.32.2/examples/bernoulli/bernoulli"
+
+# turn on threading support (for using functions that support within-chain parallelization)
+mod$compile(force_recompile = TRUE, cpp_options = list(stan_threads = TRUE))
+mod$exe_file()
+#> [1] "/Users/jgabry/.cmdstan/cmdstan-2.32.2/examples/bernoulli/bernoulli"
+
+# turn on pedantic mode (new in Stan v2.24)
+file_pedantic <- write_stan_file("
+parameters {
+  real sigma;  // pedantic mode will warn about missing <lower=0>
+}
+model {
+  sigma ~ exponential(1);
+}
+")
+mod <- cmdstan_model(file_pedantic, pedantic = TRUE)
+#> Warning in '/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/model-1621885c67f.stan', line 6, column 2: Parameter
+#>     sigma is given a exponential distribution, which has strictly positive
+#>     support, but sigma was not constrained to be strictly positive.
+
+# }
+
+
+
+
-
- +
- - + + diff --git a/docs/reference/model-method-diagnose.html b/docs/reference/model-method-diagnose.html index 602c34747..548b5959b 100644 --- a/docs/reference/model-method-diagnose.html +++ b/docs/reference/model-method-diagnose.html @@ -1,79 +1,16 @@ - - - - - - - -Run Stan's diagnose method — model-method-diagnose • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run Stan's diagnose method — model-method-diagnose • cmdstanr - - - - - - - - - - - - + + - - -
-
- -
- -
+
-

The $diagnose() method of a CmdStanModel object +

The $diagnose() method of a CmdStanModel object runs Stan's basic diagnostic feature that will calculate the gradients of the initial state and compare them with gradients calculated by finite differences. Discrepancies between the two indicate that there is a problem with the model or initial states or else there is a bug in Stan.

-
diagnose(
-  data = NULL,
-  seed = NULL,
-  init = NULL,
-  output_dir = NULL,
-  output_basename = NULL,
-  epsilon = NULL,
-  error = NULL
-)
+
+
diagnose(
+  data = NULL,
+  seed = NULL,
+  init = NULL,
+  output_dir = NULL,
+  output_basename = NULL,
+  epsilon = NULL,
+  error = NULL
+)
+
-

Arguments

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
data

(multiple options) The data to use for the variables specified in -the data block of the Stan program. One of the following:

    -
  • A named list of R objects with the names corresponding to variables +

    +

    Arguments

    +
    data
    +

    (multiple options) The data to use for the variables specified in +the data block of the Stan program. One of the following:

    • A named list of R objects with the names corresponding to variables declared in the data block of the Stan program. Internally this list is then -written to JSON for CmdStan using write_stan_json(). See -write_stan_json() for details on the conversions performed on R objects +written to JSON for CmdStan using write_stan_json(). See +write_stan_json() for details on the conversions performed on R objects before they are passed to Stan.

    • A path to a data file compatible with CmdStan (JSON or R dump). See the appendices in the CmdStan guide for details on using these formats.

    • NULL or an empty list if the Stan program has no data block.

    • -
seed

(positive integer(s)) A seed for the (P)RNG to pass to CmdStan. + + + +

seed
+

(positive integer(s)) A seed for the (P)RNG to pass to CmdStan. In the case of multi-chain sampling the single seed will automatically be augmented by the the run (chain) ID so that each chain uses a different seed. The exception is the transformed data block, which defaults to @@ -224,19 +151,18 @@

Arg chains if RNG functions are used. The only time seed should be specified as a vector (one element per chain) is if RNG functions are used in transformed data and the goal is to generate different data for each -chain.

init

(multiple options) The initialization method to use for the +chain.

+ + +
init
+

(multiple options) The initialization method to use for the variables declared in the parameters block of the Stan program. One of -the following:

    -
  • A real number x>0. This initializes all parameters randomly between +the following:

    • A real number x>0. This initializes all parameters randomly between [-x,x] on the unconstrained parameter space.;

    • The number 0. This initializes all parameters to 0;

    • A character vector of paths (one per chain) to JSON or Rdump files containing initial values for all or some parameters. See -write_stan_json() to write R objects to JSON files compatible with +write_stan_json() to write R objects to JSON files compatible with CmdStan.

    • A list of lists containing initial values for all or some parameters. For MCMC the list should contain a sublist for each chain. For optimization and @@ -249,105 +175,104 @@

      Arg has argument chain_id it will be supplied with the chain id (from 1 to number of chains) when called to generate the initial values. See Examples.

    • -
output_dir

(string) A path to a directory where CmdStan should write + + + +

output_dir
+

(string) A path to a directory where CmdStan should write its output CSV files. For interactive use this can typically be left at NULL (temporary directory) since CmdStanR makes the CmdStan output (posterior draws and diagnostics) available in R via methods of the fitted -model objects. The behavior of output_dir is as follows:

    -
  • If NULL (the default), then the CSV files are written to a temporary +model objects. The behavior of output_dir is as follows:

    • If NULL (the default), then the CSV files are written to a temporary directory and only saved permanently if the user calls one of the $save_* methods of the fitted model object (e.g., -$save_output_files()). These temporary +$save_output_files()). These temporary files are removed when the fitted model object is -garbage collected (manually or automatically).

    • +garbage collected (manually or automatically).

    • If a path, then the files are created in output_dir with names corresponding to the defaults used by $save_output_files().

    • -
output_basename

(string) A string to use as a prefix for the names of + + + +

output_basename
+

(string) A string to use as a prefix for the names of the output CSV files of CmdStan. If NULL (the default), the basename of the output CSV files will be comprised from the model name, timestamp, and -5 random characters.

epsilon

(positive real) The finite difference step size. Default -value is 1e-6.

error

(positive real) The error threshold. Default value is 1e-6.

+5 random characters.

-

Value

-

A CmdStanDiagnose object.

-

See also

+
epsilon
+

(positive real) The finite difference step size. Default +value is 1e-6.

-

The CmdStanR website -(mc-stan.org/cmdstanr) for online -documentation and tutorials.

-

The Stan and CmdStan documentation:

-

Other CmdStanModel methods: -model-method-check_syntax, -model-method-compile, -model-method-format, -model-method-generate-quantities, -model-method-optimize, -model-method-sample_mpi, -model-method-sample, -model-method-variables, -model-method-variational

+
error
+

(positive real) The error threshold. Default value is 1e-6.

-

Examples

-
# \dontrun{ -test <- cmdstanr_example("logistic", method = "diagnose") +
+
+

Value

+ -# retrieve the gradients -test$gradients() -
#> param_idx value model finite_diff error -#> 1 0 1.3362100 -9.33442 -9.33442 2.88445e-08 -#> 2 1 1.7816500 -32.65590 -32.65590 -2.89809e-10 -#> 3 2 -0.0718337 -2.56116 -2.56116 -2.13148e-08 -#> 4 3 -1.9334500 29.16060 29.16060 -3.65847e-08
# } +

A CmdStanDiagnose object.

+
+
+

See also

+ +
-
+
+

Examples

+
# \dontrun{
+test <- cmdstanr_example("logistic", method = "diagnose")
+
+# retrieve the gradients
+test$gradients()
+#>   param_idx     value     model finite_diff        error
+#> 1         0 -1.310990  28.37700    28.37700 -1.92695e-08
+#> 2         1 -1.931430   8.55341     8.55341 -1.60934e-08
+#> 3         2  0.751196 -12.17180   -12.17180 -2.15070e-08
+#> 4         3 -1.808550  25.15020    25.15020  6.91254e-09
+# }
+
+
+
+
-
- +
- - + + diff --git a/docs/reference/model-method-expose_functions.html b/docs/reference/model-method-expose_functions.html new file mode 100644 index 000000000..ad674e0e1 --- /dev/null +++ b/docs/reference/model-method-expose_functions.html @@ -0,0 +1,231 @@ + +Expose Stan functions to R — model-method-expose_functions • cmdstanr + + +
+
+ + + +
+
+ + +
+

The $expose_functions() method of a CmdStanModel object +will compile the functions in the Stan program's functions block and +expose them for use in R. This can also be specified via the +compile_standalone argument to the $compile() +method.

+

This method is also available for fitted model objects (CmdStanMCMC, CmdStanVB, etc.). +See Examples.

+

Note: there may be many compiler warnings emitted during compilation but +these can be ignored so long as they are warnings and not errors.

+
+ +
+
expose_functions(global = FALSE, verbose = FALSE)
+
+ +
+

Arguments

+
global
+

(logical) Should the functions be added to the Global +Environment? The default is FALSE, in which case the functions are +available via the functions field of the R6 object.

+ + +
verbose
+

(logical) Should detailed information about generated code be +printed to the console? Defaults to FALSE.

+ +
+
+

See also

+

The CmdStanR website +(mc-stan.org/cmdstanr) for online +documentation and tutorials.

+

The Stan and CmdStan documentation:

Other CmdStanModel methods: +model-method-check_syntax, +model-method-compile, +model-method-diagnose, +model-method-format, +model-method-generate-quantities, +model-method-optimize, +model-method-sample_mpi, +model-method-sample, +model-method-variables, +model-method-variational

+
+ +
+

Examples

+
# \dontrun{
+stan_file <- write_stan_file(
+ "
+ functions {
+   real a_plus_b(real a, real b) {
+     return a + b;
+   }
+ }
+ parameters {
+   real x;
+ }
+ model {
+   x ~ std_normal();
+ }
+ "
+)
+mod <- cmdstan_model(stan_file)
+mod$expose_functions()
+#> Compiling standalone functions...
+mod$functions$a_plus_b(1, 2)
+#> [1] 3
+
+fit <- mod$sample(refresh = 0)
+#> Running MCMC with 4 sequential chains...
+#> 
+#> Chain 1 finished in 0.0 seconds.
+#> Chain 2 finished in 0.0 seconds.
+#> Chain 3 finished in 0.0 seconds.
+#> Chain 4 finished in 0.0 seconds.
+#> 
+#> All 4 chains finished successfully.
+#> Mean chain execution time: 0.0 seconds.
+#> Total execution time: 0.6 seconds.
+#> 
+fit$expose_functions() # already compiled because of above but this would compile them otherwise
+#> Functions already compiled, nothing to do!
+fit$functions$a_plus_b(1, 2)
+#> [1] 3
+# }
+
+
+
+
+
+ +
+ + +
+ +
+

Site built with pkgdown 2.0.7.

+
+ +
+ + + + + + + + diff --git a/docs/reference/model-method-format.html b/docs/reference/model-method-format.html index 9bb9f867e..041779776 100644 --- a/docs/reference/model-method-format.html +++ b/docs/reference/model-method-format.html @@ -1,77 +1,14 @@ - - - - - - - -Run stanc's auto-formatter on the model code. — model-method-format • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run stanc's auto-formatter on the model code. — model-method-format • cmdstanr - - - - - - - - - - - - + + - - -
-
- -
- -
+
-

The $format() method of a CmdStanModel object +

The $format() method of a CmdStanModel object runs stanc's auto-formatter on the model code. Either saves the formatted model directly back to the file or prints it for inspection.

-
format(
-  overwrite_file = FALSE,
-  canonicalize = FALSE,
-  backup = TRUE,
-  max_line_length = NULL,
-  quiet = FALSE
-)
+
+
format(
+  overwrite_file = FALSE,
+  canonicalize = FALSE,
+  backup = TRUE,
+  max_line_length = NULL,
+  quiet = FALSE
+)
+
+ +
+

Arguments

+
overwrite_file
+

(logical) Should the formatted code be written back +to the input model file. The default is FALSE.

+ -

Arguments

- - - - - - - - - - - - - - - - - - - - - - -
overwrite_file

(logical) Should the formatted code be written back -to the input model file. The default is FALSE.

canonicalize

(list or logical) Defines whether or not the compiler +

canonicalize
+

(list or logical) Defines whether or not the compiler should 'canonicalize' the Stan model, removing things like deprecated syntax. Default is FALSE. If TRUE, all canonicalizations are run. You can also supply a list of strings which represent options. In that case the options -are passed to stanc (new in Stan 2.29). See the User's guide section -for available canonicalization options.

backup

(logical) If TRUE, create stanfile.bak backups before +are passed to stanc (new in Stan 2.29). See the User's guide section +for available canonicalization options.

+ + +
backup
+

(logical) If TRUE, create stanfile.bak backups before writing to the file. Disable this option if you're sure you have other copies of the file or are using a version control system like Git. Defaults -to TRUE. The value is ignored if overwrite_file = FALSE.

max_line_length

(integer) The maximum length of a line when formatting. -The default is NULL, which defers to the default line length of stanc.

quiet

(logical) Should informational messages be suppressed? The -default is FALSE.

+to TRUE. The value is ignored if overwrite_file = FALSE.

-

Value

-

The $format() method returns TRUE (invisibly) if the model -is valid.

-

See also

+
max_line_length
+

(integer) The maximum length of a line when formatting. +The default is NULL, which defers to the default line length of stanc.

-

The CmdStanR website -(mc-stan.org/cmdstanr) for online -documentation and tutorials.

-

The Stan and CmdStan documentation:

-

Other CmdStanModel methods: -model-method-check_syntax, -model-method-compile, -model-method-diagnose, -model-method-generate-quantities, -model-method-optimize, -model-method-sample_mpi, -model-method-sample, -model-method-variables, -model-method-variational

+
quiet
+

(logical) Should informational messages be suppressed? The +default is FALSE.

+ +
+
+

Value

+ -

Examples

-
# \dontrun{ -file <- write_stan_file(" -data { - int N; - int y[N]; -} -parameters { - real lambda; -} -model { - target += - poisson_log(y | lambda); -} -") -mod <- cmdstan_model(file, compile = FALSE) -mod$format(canonicalize = TRUE) -
#> Semantic error in '/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/model_44779dbadddd7550b5164157b77f4d11.stan', line 11, column 1 to column 24: -#> ------------------------------------------------- -#> 9: model { -#> 10: target += -#> 11: poisson_log(y | lambda); -#> ^ -#> 12: } -#> 13: -#> ------------------------------------------------- -#> -#> Only functions with names ending in _lpdf, _lupdf, _lpmf, _lupmf, _cdf, _lcdf, _lccdf can make use of conditional notation.
#> Error: Syntax error found! See the message above for more information.
# } +

The $format() method returns TRUE (invisibly) if the model +is valid.

+
+
+

See also

+ +
-
+
+

Examples

+
# \dontrun{
+file <- write_stan_file("
+data {
+  int N;
+  int y[N];
+}
+parameters {
+  real                     lambda;
+}
+model {
+  target +=
+ poisson_lpmf(y | lambda);
+}
+")
+mod <- cmdstan_model(file, compile = FALSE)
+mod$format(canonicalize = TRUE)
+#> data {
+#>   int N;
+#>   array[N] int y;
+#> }
+#> parameters {
+#>   real lambda;
+#> }
+#> model {
+#>   target += poisson_lpmf(y | lambda);
+#> }
+#> 
+#> 
+# }
+
+
+
+
-
- +
- - + + diff --git a/docs/reference/model-method-generate-quantities.html b/docs/reference/model-method-generate-quantities.html index 8e5b08ce5..63e57c29a 100644 --- a/docs/reference/model-method-generate-quantities.html +++ b/docs/reference/model-method-generate-quantities.html @@ -1,77 +1,14 @@ - - - - - - - -Run Stan's standalone generated quantities method — model-method-generate-quantities • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run Stan's standalone generated quantities method — model-method-generate-quantities • cmdstanr - - - - - - - - - - - + + - - - -
-
- -
- -
+
-

The $generate_quantities() method of a CmdStanModel object +

The $generate_quantities() method of a CmdStanModel object runs Stan's standalone generated quantities to obtain generated quantities based on previously fitted parameters.

-
generate_quantities(
-  fitted_params,
-  data = NULL,
-  seed = NULL,
-  output_dir = NULL,
-  output_basename = NULL,
-  sig_figs = NULL,
-  parallel_chains = getOption("mc.cores", 1),
-  threads_per_chain = NULL,
-  opencl_ids = NULL
-)
- -

Arguments

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
fitted_params

(multiple options) The parameter draws to use. One of -the following:

+
+
generate_quantities(
+  fitted_params,
+  data = NULL,
+  seed = NULL,
+  output_dir = NULL,
+  output_basename = NULL,
+  sig_figs = NULL,
+  parallel_chains = getOption("mc.cores", 1),
+  threads_per_chain = NULL,
+  opencl_ids = NULL
+)
+
-

NOTE: if you plan on making many calls to $generate_quantities() then the +

+

Arguments

+
fitted_params
+

(multiple options) The parameter draws to use. One of +the following:

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.

data

(multiple options) The data to use for the variables specified in -the data block of the Stan program. One of the following:

    -
  • A named list of R objects with the names corresponding to variables +use draws_to_csv() once to write them and then pass the resulting file +paths to $generate_quantities() as many times as needed.

    + + +
    data
    +

    (multiple options) The data to use for the variables specified in +the data block of the Stan program. One of the following:

    • A named list of R objects with the names corresponding to variables declared in the data block of the Stan program. Internally this list is then -written to JSON for CmdStan using write_stan_json(). See -write_stan_json() for details on the conversions performed on R objects +written to JSON for CmdStan using write_stan_json(). See +write_stan_json() for details on the conversions performed on R objects before they are passed to Stan.

    • A path to a data file compatible with CmdStan (JSON or R dump). See the appendices in the CmdStan guide for details on using these formats.

    • NULL or an empty list if the Stan program has no data block.

    • -
seed

(positive integer(s)) A seed for the (P)RNG to pass to CmdStan. + + + +

seed
+

(positive integer(s)) A seed for the (P)RNG to pass to CmdStan. In the case of multi-chain sampling the single seed will automatically be augmented by the the run (chain) ID so that each chain uses a different seed. The exception is the transformed data block, which defaults to @@ -239,198 +163,200 @@

Arg chains if RNG functions are used. The only time seed should be specified as a vector (one element per chain) is if RNG functions are used in transformed data and the goal is to generate different data for each -chain.

output_dir

(string) A path to a directory where CmdStan should write +chain.

+ + +
output_dir
+

(string) A path to a directory where CmdStan should write its output CSV files. For interactive use this can typically be left at NULL (temporary directory) since CmdStanR makes the CmdStan output (posterior draws and diagnostics) available in R via methods of the fitted -model objects. The behavior of output_dir is as follows:

    -
  • If NULL (the default), then the CSV files are written to a temporary +model objects. The behavior of output_dir is as follows:

    • If NULL (the default), then the CSV files are written to a temporary directory and only saved permanently if the user calls one of the $save_* methods of the fitted model object (e.g., -$save_output_files()). These temporary +$save_output_files()). These temporary files are removed when the fitted model object is -garbage collected (manually or automatically).

    • +garbage collected (manually or automatically).

    • If a path, then the files are created in output_dir with names corresponding to the defaults used by $save_output_files().

    • -
output_basename

(string) A string to use as a prefix for the names of + + + +

output_basename
+

(string) A string to use as a prefix for the names of the output CSV files of CmdStan. If NULL (the default), the basename of the output CSV files will be comprised from the model name, timestamp, and -5 random characters.

sig_figs

(positive integer) The number of significant figures used +5 random characters.

+ + +
sig_figs
+

(positive integer) The number of significant figures used when storing the output values. By default, CmdStan represent the output values with 6 significant figures. The upper limit for sig_figs is 18. Increasing this value will result in larger output CSV files and thus an -increased usage of disk space.

parallel_chains

(positive integer) The maximum number of MCMC chains +increased usage of disk space.

+ + +
parallel_chains
+

(positive integer) The maximum number of MCMC chains to run in parallel. If parallel_chains is not specified then the default is to look for the option "mc.cores", which can be set for an entire R -session by options(mc.cores=value). If the "mc.cores" option has not -been set then the default is 1.

threads_per_chain

(positive integer) If the model was -compiled with threading support, the number of +session by options(mc.cores=value). If the "mc.cores" option has not +been set then the default is 1.

+ + +
threads_per_chain
+

(positive integer) If the model was +compiled with threading support, the number of threads to use in parallelized sections within an MCMC chain (e.g., when using the Stan functions reduce_sum() or map_rect()). This is in contrast with parallel_chains, which specifies the number of chains to run in parallel. The actual number of CPU cores used is parallel_chains*threads_per_chain. For an example of using threading see the Stan case study -Reduce Sum: A Minimal Example.

opencl_ids

(integer vector of length 2) The platform and +Reduce Sum: A Minimal Example.

+ + +
opencl_ids
+

(integer vector of length 2) The platform and device IDs of the OpenCL device to use for fitting. The model must be compiled with cpp_options = list(stan_opencl = TRUE) for this -argument to have an effect.

- -

Value

+argument to have an effect.

-

A CmdStanGQ object.

-

See also

+
+
+

Value

+ -

The CmdStanR website -(mc-stan.org/cmdstanr) for online +

A CmdStanGQ object.

+
+
+

See also

+

The CmdStanR website +(mc-stan.org/cmdstanr) for online documentation and tutorials.

-

The Stan and CmdStan documentation:

- -

Other CmdStanModel methods: -model-method-check_syntax, -model-method-compile, -model-method-diagnose, -model-method-format, -model-method-optimize, -model-method-sample_mpi, -model-method-sample, -model-method-variables, -model-method-variational

- -

Examples

-
# \dontrun{ -# first fit a model using MCMC -mcmc_program <- write_stan_file( - "data { - int<lower=0> N; - int<lower=0,upper=1> y[N]; - } - parameters { - real<lower=0,upper=1> theta; - } - model { - y ~ bernoulli(theta); - }" -) -mod_mcmc <- cmdstan_model(mcmc_program) - -data <- list(N = 10, y = c(1,1,0,0,0,1,0,1,0,0)) -fit_mcmc <- mod_mcmc$sample(data = data, seed = 123, refresh = 0) -
#> Running MCMC with 4 sequential chains... -#> -#> Chain 1 finished in 0.0 seconds. -#> Chain 2 finished in 0.0 seconds. -#> Chain 3 finished in 0.0 seconds. -#> Chain 4 finished in 0.0 seconds. -#> -#> All 4 chains finished successfully. -#> Mean chain execution time: 0.0 seconds. -#> Total execution time: 0.6 seconds. -#>
-# stan program for standalone generated quantities -# (could keep model block, but not necessary so removing it) -gq_program <- write_stan_file( - "data { - int<lower=0> N; - int<lower=0,upper=1> y[N]; - } - parameters { - real<lower=0,upper=1> theta; - } - generated quantities { - int y_rep[N] = bernoulli_rng(rep_vector(theta, N)); - }" -) - -mod_gq <- cmdstan_model(gq_program) -fit_gq <- mod_gq$generate_quantities(fit_mcmc, data = data, seed = 123) -
#> Running standalone generated quantities after 4 MCMC chains, 1 chain at a time ... -#> -#> Chain 1 finished in 0.0 seconds. -#> Chain 2 finished in 0.0 seconds. -#> Chain 3 finished in 0.0 seconds. -#> Chain 4 finished in 0.0 seconds. -#> -#> All 4 chains finished successfully. -#> Mean chain execution time: 0.0 seconds. -#> Total execution time: 0.5 seconds.
str(fit_gq$draws()) -
#> 'draws_array' int [1:1000, 1:4, 1:10] 0 0 0 0 1 0 1 0 0 0 ... -#> - attr(*, "dimnames")=List of 3 -#> ..$ iteration: chr [1:1000] "1" "2" "3" "4" ... -#> ..$ chain : chr [1:4] "1" "2" "3" "4" -#> ..$ variable : chr [1:10] "y_rep[1]" "y_rep[2]" "y_rep[3]" "y_rep[4]" ...
-library(posterior) -as_draws_df(fit_gq$draws()) -
#> # A draws_df: 1000 iterations, 4 chains, and 10 variables -#> y_rep[1] y_rep[2] y_rep[3] y_rep[4] y_rep[5] y_rep[6] y_rep[7] y_rep[8] -#> 1 0 0 0 0 0 0 0 0 -#> 2 0 1 1 1 1 1 1 1 -#> 3 0 0 0 0 0 1 1 1 -#> 4 0 0 0 0 0 1 0 1 -#> 5 1 1 1 1 1 0 1 0 -#> 6 0 0 0 0 1 0 1 1 -#> 7 1 0 0 0 1 1 1 0 -#> 8 0 1 0 0 0 1 0 1 -#> 9 0 1 0 1 1 1 1 1 -#> 10 0 1 0 1 0 0 0 0 -#> # ... with 3990 more draws, and 2 more variables -#> # ... hidden reserved variables {'.chain', '.iteration', '.draw'}
# } - -
+

The Stan and CmdStan documentation:

Other CmdStanModel methods: +model-method-check_syntax, +model-method-compile, +model-method-diagnose, +model-method-expose_functions, +model-method-format, +model-method-optimize, +model-method-sample_mpi, +model-method-sample, +model-method-variables, +model-method-variational

+
+ +
+

Examples

+
# \dontrun{
+# first fit a model using MCMC
+mcmc_program <- write_stan_file(
+  "data {
+    int<lower=0> N;
+    int<lower=0,upper=1> y[N];
+  }
+  parameters {
+    real<lower=0,upper=1> theta;
+  }
+  model {
+    y ~ bernoulli(theta);
+  }"
+)
+mod_mcmc <- cmdstan_model(mcmc_program)
+
+data <- list(N = 10, y = c(1,1,0,0,0,1,0,1,0,0))
+fit_mcmc <- mod_mcmc$sample(data = data, seed = 123, refresh = 0)
+#> Running MCMC with 4 sequential chains...
+#> 
+#> Chain 1 finished in 0.0 seconds.
+#> Chain 2 finished in 0.0 seconds.
+#> Chain 3 finished in 0.0 seconds.
+#> Chain 4 finished in 0.0 seconds.
+#> 
+#> All 4 chains finished successfully.
+#> Mean chain execution time: 0.0 seconds.
+#> Total execution time: 0.6 seconds.
+#> 
+
+# stan program for standalone generated quantities
+# (could keep model block, but not necessary so removing it)
+gq_program <- write_stan_file(
+  "data {
+    int<lower=0> N;
+    int<lower=0,upper=1> y[N];
+  }
+  parameters {
+    real<lower=0,upper=1> theta;
+  }
+  generated quantities {
+    int y_rep[N] = bernoulli_rng(rep_vector(theta, N));
+  }"
+)
+
+mod_gq <- cmdstan_model(gq_program)
+fit_gq <- mod_gq$generate_quantities(fit_mcmc, data = data, seed = 123)
+#> Running standalone generated quantities after 4 MCMC chains, 1 chain at a time ...
+#> 
+#> Chain 1 finished in 0.0 seconds.
+#> Chain 2 finished in 0.0 seconds.
+#> Chain 3 finished in 0.0 seconds.
+#> Chain 4 finished in 0.0 seconds.
+#> 
+#> All 4 chains finished successfully.
+#> Mean chain execution time: 0.0 seconds.
+#> Total execution time: 0.5 seconds.
+str(fit_gq$draws())
+#>  'draws_array' int [1:1000, 1:4, 1:10] 0 0 0 0 1 0 1 0 0 0 ...
+#>  - attr(*, "dimnames")=List of 3
+#>   ..$ iteration: chr [1:1000] "1" "2" "3" "4" ...
+#>   ..$ chain    : chr [1:4] "1" "2" "3" "4"
+#>   ..$ variable : chr [1:10] "y_rep[1]" "y_rep[2]" "y_rep[3]" "y_rep[4]" ...
+
+library(posterior)
+as_draws_df(fit_gq$draws())
+#> # A draws_df: 1000 iterations, 4 chains, and 10 variables
+#>    y_rep[1] y_rep[2] y_rep[3] y_rep[4] y_rep[5] y_rep[6] y_rep[7] y_rep[8]
+#> 1         0        0        0        0        0        0        0        0
+#> 2         0        1        1        1        1        1        1        1
+#> 3         0        0        0        0        0        1        1        1
+#> 4         0        0        0        0        0        1        0        1
+#> 5         1        1        1        1        1        0        1        0
+#> 6         0        0        0        0        1        0        1        1
+#> 7         1        0        0        0        1        1        1        0
+#> 8         0        1        0        0        0        1        0        1
+#> 9         0        1        0        1        1        1        1        1
+#> 10        0        1        0        1        0        0        0        0
+#> # ... with 3990 more draws, and 2 more variables
+#> # ... hidden reserved variables {'.chain', '.iteration', '.draw'}
+# }
+
+
+
+
-
- +
- - + + diff --git a/docs/reference/model-method-optimize-1.png b/docs/reference/model-method-optimize-1.png index d7b8b97f8c19824bd7f4936ec52513cc8fae745f..27fd88217456b4a7d0da11a09599ea685749e06d 100644 GIT binary patch literal 15795 zcmeHu2UJtp+IGN#j)ie-BOr{@Y!pF2YOo9#5KyYrpfn{ykPaaPE90P|AR=8wL;|73 z&;kTSsRDx#Is~Ky2oPElNJ#ki!I^c}x7NRIzw5jATQ`fW6HZRq=Pl3sJn!DQf5Fsn z+jnB$!CKDfQHN+A?_Ee23`BFc8_N~X-M8I^%$xx$Wtq&!(VF}v-MIJmm5mR%TrqH zBa!fLZ0GfZTs=H8Pj46R)9)=h4&OU?izRd|@y(4K*+Lg!J@u?$U7d-cUhnYx-mvN!BbtBUKM; zhncpex%fmTzR9YMma?HP9}LFfDD?Zz$9sEw)zVrBqQ4Z7$@b~3Z_9GU7sVtLd%L>c z7I{ItL43s4zsBRYZ{Hqv^3)v?iDZXF7VB*)C@7elJn84C*b3Pn_Pysdk6Gc_!2J>$ zERv`<`x;H!Sku@m6I^g)(%{TWBrY?Qy>|oGV-(OIw zKc0&x*x)!xl%dZFOTKAC;4+n^!+)E?2YAS`)nW^~wQ^}0DcSg)@o*}#O_LJ6{q zmg`SS`y8hzVDOtc@~r9GH}Z((&B2x|4VpHA+QAVAcfY(d_@xwZ8=VhYFUI1at$+?PG(Tf{q1lM%p|dV4!o?dZ!mQ{f#?iC?)nJtwHH8 zQrO_|ovPj*g84alDI3C8&iVl^U&?xasgp7orO?J?i-<^96-jo}doeGLDPb$0*Uy2* zpZ{XWY4!)`Q$*)qK$Sm0$+8!mS;d;(|8SB4mk>nH1zFQs#58RNW-GV~2DQZ8Dik5L zz(6|Ytu8fDD{C*+;Z`$5QK%l4E*N`Nh0Lt5{)<>!i)d?nWqun+#zy;OZs_WZN!J0( zI0*3aw*nZvBW6SOuY%Xh=YEEU>F-?#VgKI@g?|kC??lo+PG5Uw%q~jA92tK%Sv%*!G0ai>eORRSV z^HeVTp=jei2=_OY!)9&e(gD`sjMTBBU{BRgCG}!p`wv%uKgRtJKK4I&`kK`?m*q~9 z&1zY392>6Ws1Xe}rm78|F!<_vr-%*7&Dr6@y=~lwXfvMVD5*n&3KDMc)DvOYp2bo_ zV6#QtPt?lg^h$ZiDg){__d1`Ne(R|S_0Yd6^6(_`21hS~0_l2z~eh4W*6{)E3>+l2p1y4JmF{FK1&GODcEhDF)Y z@+Y@%-%d>a%#$2eZ7RbPyR}(+)w3l<8F%{ObTY;&QppsBX4=xymGz-&DfST0DC?oo zm>7vmb$~d4N^F*vG#zqU^W@35%VEz^;w9Gu0!Y?2HU!brIRrxgl1w|G zY28z`rg!%}Xw1|Ja?}8pZyQ@!{=myYiVNR!R!^c{SO2VWiWnbRA84tzpCTy5im6#q zw_&iKl)DViwFabcuAD7h8Sqq3+FX9Nq|0nSiV4@S1;z5Or=b7MwZEIa|1X)&iv}Fb zvEas@~!R=$z~g4FOAmo(Yd znHg`IbQS4jhx%KLBf7?K6e?nDTYf%s@0FZT*^wDHTl>?=K7DFPc5n!smw ze@?tBr6Gwcl-oBCqz5?|K34JLVT1IGYE8>bGoW<8LQ0oO0oeIFw)YefQc_ZYAO(0{ zU0t0jf3P*I(%$rz2)CW33qw=8Cv2yu_b=*hT=(w(qiRq<`YQ< zXFHwS%#&OPi-1AdAo`)z)?#%WKHXloAtvPUV#?kJkcbHsLSe(;qFPZ{u7x zrCU*Ww-G5#NtK4BU!sUZ&0q`~P(R5BwaOy5ajALN*T$uD61s13;0bNGHan9>5ZktR zwma6AD#d@xJPZ)c8**}ALfj2%@Qa(p6Wml_g_+cU5j6FH^o0$w%5ptdOR`qyD&nBQ zYjA1+9|Puvs*ZCF<`Cbuvbb?d2>K^I6t?GUui z&O%@+1O&Q&mCdOiONjub7eAOwfXn@-)$6|zZ~xBRgj!i~adCf;-8{qe))yXbC5dnF zWtEx0^GR)zhhy{Ym~Ax^&56Ga!5mDy!yXLpDk0G&tgupcJB z2s5v%+jqP{PtPB2aqQd{YJJc6k`V0KONMu)0V!AZ=gxqEs2!v8visbL301~-qWJ9v zY=Iy502E64P@8Ux2Gxq%3BStdp2&yeP9|89hBe@j%7;DsdC<*AKx@0fpT`YMU><0A zCgNKN9No1huV_M5=$oM@y#q)3NE*CeuTl+^vG>hZ$P)5vdsGG*TI~Xk2OKL z^iQ9lSrb_>+p_p*3cmu8=T~0;j=(JqGDGz(>TZTr%|q3xiWC;+D_A;8A@wtV+OqV8 zhO@)bl~MuIgjId{c7Q|jd!8zjtyP0cY0j>kOULic#F`1i@*SX};3M58L`nLwi3dva z;Iz*_VeUe4`2_p?-q{{yI-f1jx$y;BYLAa)n3 zV^Jn;?N|K=ipaUy%VD5N;-H?UF-in=eda@$US9X-ykE98ec~NwemZv?bUm&$<8YpJ z73&nq<4ATl4}I-s5E_k!`bb4yC@^1w$D5j(PR`Ee)9;r|O|%u^0|8lbo*nrvLIcB| z0*pKb*eR{Bpx~lcZ-+n-PD`&kT?C4ON`j>o_5J&sqVm7w7Zq7E7>wKA{$W>KT!yJP z#>$fAHbdV2Tj$ySi$;G!BS;T}_P^V5jiDETIxbTO&ffh=yWXS&a@jvUL;p%z<;jzbC}sftPUBs+U&w`KjpQSTD-EF`MQjpg zu3L~2IFrKp+0hW02d|QKV5i>+l&4BAx4ssddCaV}VoEK3EBag0s(3IpD=?MATxqra z*4NhG_}`w}Up?jh=Tq_c$5t#@6krIg1^8PCQq?M&DY!k7%i!IF2QfLa2R1)m@`^aP zX@l3PhXq^ZEk{TCOD+V8GLsqB8EO8O*x@Yh@S_C3Dz za$nAO$U87|apm=tT|ewtScoy6VS96UwKqH-JCw+fi+QCO9d~cv(ta$BK}>6@WG;lv zU}$I%HZNYR2eA)c8)UyB>!CwJ0OJA0JVnwVgKfkF{@KWT z<*AU<34I0V~6V81Zzw9`CEQ|hri5xAL##X=Ae+5mzN7IzH#(fE@>c;76`_k z^}3=$w{3j>5yJ8a-;-6zX0zKpNpjZfcB&={nPm25*99^?*jClT1KmXX;2*O3{r&xS zz3B)YpESB+WgBt$RM7US*N5w*Que93yNWpuw91I=_rE|ij=-v<_~sqVwq)a;{C00c zd6EX&+p_m7wQqw{CsC#+ff_vaD*XAv-?_RQ2x!|iRCrc;p;v7k|<*N6AowEYkKmsL%v1lu@ zF`{NCMEoyYO((vT)Ra%??rt|{PbQeu=MH_zrtN^SZ$jRVIQ){RFyTFv-4|o!1G@^t z0onv!-x)y@uHfto!fQJsZvF60MeKSCo%LtqZ}VCs^S_sXa`9hj3r}<))bi0sb!l2Q z3@a67TB8DGF`aD}8}BdNGxrQU08`Lk^P&u*awRr3Z0N~=d;IYO#c2hywaxoI1NXs9 z)^ZdUBcpv3;bHGPb)YHNHB37)CLk#$yjxNKhc!gWPx3ts0_5EbJFmbEFv6#UD9Hb? z4b%_JdME(fFJ{XsO&y}&WbJQKbaP-77psxi!`M&O;zaI!)rG=IoHh}>lN=kI0+w== z^j~iJ7SvB;O8e_?*)}P-BU(293r7U_ocfH^fj#gc0_S=j}aoskeK}=vb22)TC4_(2%WpUcGdrw zM0(41UrY4-yzs&TUGhDn*m<)1^`ja5jP)6LdD2wRfYZ_1HwG?*_Mo=qT%XLA4O#hA z-`mN{eme4SA@U2=9jCgyR-*JTZ`~Tbf}yTcO|pESvzfN=Rf9zbZ;kwCSIg(cDwB|Vlb`1NfEcQ zw#svK+Tt*&6P|&GF#(^Ghx+DHo0=4FBYgTN_m#46Wl4@TcUI_{NxtWbH6-P}q4EU} zl1${H+^UBG@#sF6fOv2W{VE?n3q{vI>_GEyBsQ8qa_X=G!A9jm^E7Ef@= zMCU6useSYbaDBzG&b{H`HbUDU_ayq=yTbRvQ%uh&Ci7uUe$8XrdA&A6kBUV) z_0X{E5cW~q5B#Vr7i1k%xkpzn_DLt_0=PrNxWIczOvFhmb1LuM%<+T=<&`4#VK`B% zSi7h+mj_N~rgCI5_DDXtWXwRGu|y%%2#zkR#+~15ix@baA>>fOJ$+(|d^;A4z3(kd zRn<|nHyU!&t*uPv8;#H%iyU?GQ{;qM;cVojuJr{)*=U@MW=Upu-1%IijF?A{_(|~e%R=aNiG(EctP^|mJ3UF3 z*{qN)S9#8bFY^>l)XtOCRgMsf@6zoN2C0n+DNVUon1PltsgLSY=&u25Nqf{i)Km9M z{lK0yFY+cH8K*okA)zUcwmL(7vXf{XiY+ER-1?-KU!w3qFmU|&=c{vKk$7ojzk+}} zlPyEE8-Lyxi-gM=w(OV;2)`hjzSl8DL2uIEP&T3aE04UXcBJZpxnlI^-jh4hv0gD- zMa`Obhbl-*yLh}?^0U3eukbrGaTPTkqMS{7Vy4x;kX*O}JIxkeJf(d^8b|K610LEc zud5LL=y*4e?4X#r_+@tXKAY53;@&59oBEpgDM~`ZdwSu8>+70FMIB}C61v`o(cLd6 z>%>I~eIl~;r~2zrcELA37-U&z6ZXz}_q@v*XzDNl%Miyt@3U3$ad!R*i&aQ%_+Y$U zZ)tFY&Z}p5hJrtOswIVf_lCRAKZ;0&`816B zdXntaz5BYRe4S6bHzy~6rKWU|T{Yma+FS7^N$R9_@%PH9;I+tRYrzlwlA!AGhD^p# zBzwOyzb!mePQCYF&}94dD}x4@nNqs%Xq=54VvmB|(=Cc6FY0%{|M(zW=51W2{>_V^ zqr99=;bzO!?=X~j5{;d5G0EK|XMi+rb-3|qcXy$iaT%GsP}+jc?H;YVGmbi(h{~%_ zH`8TV#*E;za~r0*+pe?Zze6DHj{&;Ot9WBu?N05cX-dnT$uO^cBU6xwnM?ON3y*oqMdM{1(u$D4M=-j0f;BQaCgEFQrHOAaBUao5mkm!3Jc z6v5uagmR+c{0TF^iH!J}f(n`CaYJ}wteIX2g|Xq#D}%HsHj6cSYl~uCRh53T9&aic zCs-CSSJXd1CFc<=kCaXoHWmg>_vj9U58d56_CU3{iy129WHPjF0APn`*x}8i96Svo5Eve0V?eT+B)>ZpBbqW6O(-6I_SIu_SbJ4+#aGpk=fD zf&^;@gQ@rXZQL+ZfdtM)6G9E^j*#XcA7(3<;zH?{W?B9jr}xDPsMo8lrJp%<(N>yt2k6_-!DnJd>gCgt-$5=jSd2D<^ZjF71uMZ#bz z{cPj*4mltRH21fU!rfZJCu|U(oY`I)6)YYx1yH! zAh1WNeD=d@(gx+Y6R&V9eRRFz&RzH1I|nl^WNmMA6AG zpQwu3aOkbUA}RgUYeWlaIvq@t476>MNrsWbBUj2r<9 zo>ufczEnla!O_~I_Vwu=%$9aqZ`Wgt9NM)?&ptx1ULfH zhEwumi&FSp)LNxEe$7khyzIkCDHO@hI_J_8aqp4?i1`6dr3MK0-r>n=n1y2nuP2Q^ z<*^U6KR_K>0AF(4imkG#GWDI6Y*N^;IPF|a-;LV+WAqJg%7J~zxSs3fBxzI4(WiZ( z3<6Y91W&grAGj+iNo{R?vSG^}nSD6nMMKFD8H6wR;fI->JSjR750u_@^E}cUJ3LA3VvG96WfFm1mwEkrKqBR>C6Y&Kh;w9QK_Oo} zh)Rd*f7paEa&3qrlEHw5VKwJI?)2kMWO}r|`Wds;)sQa6V})UGJ;KkoPf|N)Dm~}2 zn|N29&N-K5(L)qq7;9!Fdpte5`Ju+Z^W8_SU4e<0ms@bDAbv(($C@^PimeK!ZtkIX zDp#1?-|?;6+4kgq@fwHtmp7;)o)rT2?;jZWhDcNe-tY|6gu#CM(v#!}?!QuIl<{Q> z{5;~t_YXij)cFf`Of?O1qtilSClG))cE2$Qhjwf<<6EKsy8md#-mcG7@<_b9!K`#E}w?HPxPe z2l9Xx(%r(OtP1*YtNi5^Iy@~Btjz|i;_`y0?rjsFZw{(dMRnvr2UYTB`mmh-HRY_XMt!D7cI zv-3NnaaKW67j`wiQLruZbFwwm!Q3AWz8UiFP$W;{`o#f24a4ql-<#M_6&x*@s!Ek27 zsY`&3V2<_i$rK*>de6IS*Dn_VN(u3_b1`A8Y-H1PG0iE`Llg#cLI7o5^;&#?liiUx zb|}S@lnAAQ)N-96M53M=WdPkU_9{xTArihaB(rY|CMXExnMZGtm*!M{^*s2g6qGC1 z&}cJI>mZN=V5FLv8tNG{0@&U;l3hPtEU#=5FC%?m5fo?DpqV~!(Rang^tb7c8Ylt= zW$eyQQ!p$5(a-DJfa7@Q!I1PDwOH*IkaKkh*dn-D5k$;>?Lb#>TNgNz=x$=2>yRK* zI#(mE>QeK-MyJR@kK%n%YmFO?e9mwNmb6cC7$6nUy&P;SvM6%9RM}yP-Mu++`lhK&YOvOT9qatWCjK zG(dL9u_ekG$167dy8Ecuymt8PZK(%$$vCzL?itW^fzjy?gVMBs!^GZ0RycncjpOyk z%7ARYP#stt^0i6%E<30ibD`pL53uT~YeB#?3(he;^FUUwQOy(jf;eEVq z+qRAVc1F|$08r)1s1noSAyg+~MjoQWTmThhFO>`pU5)~)gn#pat{~U{GEy?p)%6ZT zpy;EX8dSk>On~FUV@Bp1m83Y~5K#iM_&JDY)#j5fX`VXZNn>QPZStB22L~m4k(FT~ zTpo{u5(iT56=d`CWkHn-DK0dnOZh(mbsCUl{xUsXnzk~g5i6rX3-i-k84{(_;j1A) z145ende>vhQWT{Q1a+(oa=F1q1tcsMKL;h5O5uxMAoJdrgK$H{ynp{*hdZ8bTjqaF z4@fDHR+@+yz@(eQz->?5fdUc1DeJ6IEbjAN<6<%hk{toXlTYzCpCL0Vp$v>du3QNp z)(DpdwG8}i*>kK86xw*-(qtU37}p3OlU-U91aw6yxMl2v^&f$pH3Ndf#>QpP22Kqlhy)q9aAu03s+TBE8I5Lsbxwjs;PWUIL*6b=6S>G%)l~R73&+ zDFGn_a2Uae1T`dpkOU3I5FipwkPwplo;dfP-#&Zq&W^kH?%v;dFt5*f&-=dL`uUb~ zt{-tYr1kekP$B|R>xBaR5PZ!sG zyY$Y;fz7#*dk$-_(NNH;x%Fzv^+l~`G)^7evOi`2zU2Mi9X+~v+qQ4F-r^Wvjj?ZL zF`rY1;#NO7@xzVyvka0!B9+hTDK&BKmNdPLA0HYoTO_CJ3;t}jMy0YzRrqA}#Dr3O zM})*pzIlGJPZ{Td*>U>Xlm_{Y3fuvng8YBxxh+CyI6vjID+XQJS)ES^iQdQi3ZBwl z;(a2br^TsfwK8v>fHJ>XJu!;HOYaF+gUO_Ii}Wu16sU|BHF#8Ii$pklN%;nNN6YmW zmG}NSO2#`*5xsX!;YcpT05Z(y=44w27$E4!ubSm!@e*%%Oggei4<4<{(ELf(ezmju;_-;a+5|Yx|kM2UQFK?P>*fM9``G@z$ ze^M!LiQ#x~j?;FPZsg5}V90R|!c}04>_5Fzg>%HGth(hDShrI}Jz@CP#m>;s zNQnwwDk>$STBJpIDPFkZKc5eaYMm%cCb-%~?CKvtOKs@Wc5Jq4C!Ws=mP^(_3v60V zb`kyxh^L7U&;z6)`5lj5xK4#Mc+b4-s20Kkj4|Hnwit~6y+D7{#{*y((D2Klm>>zg zc*2RNTFSlJG~b@p#IIukF+5BK`ddNl>q8}m_oAP0MJPNTA7~Da@ZAA4yk_#5H@()e z9@xNg^<%2K9#!Dz6Fy+?B_6u?Xn)CIGwQV!1hq8^{N;N8yY>GC%tzmd^NFU1;pMn? z1}c^ULfftb=CWTz2}dg@x(F!v&N^V8n(<@dbmB^&iuqY}B5c0afz-dzO#dL6|J>z5 z!gA=I@rmO>AubC;4V~4(Ozmr3`1WEUjJ3n*z>3Z9(T@;S@H?mKy?0Of)^j(431g*2 zdTpH#*{%uGHoy{DkG!JBAO5!F?W!;1?f+akd|{~iUq$>eHX7KkZ4cR;wLy$72GIC2 zN~jk??kD%bz^ShesD1b{wMm>3{GjzbnR8Niy)e*4m?n3J4_g2#AEU4A!>{+^eWyO< z>mpQV4FbTnyaeF;hzn`Z#lt`m26|`D8aN#P?RfsbN=Uyq82w))Ud&hwB?+VW4+A#f z3tA0R2@Q5`DK1@dut++z6&T9+*$VvViKw7fA@)4qY7GeFNuEGbp_S3~_+al~@~PK? zPM76f3>{!6YAFVPCD8v%$`%M`^MEtP#IicBssMNq!i!GZ$NL8Mi2RiomDToPsuCmU zbT$!=sZiV5Z)4u9iWk|qSkV?cs;Rh;V@u@#3Q;e&t@Iy$6-*b|E#@y&%0oIt?XpW> z2X6(He)I1nv@ety{!1Fnza#JRPy@v~wY(P_C%!Kd-k=G+=y^W8CWaZviLF3pmDIiK z_*9Tfg7_3~3vF8E7}KZTTLH5E8lFn2p}Be$h7Efu!U|RD+4%eF2YQ1Va4htr*uZ8} zwPW(wcHvui-`ZWhQzuDqp53nt@9aPJERkL+a<9sco=@a~SQc6jD}(wx(I+aZRe0k( z{1C50BT(*fU#fih%}C|hHsr83wX=tQM9&iw)jSxj2%@kSm~VToTA5ntMdx`9Y6DiD zuK)trQb6*I3M&Ovu|aJC68wI1@TB!m3sd;yL4qqFG2$)O5T^7G7g)bh`1jUl|I*7r zaj8GrQO@C~y0kLUo!2|WcAu-`3p+1nnar0|PR#DS&`_{zD%2%vPaQB>pr8BS#^eyE z2zWh9I{Han1FK5RkCSTzdRUhK`1cjJ|I)(y|HS`K6}A5y$xnDF0ehFS-_*dFUu=}5 zmf_)0OLS>qp+U9-8Z1fnpuYmO-Bela(td(Seh^Z}+U@rMPd^e>hi|Ri4nVkQ3;2P~ z-e=>*b39O2$H|H&6y1~|-}V1sPk}332y#=?O)KGv0%SS{|!};z7MASud!7 z+G63HDk;s+M9oT1Bs5E|oXXTb?ZPyxz#mvhZ~>)Z+iSQdm2^nZSnfjdAh^cYjUEwJ z@nIMUmHvb2|97rT|3O99XLB_UQ#2Y9Oh@?z*I0&YeI@^WllvZ6tvAS#r3MAg9!PPmf@W&*3K zn(77t>_54K2g$?mu19A;6#qNAnqS6);jH5IqnX#Ac!msT0xJLQ6;P{z%a^)@r5F`P zlD?TfDQ|c}ZJaeRM*X8qe2@2eP>-QPTz6cP*JF@x3wXBv#Id06PwU1i1Ih4uXe_8B z7IuCpDILy6!1aamq5qTF#vfEV+zE%Eya4}le1~}ALqkVZJ-}O&W5O*}%NF{Qz539L zq4-yDPMdUawW~|=0eT6JVSAt1;$wKz#Z}~?mm^B|qc2x-uY!{H${)MBbLyA{su5(F zR+bN5vvOxU)S2JKDD-=7QLlr~f`LvPdUEH-!5Im^4G8OPV z1pU<)1br0`Dt($op)?3V106~mZGY)Ma$#F>Z}rJ@OzZ4dyHC8U zjNNblcfwM-P?6_$Yptl_*pF8O1 zw3mYV3T{bif9_?t+k8%zUpRgJxp$oD1X~6K)n#0gzcMH)S@#)x{`wXHOQUB2O|OJWFzO4gJr89g1j z!Nr>8Qp0wyt{Ul{m9&RP&`gZYtJ6lEIwY(pQY)b(RStGVmaIoJqSTUJ<6-@2U`eRXu*nR>2@)@~OpqU6m6 z!dZrq)GS=O@4QO%?#)QcW&6@$yWAXyg62l@mtG4@U*^CtDIjtSz=&DmmmJ{5z*5op3KRQZ?yB5aarJy?8UDY}HGl%O&f1V** zKev%N&FP$$@^Lq1t*9Dw?VrP_F(cF!ocwCk2rB%hj68U2=BF?jscb=(8T9ngE8B@| zhcWW{?$IFQWdTpv-P!(wJnd(T`LFC}t7*T+gEc(nGYP%gQvA zGe%6b=YB+Q>?%*B-*dK++8~3g46V+Y_H16BCCH*t?&5Mozz(-^C0A<12l>jm)ZK^e zcj{>LJfO&Q4NuPQ{tKPB+)lD6|bR=dbax+1ooZS2owWkwa=%_ohZ^#}*;j!KPi- z8h!W9YEqN|*@v|U+|x@-#+>c_H{N4h*oiZ5V8oXpl#FoxMc7R?f+_b16yPW}(xhhx zPFEyr>2#VJJzp|%CnLU+tE&|nr9J0B*x2)|IX&lfmk2w=ip=1YY2?}JDVL6<-mg{Z ztbIl4qjjBVRc#$gZm{Tlt{5wE{_1pmnk9@YNztax{_m+;oY;f#yMD;}viI#MPgZnB zU)>{fN{?3T>? z_ABNlqhN_-VU{g>dH(}gu*0LixiVvS#5fKm4W_vzU9YR0H%$?LtEi+E`{5^_(_U1Q z@%+GabB)slYl{f=7X}1Z5qgbpZ|F#;$g`~ZQu}d*>^*&+5#27xXrIu>OAAv^yC>c5 ze|WOJ3+uV=gRcHnQ+v4h21xwzzYTLRe08*iWI0KTxND$vJVX4_=^5|%@#8JMk?WI? zb#---?B3p9UI4)-#B^obz3nByzD}#+g7a~>go6a(4&>SNdl@yYG;VVcyCtDP$-u}u@20@GZg9%d zkYW@-aP&EG;!(uHd4<>h86PH7Rn01M3JRoLcOJ1ML(eO5ZZw2VLh)a%IkmW=j24-6 zG8czixPtJR7NQGTO;J2Q0|SG;UU#Faii)8Dt6M>5bd!*~CL6<|qebHZ1omM;GIA#} z97zxob#!#tLyZyRwpVfLMT!SwRm5+VTVqTq7ZICWj~~~ZKBJVBz6&244OZsV*48%I z+uKj^h3E!qPmip3XlO`nbf9;Mh- zwExEcWHiaqRzPv*l{W+pMh`AlGJjzf`R;`f$jV0W5dp}`DJ--yo-ADI>zN{k<{j(k3nGtDF!WjF;F=H<;luI7pOY?(DyNfTMsM+)$I ztl)koqqCS4J@tBsCuBu4qxw`m&O!Nx2Y2;ElbEgEHUl(v$hC0gbHD6g*G!|)^bTX) zc|pjDYMwg!U9qeWBd&985&WE$UseriK6yCa5j0p&xWH@@j&Uvso=9JHW0Gn+04vJM z$}%tQQDU5El1s4Cwl-6YD`1l2X0IX+S$;Po1tJJprK8hUmi^PE1_n9-o8i<#WQfx+ z5>A&JIrDU8W@e>{^JxXU8z*~G;5}6NlUJRd`7Ml=I_l_KuS}VM^(4KZJ(@|hG*k%P zyHR8wH_JrHj$uE{`?SOz-lgC$037dXaYnccw%46+N;C zK(ty}Sz*}d&PC^vk3J^?V;e-1S(6fpq^Htqi!~|5w;;g_Gk1g_ycFCpFGc9t?oJ;$ zU6O&Kc6T$Q#n%-asQZBh*bL+&a1P@y!uERD0dYP5d<3O2tTR=$PqWeY?Ab9z-p1uc zL02vMre6~S0R~)jdZwqS{U_^k#fSoCt-qrd#a8UY^0sN574xcOB{?}cr61Ac*4rah z40kKqRJ1B>(N?2x{NHPu^!qrd`sbw}oor%9R;4c0*QP!ldKB1KS=Ol*H^~NzHUT4B zAE6sszj4Ad?%j*xhD@i#(}{`F;p_EFjcr#26)Ze+ZK>ftH6}8AJb__~0K2#8g$Z+A zKGL;-4H1H$Kri{b@IA+?Rh6H?duKznCLlL>#!eRjz+%Tw9qWiqNn>?|{U~wJg#n=FFU~>SG>h|H@ z+J4;zmjVfx+>t9pM!BPbUK=v!Cxe)@rY><*AfXV4V-8`&%!GN-!aKVZAlQQzMu3%; zij43#zx?tG#+-Q*3NpIXSf75T{rj}7_puiq5FMT&)uB$qOR=JMWKDB(^Vy3YHjP!S z&9m$7F3QJV-xf1IHkNp6WG!+hX{KXSLq#>kV7?1gK!GKY%AT z0?rF38$D!ZR#u$W>-D~i6oU$Id3hv4hM?G;m**{hl~sWH*yKfuw%3?zL=+Yj7Rn@R z!WXYPmb+Tt&I~mjAEZ6X){311Nx|~;GhtyfrRkDH05`!v%RZLTg%X4y$>}P~h}E8jTMbO@Sv*zM)F%`8I-y_G?O3vkZ?A zvTT(!rp@gfmO9)GG`QRpM~z5tJ_RT&e)8lA2`kyJJ$mDZE0dR%Ec=n+!B~3$csSwB zrTW~fhCMLQ0x)j5bw+a`&|2+-aroUEv)ZVOwcYw@=M`e^00QD>r@e9u3)x2l$tIM- zND{L>IXStoikOH29v?8e^S=t-f74uO{Wdt!NK&xDYH7tfV3oCEkIFvR7TIwg*hA^P zQjYX2Ncq7Py4?nAbsa8!7`^9B!41TK!SK8x#g*!tN}N3ZNhn{}!RW%OSW?9p>=<>} z;^RoLv8`&2i=oaW8K-LkJc7jHPv;A_nc4L3=iHsFoB^7_QnIpwg&fNvO)CQQKr0YWU@V7jkT7n|W0ju<})lxLmp)j9?2yqm|x$OwD z1&rtL__G+SId@NOx2Rzt>x?aCG6&H*B$FNrfBP2xY!52>IW>bg3t(~UQvPLRq824Y zYao~Y_M@O;ecd4&R(If}OoUMHTAK`jLhT(N{Az>OR5Z|qD6lEt=A_bX<*6NNxT|eTl_E=uJgy{S{ zTA!jN?&4QeOKlfMS1z9fH8bx%kd&{=M~84yLSQ^U`H)5HSauYDQqRiDx7kreD7mjN zxawIwc0{WdZOs39cZ7r)V`%q(ptDc*I&(uSjOM1Je%eCY$A*=IG-AE=R%LIpcC1WIpXKG zBO{$|YYcihhZ~oH#umrd!vFp1nwZ`XU46T#Gc{yQia$1fFVZM2iv-N?Ae;$rSbo>| z@@(bZ0$F!@f8zE)A3fBOdYyF1N!c7Ptrj#dZr%hIniQsgW7BPB;RtDAod5K?o}(xe zpy!J!3)OPSxVuzYKEVa_7o+)scnIl+4EBg7YEHK|!?s9h7 z0~PBZDk0{wVkM@JTGJnwOkP3m1U~3vIcB)mPng?SXculwNkB@CDUJna>$evCJaTto zmsRG-cd^aCGV@2Qv|_hWLNo_LFZIdEf-U}k@^YZbmM1Q+;nolR_ync{dB9fZ diff --git a/docs/reference/model-method-optimize-2.png b/docs/reference/model-method-optimize-2.png index 093449f41694c87ed4f6a948f6425a8e02c8a550..4ed9fe5c527f0931750caf802c560ea60a2989a0 100644 GIT binary patch literal 16009 zcmeHu2~<<(y7oqjv<}c#1(B&%Dk=ghqRhc#72`k@1!Sg`83bfbfCQzLDgrVn%3M(p z0z~F91d4!w5CN0O7?dGEAYn=Zge3Rdc>1q@{r8?*?>#;D{%5U|71j>fdw=`e@B2Q_ z`@HYBbLXO|$<|G~HbD@y6?x`+GYFChfgtf8Ki>$x8F={X9N299@tn!`U<+O=Cu?zF z^M&sjD}M-5jDr8f;>PElA?O9V09x@qQKFma%k$;w-$$B!$Vzr?d4%x@R@JMEQQoBW_zaiZc)Cj-A5R>dnhN0X7ndoK>DKSaUqq``PlG4*r zh_xRIX-ulWBO#~PJv}4C!kp6Fe9F$wPTT%7K84L=&X2ZomZo~GHIfS%4fe#UjrsXC z_4P%Ii;FGMjv{-UfTM>%5SUCR^|B*jW8?`#%+mAx{D&RSTA|pU(bhQ6;;V0)o0|*k zMN3Od)SEPuqp$&>pZeSML&V;Zc(TM*>Ogjme9Pz$7jns@`g*0ee!9YUndn1(RNC;> zS+pEDdJwfiv%zrw99=ID$0xZKx`w@4iWC{KEQQ=qPIEPR92h^M7TBJ3r#Z(`H9H@% z_?(lFnoh{C7e(fe=g=^401j@3N9kdkUyxe%;r@&Z{t|p?zhCrf7ubHfZ~ji#{*BY0 zzt`}oqqAwgRlO%08s)ZZR9@M^eMTpvJG~F>eCzwp(@@;LT9((uU{ra26Wb9*2*(gJ z_>f5laQG|W@Ze;be&&!+cfpi>V{s)c`M9*??95C7=d;+?A+`?^&O3z8mSdJ*a5lYD zq!}yJwmF$4wms!+ar^ODD#hy<7(GQU<}~L`vysWP2F(~xnWnZ5xsMR*>gsxR&Ky;c z@-)h%t*oH0A4{eB>wMcWUQnU!Z8++W=FV6V>1=Cqgk=$!eP7>WFuR^;&#e6XaX%|d zOUoG9MxkNITvkz0kw>*{MaG6u&WBykr_oPq>gv2ez_P(4E%4@c4i5Bbes1qnVH~ly zp|;Pg)nN3- zPu9PSQiLJxQC`EjL2Qrj98w;$(a?h4cC7&IkQ?>ceJh0Z@g$ze_}EYxte z8$G2l0U!EreR*khE>5KgFpx$v%wg$iX>a|i3pkh|%%&N05*@eF#p!gp9Nqk6{@Zt? zJ}-;Z&Iu~bIC$mxK>EXoala|k&Thb{n&O1b`doJ+%d%bC#n!=rHa@<)m09$M>xD~t&^uli1pkJ2V0#F?F>_y!)zJZc_Fvgy3nH1 zNQ6T9h@`TGuA;Btyah?c|ACnJJHfTpMjARZr%BQ!(6NjcqV_c*KXSUF&@!xsQ;~0J zj^J@hQ>3JVXKI+`8Ss2EJAR;TiV&YyuGcDLULd$gu2oL-o}xIt!8GUE6yPh&IYeHR zw$4cAZr!DeQs4wl1>bx~=U|+xxr3f3@q-H;Tg$mcW}^@VDGGCY-W;cU5#e!-GR3i? z?eHfk^YlMPcKw}}`p2C9{0CTc7JA{QeFO{Ht4-0Cf)t*o^580dF&MX6Bb;}r3wc)g z1q6+43lWRRrd-Ek*@6>>X%^|R4xB=seV;lp)SOexuJ#fKM(om(fJP?MFXRtDsKaW2*oinfuJvic_3aA|1dU)Z6*CkPKix{5R+v2KHGly=X;1{W-(b4duN*fmD`FsH zB+ZG`YudW_UfatM zf|lC~Yw{6#Y#M^!;?CTE9J3hq1_N|t15tHugK<`K&GZu{jUa3+<0Q$0+k|!dAP&g* zpHjBsv8zbtj^q5MTyvb?Fa}fr4T6bJG~gd8|Nr8x{K<94?^nNFYh+BI4RCgke8a&Q zG7u0Usda}`UtDHpmu2h&hM2;hII+1s>RqDrjl-p-rFO#x3T2YgN@W=hYHt@8r4+tN z?re1iHAbQ;3P?k;vtBwiK<_#bnUBZ}?M$)_Il`r7wAfQ7mg;p3-{%#CXWPNl#xfOW zQz+&@_pMX7}uDVa#jn zqjN4ofn*V^k)NS%Lx5x8)!07; z-@WxsK0eImdFl*K?H(D~vN1Alt>28q)>eq%KcO+Ji#}w9FZZ{uv>%q=vat&n8`}zn zur$=mXw0G2Dt%&WCu4D)+5qyY+dPis)ilwi8*cjZjFeJ~raPm55TyDbybQ-LhfkH~ zlSH!Cgpn`L?@dfOzZaIVrF{i1rB<+vbvv3LB`wWQkq8?9y|(5gY=RnY+IZy)N8Bl- zRSxx>cSWB?VQoHXg#x2a8wgqhAZRV|=7DyV9iSyJ1yr_DoM*KyHK_J_jdQ7-g*iX& zE;Qm@VIHVgwCca^x7uWLlBg-4+5BXqhA7sIL??7lqKD{S$I9&q@__wP&+i4FJWKn^ z)(dg8uemubFc_oy?Ngw=DS<_J-dns1VE-U3t#&Bp3c4mlsR0i3tzfar_q9# ztxY5K9{jJr4l4mopy}IPUDuB8ikWVVlr-n8#V9ct3|KCMN&#*Y{hz*2V@E@+J%QO* z>bl+#z^+vRezvo<9h~N)fSwKa5^dN9$JHly$bRR!e<~RMN!`JJ-TR+bEjLj?N{djQ zsxVJx+B4-c-H*JZz8W|MK`C(78;Mx!C1g@?LPR1}%cxh@v}Tn;S_H>IkO>NuAQ9pV zs>uR9IdkG+A5ci5lFiw+7`_J7u=`8+?1p=i<|tEZLX}lz;li*T6wx%|91KVKANGS` zg=!{P2+rlm`{33z-U13UD6-Z-2lPHsSQwU^F(A+U8cwpO6q-kxQ9Vg(|*TIS?{Uj`amqBDhDSDa7cy2=*j0zs>`d+s;&>-g#Jg6R%vI3=*_E|)KC{0`zys-f~X5~*rN zeL475s!gFKI2u1r42N&*&-07j@bc6Y+>vH2eEH@)iHqEJ<|412i4156ZyQ*6C6TdY0wZh29)N)B9Pi*)DN{ zzBZ2%q^}N2poN1n(KU4jgPw1_wepi1Lec1z1!lL~QhWpdJw5W;4L?6Ka0NiWHmIA# zU7!j4MV*qk>H%B~!S!u>G^l#((I#!@rp2PmAFH>WUBOvOp2xt8w&nswl+sEv6-= zUKFrik)D8aTN35rk%dJ0pG&H)EKJmv`8Jt3`Fz#?8{ z{u66zk9Qa-ETK|kHL!TPJYznOYG+PArvhX7sLGt5@34XLTL%Fz4nW~N(Vij;=nURB z^5}~?g|tQK;cEW4qEJBkmH z0?PLW*2#Mb>HbR2!Cb+VO==846c z<69#@UEbT<3&bn$ZR7l~RyeZ$5Vmlb!-fPH`jibVSYf%I$sB3nnmNenAEUD> z_?Yr%!-5hwddwrUe z)Rop8TeTl;4ip|r&)X4w^vS+6M|RxVu{ZKB^WXk7V)N!pMfLBEH#n8Hu`-7IS<2_Q zPn?doO{9f)C59PkJsz6TW$?mK8U7h`|9UhRUDI=UjGaeK%)?&dKK^wqG>)?`M9gi! z1mHsGa=t}E_JnNukACDWsspzZ_PD4nVxmp8s$)nRdSZ~|w~UXi_I)1@hm4W?;dT%N zojv|yP=4xzb@Fj|IL}0eS8`tDe2bw;}%&@w|{I{efR8>Z{~kxi2U00NOFduzCa+D zwf#&o3w`aulRZ$~Uq4VG5{XtXvT`T)y*XxRXlV7q@kIAw#};!uWr@Ri zW`V!JoR2wut-r(Dvr+%pv4_RQ#X%ak#4i%pyWmw6E*` z4VC{D>;8uUtL53WZD?iYw(w{Q9CeOFvjC7)A!wh31pCAU%fw@)Yft&>!X4>Oew@?Y zV3h@evJ|%0N&d?6@EiQ$RPLj}-ji)jHgJH0S2|huZ=vJg-EvJdy!Zu4M!IOByA%COyqmR+ZEAxDSb!SlCa{O>0E z{|9*fYOa9Wzjlv3e(xdV%SyxMa0xzMI=z&;_*-AhlWb_a>AFQ!kki+Y-?h~ZpY6W1 z*IfCW68%yeA?V7EI_T0mGmyK@k+8j*$Aa#ukcKY>Y>Mc5ukgtnF?322_S`$0PFK?K zLT~-xqFeTxgO~HJB#6+jeeDfg3nuq9h<%(&Qp?=rGR@`~=NaD2>tWu#d*A6#KUia1 zO3Nrp=rpV|SVWI5>xGjks(b%lUXyBqi$9qs{?6gkF+;HnfTt57-tD%hPuF_CUQ3dP zU1vaG(D#ngAAP5O?8rk~QMOgJ(4_Qk?2%`*wMvW;Z^HF%tk{g?dKxf})=mZX8hazf z3eFsiHz*EA?QD^-6o8y?6|7cXN4N}o4FY4aEMxR!)8{Q zm70#pPO!G@M(#a+G{s=~`?y;?XdP0J&KXX?cbfWjliL&JcOtP1%qN#;thCzR3)-S5 zWB}3;IE;a+WQLScl_Gr6h>vLck8`>PiNASvsQSyQj)U8zZnk~ShQa7U{1fz*tHdSa4V>n?#5uLr3= ze%5?zXnLeH8J-7pXvfDr|49<|6EwH!mBZ2VKJfY0HJy1adL^@yHD z+iizn?;F~B4`-gMvT@_F2h+4H0@8Xe&Q-kI9o}|nG1~NSb*6!?@HA|Pkr6YdX)K}) z7&z2rUtd}I^u;4;6qPl28j?AOxmO5-*7_E3I} z`f>(yfmNU?uDF_VzJ*TDR;;gQ)>4BdT@|oFnSLfje}}}jWq#<>CK}Iek9*LvQA-i| zOMNEt8I1Fzy(^i!cXd9E@9L@=?E~LOwbDAoWi!kp2NOG;M`Jm}KQa#v*52IfB)Yvid$nG#gh3&8_} z;N@;uQ7GY)-F-&>Hv8&;NrJjKNMhF6y4Wk$q9uDxEf@ZoBe@mu>xG3Uzt`3^NV$SX0=Q^)zg~_nF3nu@ zSsB#L>hsF!-X}bSKT^O>&qkswdxjeIjGQICB5P`Da?->%GDrP`Eu#qR z_r*>RIYjzi{_A(hmR+NyQ*Z8ahA7(g**&qkS=*VRDpQ(`t}U2oYOsDM^PIg-?c{cT z5gzYJvKPgi&eqyIeDmhbEz;7Jn2<>~Aggr8?w?#(>P5K*1e8tc9Lio@T|MI3m8Q}* zGU6D-8np8L_K_8kOHoP~w~Ffn598ydghR*OBJKFb$RkIOCe031%BFqpGWH=+&-^~TbngreQ1uh(KSf=%QLh6YfD=${#47VQNvplo=r$YPdv7& z@Um*W<2dnHT<5A_xfRjnYP9%RrA>Z#?smb|;wK~DA6h&>wtwGg(9k$h+^W>!oNV_{ z1>LM>AJ41j5hYY_J+37A8(Uh^$_Vb%g;H;?zLM{FbQ~_h$4DheJ$qC=+c&K*y4W|e$xBXP;Vg}(t}hT zuUqUom!J^%_EMpeQiN2{OmQn1PBkOs$3}PP5mFP=9lduV!m@thfkdvD2Tj&+iWT>nR&Lf&r3!TUc3a|G{*Li&4EwQ{X?Ptxw#pb1ILE~F0<QGV1LM;~oBE z@g@~ha?l~W*}-5@qcrw@T=>j2tKuI|bs6#oWxm^(Wo~UK3D(RCY$`P>hk|Ud+|tZv z1cD}fi^Hqb$_XA$#2c8~GBR?>{a9*e9_s~qaUyK;q;flp74+K|s$&Zsny6r&J?Evm z;^qjh=Xel57a?%hs9*jt6#GC$SvVI}>eQAXXy0tiEc2&_J34+NYwLRg#F;<0&y}&Z zNT$=Ppt6g2Mg*XQa~jnusmHGO&(6x)hy2i`GkVXR@pI%*l7tUX`1@pnFPcjH#@hichKY~w@JMwa~8e3vmq1tv{I8R;SyvXupHahpBHuR>)GYLx@>$GpxYqy_c6*Al~N zQESR;Ba*%Cn~XinJ?R2IU4-?nnaZ&ZdH=I6=j~-4VjrYV1Jfv~Wt}}Dl$QquB)L{F z=uhrU(e~WiBEcPcD&bSw_Zo#=NK|QKuXV9!xJGciC5-(VrIg~g`=j?bL3}`3rU?o+ zUVe3Xm|%gQJ$D}J&$8pQ$Oen&HEL%{?nHZTc!TagEV)hq+pFH3PR#f!l+T?-CV<8r zC_-nsMzzB;afaM?Nt@l*?*(5u0OA>k7@w^i^gEX@R!#_?t$+Dh*4F-F_ORPg*fUF9 z?nKWy%?r=W+%H^(tn(H98;ZVNme3420Rl5A)w^atcoYleR9Vj{%(KX?W2r(~PapU)f2D~H#HkMcGzdDtRS|eKEou_)9p_jT%{F}BOhtavo{!tEc^RQji zptQ8KtCN#crEEQVZN4>81x7%Q?HRS!4OxQz;vw&2sa8ZxU=fkquhRC|HRJIPHH#VU z*&1kjF1S7!CtSRD@1B!jm7}}(S_?N?aXLF*Wo03mlt#dE@W_NzpZdNPwAiM%(_}HS zU@Nh$sPabp{@k(K^4_mb)7<5~=e2A)yVG7A_L-RFS4S?|=F|AS`?; zQ#)NiHYAVrdlEXoP))nfEUMLDhcWaY)Iy5S75OaSP|yP*&AZYFVycgq<)CH{j>5&f zD}JvJx2mj&ay^%?*G@!&hZxxY_Kt%|BTs9hSE75}Rep3^bv_-hADWr-`QR0HZ;C1_+t+33a22>_^LwvxCL% z(x!zjeI?Gw1Rv~TDjyb72P^lade z3==RN$e{6)Fuw;wE3`?L_o+J!T29+e9eTk&(8&;bzx6g)dUJARE(%dMF!1o8RYJ68 z{qk{PF0s$cG|hoIjVE-)n<(kd7DM|i)Fxm=)d^;OP$dlfyoObY3Qowt4L@0eX5uWc zQt#5El(9O>t8b$G{+gG3?0g}v4L~9cO>h@&b8~ZxEqDw3N-Ak3b&bUqdT-7YQ?T7j zeATa^8QRyeutLTe9Ul(4#;Rsyz=>*H6NffM2$l}o*M(I6JX5sjDhLWTNC(p~1=C^J z-wZ}EECYn6BD%WU$zo8_IdHLSvATO{cENTQ1pD+rCUxABv}!J+VfzTC<&I=c^6n^w z9xmfE$r3}Qk9{m-SHIuXK2g>DaohAiEr+tQX9laa%B|JG8#r1`5A=)z%2=Qe2Q~QM zK_kxu=o~ZO&p<0zi*-43^$KvLJzzH((0O%!1?o4r%yh8@a-V3=p4=1IaUVQ1{vS4U zv?kyL1Wq?vh>uf2W?-iC-g=aS_h2ZSSQ~ymyZaT0({)e1IVs(lrt1$A>e?bg~o^y*Mk$!TZv)OS*DZQrp>h!gVj)&@Kkl!E0$R8KBkbQ_8>L7+$xY8hLbRW3Y8IW6V z*K#s$C3ywtVqsk-J(wO|&93J!0p0|3r)Ng62my3K*K8#{!?UP*FUpW}Wmn8;(Dq#HBV&&tOKyy|ge_$& zhYyctge|nC`Tq7rU)2o|YZH%Pi-IPsoVXBQUfpl8!N%rf#aJ+oP0az;o1wyjn-az0{&u3zD)^rVnkn%z%1|5W*COZowA*dQzXete$d+@H57aDO8gEI!gR)p%=fF(XI!J5h zO!cOos3t8VnBB1fWBqcwR8|cR&^os-aes=sq{1zIR%B+pzhg=tp}DVu&X_W z^cxDKIdfuV3=6F>E}qFP}ZrAl+KBlyx_qbCJF0QQd6r+ zA1b_Zz^W#|9hP^JN+FIUKOoAz1}fC!5W)~8Fk!FZI$gXaAwwr&Cj|AM0uC{5ot~W? zVzkcad2kygmCqMiq%PEh2dR-jGCmBKP9D1{sq{(}vC*{N=i;9&N%C`szw)Faa`AG zZoelF?FF|bVa!YIGf@r?IOaY0XuKoY6$tO^RxLxpbi+$5;Z&y39Tqo3O4rv0F9QNG z)?e=mOD4hD1(^V%v+{b!G7Tr7sUUGUTv7e%G!pgQJOFd0Iv^euc>GOoWB1sSjrcPv zqYO$okOZnk`sAdW6k=@-aK_pINibmK95(rDRDud2q*<+pLMb0;jfsh=h8J(H=Yj}v zY*EB6zel#j`KGfZy7n&S94GEKQMmDa!WfW(=}XvT2P_&!4ycsUZnVhpljf^NW6veP z!V}2#T1DJ=`-48<^Rf&urx|s)Gp5Cg@d+D!$=fWeaUT5ku){R(4N%}fZ+apVVAak> zlS3Eq4uS(8VQf?3)h3BpZY;2^K7w2T>~t6utwXu@;A$yhesc|xX~%8{As4SACnwh? zE^Tlh*pjg=bNTxTa%QH=3PH50$ruH(t`0Nm>#A#UhR5Kd1Qf!VD(**jsVj=c5>Z`> z!GrODp~8SJ?2NWwdU6F%0q=vhRfjAc!UOXu9!9)svNNDfe%d^TfD4BUs_*19e~Hui z@C&F}U~z0tz?gg2&Q=VDjK*w}Mf0anxD=1_6j*wwhi8CQHFv!vkO;)z!b(oGLS_JP znt^(r4cC?MQT|jb*Ks>G#&V)FwbEgfexp@!1@_S(nvo9hY*pff90uhR11=drP1Os) zR~#39FjKgcdl^qD!EmP2{Mz@cV}ii)2fQi)7D&`{-QX?s2`hvDX^Q)^hY%okc!*B! TDKcAs_5^v#^!uW}INtg<4VB|G literal 12652 zcmeHt2Ut^CyY5z0MnM_J89_mr5=2y_NRh5%!GM6m4818$X+c`(MEw;V1ayZYCCM-t zG7cgN0!9eIf=sAlfPfG{2~8w{P(lbKXYF{}bDs16^WSsl{`a1H+|Q#cthT@PeeYM- zzJAKqa^r^W8z2bUh(2-D9)i}!K#XLNrc`+1u1C+!>b$$x2{|T$ zf!W8mad$ZVxwc$Ra*`m)Jj^H{iig3r35jE3(i$mQf8u|*)yyNy>=IN)t!SBmnmw}Y zCf!`6ki=mBYNBpr5hI6m)IY3HGLw$rWGl9tLAdYq+8xX#r!oeOjFWF0F*%Dn!RR8i z#uMkmc`p~6l!Wq9q75hQD;wEThSJIySOtb#kx~CVn4*>L`LLIp#2-!T*bDlHVm^;q zm0qZ>x{c;tff?K!111ms`k1jDdEp_Ai;775b7sAil2cYgYmvWqt4*&)+RQJI=@4YK zz7}a9@)}R1!P&3YLfTKuKd}zM!6(@K!&Rm;a1MfcjFa`sh{ieX8N>@-TZK6+V!k+f zP98|)B~bby6Vut4Y{Tf;_+|~4lSQoHD!Oeq!%JOi0&I5!%{Pcy>fl_DC~^v3$inP0 z6j+vlrQWE3f2i^!C&6uX^1LmXTfV#8HohaJ*W|=Pcaf7yDAppD^8?HoBnnewr}H*e zMQ#Q3C8%Fi95T0IRA3kIaskJ+dV?{^bC=>xZsV1)uw^@{Ib_8GHlpgp$$-iIvS4ye zn19ytkmd2Ro)1A7wRr6Dvd0#xw3`L&ZM1hQr7Xt0Tago(TTcs_taJcBz_QE#6YQa5 zkt_t=nCq+*itx)X#&-yO%*Ip)W0K+`<~9Kw#D7)`)n7L#n~h**(zgMBb8o9qh)TAI z1FIgG0Z)KKsV3_JWI5H+`$P<g?^c9W@h9SA=RN~2M-~N8snDu7)){`w-P|IM;m^XT848Xgkd4s> z@0>nWn%%b}1~VlGeAOYXe+-E4c8#xs>M!Sx`Q9=Wb|{XLcGCRt^O?;>hJY-U06E6_O6kzb6iuo72!Cff&u+s#?M8D&%Yc0DnD^$X&mvojrjm{4UWy6{x;C7S+Jl0 zfkO#m0_F|+!ho(JOYdz3!elxb%xoCdei5R!&y1?uaOAD_hd ze_o9Ln<)6_<%nk2Kc8Q;o^3c#J)2*IMZ_02x5o3}Xxl(j!~D0&x;6~GIKo4GNXWb} z#R*~|A@kQ4)_rt5ntzZ@yQb}gTJP5#OvZEzdpk@v9k7cvogM!QDp)gHaFUVXk$6U& z)!~M8&sUBWCo2J}p!7@ia;o(SH%Tp-T4@6pc3)7$DKPZZCXGn8{0U@oyRZg@prR2> zv>dV|o{X-VtH--x;WBWn)j0gSCLxC}?AU7{TB?Sz(Fnn~qVJ}kZFbh=ii3+rvbn2= zVq8!5iSllvm>`;g!d_G@P9gCN1f@uGg-`iE!i!I}kH22`3Dl1R97=E=HA0uiy_1{0 z^3=h=Rh^PuWC=o^BcP@<^x}50ua!Bq;&+pxYLIH32Kgy;@H7aNK=KOWr%6fvhjt_j zd-Xjs`>0Xn$^C>KAcCq6-6ax92cFqS(U1GWQ?b^c}Kz~5H} z`{+S`ZWbp9F6fLXlAajQjiOuM7HfDV%~w+}H$b6o`T^o5>#=@V30plv95{YcG@Fa^ z+HSTQ8ajh$8%~!0d=OtS@cPK$!Wd_-TVjX~RNsNH3nyD%aUwb!Nw?0MfdHdE#mAbC zK@tjR$n$?fVXhL?Mv>y>j(d1!Gm4>@Jk&m>wTT$i0;t%7R`S->;N)pfi=yCc3%iqa#j3n z%ZAHWxOtYHD3lt*chC0Mhf=0*YoGrOemn7K{h7Rz1lz(#YWRak8n}T!RB!wK{KaB} z+x!h0J%?`GTK??Wv#Rdb+?DwZTKQjkN<7Z<*b!y(!j^uc0D&nNt12)IpvQBKKyh&Q zT4`ikf6e}5P58#IGsQ?zq`rv#y+=WI9>HzUsVvx_H8(5IZBt$8@{dd-$a$M|k$lfX zVZ(V1VW~fUUs-0Y&h<-*-bZ&Mj?_EN{h=B)%!8>BCt7}5yafuY`VxWsgX1ro-pN2q z4gc)vk7r(zGRFI;#z+7A|87TT3=_%tao^a7k1Pz{)jDtdGI!sj@NuqTmX-lQ##>2x zaGYgl9!otok!jR+r}Ab7N=Pk^faGPQ?3%t-stju?>JfgaHmS>3Az+Nx)=!_3ay{d= zlJ%~X$C^reZPX#9{h{T^eJZ5=isELMcGv5Tga_&*VY>8JksF2*3K3%m9dGj41viES z8Xv=82T1)EEM(~Ic0^`>^Y#BiU|{WpbZW+~#;x!b+wzsGOLfH+`vSfZ=3wb$)1Jsp zL;W8`yfohPefcT;%)?sp#6DW&`?KrK9Qk#q4W3G8HXtg7Gj}u0Hl5@bJIqBdo(pe$ zTkHU>4E?WDaP(E@j!R+(sVE8p(s%OOG84jk1_#V^a-!kh;)pq29b%aZPmgdmR+*)aRVPoV%#ozX z9WtH&E+7B!n~<0>McCx(QvW-=f!9s<@WTN4H9_avlZ#b9vS{q?#z}bQ8_gJ1BF6Y> zQz=GGnWYbqFazJHN53p6`X+HbqIJ*%mH()Ze@#K5`iW5!#@a1tICmr6N!ga!H*=+U zOIY2&K4Alwa^D551^S%^1B>qBso^oY=Ba2DZ# z8j}oX0`Y+-Y#=`7%tMYQgJ(b>=j2)bWVM#(Vn1ED>Vi51ZI*ruu<7?`;&1;==%9b*MiV+j2B~E{3Twbmw6>Up4i4AajZH`*Rx# z4&R-juF!5sSbeUGYl#zXSAt~-V&TuWu1)^&t2bgKLWJtHOOK#XkRXny7FgsJsibV=qi z8}9cE;)WXAX({Yz&md>Xy6JmijIFiwg}2HVGX?zM!*yb zCt||){=`9R4Ye)$v7v!tFIbe<#%z8lbSJ>i)r7~HE^&K$Z{;yiUgwOhw8*}0Hbgkj z4k5v{qVN&_gX?SqoIsy2HOq2$gE5_Xm%+{>Plcv6k91jyi3;R53=xJ><~Uk4JBzwu3&t;M}L03;|j1Vfj8-Xvz zRsI;X5~eYtm9fKQq1q;3mG@Mpz4({zrBoju9};rRKYGS~DQIn)iWXT~YhX$%ZPkoi zt%P=^j*}jug(=ZMulWTF!PHHMB7`~HPPVWk&`3%-2RtroFp^^i? z`z%D)th_*Zl~kHXMMp2(@1m^z*=rrU_d`E5qH%F?(T?R>wuhW>VY0iFS3C1kIYZzx z7-k+=8rg97?p?1Fe6lTNHaDcN%EQ3Oh+5SB<;RVS%k{TtXvdSb) zhL&0{>}y>*UnwUi=QUUv#7dRDrHYF{2vDSr9~(w*Lb+5wco62OPJpzXFRMr>#l`mv z^75WU1qTNwQ<&6PfB#WRF@+-7gFO@F7^&SATAi%N$btJ09yl=j#Gx8f-RFf4@2Cpt zBR+x^eLtQ)b~)J!w(D~Bq9uwJ+!R#J`;Fq}#`VdW7PkCOR0O)JrKQDG?^@YfT$b{j zPJ9hJ$qx29Q680)BwjDONo8^2y@SjHS3phQ)IuLztIiOEqtfhoGAk9o9Eb@jHQa@! zFk^WNTEAiJ%BNlx9+8|Ym9jl{S<-6Xl+oVSmNfcO8DpBnv@z6dX=@Xc0KW=Qa_C*w z8d@KCPEb8niK8Q$XL(6#?VDD}nTaK>>klPw3|vNdMF0IPRTMR{e{QgREia1YfjzG= z@&?toz#EjLslGW}GC$!vqadj4SA;Hiwd=&U6V0}eGy5nM3eP;TSG*!pP#2znBaI2_ zWyS}g5?#P+b`2IY9%;;by!5`rPHPi%uIJ~M5`X|aIg`c?!S2BpO0qR$8XFr)IjG8R zH+&~EM-^x}rl!I!c4V&?)vt8nBdP}K5=GAdvqKL)-{UoI%l4K1`OIZge^P$FNI=eH zaoIK16-#%ZIp)_dC1&vpCs9T->1hgWfFGr*E*DiF1wVBQqU}OkX<+wNE^i?%zDU?w zmVbM=F@xt^lDJCSc}1l{z-9LtF_Yh0Yve>xNJeAz&|JgM>AgS{?b-IBuJ73@kRImq zVae0WvdMcGFS#ka$s;Gd*AF+Bp0bJ!hdW*A5m&poC&Q0v_=#MnL^<6{h&LrWq=wn_9NQB#@1H+ zhRT(}i6;b$^mqaHq3dLdwFbSPat)F{L~oSP;ssT3?PJl~DRO3f8Fe(zi&#*QkU(Jy zWzk~K()sM@nkgRSO!jLZvf-b?8b@D^>Q+N*j9k=5^;{+}zxhY&S*R@%gA_2|tHkD}GTISW4G3F%cnSTT(4Vpm$ja z%*FzWF8R%g_P*VGsUu^jsbD-T$&H~OgW=g4lFn47!gsm?HDd|chd&^EOx1}G4dv3v znTC&hSJzLEk1bm0>(399Gp~bP-IkO#<5rCeW+XBSrqjP~)CXvyM=kMJM1sN7Rzeaw ze0gyuhZN;Kw0W=5Wx)$VE9s3-EV^7D0mJ>bb&%4%i|M^J(Nl3DrSlG|qMkOFUc}^)31(*tj>e+Jv0h3nb%2@bQNn%gP!hKyzarvqOR8p4m6S z0c%;Vk|0>I)3xkiO6?(*)%~aO@6tz|v?>z<0|Sp>7u=*4Q;Lx7oZDvLB<1!^$0{l+ zB!2qaR*lnF-H?=`wpg3mDp~8E4)S0y)FJub0Y)tHP_whM)>|KwGeu9B@$KL43Cr`7 z8vvx#;1hHien4N@Wb1q3e%K|hR7drH)u{nw88RXQ{Qb=zbn-oFqRqJXF0Fp$lxQxN zWC7-tcYepRo==&rhQ9Px#HHTn=_3R3)yl*`A2%2lI z&*-(*AfR$dB;LO2{ZLSG*|218ZmtyA#gfW8Az3SN;tFMdA3&%xOtRwxx^nv*bCuhI z{K$K`Zz?A%$(fRyoJu?%uZo7LR4TXyDzv3U%mb4{k6bdS!Sa$?`uqF6P`&O}v4;ip z!()%MpuCQ|52sA~x|9QmxfM%O_rfQ{Zj9LHhk4#EU8nuXGn>=1EnDK4XL1=!4F(q+ zyOECqUfoew&kZp?s$kbP?GHYA0vRp@<;~tfk*q=9c~eb3!T@~M^cN81;C8uZae~l0 z`&MGUP0jiK;LPK&+$paD&L~O&C8VR1cBLBnn&2twLPK<2F6SvqvX{|5l49Lo(OPAe z%9^0*Gj4H*+iP-FFwzV%!&Rcw?Byls44STj6CR6ZCNjKu4-?V+HdJzE!|N*K;E~uG zx>fj$k$?XC`xROYGCR?3m#~XFW|2LT8h{)fcPsLjdo-T>WWnwjo*h30outmF+P9VB zR^j}LxI5Nx-@_FXe1fTk`y*SFQ9qm8y*%Ap)$G?7(==NbetkrM&GG1)-3yNWBR^XQ zg03F+cxs#vFIS^5w&4$IS_@HSCVqqx+dh9wxLRG9rbZl&*=pU7qV8f0S~LeMs0n?s zORZ|zz*8h1&X@uc=t6Qj`O9q^Sbfzm#_GbFmeZNpv>FpyX`|RYwrP3Zta~CW%h7xq;<2q>G8@|m{0W5ha)R(=gLwIZh9BspE=vcE3^UPi-ZyJB6o%8mHWd;y@P zed<1_=hSOEw{EMYwGedaQD2FS9I99-sv08z|0tpy;2fuq6lT1YQSe31z|YPnapN ziuojf{3}^00O!21PxLPv8LW&^K1i??F$W%z-AO=G1;k@jW04d^6m|NMUn$Bda*Qol z4dE`HmO{CVs4G#ZVV0tkXm%pWFbW$vCOHqwprbjQ3)5tmeHRC_@qW`*6@(|t8F27; zo5g;HEUdyyO0d~#JQ6T zcksyOZWE45>_CbL6!Z^_yT(bmJm57;6Yp6 jhb<9ELGSrG diff --git a/docs/reference/model-method-optimize.html b/docs/reference/model-method-optimize.html index ff22f0e99..b4d1ad67a 100644 --- a/docs/reference/model-method-optimize.html +++ b/docs/reference/model-method-optimize.html @@ -1,81 +1,18 @@ - - - - - - - -Run Stan's optimization algorithms — model-method-optimize • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run Stan's optimization algorithms — model-method-optimize • cmdstanr - - - - - - - - - - + + - - - - -
-
- -
- -
+
-

The $optimize() method of a CmdStanModel object runs +

The $optimize() method of a CmdStanModel object runs Stan's optimizer to obtain a posterior mode (penalized maximum likelihood) estimate.

Any argument left as NULL will default to the default value used by the installed version of CmdStan. See the -CmdStan User’s Guide +CmdStan User’s Guide for more details.

-
optimize(
-  data = NULL,
-  seed = NULL,
-  refresh = NULL,
-  init = NULL,
-  save_latent_dynamics = FALSE,
-  output_dir = NULL,
-  output_basename = NULL,
-  sig_figs = NULL,
-  threads = NULL,
-  opencl_ids = NULL,
-  algorithm = NULL,
-  init_alpha = NULL,
-  iter = NULL,
-  tol_obj = NULL,
-  tol_rel_obj = NULL,
-  tol_grad = NULL,
-  tol_rel_grad = NULL,
-  tol_param = NULL,
-  history_size = NULL
-)
- -

Arguments

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
data

(multiple options) The data to use for the variables specified in -the data block of the Stan program. One of the following:

    -
  • A named list of R objects with the names corresponding to variables +

    +
    optimize(
    +  data = NULL,
    +  seed = NULL,
    +  refresh = NULL,
    +  init = NULL,
    +  save_latent_dynamics = FALSE,
    +  output_dir = NULL,
    +  output_basename = NULL,
    +  sig_figs = NULL,
    +  threads = NULL,
    +  opencl_ids = NULL,
    +  algorithm = NULL,
    +  init_alpha = NULL,
    +  iter = NULL,
    +  tol_obj = NULL,
    +  tol_rel_obj = NULL,
    +  tol_grad = NULL,
    +  tol_rel_grad = NULL,
    +  tol_param = NULL,
    +  history_size = NULL
    +)
    +
    + +
    +

    Arguments

    +
    data
    +

    (multiple options) The data to use for the variables specified in +the data block of the Stan program. One of the following:

    • A named list of R objects with the names corresponding to variables declared in the data block of the Stan program. Internally this list is then -written to JSON for CmdStan using write_stan_json(). See -write_stan_json() for details on the conversions performed on R objects +written to JSON for CmdStan using write_stan_json(). See +write_stan_json() for details on the conversions performed on R objects before they are passed to Stan.

    • A path to a data file compatible with CmdStan (JSON or R dump). See the appendices in the CmdStan guide for details on using these formats.

    • NULL or an empty list if the Stan program has no data block.

    • -
seed

(positive integer(s)) A seed for the (P)RNG to pass to CmdStan. + + + +

seed
+

(positive integer(s)) A seed for the (P)RNG to pass to CmdStan. In the case of multi-chain sampling the single seed will automatically be augmented by the the run (chain) ID so that each chain uses a different seed. The exception is the transformed data block, which defaults to @@ -240,25 +167,24 @@

Arg chains if RNG functions are used. The only time seed should be specified as a vector (one element per chain) is if RNG functions are used in transformed data and the goal is to generate different data for each -chain.

refresh

(non-negative integer) The number of iterations between +chain.

+ + +
refresh
+

(non-negative integer) The number of iterations between printed screen updates. If refresh = 0, only error messages will be -printed.

init

(multiple options) The initialization method to use for the +printed.

+ + +
init
+

(multiple options) The initialization method to use for the variables declared in the parameters block of the Stan program. One of -the following:

    -
  • A real number x>0. This initializes all parameters randomly between +the following:

    • A real number x>0. This initializes all parameters randomly between [-x,x] on the unconstrained parameter space.;

    • The number 0. This initializes all parameters to 0;

    • A character vector of paths (one per chain) to JSON or Rdump files containing initial values for all or some parameters. See -write_stan_json() to write R objects to JSON files compatible with +write_stan_json() to write R objects to JSON files compatible with CmdStan.

    • A list of lists containing initial values for all or some parameters. For MCMC the list should contain a sublist for each chain. For optimization and @@ -271,494 +197,515 @@

      Arg has argument chain_id it will be supplied with the chain id (from 1 to number of chains) when called to generate the initial values. See Examples.

    • -
save_latent_dynamics

(logical) Should auxiliary diagnostic information + + + +

save_latent_dynamics
+

(logical) Should auxiliary diagnostic information about the latent dynamics be written to temporary diagnostic CSV files? This argument replaces CmdStan's diagnostic_file argument and the content written to CSV is controlled by the user's CmdStan installation and not CmdStanR (for some algorithms no content may be written). The default is FALSE, which is appropriate for almost every use case. To save the temporary files created when save_latent_dynamics=TRUE see the -$save_latent_dynamics_files() -method.

output_dir

(string) A path to a directory where CmdStan should write +$save_latent_dynamics_files() +method.

+ + +
output_dir
+

(string) A path to a directory where CmdStan should write its output CSV files. For interactive use this can typically be left at NULL (temporary directory) since CmdStanR makes the CmdStan output (posterior draws and diagnostics) available in R via methods of the fitted -model objects. The behavior of output_dir is as follows:

    -
  • If NULL (the default), then the CSV files are written to a temporary +model objects. The behavior of output_dir is as follows:

    • If NULL (the default), then the CSV files are written to a temporary directory and only saved permanently if the user calls one of the $save_* methods of the fitted model object (e.g., -$save_output_files()). These temporary +$save_output_files()). These temporary files are removed when the fitted model object is -garbage collected (manually or automatically).

    • +garbage collected (manually or automatically).

    • If a path, then the files are created in output_dir with names corresponding to the defaults used by $save_output_files().

    • -
output_basename

(string) A string to use as a prefix for the names of + + + +

output_basename
+

(string) A string to use as a prefix for the names of the output CSV files of CmdStan. If NULL (the default), the basename of the output CSV files will be comprised from the model name, timestamp, and -5 random characters.

sig_figs

(positive integer) The number of significant figures used +5 random characters.

+ + +
sig_figs
+

(positive integer) The number of significant figures used when storing the output values. By default, CmdStan represent the output values with 6 significant figures. The upper limit for sig_figs is 18. Increasing this value will result in larger output CSV files and thus an -increased usage of disk space.

threads

(positive integer) If the model was -compiled with threading support, the number of +increased usage of disk space.

+ + +
threads
+

(positive integer) If the model was +compiled with threading support, the number of threads to use in parallelized sections (e.g., when -using the Stan functions reduce_sum() or map_rect()).

opencl_ids

(integer vector of length 2) The platform and +using the Stan functions reduce_sum() or map_rect()).

+ + +
opencl_ids
+

(integer vector of length 2) The platform and device IDs of the OpenCL device to use for fitting. The model must be compiled with cpp_options = list(stan_opencl = TRUE) for this -argument to have an effect.

algorithm

(string) The optimization algorithm. One of "lbfgs", +argument to have an effect.

+ + +
algorithm
+

(string) The optimization algorithm. One of "lbfgs", "bfgs", or "newton". The control parameters below are only available for "lbfgs" and "bfgs. For their default values and more details see the CmdStan User's Guide. The default values can also be obtained by -running cmdstanr_example(method="optimize")$metadata().

init_alpha

(positive real) The initial step size parameter.

iter

(positive integer) The maximum number of iterations.

tol_obj

(positive real) Convergence tolerance on changes in objective function value.

tol_rel_obj

(positive real) Convergence tolerance on relative changes in objective function value.

tol_grad

(positive real) Convergence tolerance on the norm of the gradient.

tol_rel_grad

(positive real) Convergence tolerance on the relative norm of the gradient.

tol_param

(positive real) Convergence tolerance on changes in parameter value.

history_size

(positive integer) The size of the history used when -approximating the Hessian. Only available for L-BFGS.

- -

Value

- -

A CmdStanMLE object.

-

Details

+running cmdstanr_example(method="optimize")$metadata().

+ + +
init_alpha
+

(positive real) The initial step size parameter.

+ + +
iter
+

(positive integer) The maximum number of iterations.

+ + +
tol_obj
+

(positive real) Convergence tolerance on changes in objective function value.

+ +
tol_rel_obj
+

(positive real) Convergence tolerance on relative changes in objective function value.

+ + +
tol_grad
+

(positive real) Convergence tolerance on the norm of the gradient.

+ + +
tol_rel_grad
+

(positive real) Convergence tolerance on the relative norm of the gradient.

+ + +
tol_param
+

(positive real) Convergence tolerance on changes in parameter value.

+ + +
history_size
+

(positive integer) The size of the history used when +approximating the Hessian. Only available for L-BFGS.

+ +
+
+

Value

+ + +

A CmdStanMLE object.

+
+
+

Details

CmdStan can find the posterior mode (assuming there is one). If the posterior is not convex, there is no guarantee Stan will be able to find the global mode as opposed to a local optimum of log probability. For optimization, the mode is calculated without the Jacobian adjustment for constrained variables, which shifts the mode due to the change of variables. Thus modes correspond to modes of the model as written.

-

-- CmdStan User's Guide

-

See also

- -

The CmdStanR website -(mc-stan.org/cmdstanr) for online +

-- CmdStan User's Guide

+
+
+

See also

+

The CmdStanR website +(mc-stan.org/cmdstanr) for online documentation and tutorials.

-

The Stan and CmdStan documentation:

- -

Other CmdStanModel methods: -model-method-check_syntax, -model-method-compile, -model-method-diagnose, -model-method-format, -model-method-generate-quantities, -model-method-sample_mpi, -model-method-sample, -model-method-variables, -model-method-variational

- -

Examples

-
# \dontrun{ -library(cmdstanr) -library(posterior) -library(bayesplot) -color_scheme_set("brightblue") - -# Set path to CmdStan -# (Note: if you installed CmdStan via install_cmdstan() with default settings -# then setting the path is unnecessary but the default below should still work. -# Otherwise use the `path` argument to specify the location of your -# CmdStan installation.) -set_cmdstan_path(path = NULL) -
#> CmdStan path set to: /Users/jgabry/.cmdstan/cmdstan-2.29.1
-# Create a CmdStanModel object from a Stan program, -# here using the example model that comes with CmdStan -file <- file.path(cmdstan_path(), "examples/bernoulli/bernoulli.stan") -mod <- cmdstan_model(file) -mod$print() -
#> data { -#> int<lower=0> N; -#> array[N] int<lower=0,upper=1> y; // or int<lower=0,upper=1> y[N]; -#> } -#> parameters { -#> real<lower=0,upper=1> theta; -#> } -#> model { -#> theta ~ beta(1,1); // uniform prior on interval 0,1 -#> y ~ bernoulli(theta); -#> }
-# Data as a named list (like RStan) -stan_data <- list(N = 10, y = c(0,1,0,0,0,0,0,0,0,1)) - -# Run MCMC using the 'sample' method -fit_mcmc <- mod$sample( - data = stan_data, - seed = 123, - chains = 2, - parallel_chains = 2 -) -
#> Running MCMC with 2 parallel chains... -#> -#> Chain 1 Iteration: 1 / 2000 [ 0%] (Warmup) -#> Chain 1 Iteration: 100 / 2000 [ 5%] (Warmup) -#> Chain 1 Iteration: 200 / 2000 [ 10%] (Warmup) -#> Chain 1 Iteration: 300 / 2000 [ 15%] (Warmup) -#> Chain 1 Iteration: 400 / 2000 [ 20%] (Warmup) -#> Chain 1 Iteration: 500 / 2000 [ 25%] (Warmup) -#> Chain 1 Iteration: 600 / 2000 [ 30%] (Warmup) -#> Chain 1 Iteration: 700 / 2000 [ 35%] (Warmup) -#> Chain 1 Iteration: 800 / 2000 [ 40%] (Warmup) -#> Chain 1 Iteration: 900 / 2000 [ 45%] (Warmup) -#> Chain 1 Iteration: 1000 / 2000 [ 50%] (Warmup) -#> Chain 1 Iteration: 1001 / 2000 [ 50%] (Sampling) -#> Chain 1 Iteration: 1100 / 2000 [ 55%] (Sampling) -#> Chain 1 Iteration: 1200 / 2000 [ 60%] (Sampling) -#> Chain 1 Iteration: 1300 / 2000 [ 65%] (Sampling) -#> Chain 1 Iteration: 1400 / 2000 [ 70%] (Sampling) -#> Chain 1 Iteration: 1500 / 2000 [ 75%] (Sampling) -#> Chain 1 Iteration: 1600 / 2000 [ 80%] (Sampling) -#> Chain 1 Iteration: 1700 / 2000 [ 85%] (Sampling) -#> Chain 1 Iteration: 1800 / 2000 [ 90%] (Sampling) -#> Chain 1 Iteration: 1900 / 2000 [ 95%] (Sampling) -#> Chain 1 Iteration: 2000 / 2000 [100%] (Sampling) -#> Chain 2 Iteration: 1 / 2000 [ 0%] (Warmup) -#> Chain 2 Iteration: 100 / 2000 [ 5%] (Warmup) -#> Chain 2 Iteration: 200 / 2000 [ 10%] (Warmup) -#> Chain 2 Iteration: 300 / 2000 [ 15%] (Warmup) -#> Chain 2 Iteration: 400 / 2000 [ 20%] (Warmup) -#> Chain 2 Iteration: 500 / 2000 [ 25%] (Warmup) -#> Chain 2 Iteration: 600 / 2000 [ 30%] (Warmup) -#> Chain 2 Iteration: 700 / 2000 [ 35%] (Warmup) -#> Chain 2 Iteration: 800 / 2000 [ 40%] (Warmup) -#> Chain 2 Iteration: 900 / 2000 [ 45%] (Warmup) -#> Chain 2 Iteration: 1000 / 2000 [ 50%] (Warmup) -#> Chain 2 Iteration: 1001 / 2000 [ 50%] (Sampling) -#> Chain 2 Iteration: 1100 / 2000 [ 55%] (Sampling) -#> Chain 2 Iteration: 1200 / 2000 [ 60%] (Sampling) -#> Chain 2 Iteration: 1300 / 2000 [ 65%] (Sampling) -#> Chain 2 Iteration: 1400 / 2000 [ 70%] (Sampling) -#> Chain 2 Iteration: 1500 / 2000 [ 75%] (Sampling) -#> Chain 2 Iteration: 1600 / 2000 [ 80%] (Sampling) -#> Chain 2 Iteration: 1700 / 2000 [ 85%] (Sampling) -#> Chain 2 Iteration: 1800 / 2000 [ 90%] (Sampling) -#> Chain 2 Iteration: 1900 / 2000 [ 95%] (Sampling) -#> Chain 2 Iteration: 2000 / 2000 [100%] (Sampling) -#> Chain 1 finished in 0.0 seconds. -#> Chain 2 finished in 0.0 seconds. -#> -#> Both chains finished successfully. -#> Mean chain execution time: 0.0 seconds. -#> Total execution time: 0.2 seconds. -#>
-# Use 'posterior' package for summaries -fit_mcmc$summary() -
#> # A tibble: 2 × 10 -#> variable mean median sd mad q5 q95 rhat ess_bulk ess_tail -#> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> -#> 1 lp__ -7.30 -7.03 0.721 0.380 -8.82 -6.75 1.00 902. 1006. -#> 2 theta 0.247 0.233 0.122 0.129 0.0786 0.470 1.00 762. 712.
-# Get posterior draws -draws <- fit_mcmc$draws() -print(draws) -
#> # A draws_array: 1000 iterations, 2 chains, and 2 variables -#> , , variable = lp__ -#> -#> chain -#> iteration 1 2 -#> 1 -6.8 -6.8 -#> 2 -6.9 -6.8 -#> 3 -7.0 -7.0 -#> 4 -6.9 -7.1 -#> 5 -6.7 -7.0 -#> -#> , , variable = theta -#> -#> chain -#> iteration 1 2 -#> 1 0.28 0.21 -#> 2 0.19 0.20 -#> 3 0.16 0.17 -#> 4 0.20 0.36 -#> 5 0.25 0.34 -#> -#> # ... with 995 more iterations
-# Convert to data frame using posterior::as_draws_df -as_draws_df(draws) -
#> # A draws_df: 1000 iterations, 2 chains, and 2 variables -#> lp__ theta -#> 1 -6.8 0.28 -#> 2 -6.9 0.19 -#> 3 -7.0 0.16 -#> 4 -6.9 0.20 -#> 5 -6.7 0.25 -#> 6 -7.1 0.36 -#> 7 -9.0 0.55 -#> 8 -7.2 0.15 -#> 9 -6.8 0.23 -#> 10 -7.5 0.42 -#> # ... with 1990 more draws -#> # ... hidden reserved variables {'.chain', '.iteration', '.draw'}
-# Plot posterior using bayesplot (ggplot2) -mcmc_hist(fit_mcmc$draws("theta")) -
#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
-# Call CmdStan's diagnose and stansummary utilities -fit_mcmc$cmdstan_diagnose() -
#> Processing csv files: /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/bernoulli-202203181226-1-73471f.csv, /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/bernoulli-202203181226-2-73471f.csv -#> -#> Checking sampler transitions treedepth. -#> Treedepth satisfactory for all transitions. -#> -#> Checking sampler transitions for divergences. -#> No divergent transitions found. -#> -#> Checking E-BFMI - sampler transitions HMC potential energy. -#> E-BFMI satisfactory. -#> -#> Effective sample size satisfactory. -#> -#> Split R-hat values satisfactory all parameters. -#> -#> Processing complete, no problems detected.
fit_mcmc$cmdstan_summary() -
#> Inference for Stan model: bernoulli_model -#> 2 chains: each with iter=(1000,1000); warmup=(0,0); thin=(1,1); 2000 iterations saved. -#> -#> Warmup took (0.0050, 0.0050) seconds, 0.010 seconds total -#> Sampling took (0.015, 0.014) seconds, 0.029 seconds total -#> -#> Mean MCSE StdDev 5% 50% 95% N_Eff N_Eff/s R_hat -#> -#> lp__ -7.3 2.6e-02 0.72 -8.8 -7.0 -6.8 781 26932 1.0 -#> accept_stat__ 0.92 8.3e-03 0.13 0.64 0.97 1.0 2.3e+02 8.1e+03 1.0e+00 -#> stepsize__ 0.95 7.9e-02 0.079 0.87 1.0 1.0 1.0e+00 3.5e+01 2.0e+13 -#> treedepth__ 1.4 1.1e-02 0.48 1.0 1.0 2.0 1.9e+03 6.5e+04 1.0e+00 -#> n_leapfrog__ 2.5 1.4e-01 1.3 1.0 3.0 3.0 8.9e+01 3.1e+03 1.0e+00 -#> divergent__ 0.00 nan 0.00 0.00 0.00 0.00 nan nan nan -#> energy__ 7.8 3.6e-02 1.00 6.8 7.5 9.6 7.7e+02 2.7e+04 1.0e+00 -#> -#> theta 0.25 4.3e-03 0.12 0.079 0.23 0.47 796 27460 1.0 -#> -#> Samples were drawn using hmc with nuts. -#> For each parameter, N_Eff is a crude measure of effective sample size, -#> and R_hat is the potential scale reduction factor on split chains (at -#> convergence, R_hat=1).
-# For models fit using MCMC, if you like working with RStan's stanfit objects -# then you can create one with rstan::read_stan_csv() - -# stanfit <- rstan::read_stan_csv(fit_mcmc$output_files()) - - -# Run 'optimize' method to get a point estimate (default is Stan's LBFGS algorithm) -# and also demonstrate specifying data as a path to a file instead of a list -my_data_file <- file.path(cmdstan_path(), "examples/bernoulli/bernoulli.data.json") -fit_optim <- mod$optimize(data = my_data_file, seed = 123) -
#> Initial log joint probability = -9.51104 -#> Iter log prob ||dx|| ||grad|| alpha alpha0 # evals Notes -#> 6 -5.00402 0.000103557 2.55661e-07 1 1 9 -#> Optimization terminated normally: -#> Convergence detected: relative gradient magnitude is below tolerance -#> Finished in 0.1 seconds.
-fit_optim$summary() -
#> # A tibble: 2 × 2 -#> variable estimate -#> <chr> <dbl> -#> 1 lp__ -5.00 -#> 2 theta 0.2
- -# Run 'variational' method to approximate the posterior (default is meanfield ADVI) -fit_vb <- mod$variational(data = stan_data, seed = 123) -
#> ------------------------------------------------------------ -#> EXPERIMENTAL ALGORITHM: -#> This procedure has not been thoroughly tested and may be unstable -#> or buggy. The interface is subject to change. -#> ------------------------------------------------------------ -#> Gradient evaluation took 9e-06 seconds -#> 1000 transitions using 10 leapfrog steps per transition would take 0.09 seconds. -#> Adjust your expectations accordingly! -#> Begin eta adaptation. -#> Iteration: 1 / 250 [ 0%] (Adaptation) -#> Iteration: 50 / 250 [ 20%] (Adaptation) -#> Iteration: 100 / 250 [ 40%] (Adaptation) -#> Iteration: 150 / 250 [ 60%] (Adaptation) -#> Iteration: 200 / 250 [ 80%] (Adaptation) -#> Success! Found best value [eta = 1] earlier than expected. -#> Begin stochastic gradient ascent. -#> iter ELBO delta_ELBO_mean delta_ELBO_med notes -#> 100 -6.262 1.000 1.000 -#> 200 -6.263 0.500 1.000 -#> 300 -6.307 0.336 0.007 MEDIAN ELBO CONVERGED -#> Drawing a sample of size 1000 from the approximate posterior... -#> COMPLETED. -#> Finished in 0.1 seconds.
-fit_vb$summary() -
#> # A tibble: 3 × 7 -#> variable mean median sd mad q5 q95 -#> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> -#> 1 lp__ -7.18 -6.94 0.588 0.259 -8.36 -6.75 -#> 2 lp_approx__ -0.515 -0.221 0.692 0.303 -2.06 -0.00257 -#> 3 theta 0.263 0.246 0.115 0.113 0.106 0.481
-# Plot approximate posterior using bayesplot -mcmc_hist(fit_vb$draws("theta")) -
#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
- -# Specifying initial values as a function -fit_mcmc_w_init_fun <- mod$sample( - data = stan_data, - seed = 123, - chains = 2, - refresh = 0, - init = function() list(theta = runif(1)) -) -
#> Running MCMC with 2 sequential chains... -#> -#> Chain 1 finished in 0.0 seconds. -#> Chain 2 finished in 0.0 seconds. -#> -#> Both chains finished successfully. -#> Mean chain execution time: 0.0 seconds. -#> Total execution time: 0.3 seconds. -#>
fit_mcmc_w_init_fun_2 <- mod$sample( - data = stan_data, - seed = 123, - chains = 2, - refresh = 0, - init = function(chain_id) { - # silly but demonstrates optional use of chain_id - list(theta = 1 / (chain_id + 1)) - } -) -
#> Running MCMC with 2 sequential chains... -#> -#> Chain 1 finished in 0.0 seconds. -#> Chain 2 finished in 0.0 seconds. -#> -#> Both chains finished successfully. -#> Mean chain execution time: 0.0 seconds. -#> Total execution time: 0.3 seconds. -#>
fit_mcmc_w_init_fun_2$init() -
#> [[1]] -#> [[1]]$theta -#> [1] 0.5 -#> -#> -#> [[2]] -#> [[2]]$theta -#> [1] 0.3333333 -#> -#>
-# Specifying initial values as a list of lists -fit_mcmc_w_init_list <- mod$sample( - data = stan_data, - seed = 123, - chains = 2, - refresh = 0, - init = list( - list(theta = 0.75), # chain 1 - list(theta = 0.25) # chain 2 - ) -) -
#> Running MCMC with 2 sequential chains... -#> -#> Chain 1 finished in 0.0 seconds. -#> Chain 2 finished in 0.0 seconds. -#> -#> Both chains finished successfully. -#> Mean chain execution time: 0.0 seconds. -#> Total execution time: 0.5 seconds. -#>
fit_optim_w_init_list <- mod$optimize( - data = stan_data, - seed = 123, - init = list( - list(theta = 0.75) - ) -) -
#> Initial log joint probability = -11.6657 -#> Iter log prob ||dx|| ||grad|| alpha alpha0 # evals Notes -#> 6 -5.00402 0.000237915 9.55309e-07 1 1 9 -#> Optimization terminated normally: -#> Convergence detected: relative gradient magnitude is below tolerance -#> Finished in 0.1 seconds.
fit_optim_w_init_list$init() -
#> [[1]] -#> [[1]]$theta -#> [1] 0.75 -#> -#>
# } - -
+

The Stan and CmdStan documentation:

Other CmdStanModel methods: +model-method-check_syntax, +model-method-compile, +model-method-diagnose, +model-method-expose_functions, +model-method-format, +model-method-generate-quantities, +model-method-sample_mpi, +model-method-sample, +model-method-variables, +model-method-variational

+
+ +
+

Examples

+
# \dontrun{
+library(cmdstanr)
+library(posterior)
+library(bayesplot)
+color_scheme_set("brightblue")
+
+# Set path to CmdStan
+# (Note: if you installed CmdStan via install_cmdstan() with default settings
+# then setting the path is unnecessary but the default below should still work.
+# Otherwise use the `path` argument to specify the location of your
+# CmdStan installation.)
+set_cmdstan_path(path = NULL)
+#> CmdStan path set to: /Users/jgabry/.cmdstan/cmdstan-2.32.2
+
+# Create a CmdStanModel object from a Stan program,
+# here using the example model that comes with CmdStan
+file <- file.path(cmdstan_path(), "examples/bernoulli/bernoulli.stan")
+mod <- cmdstan_model(file)
+mod$print()
+#> data {
+#>   int<lower=0> N;
+#>   array[N] int<lower=0,upper=1> y;
+#> }
+#> parameters {
+#>   real<lower=0,upper=1> theta;
+#> }
+#> model {
+#>   theta ~ beta(1,1);  // uniform prior on interval 0,1
+#>   y ~ bernoulli(theta);
+#> }
+
+# Data as a named list (like RStan)
+stan_data <- list(N = 10, y = c(0,1,0,0,0,0,0,0,0,1))
+
+# Run MCMC using the 'sample' method
+fit_mcmc <- mod$sample(
+  data = stan_data,
+  seed = 123,
+  chains = 2,
+  parallel_chains = 2
+)
+#> Running MCMC with 2 parallel chains...
+#> 
+#> Chain 1 Iteration:    1 / 2000 [  0%]  (Warmup) 
+#> Chain 1 Iteration:  100 / 2000 [  5%]  (Warmup) 
+#> Chain 1 Iteration:  200 / 2000 [ 10%]  (Warmup) 
+#> Chain 1 Iteration:  300 / 2000 [ 15%]  (Warmup) 
+#> Chain 1 Iteration:  400 / 2000 [ 20%]  (Warmup) 
+#> Chain 1 Iteration:  500 / 2000 [ 25%]  (Warmup) 
+#> Chain 1 Iteration:  600 / 2000 [ 30%]  (Warmup) 
+#> Chain 1 Iteration:  700 / 2000 [ 35%]  (Warmup) 
+#> Chain 1 Iteration:  800 / 2000 [ 40%]  (Warmup) 
+#> Chain 1 Iteration:  900 / 2000 [ 45%]  (Warmup) 
+#> Chain 1 Iteration: 1000 / 2000 [ 50%]  (Warmup) 
+#> Chain 1 Iteration: 1001 / 2000 [ 50%]  (Sampling) 
+#> Chain 1 Iteration: 1100 / 2000 [ 55%]  (Sampling) 
+#> Chain 1 Iteration: 1200 / 2000 [ 60%]  (Sampling) 
+#> Chain 1 Iteration: 1300 / 2000 [ 65%]  (Sampling) 
+#> Chain 1 Iteration: 1400 / 2000 [ 70%]  (Sampling) 
+#> Chain 1 Iteration: 1500 / 2000 [ 75%]  (Sampling) 
+#> Chain 1 Iteration: 1600 / 2000 [ 80%]  (Sampling) 
+#> Chain 1 Iteration: 1700 / 2000 [ 85%]  (Sampling) 
+#> Chain 1 Iteration: 1800 / 2000 [ 90%]  (Sampling) 
+#> Chain 1 Iteration: 1900 / 2000 [ 95%]  (Sampling) 
+#> Chain 1 Iteration: 2000 / 2000 [100%]  (Sampling) 
+#> Chain 2 Iteration:    1 / 2000 [  0%]  (Warmup) 
+#> Chain 2 Iteration:  100 / 2000 [  5%]  (Warmup) 
+#> Chain 2 Iteration:  200 / 2000 [ 10%]  (Warmup) 
+#> Chain 2 Iteration:  300 / 2000 [ 15%]  (Warmup) 
+#> Chain 2 Iteration:  400 / 2000 [ 20%]  (Warmup) 
+#> Chain 2 Iteration:  500 / 2000 [ 25%]  (Warmup) 
+#> Chain 2 Iteration:  600 / 2000 [ 30%]  (Warmup) 
+#> Chain 2 Iteration:  700 / 2000 [ 35%]  (Warmup) 
+#> Chain 2 Iteration:  800 / 2000 [ 40%]  (Warmup) 
+#> Chain 2 Iteration:  900 / 2000 [ 45%]  (Warmup) 
+#> Chain 2 Iteration: 1000 / 2000 [ 50%]  (Warmup) 
+#> Chain 2 Iteration: 1001 / 2000 [ 50%]  (Sampling) 
+#> Chain 2 Iteration: 1100 / 2000 [ 55%]  (Sampling) 
+#> Chain 2 Iteration: 1200 / 2000 [ 60%]  (Sampling) 
+#> Chain 2 Iteration: 1300 / 2000 [ 65%]  (Sampling) 
+#> Chain 2 Iteration: 1400 / 2000 [ 70%]  (Sampling) 
+#> Chain 2 Iteration: 1500 / 2000 [ 75%]  (Sampling) 
+#> Chain 2 Iteration: 1600 / 2000 [ 80%]  (Sampling) 
+#> Chain 2 Iteration: 1700 / 2000 [ 85%]  (Sampling) 
+#> Chain 2 Iteration: 1800 / 2000 [ 90%]  (Sampling) 
+#> Chain 2 Iteration: 1900 / 2000 [ 95%]  (Sampling) 
+#> Chain 2 Iteration: 2000 / 2000 [100%]  (Sampling) 
+#> Chain 1 finished in 0.0 seconds.
+#> Chain 2 finished in 0.0 seconds.
+#> 
+#> Both chains finished successfully.
+#> Mean chain execution time: 0.0 seconds.
+#> Total execution time: 0.2 seconds.
+#> 
+
+# Use 'posterior' package for summaries
+fit_mcmc$summary()
+#> # A tibble: 2 × 10
+#>   variable   mean median    sd   mad      q5    q95  rhat ess_bulk ess_tail
+#>   <chr>     <num>  <num> <num> <num>   <num>  <num> <num>    <num>    <num>
+#> 1 lp__     -7.30  -7.03  0.721 0.380 -8.82   -6.75   1.00     902.    1006.
+#> 2 theta     0.247  0.233 0.122 0.129  0.0786  0.470  1.00     762.     712.
+
+# Get posterior draws
+draws <- fit_mcmc$draws()
+print(draws)
+#> # A draws_array: 1000 iterations, 2 chains, and 2 variables
+#> , , variable = lp__
+#> 
+#>          chain
+#> iteration    1    2
+#>         1 -6.8 -6.8
+#>         2 -6.9 -6.8
+#>         3 -7.0 -7.0
+#>         4 -6.9 -7.1
+#>         5 -6.7 -7.0
+#> 
+#> , , variable = theta
+#> 
+#>          chain
+#> iteration    1    2
+#>         1 0.28 0.21
+#>         2 0.19 0.20
+#>         3 0.16 0.17
+#>         4 0.20 0.36
+#>         5 0.25 0.34
+#> 
+#> # ... with 995 more iterations
+
+# Convert to data frame using posterior::as_draws_df
+as_draws_df(draws)
+#> # A draws_df: 1000 iterations, 2 chains, and 2 variables
+#>    lp__ theta
+#> 1  -6.8  0.28
+#> 2  -6.9  0.19
+#> 3  -7.0  0.16
+#> 4  -6.9  0.20
+#> 5  -6.7  0.25
+#> 6  -7.1  0.36
+#> 7  -9.0  0.55
+#> 8  -7.2  0.15
+#> 9  -6.8  0.23
+#> 10 -7.5  0.42
+#> # ... with 1990 more draws
+#> # ... hidden reserved variables {'.chain', '.iteration', '.draw'}
+
+# Plot posterior using bayesplot (ggplot2)
+mcmc_hist(fit_mcmc$draws("theta"))
+#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
+
+
+# Call CmdStan's diagnose and stansummary utilities
+fit_mcmc$cmdstan_diagnose()
+#> Processing csv files: /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/bernoulli-202307251438-1-65b170.csv, /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/bernoulli-202307251438-2-65b170.csv
+#> 
+#> Checking sampler transitions treedepth.
+#> Treedepth satisfactory for all transitions.
+#> 
+#> Checking sampler transitions for divergences.
+#> No divergent transitions found.
+#> 
+#> Checking E-BFMI - sampler transitions HMC potential energy.
+#> E-BFMI satisfactory.
+#> 
+#> Effective sample size satisfactory.
+#> 
+#> Split R-hat values satisfactory all parameters.
+#> 
+#> Processing complete, no problems detected.
+fit_mcmc$cmdstan_summary()
+#> Inference for Stan model: bernoulli_model
+#> 2 chains: each with iter=(1000,1000); warmup=(0,0); thin=(1,1); 2000 iterations saved.
+#> 
+#> Warmup took (0.0040, 0.0040) seconds, 0.0080 seconds total
+#> Sampling took (0.011, 0.011) seconds, 0.022 seconds total
+#> 
+#>                 Mean     MCSE  StdDev     5%   50%   95%  N_Eff  N_Eff/s    R_hat
+#> 
+#> lp__            -7.3  2.6e-02    0.72   -8.8  -7.0  -6.8    781    35502      1.0
+#> accept_stat__   0.92  8.3e-03    0.13   0.64  0.97   1.0    235    10662  1.0e+00
+#> stepsize__      0.95  7.9e-02   0.079   0.87   1.0   1.0    1.0       46  2.0e+13
+#> treedepth__      1.4  1.1e-02    0.48    1.0   1.0   2.0   1874    85179  1.0e+00
+#> n_leapfrog__     2.5  1.4e-01     1.3    1.0   3.0   3.0     89     4050  1.0e+00
+#> divergent__     0.00      nan    0.00   0.00  0.00  0.00    nan      nan      nan
+#> energy__         7.8  3.6e-02    1.00    6.8   7.5   9.6    775    35215  1.0e+00
+#> 
+#> theta           0.25  4.3e-03    0.12  0.079  0.23  0.47    796    36197      1.0
+#> 
+#> Samples were drawn using hmc with nuts.
+#> For each parameter, N_Eff is a crude measure of effective sample size,
+#> and R_hat is the potential scale reduction factor on split chains (at 
+#> convergence, R_hat=1).
+
+# For models fit using MCMC, if you like working with RStan's stanfit objects
+# then you can create one with rstan::read_stan_csv()
+
+# stanfit <- rstan::read_stan_csv(fit_mcmc$output_files())
+
+
+# Run 'optimize' method to get a point estimate (default is Stan's LBFGS algorithm)
+# and also demonstrate specifying data as a path to a file instead of a list
+my_data_file <- file.path(cmdstan_path(), "examples/bernoulli/bernoulli.data.json")
+fit_optim <- mod$optimize(data = my_data_file, seed = 123)
+#> Initial log joint probability = -9.51104 
+#>     Iter      log prob        ||dx||      ||grad||       alpha      alpha0  # evals  Notes  
+#>        6      -5.00402   0.000103557   2.55661e-07           1           1        9    
+#> Optimization terminated normally:  
+#>   Convergence detected: relative gradient magnitude is below tolerance 
+#> Finished in  0.1 seconds.
+
+fit_optim$summary()
+#> # A tibble: 2 × 2
+#>   variable estimate
+#>   <chr>       <num>
+#> 1 lp__        -5.00
+#> 2 theta        0.2 
+
+
+# Run 'variational' method to approximate the posterior (default is meanfield ADVI)
+fit_vb <- mod$variational(data = stan_data, seed = 123)
+#> ------------------------------------------------------------ 
+#> EXPERIMENTAL ALGORITHM: 
+#>   This procedure has not been thoroughly tested and may be unstable 
+#>   or buggy. The interface is subject to change. 
+#> ------------------------------------------------------------ 
+#> Gradient evaluation took 8e-06 seconds 
+#> 1000 transitions using 10 leapfrog steps per transition would take 0.08 seconds. 
+#> Adjust your expectations accordingly! 
+#> Begin eta adaptation. 
+#> Iteration:   1 / 250 [  0%]  (Adaptation) 
+#> Iteration:  50 / 250 [ 20%]  (Adaptation) 
+#> Iteration: 100 / 250 [ 40%]  (Adaptation) 
+#> Iteration: 150 / 250 [ 60%]  (Adaptation) 
+#> Iteration: 200 / 250 [ 80%]  (Adaptation) 
+#> Success! Found best value [eta = 1] earlier than expected. 
+#> Begin stochastic gradient ascent. 
+#>   iter             ELBO   delta_ELBO_mean   delta_ELBO_med   notes  
+#>    100           -6.262             1.000            1.000 
+#>    200           -6.263             0.500            1.000 
+#>    300           -6.307             0.336            0.007   MEDIAN ELBO CONVERGED 
+#> Drawing a sample of size 1000 from the approximate posterior...  
+#> COMPLETED. 
+#> Finished in  0.1 seconds.
+
+fit_vb$summary()
+#> # A tibble: 3 × 7
+#>   variable      mean median    sd   mad     q5      q95
+#>   <chr>        <num>  <num> <num> <num>  <num>    <num>
+#> 1 lp__        -7.18  -6.94  0.588 0.259 -8.36  -6.75   
+#> 2 lp_approx__ -0.515 -0.221 0.692 0.303 -2.06  -0.00257
+#> 3 theta        0.263  0.246 0.115 0.113  0.106  0.481  
+
+# Plot approximate posterior using bayesplot
+mcmc_hist(fit_vb$draws("theta"))
+#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
+
+
+
+# Specifying initial values as a function
+fit_mcmc_w_init_fun <- mod$sample(
+  data = stan_data,
+  seed = 123,
+  chains = 2,
+  refresh = 0,
+  init = function() list(theta = runif(1))
+)
+#> Running MCMC with 2 sequential chains...
+#> 
+#> Chain 1 finished in 0.0 seconds.
+#> Chain 2 finished in 0.0 seconds.
+#> 
+#> Both chains finished successfully.
+#> Mean chain execution time: 0.0 seconds.
+#> Total execution time: 0.3 seconds.
+#> 
+fit_mcmc_w_init_fun_2 <- mod$sample(
+  data = stan_data,
+  seed = 123,
+  chains = 2,
+  refresh = 0,
+  init = function(chain_id) {
+    # silly but demonstrates optional use of chain_id
+    list(theta = 1 / (chain_id + 1))
+  }
+)
+#> Running MCMC with 2 sequential chains...
+#> 
+#> Chain 1 finished in 0.0 seconds.
+#> Chain 2 finished in 0.0 seconds.
+#> 
+#> Both chains finished successfully.
+#> Mean chain execution time: 0.0 seconds.
+#> Total execution time: 0.3 seconds.
+#> 
+fit_mcmc_w_init_fun_2$init()
+#> [[1]]
+#> [[1]]$theta
+#> [1] 0.5
+#> 
+#> 
+#> [[2]]
+#> [[2]]$theta
+#> [1] 0.3333333
+#> 
+#> 
+
+# Specifying initial values as a list of lists
+fit_mcmc_w_init_list <- mod$sample(
+  data = stan_data,
+  seed = 123,
+  chains = 2,
+  refresh = 0,
+  init = list(
+    list(theta = 0.75), # chain 1
+    list(theta = 0.25)  # chain 2
+  )
+)
+#> Running MCMC with 2 sequential chains...
+#> 
+#> Chain 1 finished in 0.0 seconds.
+#> Chain 2 finished in 0.0 seconds.
+#> 
+#> Both chains finished successfully.
+#> Mean chain execution time: 0.0 seconds.
+#> Total execution time: 0.3 seconds.
+#> 
+fit_optim_w_init_list <- mod$optimize(
+  data = stan_data,
+  seed = 123,
+  init = list(
+    list(theta = 0.75)
+  )
+)
+#> Initial log joint probability = -11.6657 
+#>     Iter      log prob        ||dx||      ||grad||       alpha      alpha0  # evals  Notes  
+#>        6      -5.00402   0.000237915   9.55309e-07           1           1        9    
+#> Optimization terminated normally:  
+#>   Convergence detected: relative gradient magnitude is below tolerance 
+#> Finished in  0.1 seconds.
+fit_optim_w_init_list$init()
+#> [[1]]
+#> [[1]]$theta
+#> [1] 0.75
+#> 
+#> 
+# }
+
+
+
+
-
- +
- - + + diff --git a/docs/reference/model-method-sample-1.png b/docs/reference/model-method-sample-1.png index d7b8b97f8c19824bd7f4936ec52513cc8fae745f..27fd88217456b4a7d0da11a09599ea685749e06d 100644 GIT binary patch literal 15795 zcmeHu2UJtp+IGN#j)ie-BOr{@Y!pF2YOo9#5KyYrpfn{ykPaaPE90P|AR=8wL;|73 z&;kTSsRDx#Is~Ky2oPElNJ#ki!I^c}x7NRIzw5jATQ`fW6HZRq=Pl3sJn!DQf5Fsn z+jnB$!CKDfQHN+A?_Ee23`BFc8_N~X-M8I^%$xx$Wtq&!(VF}v-MIJmm5mR%TrqH zBa!fLZ0GfZTs=H8Pj46R)9)=h4&OU?izRd|@y(4K*+Lg!J@u?$U7d-cUhnYx-mvN!BbtBUKM; zhncpex%fmTzR9YMma?HP9}LFfDD?Zz$9sEw)zVrBqQ4Z7$@b~3Z_9GU7sVtLd%L>c z7I{ItL43s4zsBRYZ{Hqv^3)v?iDZXF7VB*)C@7elJn84C*b3Pn_Pysdk6Gc_!2J>$ zERv`<`x;H!Sku@m6I^g)(%{TWBrY?Qy>|oGV-(OIw zKc0&x*x)!xl%dZFOTKAC;4+n^!+)E?2YAS`)nW^~wQ^}0DcSg)@o*}#O_LJ6{q zmg`SS`y8hzVDOtc@~r9GH}Z((&B2x|4VpHA+QAVAcfY(d_@xwZ8=VhYFUI1at$+?PG(Tf{q1lM%p|dV4!o?dZ!mQ{f#?iC?)nJtwHH8 zQrO_|ovPj*g84alDI3C8&iVl^U&?xasgp7orO?J?i-<^96-jo}doeGLDPb$0*Uy2* zpZ{XWY4!)`Q$*)qK$Sm0$+8!mS;d;(|8SB4mk>nH1zFQs#58RNW-GV~2DQZ8Dik5L zz(6|Ytu8fDD{C*+;Z`$5QK%l4E*N`Nh0Lt5{)<>!i)d?nWqun+#zy;OZs_WZN!J0( zI0*3aw*nZvBW6SOuY%Xh=YEEU>F-?#VgKI@g?|kC??lo+PG5Uw%q~jA92tK%Sv%*!G0ai>eORRSV z^HeVTp=jei2=_OY!)9&e(gD`sjMTBBU{BRgCG}!p`wv%uKgRtJKK4I&`kK`?m*q~9 z&1zY392>6Ws1Xe}rm78|F!<_vr-%*7&Dr6@y=~lwXfvMVD5*n&3KDMc)DvOYp2bo_ zV6#QtPt?lg^h$ZiDg){__d1`Ne(R|S_0Yd6^6(_`21hS~0_l2z~eh4W*6{)E3>+l2p1y4JmF{FK1&GODcEhDF)Y z@+Y@%-%d>a%#$2eZ7RbPyR}(+)w3l<8F%{ObTY;&QppsBX4=xymGz-&DfST0DC?oo zm>7vmb$~d4N^F*vG#zqU^W@35%VEz^;w9Gu0!Y?2HU!brIRrxgl1w|G zY28z`rg!%}Xw1|Ja?}8pZyQ@!{=myYiVNR!R!^c{SO2VWiWnbRA84tzpCTy5im6#q zw_&iKl)DViwFabcuAD7h8Sqq3+FX9Nq|0nSiV4@S1;z5Or=b7MwZEIa|1X)&iv}Fb zvEas@~!R=$z~g4FOAmo(Yd znHg`IbQS4jhx%KLBf7?K6e?nDTYf%s@0FZT*^wDHTl>?=K7DFPc5n!smw ze@?tBr6Gwcl-oBCqz5?|K34JLVT1IGYE8>bGoW<8LQ0oO0oeIFw)YefQc_ZYAO(0{ zU0t0jf3P*I(%$rz2)CW33qw=8Cv2yu_b=*hT=(w(qiRq<`YQ< zXFHwS%#&OPi-1AdAo`)z)?#%WKHXloAtvPUV#?kJkcbHsLSe(;qFPZ{u7x zrCU*Ww-G5#NtK4BU!sUZ&0q`~P(R5BwaOy5ajALN*T$uD61s13;0bNGHan9>5ZktR zwma6AD#d@xJPZ)c8**}ALfj2%@Qa(p6Wml_g_+cU5j6FH^o0$w%5ptdOR`qyD&nBQ zYjA1+9|Puvs*ZCF<`Cbuvbb?d2>K^I6t?GUui z&O%@+1O&Q&mCdOiONjub7eAOwfXn@-)$6|zZ~xBRgj!i~adCf;-8{qe))yXbC5dnF zWtEx0^GR)zhhy{Ym~Ax^&56Ga!5mDy!yXLpDk0G&tgupcJB z2s5v%+jqP{PtPB2aqQd{YJJc6k`V0KONMu)0V!AZ=gxqEs2!v8visbL301~-qWJ9v zY=Iy502E64P@8Ux2Gxq%3BStdp2&yeP9|89hBe@j%7;DsdC<*AKx@0fpT`YMU><0A zCgNKN9No1huV_M5=$oM@y#q)3NE*CeuTl+^vG>hZ$P)5vdsGG*TI~Xk2OKL z^iQ9lSrb_>+p_p*3cmu8=T~0;j=(JqGDGz(>TZTr%|q3xiWC;+D_A;8A@wtV+OqV8 zhO@)bl~MuIgjId{c7Q|jd!8zjtyP0cY0j>kOULic#F`1i@*SX};3M58L`nLwi3dva z;Iz*_VeUe4`2_p?-q{{yI-f1jx$y;BYLAa)n3 zV^Jn;?N|K=ipaUy%VD5N;-H?UF-in=eda@$US9X-ykE98ec~NwemZv?bUm&$<8YpJ z73&nq<4ATl4}I-s5E_k!`bb4yC@^1w$D5j(PR`Ee)9;r|O|%u^0|8lbo*nrvLIcB| z0*pKb*eR{Bpx~lcZ-+n-PD`&kT?C4ON`j>o_5J&sqVm7w7Zq7E7>wKA{$W>KT!yJP z#>$fAHbdV2Tj$ySi$;G!BS;T}_P^V5jiDETIxbTO&ffh=yWXS&a@jvUL;p%z<;jzbC}sftPUBs+U&w`KjpQSTD-EF`MQjpg zu3L~2IFrKp+0hW02d|QKV5i>+l&4BAx4ssddCaV}VoEK3EBag0s(3IpD=?MATxqra z*4NhG_}`w}Up?jh=Tq_c$5t#@6krIg1^8PCQq?M&DY!k7%i!IF2QfLa2R1)m@`^aP zX@l3PhXq^ZEk{TCOD+V8GLsqB8EO8O*x@Yh@S_C3Dz za$nAO$U87|apm=tT|ewtScoy6VS96UwKqH-JCw+fi+QCO9d~cv(ta$BK}>6@WG;lv zU}$I%HZNYR2eA)c8)UyB>!CwJ0OJA0JVnwVgKfkF{@KWT z<*AU<34I0V~6V81Zzw9`CEQ|hri5xAL##X=Ae+5mzN7IzH#(fE@>c;76`_k z^}3=$w{3j>5yJ8a-;-6zX0zKpNpjZfcB&={nPm25*99^?*jClT1KmXX;2*O3{r&xS zz3B)YpESB+WgBt$RM7US*N5w*Que93yNWpuw91I=_rE|ij=-v<_~sqVwq)a;{C00c zd6EX&+p_m7wQqw{CsC#+ff_vaD*XAv-?_RQ2x!|iRCrc;p;v7k|<*N6AowEYkKmsL%v1lu@ zF`{NCMEoyYO((vT)Ra%??rt|{PbQeu=MH_zrtN^SZ$jRVIQ){RFyTFv-4|o!1G@^t z0onv!-x)y@uHfto!fQJsZvF60MeKSCo%LtqZ}VCs^S_sXa`9hj3r}<))bi0sb!l2Q z3@a67TB8DGF`aD}8}BdNGxrQU08`Lk^P&u*awRr3Z0N~=d;IYO#c2hywaxoI1NXs9 z)^ZdUBcpv3;bHGPb)YHNHB37)CLk#$yjxNKhc!gWPx3ts0_5EbJFmbEFv6#UD9Hb? z4b%_JdME(fFJ{XsO&y}&WbJQKbaP-77psxi!`M&O;zaI!)rG=IoHh}>lN=kI0+w== z^j~iJ7SvB;O8e_?*)}P-BU(293r7U_ocfH^fj#gc0_S=j}aoskeK}=vb22)TC4_(2%WpUcGdrw zM0(41UrY4-yzs&TUGhDn*m<)1^`ja5jP)6LdD2wRfYZ_1HwG?*_Mo=qT%XLA4O#hA z-`mN{eme4SA@U2=9jCgyR-*JTZ`~Tbf}yTcO|pESvzfN=Rf9zbZ;kwCSIg(cDwB|Vlb`1NfEcQ zw#svK+Tt*&6P|&GF#(^Ghx+DHo0=4FBYgTN_m#46Wl4@TcUI_{NxtWbH6-P}q4EU} zl1${H+^UBG@#sF6fOv2W{VE?n3q{vI>_GEyBsQ8qa_X=G!A9jm^E7Ef@= zMCU6useSYbaDBzG&b{H`HbUDU_ayq=yTbRvQ%uh&Ci7uUe$8XrdA&A6kBUV) z_0X{E5cW~q5B#Vr7i1k%xkpzn_DLt_0=PrNxWIczOvFhmb1LuM%<+T=<&`4#VK`B% zSi7h+mj_N~rgCI5_DDXtWXwRGu|y%%2#zkR#+~15ix@baA>>fOJ$+(|d^;A4z3(kd zRn<|nHyU!&t*uPv8;#H%iyU?GQ{;qM;cVojuJr{)*=U@MW=Upu-1%IijF?A{_(|~e%R=aNiG(EctP^|mJ3UF3 z*{qN)S9#8bFY^>l)XtOCRgMsf@6zoN2C0n+DNVUon1PltsgLSY=&u25Nqf{i)Km9M z{lK0yFY+cH8K*okA)zUcwmL(7vXf{XiY+ER-1?-KU!w3qFmU|&=c{vKk$7ojzk+}} zlPyEE8-Lyxi-gM=w(OV;2)`hjzSl8DL2uIEP&T3aE04UXcBJZpxnlI^-jh4hv0gD- zMa`Obhbl-*yLh}?^0U3eukbrGaTPTkqMS{7Vy4x;kX*O}JIxkeJf(d^8b|K610LEc zud5LL=y*4e?4X#r_+@tXKAY53;@&59oBEpgDM~`ZdwSu8>+70FMIB}C61v`o(cLd6 z>%>I~eIl~;r~2zrcELA37-U&z6ZXz}_q@v*XzDNl%Miyt@3U3$ad!R*i&aQ%_+Y$U zZ)tFY&Z}p5hJrtOswIVf_lCRAKZ;0&`816B zdXntaz5BYRe4S6bHzy~6rKWU|T{Yma+FS7^N$R9_@%PH9;I+tRYrzlwlA!AGhD^p# zBzwOyzb!mePQCYF&}94dD}x4@nNqs%Xq=54VvmB|(=Cc6FY0%{|M(zW=51W2{>_V^ zqr99=;bzO!?=X~j5{;d5G0EK|XMi+rb-3|qcXy$iaT%GsP}+jc?H;YVGmbi(h{~%_ zH`8TV#*E;za~r0*+pe?Zze6DHj{&;Ot9WBu?N05cX-dnT$uO^cBU6xwnM?ON3y*oqMdM{1(u$D4M=-j0f;BQaCgEFQrHOAaBUao5mkm!3Jc z6v5uagmR+c{0TF^iH!J}f(n`CaYJ}wteIX2g|Xq#D}%HsHj6cSYl~uCRh53T9&aic zCs-CSSJXd1CFc<=kCaXoHWmg>_vj9U58d56_CU3{iy129WHPjF0APn`*x}8i96Svo5Eve0V?eT+B)>ZpBbqW6O(-6I_SIu_SbJ4+#aGpk=fD zf&^;@gQ@rXZQL+ZfdtM)6G9E^j*#XcA7(3<;zH?{W?B9jr}xDPsMo8lrJp%<(N>yt2k6_-!DnJd>gCgt-$5=jSd2D<^ZjF71uMZ#bz z{cPj*4mltRH21fU!rfZJCu|U(oY`I)6)YYx1yH! zAh1WNeD=d@(gx+Y6R&V9eRRFz&RzH1I|nl^WNmMA6AG zpQwu3aOkbUA}RgUYeWlaIvq@t476>MNrsWbBUj2r<9 zo>ufczEnla!O_~I_Vwu=%$9aqZ`Wgt9NM)?&ptx1ULfH zhEwumi&FSp)LNxEe$7khyzIkCDHO@hI_J_8aqp4?i1`6dr3MK0-r>n=n1y2nuP2Q^ z<*^U6KR_K>0AF(4imkG#GWDI6Y*N^;IPF|a-;LV+WAqJg%7J~zxSs3fBxzI4(WiZ( z3<6Y91W&grAGj+iNo{R?vSG^}nSD6nMMKFD8H6wR;fI->JSjR750u_@^E}cUJ3LA3VvG96WfFm1mwEkrKqBR>C6Y&Kh;w9QK_Oo} zh)Rd*f7paEa&3qrlEHw5VKwJI?)2kMWO}r|`Wds;)sQa6V})UGJ;KkoPf|N)Dm~}2 zn|N29&N-K5(L)qq7;9!Fdpte5`Ju+Z^W8_SU4e<0ms@bDAbv(($C@^PimeK!ZtkIX zDp#1?-|?;6+4kgq@fwHtmp7;)o)rT2?;jZWhDcNe-tY|6gu#CM(v#!}?!QuIl<{Q> z{5;~t_YXij)cFf`Of?O1qtilSClG))cE2$Qhjwf<<6EKsy8md#-mcG7@<_b9!K`#E}w?HPxPe z2l9Xx(%r(OtP1*YtNi5^Iy@~Btjz|i;_`y0?rjsFZw{(dMRnvr2UYTB`mmh-HRY_XMt!D7cI zv-3NnaaKW67j`wiQLruZbFwwm!Q3AWz8UiFP$W;{`o#f24a4ql-<#M_6&x*@s!Ek27 zsY`&3V2<_i$rK*>de6IS*Dn_VN(u3_b1`A8Y-H1PG0iE`Llg#cLI7o5^;&#?liiUx zb|}S@lnAAQ)N-96M53M=WdPkU_9{xTArihaB(rY|CMXExnMZGtm*!M{^*s2g6qGC1 z&}cJI>mZN=V5FLv8tNG{0@&U;l3hPtEU#=5FC%?m5fo?DpqV~!(Rang^tb7c8Ylt= zW$eyQQ!p$5(a-DJfa7@Q!I1PDwOH*IkaKkh*dn-D5k$;>?Lb#>TNgNz=x$=2>yRK* zI#(mE>QeK-MyJR@kK%n%YmFO?e9mwNmb6cC7$6nUy&P;SvM6%9RM}yP-Mu++`lhK&YOvOT9qatWCjK zG(dL9u_ekG$167dy8Ecuymt8PZK(%$$vCzL?itW^fzjy?gVMBs!^GZ0RycncjpOyk z%7ARYP#stt^0i6%E<30ibD`pL53uT~YeB#?3(he;^FUUwQOy(jf;eEVq z+qRAVc1F|$08r)1s1noSAyg+~MjoQWTmThhFO>`pU5)~)gn#pat{~U{GEy?p)%6ZT zpy;EX8dSk>On~FUV@Bp1m83Y~5K#iM_&JDY)#j5fX`VXZNn>QPZStB22L~m4k(FT~ zTpo{u5(iT56=d`CWkHn-DK0dnOZh(mbsCUl{xUsXnzk~g5i6rX3-i-k84{(_;j1A) z145ende>vhQWT{Q1a+(oa=F1q1tcsMKL;h5O5uxMAoJdrgK$H{ynp{*hdZ8bTjqaF z4@fDHR+@+yz@(eQz->?5fdUc1DeJ6IEbjAN<6<%hk{toXlTYzCpCL0Vp$v>du3QNp z)(DpdwG8}i*>kK86xw*-(qtU37}p3OlU-U91aw6yxMl2v^&f$pH3Ndf#>QpP22Kqlhy)q9aAu03s+TBE8I5Lsbxwjs;PWUIL*6b=6S>G%)l~R73&+ zDFGn_a2Uae1T`dpkOU3I5FipwkPwplo;dfP-#&Zq&W^kH?%v;dFt5*f&-=dL`uUb~ zt{-tYr1kekP$B|R>xBaR5PZ!sG zyY$Y;fz7#*dk$-_(NNH;x%Fzv^+l~`G)^7evOi`2zU2Mi9X+~v+qQ4F-r^Wvjj?ZL zF`rY1;#NO7@xzVyvka0!B9+hTDK&BKmNdPLA0HYoTO_CJ3;t}jMy0YzRrqA}#Dr3O zM})*pzIlGJPZ{Td*>U>Xlm_{Y3fuvng8YBxxh+CyI6vjID+XQJS)ES^iQdQi3ZBwl z;(a2br^TsfwK8v>fHJ>XJu!;HOYaF+gUO_Ii}Wu16sU|BHF#8Ii$pklN%;nNN6YmW zmG}NSO2#`*5xsX!;YcpT05Z(y=44w27$E4!ubSm!@e*%%Oggei4<4<{(ELf(ezmju;_-;a+5|Yx|kM2UQFK?P>*fM9``G@z$ ze^M!LiQ#x~j?;FPZsg5}V90R|!c}04>_5Fzg>%HGth(hDShrI}Jz@CP#m>;s zNQnwwDk>$STBJpIDPFkZKc5eaYMm%cCb-%~?CKvtOKs@Wc5Jq4C!Ws=mP^(_3v60V zb`kyxh^L7U&;z6)`5lj5xK4#Mc+b4-s20Kkj4|Hnwit~6y+D7{#{*y((D2Klm>>zg zc*2RNTFSlJG~b@p#IIukF+5BK`ddNl>q8}m_oAP0MJPNTA7~Da@ZAA4yk_#5H@()e z9@xNg^<%2K9#!Dz6Fy+?B_6u?Xn)CIGwQV!1hq8^{N;N8yY>GC%tzmd^NFU1;pMn? z1}c^ULfftb=CWTz2}dg@x(F!v&N^V8n(<@dbmB^&iuqY}B5c0afz-dzO#dL6|J>z5 z!gA=I@rmO>AubC;4V~4(Ozmr3`1WEUjJ3n*z>3Z9(T@;S@H?mKy?0Of)^j(431g*2 zdTpH#*{%uGHoy{DkG!JBAO5!F?W!;1?f+akd|{~iUq$>eHX7KkZ4cR;wLy$72GIC2 zN~jk??kD%bz^ShesD1b{wMm>3{GjzbnR8Niy)e*4m?n3J4_g2#AEU4A!>{+^eWyO< z>mpQV4FbTnyaeF;hzn`Z#lt`m26|`D8aN#P?RfsbN=Uyq82w))Ud&hwB?+VW4+A#f z3tA0R2@Q5`DK1@dut++z6&T9+*$VvViKw7fA@)4qY7GeFNuEGbp_S3~_+al~@~PK? zPM76f3>{!6YAFVPCD8v%$`%M`^MEtP#IicBssMNq!i!GZ$NL8Mi2RiomDToPsuCmU zbT$!=sZiV5Z)4u9iWk|qSkV?cs;Rh;V@u@#3Q;e&t@Iy$6-*b|E#@y&%0oIt?XpW> z2X6(He)I1nv@ety{!1Fnza#JRPy@v~wY(P_C%!Kd-k=G+=y^W8CWaZviLF3pmDIiK z_*9Tfg7_3~3vF8E7}KZTTLH5E8lFn2p}Be$h7Efu!U|RD+4%eF2YQ1Va4htr*uZ8} zwPW(wcHvui-`ZWhQzuDqp53nt@9aPJERkL+a<9sco=@a~SQc6jD}(wx(I+aZRe0k( z{1C50BT(*fU#fih%}C|hHsr83wX=tQM9&iw)jSxj2%@kSm~VToTA5ntMdx`9Y6DiD zuK)trQb6*I3M&Ovu|aJC68wI1@TB!m3sd;yL4qqFG2$)O5T^7G7g)bh`1jUl|I*7r zaj8GrQO@C~y0kLUo!2|WcAu-`3p+1nnar0|PR#DS&`_{zD%2%vPaQB>pr8BS#^eyE z2zWh9I{Han1FK5RkCSTzdRUhK`1cjJ|I)(y|HS`K6}A5y$xnDF0ehFS-_*dFUu=}5 zmf_)0OLS>qp+U9-8Z1fnpuYmO-Bela(td(Seh^Z}+U@rMPd^e>hi|Ri4nVkQ3;2P~ z-e=>*b39O2$H|H&6y1~|-}V1sPk}332y#=?O)KGv0%SS{|!};z7MASud!7 z+G63HDk;s+M9oT1Bs5E|oXXTb?ZPyxz#mvhZ~>)Z+iSQdm2^nZSnfjdAh^cYjUEwJ z@nIMUmHvb2|97rT|3O99XLB_UQ#2Y9Oh@?z*I0&YeI@^WllvZ6tvAS#r3MAg9!PPmf@W&*3K zn(77t>_54K2g$?mu19A;6#qNAnqS6);jH5IqnX#Ac!msT0xJLQ6;P{z%a^)@r5F`P zlD?TfDQ|c}ZJaeRM*X8qe2@2eP>-QPTz6cP*JF@x3wXBv#Id06PwU1i1Ih4uXe_8B z7IuCpDILy6!1aamq5qTF#vfEV+zE%Eya4}le1~}ALqkVZJ-}O&W5O*}%NF{Qz539L zq4-yDPMdUawW~|=0eT6JVSAt1;$wKz#Z}~?mm^B|qc2x-uY!{H${)MBbLyA{su5(F zR+bN5vvOxU)S2JKDD-=7QLlr~f`LvPdUEH-!5Im^4G8OPV z1pU<)1br0`Dt($op)?3V106~mZGY)Ma$#F>Z}rJ@OzZ4dyHC8U zjNNblcfwM-P?6_$Yptl_*pF8O1 zw3mYV3T{bif9_?t+k8%zUpRgJxp$oD1X~6K)n#0gzcMH)S@#)x{`wXHOQUB2O|OJWFzO4gJr89g1j z!Nr>8Qp0wyt{Ul{m9&RP&`gZYtJ6lEIwY(pQY)b(RStGVmaIoJqSTUJ<6-@2U`eRXu*nR>2@)@~OpqU6m6 z!dZrq)GS=O@4QO%?#)QcW&6@$yWAXyg62l@mtG4@U*^CtDIjtSz=&DmmmJ{5z*5op3KRQZ?yB5aarJy?8UDY}HGl%O&f1V** zKev%N&FP$$@^Lq1t*9Dw?VrP_F(cF!ocwCk2rB%hj68U2=BF?jscb=(8T9ngE8B@| zhcWW{?$IFQWdTpv-P!(wJnd(T`LFC}t7*T+gEc(nGYP%gQvA zGe%6b=YB+Q>?%*B-*dK++8~3g46V+Y_H16BCCH*t?&5Mozz(-^C0A<12l>jm)ZK^e zcj{>LJfO&Q4NuPQ{tKPB+)lD6|bR=dbax+1ooZS2owWkwa=%_ohZ^#}*;j!KPi- z8h!W9YEqN|*@v|U+|x@-#+>c_H{N4h*oiZ5V8oXpl#FoxMc7R?f+_b16yPW}(xhhx zPFEyr>2#VJJzp|%CnLU+tE&|nr9J0B*x2)|IX&lfmk2w=ip=1YY2?}JDVL6<-mg{Z ztbIl4qjjBVRc#$gZm{Tlt{5wE{_1pmnk9@YNztax{_m+;oY;f#yMD;}viI#MPgZnB zU)>{fN{?3T>? z_ABNlqhN_-VU{g>dH(}gu*0LixiVvS#5fKm4W_vzU9YR0H%$?LtEi+E`{5^_(_U1Q z@%+GabB)slYl{f=7X}1Z5qgbpZ|F#;$g`~ZQu}d*>^*&+5#27xXrIu>OAAv^yC>c5 ze|WOJ3+uV=gRcHnQ+v4h21xwzzYTLRe08*iWI0KTxND$vJVX4_=^5|%@#8JMk?WI? zb#---?B3p9UI4)-#B^obz3nByzD}#+g7a~>go6a(4&>SNdl@yYG;VVcyCtDP$-u}u@20@GZg9%d zkYW@-aP&EG;!(uHd4<>h86PH7Rn01M3JRoLcOJ1ML(eO5ZZw2VLh)a%IkmW=j24-6 zG8czixPtJR7NQGTO;J2Q0|SG;UU#Faii)8Dt6M>5bd!*~CL6<|qebHZ1omM;GIA#} z97zxob#!#tLyZyRwpVfLMT!SwRm5+VTVqTq7ZICWj~~~ZKBJVBz6&244OZsV*48%I z+uKj^h3E!qPmip3XlO`nbf9;Mh- zwExEcWHiaqRzPv*l{W+pMh`AlGJjzf`R;`f$jV0W5dp}`DJ--yo-ADI>zN{k<{j(k3nGtDF!WjF;F=H<;luI7pOY?(DyNfTMsM+)$I ztl)koqqCS4J@tBsCuBu4qxw`m&O!Nx2Y2;ElbEgEHUl(v$hC0gbHD6g*G!|)^bTX) zc|pjDYMwg!U9qeWBd&985&WE$UseriK6yCa5j0p&xWH@@j&Uvso=9JHW0Gn+04vJM z$}%tQQDU5El1s4Cwl-6YD`1l2X0IX+S$;Po1tJJprK8hUmi^PE1_n9-o8i<#WQfx+ z5>A&JIrDU8W@e>{^JxXU8z*~G;5}6NlUJRd`7Ml=I_l_KuS}VM^(4KZJ(@|hG*k%P zyHR8wH_JrHj$uE{`?SOz-lgC$037dXaYnccw%46+N;C zK(ty}Sz*}d&PC^vk3J^?V;e-1S(6fpq^Htqi!~|5w;;g_Gk1g_ycFCpFGc9t?oJ;$ zU6O&Kc6T$Q#n%-asQZBh*bL+&a1P@y!uERD0dYP5d<3O2tTR=$PqWeY?Ab9z-p1uc zL02vMre6~S0R~)jdZwqS{U_^k#fSoCt-qrd#a8UY^0sN574xcOB{?}cr61Ac*4rah z40kKqRJ1B>(N?2x{NHPu^!qrd`sbw}oor%9R;4c0*QP!ldKB1KS=Ol*H^~NzHUT4B zAE6sszj4Ad?%j*xhD@i#(}{`F;p_EFjcr#26)Ze+ZK>ftH6}8AJb__~0K2#8g$Z+A zKGL;-4H1H$Kri{b@IA+?Rh6H?duKznCLlL>#!eRjz+%Tw9qWiqNn>?|{U~wJg#n=FFU~>SG>h|H@ z+J4;zmjVfx+>t9pM!BPbUK=v!Cxe)@rY><*AfXV4V-8`&%!GN-!aKVZAlQQzMu3%; zij43#zx?tG#+-Q*3NpIXSf75T{rj}7_puiq5FMT&)uB$qOR=JMWKDB(^Vy3YHjP!S z&9m$7F3QJV-xf1IHkNp6WG!+hX{KXSLq#>kV7?1gK!GKY%AT z0?rF38$D!ZR#u$W>-D~i6oU$Id3hv4hM?G;m**{hl~sWH*yKfuw%3?zL=+Yj7Rn@R z!WXYPmb+Tt&I~mjAEZ6X){311Nx|~;GhtyfrRkDH05`!v%RZLTg%X4y$>}P~h}E8jTMbO@Sv*zM)F%`8I-y_G?O3vkZ?A zvTT(!rp@gfmO9)GG`QRpM~z5tJ_RT&e)8lA2`kyJJ$mDZE0dR%Ec=n+!B~3$csSwB zrTW~fhCMLQ0x)j5bw+a`&|2+-aroUEv)ZVOwcYw@=M`e^00QD>r@e9u3)x2l$tIM- zND{L>IXStoikOH29v?8e^S=t-f74uO{Wdt!NK&xDYH7tfV3oCEkIFvR7TIwg*hA^P zQjYX2Ncq7Py4?nAbsa8!7`^9B!41TK!SK8x#g*!tN}N3ZNhn{}!RW%OSW?9p>=<>} z;^RoLv8`&2i=oaW8K-LkJc7jHPv;A_nc4L3=iHsFoB^7_QnIpwg&fNvO)CQQKr0YWU@V7jkT7n|W0ju<})lxLmp)j9?2yqm|x$OwD z1&rtL__G+SId@NOx2Rzt>x?aCG6&H*B$FNrfBP2xY!52>IW>bg3t(~UQvPLRq824Y zYao~Y_M@O;ecd4&R(If}OoUMHTAK`jLhT(N{Az>OR5Z|qD6lEt=A_bX<*6NNxT|eTl_E=uJgy{S{ zTA!jN?&4QeOKlfMS1z9fH8bx%kd&{=M~84yLSQ^U`H)5HSauYDQqRiDx7kreD7mjN zxawIwc0{WdZOs39cZ7r)V`%q(ptDc*I&(uSjOM1Je%eCY$A*=IG-AE=R%LIpcC1WIpXKG zBO{$|YYcihhZ~oH#umrd!vFp1nwZ`XU46T#Gc{yQia$1fFVZM2iv-N?Ae;$rSbo>| z@@(bZ0$F!@f8zE)A3fBOdYyF1N!c7Ptrj#dZr%hIniQsgW7BPB;RtDAod5K?o}(xe zpy!J!3)OPSxVuzYKEVa_7o+)scnIl+4EBg7YEHK|!?s9h7 z0~PBZDk0{wVkM@JTGJnwOkP3m1U~3vIcB)mPng?SXculwNkB@CDUJna>$evCJaTto zmsRG-cd^aCGV@2Qv|_hWLNo_LFZIdEf-U}k@^YZbmM1Q+;nolR_ync{dB9fZ diff --git a/docs/reference/model-method-sample-2.png b/docs/reference/model-method-sample-2.png index 093449f41694c87ed4f6a948f6425a8e02c8a550..4ed9fe5c527f0931750caf802c560ea60a2989a0 100644 GIT binary patch literal 16009 zcmeHu2~<<(y7oqjv<}c#1(B&%Dk=ghqRhc#72`k@1!Sg`83bfbfCQzLDgrVn%3M(p z0z~F91d4!w5CN0O7?dGEAYn=Zge3Rdc>1q@{r8?*?>#;D{%5U|71j>fdw=`e@B2Q_ z`@HYBbLXO|$<|G~HbD@y6?x`+GYFChfgtf8Ki>$x8F={X9N299@tn!`U<+O=Cu?zF z^M&sjD}M-5jDr8f;>PElA?O9V09x@qQKFma%k$;w-$$B!$Vzr?d4%x@R@JMEQQoBW_zaiZc)Cj-A5R>dnhN0X7ndoK>DKSaUqq``PlG4*r zh_xRIX-ulWBO#~PJv}4C!kp6Fe9F$wPTT%7K84L=&X2ZomZo~GHIfS%4fe#UjrsXC z_4P%Ii;FGMjv{-UfTM>%5SUCR^|B*jW8?`#%+mAx{D&RSTA|pU(bhQ6;;V0)o0|*k zMN3Od)SEPuqp$&>pZeSML&V;Zc(TM*>Ogjme9Pz$7jns@`g*0ee!9YUndn1(RNC;> zS+pEDdJwfiv%zrw99=ID$0xZKx`w@4iWC{KEQQ=qPIEPR92h^M7TBJ3r#Z(`H9H@% z_?(lFnoh{C7e(fe=g=^401j@3N9kdkUyxe%;r@&Z{t|p?zhCrf7ubHfZ~ji#{*BY0 zzt`}oqqAwgRlO%08s)ZZR9@M^eMTpvJG~F>eCzwp(@@;LT9((uU{ra26Wb9*2*(gJ z_>f5laQG|W@Ze;be&&!+cfpi>V{s)c`M9*??95C7=d;+?A+`?^&O3z8mSdJ*a5lYD zq!}yJwmF$4wms!+ar^ODD#hy<7(GQU<}~L`vysWP2F(~xnWnZ5xsMR*>gsxR&Ky;c z@-)h%t*oH0A4{eB>wMcWUQnU!Z8++W=FV6V>1=Cqgk=$!eP7>WFuR^;&#e6XaX%|d zOUoG9MxkNITvkz0kw>*{MaG6u&WBykr_oPq>gv2ez_P(4E%4@c4i5Bbes1qnVH~ly zp|;Pg)nN3- zPu9PSQiLJxQC`EjL2Qrj98w;$(a?h4cC7&IkQ?>ceJh0Z@g$ze_}EYxte z8$G2l0U!EreR*khE>5KgFpx$v%wg$iX>a|i3pkh|%%&N05*@eF#p!gp9Nqk6{@Zt? zJ}-;Z&Iu~bIC$mxK>EXoala|k&Thb{n&O1b`doJ+%d%bC#n!=rHa@<)m09$M>xD~t&^uli1pkJ2V0#F?F>_y!)zJZc_Fvgy3nH1 zNQ6T9h@`TGuA;Btyah?c|ACnJJHfTpMjARZr%BQ!(6NjcqV_c*KXSUF&@!xsQ;~0J zj^J@hQ>3JVXKI+`8Ss2EJAR;TiV&YyuGcDLULd$gu2oL-o}xIt!8GUE6yPh&IYeHR zw$4cAZr!DeQs4wl1>bx~=U|+xxr3f3@q-H;Tg$mcW}^@VDGGCY-W;cU5#e!-GR3i? z?eHfk^YlMPcKw}}`p2C9{0CTc7JA{QeFO{Ht4-0Cf)t*o^580dF&MX6Bb;}r3wc)g z1q6+43lWRRrd-Ek*@6>>X%^|R4xB=seV;lp)SOexuJ#fKM(om(fJP?MFXRtDsKaW2*oinfuJvic_3aA|1dU)Z6*CkPKix{5R+v2KHGly=X;1{W-(b4duN*fmD`FsH zB+ZG`YudW_UfatM zf|lC~Yw{6#Y#M^!;?CTE9J3hq1_N|t15tHugK<`K&GZu{jUa3+<0Q$0+k|!dAP&g* zpHjBsv8zbtj^q5MTyvb?Fa}fr4T6bJG~gd8|Nr8x{K<94?^nNFYh+BI4RCgke8a&Q zG7u0Usda}`UtDHpmu2h&hM2;hII+1s>RqDrjl-p-rFO#x3T2YgN@W=hYHt@8r4+tN z?re1iHAbQ;3P?k;vtBwiK<_#bnUBZ}?M$)_Il`r7wAfQ7mg;p3-{%#CXWPNl#xfOW zQz+&@_pMX7}uDVa#jn zqjN4ofn*V^k)NS%Lx5x8)!07; z-@WxsK0eImdFl*K?H(D~vN1Alt>28q)>eq%KcO+Ji#}w9FZZ{uv>%q=vat&n8`}zn zur$=mXw0G2Dt%&WCu4D)+5qyY+dPis)ilwi8*cjZjFeJ~raPm55TyDbybQ-LhfkH~ zlSH!Cgpn`L?@dfOzZaIVrF{i1rB<+vbvv3LB`wWQkq8?9y|(5gY=RnY+IZy)N8Bl- zRSxx>cSWB?VQoHXg#x2a8wgqhAZRV|=7DyV9iSyJ1yr_DoM*KyHK_J_jdQ7-g*iX& zE;Qm@VIHVgwCca^x7uWLlBg-4+5BXqhA7sIL??7lqKD{S$I9&q@__wP&+i4FJWKn^ z)(dg8uemubFc_oy?Ngw=DS<_J-dns1VE-U3t#&Bp3c4mlsR0i3tzfar_q9# ztxY5K9{jJr4l4mopy}IPUDuB8ikWVVlr-n8#V9ct3|KCMN&#*Y{hz*2V@E@+J%QO* z>bl+#z^+vRezvo<9h~N)fSwKa5^dN9$JHly$bRR!e<~RMN!`JJ-TR+bEjLj?N{djQ zsxVJx+B4-c-H*JZz8W|MK`C(78;Mx!C1g@?LPR1}%cxh@v}Tn;S_H>IkO>NuAQ9pV zs>uR9IdkG+A5ci5lFiw+7`_J7u=`8+?1p=i<|tEZLX}lz;li*T6wx%|91KVKANGS` zg=!{P2+rlm`{33z-U13UD6-Z-2lPHsSQwU^F(A+U8cwpO6q-kxQ9Vg(|*TIS?{Uj`amqBDhDSDa7cy2=*j0zs>`d+s;&>-g#Jg6R%vI3=*_E|)KC{0`zys-f~X5~*rN zeL475s!gFKI2u1r42N&*&-07j@bc6Y+>vH2eEH@)iHqEJ<|412i4156ZyQ*6C6TdY0wZh29)N)B9Pi*)DN{ zzBZ2%q^}N2poN1n(KU4jgPw1_wepi1Lec1z1!lL~QhWpdJw5W;4L?6Ka0NiWHmIA# zU7!j4MV*qk>H%B~!S!u>G^l#((I#!@rp2PmAFH>WUBOvOp2xt8w&nswl+sEv6-= zUKFrik)D8aTN35rk%dJ0pG&H)EKJmv`8Jt3`Fz#?8{ z{u66zk9Qa-ETK|kHL!TPJYznOYG+PArvhX7sLGt5@34XLTL%Fz4nW~N(Vij;=nURB z^5}~?g|tQK;cEW4qEJBkmH z0?PLW*2#Mb>HbR2!Cb+VO==846c z<69#@UEbT<3&bn$ZR7l~RyeZ$5Vmlb!-fPH`jibVSYf%I$sB3nnmNenAEUD> z_?Yr%!-5hwddwrUe z)Rop8TeTl;4ip|r&)X4w^vS+6M|RxVu{ZKB^WXk7V)N!pMfLBEH#n8Hu`-7IS<2_Q zPn?doO{9f)C59PkJsz6TW$?mK8U7h`|9UhRUDI=UjGaeK%)?&dKK^wqG>)?`M9gi! z1mHsGa=t}E_JnNukACDWsspzZ_PD4nVxmp8s$)nRdSZ~|w~UXi_I)1@hm4W?;dT%N zojv|yP=4xzb@Fj|IL}0eS8`tDe2bw;}%&@w|{I{efR8>Z{~kxi2U00NOFduzCa+D zwf#&o3w`aulRZ$~Uq4VG5{XtXvT`T)y*XxRXlV7q@kIAw#};!uWr@Ri zW`V!JoR2wut-r(Dvr+%pv4_RQ#X%ak#4i%pyWmw6E*` z4VC{D>;8uUtL53WZD?iYw(w{Q9CeOFvjC7)A!wh31pCAU%fw@)Yft&>!X4>Oew@?Y zV3h@evJ|%0N&d?6@EiQ$RPLj}-ji)jHgJH0S2|huZ=vJg-EvJdy!Zu4M!IOByA%COyqmR+ZEAxDSb!SlCa{O>0E z{|9*fYOa9Wzjlv3e(xdV%SyxMa0xzMI=z&;_*-AhlWb_a>AFQ!kki+Y-?h~ZpY6W1 z*IfCW68%yeA?V7EI_T0mGmyK@k+8j*$Aa#ukcKY>Y>Mc5ukgtnF?322_S`$0PFK?K zLT~-xqFeTxgO~HJB#6+jeeDfg3nuq9h<%(&Qp?=rGR@`~=NaD2>tWu#d*A6#KUia1 zO3Nrp=rpV|SVWI5>xGjks(b%lUXyBqi$9qs{?6gkF+;HnfTt57-tD%hPuF_CUQ3dP zU1vaG(D#ngAAP5O?8rk~QMOgJ(4_Qk?2%`*wMvW;Z^HF%tk{g?dKxf})=mZX8hazf z3eFsiHz*EA?QD^-6o8y?6|7cXN4N}o4FY4aEMxR!)8{Q zm70#pPO!G@M(#a+G{s=~`?y;?XdP0J&KXX?cbfWjliL&JcOtP1%qN#;thCzR3)-S5 zWB}3;IE;a+WQLScl_Gr6h>vLck8`>PiNASvsQSyQj)U8zZnk~ShQa7U{1fz*tHdSa4V>n?#5uLr3= ze%5?zXnLeH8J-7pXvfDr|49<|6EwH!mBZ2VKJfY0HJy1adL^@yHD z+iizn?;F~B4`-gMvT@_F2h+4H0@8Xe&Q-kI9o}|nG1~NSb*6!?@HA|Pkr6YdX)K}) z7&z2rUtd}I^u;4;6qPl28j?AOxmO5-*7_E3I} z`f>(yfmNU?uDF_VzJ*TDR;;gQ)>4BdT@|oFnSLfje}}}jWq#<>CK}Iek9*LvQA-i| zOMNEt8I1Fzy(^i!cXd9E@9L@=?E~LOwbDAoWi!kp2NOG;M`Jm}KQa#v*52IfB)Yvid$nG#gh3&8_} z;N@;uQ7GY)-F-&>Hv8&;NrJjKNMhF6y4Wk$q9uDxEf@ZoBe@mu>xG3Uzt`3^NV$SX0=Q^)zg~_nF3nu@ zSsB#L>hsF!-X}bSKT^O>&qkswdxjeIjGQICB5P`Da?->%GDrP`Eu#qR z_r*>RIYjzi{_A(hmR+NyQ*Z8ahA7(g**&qkS=*VRDpQ(`t}U2oYOsDM^PIg-?c{cT z5gzYJvKPgi&eqyIeDmhbEz;7Jn2<>~Aggr8?w?#(>P5K*1e8tc9Lio@T|MI3m8Q}* zGU6D-8np8L_K_8kOHoP~w~Ffn598ydghR*OBJKFb$RkIOCe031%BFqpGWH=+&-^~TbngreQ1uh(KSf=%QLh6YfD=${#47VQNvplo=r$YPdv7& z@Um*W<2dnHT<5A_xfRjnYP9%RrA>Z#?smb|;wK~DA6h&>wtwGg(9k$h+^W>!oNV_{ z1>LM>AJ41j5hYY_J+37A8(Uh^$_Vb%g;H;?zLM{FbQ~_h$4DheJ$qC=+c&K*y4W|e$xBXP;Vg}(t}hT zuUqUom!J^%_EMpeQiN2{OmQn1PBkOs$3}PP5mFP=9lduV!m@thfkdvD2Tj&+iWT>nR&Lf&r3!TUc3a|G{*Li&4EwQ{X?Ptxw#pb1ILE~F0<QGV1LM;~oBE z@g@~ha?l~W*}-5@qcrw@T=>j2tKuI|bs6#oWxm^(Wo~UK3D(RCY$`P>hk|Ud+|tZv z1cD}fi^Hqb$_XA$#2c8~GBR?>{a9*e9_s~qaUyK;q;flp74+K|s$&Zsny6r&J?Evm z;^qjh=Xel57a?%hs9*jt6#GC$SvVI}>eQAXXy0tiEc2&_J34+NYwLRg#F;<0&y}&Z zNT$=Ppt6g2Mg*XQa~jnusmHGO&(6x)hy2i`GkVXR@pI%*l7tUX`1@pnFPcjH#@hichKY~w@JMwa~8e3vmq1tv{I8R;SyvXupHahpBHuR>)GYLx@>$GpxYqy_c6*Al~N zQESR;Ba*%Cn~XinJ?R2IU4-?nnaZ&ZdH=I6=j~-4VjrYV1Jfv~Wt}}Dl$QquB)L{F z=uhrU(e~WiBEcPcD&bSw_Zo#=NK|QKuXV9!xJGciC5-(VrIg~g`=j?bL3}`3rU?o+ zUVe3Xm|%gQJ$D}J&$8pQ$Oen&HEL%{?nHZTc!TagEV)hq+pFH3PR#f!l+T?-CV<8r zC_-nsMzzB;afaM?Nt@l*?*(5u0OA>k7@w^i^gEX@R!#_?t$+Dh*4F-F_ORPg*fUF9 z?nKWy%?r=W+%H^(tn(H98;ZVNme3420Rl5A)w^atcoYleR9Vj{%(KX?W2r(~PapU)f2D~H#HkMcGzdDtRS|eKEou_)9p_jT%{F}BOhtavo{!tEc^RQji zptQ8KtCN#crEEQVZN4>81x7%Q?HRS!4OxQz;vw&2sa8ZxU=fkquhRC|HRJIPHH#VU z*&1kjF1S7!CtSRD@1B!jm7}}(S_?N?aXLF*Wo03mlt#dE@W_NzpZdNPwAiM%(_}HS zU@Nh$sPabp{@k(K^4_mb)7<5~=e2A)yVG7A_L-RFS4S?|=F|AS`?; zQ#)NiHYAVrdlEXoP))nfEUMLDhcWaY)Iy5S75OaSP|yP*&AZYFVycgq<)CH{j>5&f zD}JvJx2mj&ay^%?*G@!&hZxxY_Kt%|BTs9hSE75}Rep3^bv_-hADWr-`QR0HZ;C1_+t+33a22>_^LwvxCL% z(x!zjeI?Gw1Rv~TDjyb72P^lade z3==RN$e{6)Fuw;wE3`?L_o+J!T29+e9eTk&(8&;bzx6g)dUJARE(%dMF!1o8RYJ68 z{qk{PF0s$cG|hoIjVE-)n<(kd7DM|i)Fxm=)d^;OP$dlfyoObY3Qowt4L@0eX5uWc zQt#5El(9O>t8b$G{+gG3?0g}v4L~9cO>h@&b8~ZxEqDw3N-Ak3b&bUqdT-7YQ?T7j zeATa^8QRyeutLTe9Ul(4#;Rsyz=>*H6NffM2$l}o*M(I6JX5sjDhLWTNC(p~1=C^J z-wZ}EECYn6BD%WU$zo8_IdHLSvATO{cENTQ1pD+rCUxABv}!J+VfzTC<&I=c^6n^w z9xmfE$r3}Qk9{m-SHIuXK2g>DaohAiEr+tQX9laa%B|JG8#r1`5A=)z%2=Qe2Q~QM zK_kxu=o~ZO&p<0zi*-43^$KvLJzzH((0O%!1?o4r%yh8@a-V3=p4=1IaUVQ1{vS4U zv?kyL1Wq?vh>uf2W?-iC-g=aS_h2ZSSQ~ymyZaT0({)e1IVs(lrt1$A>e?bg~o^y*Mk$!TZv)OS*DZQrp>h!gVj)&@Kkl!E0$R8KBkbQ_8>L7+$xY8hLbRW3Y8IW6V z*K#s$C3ywtVqsk-J(wO|&93J!0p0|3r)Ng62my3K*K8#{!?UP*FUpW}Wmn8;(Dq#HBV&&tOKyy|ge_$& zhYyctge|nC`Tq7rU)2o|YZH%Pi-IPsoVXBQUfpl8!N%rf#aJ+oP0az;o1wyjn-az0{&u3zD)^rVnkn%z%1|5W*COZowA*dQzXete$d+@H57aDO8gEI!gR)p%=fF(XI!J5h zO!cOos3t8VnBB1fWBqcwR8|cR&^os-aes=sq{1zIR%B+pzhg=tp}DVu&X_W z^cxDKIdfuV3=6F>E}qFP}ZrAl+KBlyx_qbCJF0QQd6r+ zA1b_Zz^W#|9hP^JN+FIUKOoAz1}fC!5W)~8Fk!FZI$gXaAwwr&Cj|AM0uC{5ot~W? zVzkcad2kygmCqMiq%PEh2dR-jGCmBKP9D1{sq{(}vC*{N=i;9&N%C`szw)Faa`AG zZoelF?FF|bVa!YIGf@r?IOaY0XuKoY6$tO^RxLxpbi+$5;Z&y39Tqo3O4rv0F9QNG z)?e=mOD4hD1(^V%v+{b!G7Tr7sUUGUTv7e%G!pgQJOFd0Iv^euc>GOoWB1sSjrcPv zqYO$okOZnk`sAdW6k=@-aK_pINibmK95(rDRDud2q*<+pLMb0;jfsh=h8J(H=Yj}v zY*EB6zel#j`KGfZy7n&S94GEKQMmDa!WfW(=}XvT2P_&!4ycsUZnVhpljf^NW6veP z!V}2#T1DJ=`-48<^Rf&urx|s)Gp5Cg@d+D!$=fWeaUT5ku){R(4N%}fZ+apVVAak> zlS3Eq4uS(8VQf?3)h3BpZY;2^K7w2T>~t6utwXu@;A$yhesc|xX~%8{As4SACnwh? zE^Tlh*pjg=bNTxTa%QH=3PH50$ruH(t`0Nm>#A#UhR5Kd1Qf!VD(**jsVj=c5>Z`> z!GrODp~8SJ?2NWwdU6F%0q=vhRfjAc!UOXu9!9)svNNDfe%d^TfD4BUs_*19e~Hui z@C&F}U~z0tz?gg2&Q=VDjK*w}Mf0anxD=1_6j*wwhi8CQHFv!vkO;)z!b(oGLS_JP znt^(r4cC?MQT|jb*Ks>G#&V)FwbEgfexp@!1@_S(nvo9hY*pff90uhR11=drP1Os) zR~#39FjKgcdl^qD!EmP2{Mz@cV}ii)2fQi)7D&`{-QX?s2`hvDX^Q)^hY%okc!*B! TDKcAs_5^v#^!uW}INtg<4VB|G literal 12652 zcmeHt2Ut^CyY5z0MnM_J89_mr5=2y_NRh5%!GM6m4818$X+c`(MEw;V1ayZYCCM-t zG7cgN0!9eIf=sAlfPfG{2~8w{P(lbKXYF{}bDs16^WSsl{`a1H+|Q#cthT@PeeYM- zzJAKqa^r^W8z2bUh(2-D9)i}!K#XLNrc`+1u1C+!>b$$x2{|T$ zf!W8mad$ZVxwc$Ra*`m)Jj^H{iig3r35jE3(i$mQf8u|*)yyNy>=IN)t!SBmnmw}Y zCf!`6ki=mBYNBpr5hI6m)IY3HGLw$rWGl9tLAdYq+8xX#r!oeOjFWF0F*%Dn!RR8i z#uMkmc`p~6l!Wq9q75hQD;wEThSJIySOtb#kx~CVn4*>L`LLIp#2-!T*bDlHVm^;q zm0qZ>x{c;tff?K!111ms`k1jDdEp_Ai;775b7sAil2cYgYmvWqt4*&)+RQJI=@4YK zz7}a9@)}R1!P&3YLfTKuKd}zM!6(@K!&Rm;a1MfcjFa`sh{ieX8N>@-TZK6+V!k+f zP98|)B~bby6Vut4Y{Tf;_+|~4lSQoHD!Oeq!%JOi0&I5!%{Pcy>fl_DC~^v3$inP0 z6j+vlrQWE3f2i^!C&6uX^1LmXTfV#8HohaJ*W|=Pcaf7yDAppD^8?HoBnnewr}H*e zMQ#Q3C8%Fi95T0IRA3kIaskJ+dV?{^bC=>xZsV1)uw^@{Ib_8GHlpgp$$-iIvS4ye zn19ytkmd2Ro)1A7wRr6Dvd0#xw3`L&ZM1hQr7Xt0Tago(TTcs_taJcBz_QE#6YQa5 zkt_t=nCq+*itx)X#&-yO%*Ip)W0K+`<~9Kw#D7)`)n7L#n~h**(zgMBb8o9qh)TAI z1FIgG0Z)KKsV3_JWI5H+`$P<g?^c9W@h9SA=RN~2M-~N8snDu7)){`w-P|IM;m^XT848Xgkd4s> z@0>nWn%%b}1~VlGeAOYXe+-E4c8#xs>M!Sx`Q9=Wb|{XLcGCRt^O?;>hJY-U06E6_O6kzb6iuo72!Cff&u+s#?M8D&%Yc0DnD^$X&mvojrjm{4UWy6{x;C7S+Jl0 zfkO#m0_F|+!ho(JOYdz3!elxb%xoCdei5R!&y1?uaOAD_hd ze_o9Ln<)6_<%nk2Kc8Q;o^3c#J)2*IMZ_02x5o3}Xxl(j!~D0&x;6~GIKo4GNXWb} z#R*~|A@kQ4)_rt5ntzZ@yQb}gTJP5#OvZEzdpk@v9k7cvogM!QDp)gHaFUVXk$6U& z)!~M8&sUBWCo2J}p!7@ia;o(SH%Tp-T4@6pc3)7$DKPZZCXGn8{0U@oyRZg@prR2> zv>dV|o{X-VtH--x;WBWn)j0gSCLxC}?AU7{TB?Sz(Fnn~qVJ}kZFbh=ii3+rvbn2= zVq8!5iSllvm>`;g!d_G@P9gCN1f@uGg-`iE!i!I}kH22`3Dl1R97=E=HA0uiy_1{0 z^3=h=Rh^PuWC=o^BcP@<^x}50ua!Bq;&+pxYLIH32Kgy;@H7aNK=KOWr%6fvhjt_j zd-Xjs`>0Xn$^C>KAcCq6-6ax92cFqS(U1GWQ?b^c}Kz~5H} z`{+S`ZWbp9F6fLXlAajQjiOuM7HfDV%~w+}H$b6o`T^o5>#=@V30plv95{YcG@Fa^ z+HSTQ8ajh$8%~!0d=OtS@cPK$!Wd_-TVjX~RNsNH3nyD%aUwb!Nw?0MfdHdE#mAbC zK@tjR$n$?fVXhL?Mv>y>j(d1!Gm4>@Jk&m>wTT$i0;t%7R`S->;N)pfi=yCc3%iqa#j3n z%ZAHWxOtYHD3lt*chC0Mhf=0*YoGrOemn7K{h7Rz1lz(#YWRak8n}T!RB!wK{KaB} z+x!h0J%?`GTK??Wv#Rdb+?DwZTKQjkN<7Z<*b!y(!j^uc0D&nNt12)IpvQBKKyh&Q zT4`ikf6e}5P58#IGsQ?zq`rv#y+=WI9>HzUsVvx_H8(5IZBt$8@{dd-$a$M|k$lfX zVZ(V1VW~fUUs-0Y&h<-*-bZ&Mj?_EN{h=B)%!8>BCt7}5yafuY`VxWsgX1ro-pN2q z4gc)vk7r(zGRFI;#z+7A|87TT3=_%tao^a7k1Pz{)jDtdGI!sj@NuqTmX-lQ##>2x zaGYgl9!otok!jR+r}Ab7N=Pk^faGPQ?3%t-stju?>JfgaHmS>3Az+Nx)=!_3ay{d= zlJ%~X$C^reZPX#9{h{T^eJZ5=isELMcGv5Tga_&*VY>8JksF2*3K3%m9dGj41viES z8Xv=82T1)EEM(~Ic0^`>^Y#BiU|{WpbZW+~#;x!b+wzsGOLfH+`vSfZ=3wb$)1Jsp zL;W8`yfohPefcT;%)?sp#6DW&`?KrK9Qk#q4W3G8HXtg7Gj}u0Hl5@bJIqBdo(pe$ zTkHU>4E?WDaP(E@j!R+(sVE8p(s%OOG84jk1_#V^a-!kh;)pq29b%aZPmgdmR+*)aRVPoV%#ozX z9WtH&E+7B!n~<0>McCx(QvW-=f!9s<@WTN4H9_avlZ#b9vS{q?#z}bQ8_gJ1BF6Y> zQz=GGnWYbqFazJHN53p6`X+HbqIJ*%mH()Ze@#K5`iW5!#@a1tICmr6N!ga!H*=+U zOIY2&K4Alwa^D551^S%^1B>qBso^oY=Ba2DZ# z8j}oX0`Y+-Y#=`7%tMYQgJ(b>=j2)bWVM#(Vn1ED>Vi51ZI*ruu<7?`;&1;==%9b*MiV+j2B~E{3Twbmw6>Up4i4AajZH`*Rx# z4&R-juF!5sSbeUGYl#zXSAt~-V&TuWu1)^&t2bgKLWJtHOOK#XkRXny7FgsJsibV=qi z8}9cE;)WXAX({Yz&md>Xy6JmijIFiwg}2HVGX?zM!*yb zCt||){=`9R4Ye)$v7v!tFIbe<#%z8lbSJ>i)r7~HE^&K$Z{;yiUgwOhw8*}0Hbgkj z4k5v{qVN&_gX?SqoIsy2HOq2$gE5_Xm%+{>Plcv6k91jyi3;R53=xJ><~Uk4JBzwu3&t;M}L03;|j1Vfj8-Xvz zRsI;X5~eYtm9fKQq1q;3mG@Mpz4({zrBoju9};rRKYGS~DQIn)iWXT~YhX$%ZPkoi zt%P=^j*}jug(=ZMulWTF!PHHMB7`~HPPVWk&`3%-2RtroFp^^i? z`z%D)th_*Zl~kHXMMp2(@1m^z*=rrU_d`E5qH%F?(T?R>wuhW>VY0iFS3C1kIYZzx z7-k+=8rg97?p?1Fe6lTNHaDcN%EQ3Oh+5SB<;RVS%k{TtXvdSb) zhL&0{>}y>*UnwUi=QUUv#7dRDrHYF{2vDSr9~(w*Lb+5wco62OPJpzXFRMr>#l`mv z^75WU1qTNwQ<&6PfB#WRF@+-7gFO@F7^&SATAi%N$btJ09yl=j#Gx8f-RFf4@2Cpt zBR+x^eLtQ)b~)J!w(D~Bq9uwJ+!R#J`;Fq}#`VdW7PkCOR0O)JrKQDG?^@YfT$b{j zPJ9hJ$qx29Q680)BwjDONo8^2y@SjHS3phQ)IuLztIiOEqtfhoGAk9o9Eb@jHQa@! zFk^WNTEAiJ%BNlx9+8|Ym9jl{S<-6Xl+oVSmNfcO8DpBnv@z6dX=@Xc0KW=Qa_C*w z8d@KCPEb8niK8Q$XL(6#?VDD}nTaK>>klPw3|vNdMF0IPRTMR{e{QgREia1YfjzG= z@&?toz#EjLslGW}GC$!vqadj4SA;Hiwd=&U6V0}eGy5nM3eP;TSG*!pP#2znBaI2_ zWyS}g5?#P+b`2IY9%;;by!5`rPHPi%uIJ~M5`X|aIg`c?!S2BpO0qR$8XFr)IjG8R zH+&~EM-^x}rl!I!c4V&?)vt8nBdP}K5=GAdvqKL)-{UoI%l4K1`OIZge^P$FNI=eH zaoIK16-#%ZIp)_dC1&vpCs9T->1hgWfFGr*E*DiF1wVBQqU}OkX<+wNE^i?%zDU?w zmVbM=F@xt^lDJCSc}1l{z-9LtF_Yh0Yve>xNJeAz&|JgM>AgS{?b-IBuJ73@kRImq zVae0WvdMcGFS#ka$s;Gd*AF+Bp0bJ!hdW*A5m&poC&Q0v_=#MnL^<6{h&LrWq=wn_9NQB#@1H+ zhRT(}i6;b$^mqaHq3dLdwFbSPat)F{L~oSP;ssT3?PJl~DRO3f8Fe(zi&#*QkU(Jy zWzk~K()sM@nkgRSO!jLZvf-b?8b@D^>Q+N*j9k=5^;{+}zxhY&S*R@%gA_2|tHkD}GTISW4G3F%cnSTT(4Vpm$ja z%*FzWF8R%g_P*VGsUu^jsbD-T$&H~OgW=g4lFn47!gsm?HDd|chd&^EOx1}G4dv3v znTC&hSJzLEk1bm0>(399Gp~bP-IkO#<5rCeW+XBSrqjP~)CXvyM=kMJM1sN7Rzeaw ze0gyuhZN;Kw0W=5Wx)$VE9s3-EV^7D0mJ>bb&%4%i|M^J(Nl3DrSlG|qMkOFUc}^)31(*tj>e+Jv0h3nb%2@bQNn%gP!hKyzarvqOR8p4m6S z0c%;Vk|0>I)3xkiO6?(*)%~aO@6tz|v?>z<0|Sp>7u=*4Q;Lx7oZDvLB<1!^$0{l+ zB!2qaR*lnF-H?=`wpg3mDp~8E4)S0y)FJub0Y)tHP_whM)>|KwGeu9B@$KL43Cr`7 z8vvx#;1hHien4N@Wb1q3e%K|hR7drH)u{nw88RXQ{Qb=zbn-oFqRqJXF0Fp$lxQxN zWC7-tcYepRo==&rhQ9Px#HHTn=_3R3)yl*`A2%2lI z&*-(*AfR$dB;LO2{ZLSG*|218ZmtyA#gfW8Az3SN;tFMdA3&%xOtRwxx^nv*bCuhI z{K$K`Zz?A%$(fRyoJu?%uZo7LR4TXyDzv3U%mb4{k6bdS!Sa$?`uqF6P`&O}v4;ip z!()%MpuCQ|52sA~x|9QmxfM%O_rfQ{Zj9LHhk4#EU8nuXGn>=1EnDK4XL1=!4F(q+ zyOECqUfoew&kZp?s$kbP?GHYA0vRp@<;~tfk*q=9c~eb3!T@~M^cN81;C8uZae~l0 z`&MGUP0jiK;LPK&+$paD&L~O&C8VR1cBLBnn&2twLPK<2F6SvqvX{|5l49Lo(OPAe z%9^0*Gj4H*+iP-FFwzV%!&Rcw?Byls44STj6CR6ZCNjKu4-?V+HdJzE!|N*K;E~uG zx>fj$k$?XC`xROYGCR?3m#~XFW|2LT8h{)fcPsLjdo-T>WWnwjo*h30outmF+P9VB zR^j}LxI5Nx-@_FXe1fTk`y*SFQ9qm8y*%Ap)$G?7(==NbetkrM&GG1)-3yNWBR^XQ zg03F+cxs#vFIS^5w&4$IS_@HSCVqqx+dh9wxLRG9rbZl&*=pU7qV8f0S~LeMs0n?s zORZ|zz*8h1&X@uc=t6Qj`O9q^Sbfzm#_GbFmeZNpv>FpyX`|RYwrP3Zta~CW%h7xq;<2q>G8@|m{0W5ha)R(=gLwIZh9BspE=vcE3^UPi-ZyJB6o%8mHWd;y@P zed<1_=hSOEw{EMYwGedaQD2FS9I99-sv08z|0tpy;2fuq6lT1YQSe31z|YPnapN ziuojf{3}^00O!21PxLPv8LW&^K1i??F$W%z-AO=G1;k@jW04d^6m|NMUn$Bda*Qol z4dE`HmO{CVs4G#ZVV0tkXm%pWFbW$vCOHqwprbjQ3)5tmeHRC_@qW`*6@(|t8F27; zo5g;HEUdyyO0d~#JQ6T zcksyOZWE45>_CbL6!Z^_yT(bmJm57;6Yp6 jhb<9ELGSrG diff --git a/docs/reference/model-method-sample.html b/docs/reference/model-method-sample.html index d84264098..f656c23a7 100644 --- a/docs/reference/model-method-sample.html +++ b/docs/reference/model-method-sample.html @@ -1,82 +1,19 @@ - - - - - - - -Run Stan's MCMC algorithms — model-method-sample • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run Stan's MCMC algorithms — model-method-sample • cmdstanr - - - - - - - - - - - - + + - - -
-
- -
- -
+
-

The $sample() method of a CmdStanModel object runs Stan's +

The $sample() method of a CmdStanModel object runs Stan's main Markov chain Monte Carlo algorithm.

Any argument left as NULL will default to the default value used by the installed version of CmdStan. See the -CmdStan User’s Guide +CmdStan User’s Guide for more details.

After model fitting any diagnostics specified via the diagnostics argument will be checked and warnings will be printed if warranted.

-
sample(
-  data = NULL,
-  seed = NULL,
-  refresh = NULL,
-  init = NULL,
-  save_latent_dynamics = FALSE,
-  output_dir = NULL,
-  output_basename = NULL,
-  sig_figs = NULL,
-  chains = 4,
-  parallel_chains = getOption("mc.cores", 1),
-  chain_ids = seq_len(chains),
-  threads_per_chain = NULL,
-  opencl_ids = NULL,
-  iter_warmup = NULL,
-  iter_sampling = NULL,
-  save_warmup = FALSE,
-  thin = NULL,
-  max_treedepth = NULL,
-  adapt_engaged = TRUE,
-  adapt_delta = NULL,
-  step_size = NULL,
-  metric = NULL,
-  metric_file = NULL,
-  inv_metric = NULL,
-  init_buffer = NULL,
-  term_buffer = NULL,
-  window = NULL,
-  fixed_param = FALSE,
-  show_messages = TRUE,
-  diagnostics = c("divergences", "treedepth", "ebfmi"),
-  cores = NULL,
-  num_cores = NULL,
-  num_chains = NULL,
-  num_warmup = NULL,
-  num_samples = NULL,
-  validate_csv = NULL,
-  save_extra_diagnostics = NULL,
-  max_depth = NULL,
-  stepsize = NULL
-)
- -

Arguments

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
data

(multiple options) The data to use for the variables specified in -the data block of the Stan program. One of the following:

    -
  • A named list of R objects with the names corresponding to variables +

    +
    sample(
    +  data = NULL,
    +  seed = NULL,
    +  refresh = NULL,
    +  init = NULL,
    +  save_latent_dynamics = FALSE,
    +  output_dir = NULL,
    +  output_basename = NULL,
    +  sig_figs = NULL,
    +  chains = 4,
    +  parallel_chains = getOption("mc.cores", 1),
    +  chain_ids = seq_len(chains),
    +  threads_per_chain = NULL,
    +  opencl_ids = NULL,
    +  iter_warmup = NULL,
    +  iter_sampling = NULL,
    +  save_warmup = FALSE,
    +  thin = NULL,
    +  max_treedepth = NULL,
    +  adapt_engaged = TRUE,
    +  adapt_delta = NULL,
    +  step_size = NULL,
    +  metric = NULL,
    +  metric_file = NULL,
    +  inv_metric = NULL,
    +  init_buffer = NULL,
    +  term_buffer = NULL,
    +  window = NULL,
    +  fixed_param = FALSE,
    +  show_messages = TRUE,
    +  show_exceptions = TRUE,
    +  diagnostics = c("divergences", "treedepth", "ebfmi"),
    +  cores = NULL,
    +  num_cores = NULL,
    +  num_chains = NULL,
    +  num_warmup = NULL,
    +  num_samples = NULL,
    +  validate_csv = NULL,
    +  save_extra_diagnostics = NULL,
    +  max_depth = NULL,
    +  stepsize = NULL
    +)
    +
    + +
    +

    Arguments

    +
    data
    +

    (multiple options) The data to use for the variables specified in +the data block of the Stan program. One of the following:

    • A named list of R objects with the names corresponding to variables declared in the data block of the Stan program. Internally this list is then -written to JSON for CmdStan using write_stan_json(). See -write_stan_json() for details on the conversions performed on R objects +written to JSON for CmdStan using write_stan_json(). See +write_stan_json() for details on the conversions performed on R objects before they are passed to Stan.

    • A path to a data file compatible with CmdStan (JSON or R dump). See the appendices in the CmdStan guide for details on using these formats.

    • NULL or an empty list if the Stan program has no data block.

    • -
seed

(positive integer(s)) A seed for the (P)RNG to pass to CmdStan. + + + +

seed
+

(positive integer(s)) A seed for the (P)RNG to pass to CmdStan. In the case of multi-chain sampling the single seed will automatically be augmented by the the run (chain) ID so that each chain uses a different seed. The exception is the transformed data block, which defaults to @@ -262,25 +190,24 @@

Arg chains if RNG functions are used. The only time seed should be specified as a vector (one element per chain) is if RNG functions are used in transformed data and the goal is to generate different data for each -chain.

refresh

(non-negative integer) The number of iterations between +chain.

+ + +
refresh
+

(non-negative integer) The number of iterations between printed screen updates. If refresh = 0, only error messages will be -printed.

init

(multiple options) The initialization method to use for the +printed.

+ + +
init
+

(multiple options) The initialization method to use for the variables declared in the parameters block of the Stan program. One of -the following:

    -
  • A real number x>0. This initializes all parameters randomly between +the following:

    • A real number x>0. This initializes all parameters randomly between [-x,x] on the unconstrained parameter space.;

    • The number 0. This initializes all parameters to 0;

    • A character vector of paths (one per chain) to JSON or Rdump files containing initial values for all or some parameters. See -write_stan_json() to write R objects to JSON files compatible with +write_stan_json() to write R objects to JSON files compatible with CmdStan.

    • A list of lists containing initial values for all or some parameters. For MCMC the list should contain a sublist for each chain. For optimization and @@ -293,601 +220,628 @@

      Arg has argument chain_id it will be supplied with the chain id (from 1 to number of chains) when called to generate the initial values. See Examples.

    • -
save_latent_dynamics

(logical) Should auxiliary diagnostic information + + + +

save_latent_dynamics
+

(logical) Should auxiliary diagnostic information about the latent dynamics be written to temporary diagnostic CSV files? This argument replaces CmdStan's diagnostic_file argument and the content written to CSV is controlled by the user's CmdStan installation and not CmdStanR (for some algorithms no content may be written). The default is FALSE, which is appropriate for almost every use case. To save the temporary files created when save_latent_dynamics=TRUE see the -$save_latent_dynamics_files() -method.

output_dir

(string) A path to a directory where CmdStan should write +$save_latent_dynamics_files() +method.

+ + +
output_dir
+

(string) A path to a directory where CmdStan should write its output CSV files. For interactive use this can typically be left at NULL (temporary directory) since CmdStanR makes the CmdStan output (posterior draws and diagnostics) available in R via methods of the fitted -model objects. The behavior of output_dir is as follows:

    -
  • If NULL (the default), then the CSV files are written to a temporary +model objects. The behavior of output_dir is as follows:

    • If NULL (the default), then the CSV files are written to a temporary directory and only saved permanently if the user calls one of the $save_* methods of the fitted model object (e.g., -$save_output_files()). These temporary +$save_output_files()). These temporary files are removed when the fitted model object is -garbage collected (manually or automatically).

    • +garbage collected (manually or automatically).

    • If a path, then the files are created in output_dir with names corresponding to the defaults used by $save_output_files().

    • -
output_basename

(string) A string to use as a prefix for the names of + + + +

output_basename
+

(string) A string to use as a prefix for the names of the output CSV files of CmdStan. If NULL (the default), the basename of the output CSV files will be comprised from the model name, timestamp, and -5 random characters.

sig_figs

(positive integer) The number of significant figures used +5 random characters.

+ + +
sig_figs
+

(positive integer) The number of significant figures used when storing the output values. By default, CmdStan represent the output values with 6 significant figures. The upper limit for sig_figs is 18. Increasing this value will result in larger output CSV files and thus an -increased usage of disk space.

chains

(positive integer) The number of Markov chains to run. The -default is 4.

parallel_chains

(positive integer) The maximum number of MCMC chains +increased usage of disk space.

+ + +
chains
+

(positive integer) The number of Markov chains to run. The +default is 4.

+ + +
parallel_chains
+

(positive integer) The maximum number of MCMC chains to run in parallel. If parallel_chains is not specified then the default is to look for the option "mc.cores", which can be set for an entire R -session by options(mc.cores=value). If the "mc.cores" option has not -been set then the default is 1.

chain_ids

(integer vector) A vector of chain IDs. Must contain as many +session by options(mc.cores=value). If the "mc.cores" option has not +been set then the default is 1.

+ + +
chain_ids
+

(integer vector) A vector of chain IDs. Must contain as many unique positive integers as the number of chains. If not set, the default -chain IDs are used (integers starting from 1).

threads_per_chain

(positive integer) If the model was -compiled with threading support, the number of +chain IDs are used (integers starting from 1).

+ + +
threads_per_chain
+

(positive integer) If the model was +compiled with threading support, the number of threads to use in parallelized sections within an MCMC chain (e.g., when using the Stan functions reduce_sum() or map_rect()). This is in contrast with parallel_chains, which specifies the number of chains to run in parallel. The actual number of CPU cores used is parallel_chains*threads_per_chain. For an example of using threading see the Stan case study -Reduce Sum: A Minimal Example.

opencl_ids

(integer vector of length 2) The platform and +Reduce Sum: A Minimal Example.

+ + +
opencl_ids
+

(integer vector of length 2) The platform and device IDs of the OpenCL device to use for fitting. The model must be compiled with cpp_options = list(stan_opencl = TRUE) for this -argument to have an effect.

iter_warmup

(positive integer) The number of warmup iterations to run +argument to have an effect.

+ + +
iter_warmup
+

(positive integer) The number of warmup iterations to run per chain. Note: in the CmdStan User's Guide this is referred to as -num_warmup.

iter_sampling

(positive integer) The number of post-warmup iterations +num_warmup.

+ + +
iter_sampling
+

(positive integer) The number of post-warmup iterations to run per chain. Note: in the CmdStan User's Guide this is referred to as -num_samples.

save_warmup

(logical) Should warmup iterations be saved? The default -is FALSE.

thin

(positive integer) The period between saved samples. This should -typically be left at its default (no thinning) unless memory is a problem.

max_treedepth

(positive integer) The maximum allowed tree depth for +num_samples.

+ + +
save_warmup
+

(logical) Should warmup iterations be saved? The default +is FALSE.

+ + +
thin
+

(positive integer) The period between saved samples. This should +typically be left at its default (no thinning) unless memory is a problem.

+ + +
max_treedepth
+

(positive integer) The maximum allowed tree depth for the NUTS engine. See the Tree Depth section of the CmdStan User's Guide -for more details.

adapt_engaged

(logical) Do warmup adaptation? The default is TRUE. +for more details.

+ + +
adapt_engaged
+

(logical) Do warmup adaptation? The default is TRUE. If a precomputed inverse metric is specified via the inv_metric argument (or metric_file) then, if adapt_engaged=TRUE, Stan will use the provided inverse metric just as an initial guess during adaptation. To turn off adaptation when using a precomputed inverse metric set -adapt_engaged=FALSE.

adapt_delta

(real in (0,1)) The adaptation target acceptance -statistic.

step_size

(positive real) The initial step size for the discrete +adapt_engaged=FALSE.

+ + +
adapt_delta
+

(real in (0,1)) The adaptation target acceptance +statistic.

+ + +
step_size
+

(positive real) The initial step size for the discrete approximation to continuous Hamiltonian dynamics. This is further tuned -during warmup.

metric

(string) One of "diag_e", "dense_e", or "unit_e", +during warmup.

+ + +
metric
+

(string) One of "diag_e", "dense_e", or "unit_e", specifying the geometry of the base manifold. See the Euclidean Metric section of the CmdStan User's Guide for more details. To specify a -precomputed (inverse) metric, see the inv_metric argument below.

metric_file

(character vector) The paths to JSON or +precomputed (inverse) metric, see the inv_metric argument below.

+ + +
metric_file
+

(character vector) The paths to JSON or Rdump files (one per chain) compatible with CmdStan that contain precomputed inverse metrics. The metric_file argument is inherited from CmdStan but is confusing in that the entry in JSON or Rdump file(s) must be named inv_metric, referring to the inverse metric. We recommend instead using CmdStanR's inv_metric argument (see below) to specify an inverse -metric directly using a vector or matrix from your R session.

inv_metric

(vector, matrix) A vector (if metric='diag_e') or a +metric directly using a vector or matrix from your R session.

+ + +
inv_metric
+

(vector, matrix) A vector (if metric='diag_e') or a matrix (if metric='dense_e') for initializing the inverse metric. This can be used as an alternative to the metric_file argument. A vector is interpreted as a diagonal metric. The inverse metric is usually set to an estimate of the posterior covariance. See the adapt_engaged argument above for details about (and control over) how specifying a precomputed -inverse metric interacts with adaptation.

init_buffer

(nonnegative integer) Width of initial fast timestep -adaptation interval during warmup.

term_buffer

(nonnegative integer) Width of final fast timestep -adaptation interval during warmup.

window

(nonnegative integer) Initial width of slow timestep/metric -adaptation interval.

fixed_param

(logical) When TRUE, call CmdStan with argument +inverse metric interacts with adaptation.

+ + +
init_buffer
+

(nonnegative integer) Width of initial fast timestep +adaptation interval during warmup.

+ + +
term_buffer
+

(nonnegative integer) Width of final fast timestep +adaptation interval during warmup.

+ + +
window
+

(nonnegative integer) Initial width of slow timestep/metric +adaptation interval.

+ + +
fixed_param
+

(logical) When TRUE, call CmdStan with argument "algorithm=fixed_param". The default is FALSE. The fixed parameter sampler generates a new sample without changing the current state of the Markov chain; only generated quantities may change. This can be useful when, for example, trying to generate pseudo-data using the generated quantities block. If the parameters block is empty then using fixed_param=TRUE is mandatory. When fixed_param=TRUE the chains and -parallel_chains arguments will be set to 1.

show_messages

(logical) When TRUE (the default), prints all +parallel_chains arguments will be set to 1.

+ + +
show_messages
+

(logical) When TRUE (the default), prints all +output during the sampling process, such as iteration numbers and elapsed times. +If the output is silenced then the $output() method of +the resulting fit object can be used to display the silenced messages.

+ + +
show_exceptions
+

(logical) When TRUE (the default), prints all informational messages, for example rejection of the current proposal. Disable if you wish to silence these messages, but this is not usually recommended unless you are very confident that the model is correct up to numerical error. If the messages are silenced then the -$output() method of the resulting fit object can be -used to display the silenced messages.

diagnostics

(character vector) The diagnostics to automatically check +$output() method of the resulting fit object can be +used to display the silenced messages.

+ + +
diagnostics
+

(character vector) The diagnostics to automatically check and warn about after sampling. Setting this to an empty string "" or NULL can be used to prevent CmdStanR from automatically reading in the sampler diagnostics from CSV if you wish to manually read in the results -and validate them yourself, for example using read_cmdstan_csv(). The +and validate them yourself, for example using read_cmdstan_csv(). The currently available diagnostics are "divergences", "treedepth", and "ebfmi" (the default is to check all of them).

These diagnostics are also available after fitting. The -$sampler_diagnostics() method provides +$sampler_diagnostics() method provides access the diagnostic values for each iteration and the -$diagnostic_summary() method provides +$diagnostic_summary() method provides summaries of the diagnostics and can regenerate the warning messages.

Diagnostics like R-hat and effective sample size are not currently available via the diagnostics argument but can be checked after fitting -using the $summary() method.

cores, num_cores, num_chains, num_warmup, num_samples, save_extra_diagnostics, max_depth, stepsize, validate_csv

Deprecated and will be removed in a future release.

+using the $summary() method.

+ -

Value

+
cores, num_cores, num_chains, num_warmup, num_samples, save_extra_diagnostics, max_depth, stepsize, validate_csv
+

Deprecated and will be removed in a future release.

-

A CmdStanMCMC object.

-

See also

+
+
+

Value

+ -

The CmdStanR website -(mc-stan.org/cmdstanr) for online +

A CmdStanMCMC object.

+
+
+

See also

+

The CmdStanR website +(mc-stan.org/cmdstanr) for online documentation and tutorials.

-

The Stan and CmdStan documentation:

- -

Other CmdStanModel methods: -model-method-check_syntax, -model-method-compile, -model-method-diagnose, -model-method-format, -model-method-generate-quantities, -model-method-optimize, -model-method-sample_mpi, -model-method-variables, -model-method-variational

- -

Examples

-
# \dontrun{ -library(cmdstanr) -library(posterior) -library(bayesplot) -color_scheme_set("brightblue") - -# Set path to CmdStan -# (Note: if you installed CmdStan via install_cmdstan() with default settings -# then setting the path is unnecessary but the default below should still work. -# Otherwise use the `path` argument to specify the location of your -# CmdStan installation.) -set_cmdstan_path(path = NULL) -
#> CmdStan path set to: /Users/jgabry/.cmdstan/cmdstan-2.29.1
-# Create a CmdStanModel object from a Stan program, -# here using the example model that comes with CmdStan -file <- file.path(cmdstan_path(), "examples/bernoulli/bernoulli.stan") -mod <- cmdstan_model(file) -mod$print() -
#> data { -#> int<lower=0> N; -#> array[N] int<lower=0,upper=1> y; // or int<lower=0,upper=1> y[N]; -#> } -#> parameters { -#> real<lower=0,upper=1> theta; -#> } -#> model { -#> theta ~ beta(1,1); // uniform prior on interval 0,1 -#> y ~ bernoulli(theta); -#> }
-# Data as a named list (like RStan) -stan_data <- list(N = 10, y = c(0,1,0,0,0,0,0,0,0,1)) - -# Run MCMC using the 'sample' method -fit_mcmc <- mod$sample( - data = stan_data, - seed = 123, - chains = 2, - parallel_chains = 2 -) -
#> Running MCMC with 2 parallel chains... -#> -#> Chain 1 Iteration: 1 / 2000 [ 0%] (Warmup) -#> Chain 1 Iteration: 100 / 2000 [ 5%] (Warmup) -#> Chain 1 Iteration: 200 / 2000 [ 10%] (Warmup) -#> Chain 1 Iteration: 300 / 2000 [ 15%] (Warmup) -#> Chain 1 Iteration: 400 / 2000 [ 20%] (Warmup) -#> Chain 1 Iteration: 500 / 2000 [ 25%] (Warmup) -#> Chain 1 Iteration: 600 / 2000 [ 30%] (Warmup) -#> Chain 1 Iteration: 700 / 2000 [ 35%] (Warmup) -#> Chain 1 Iteration: 800 / 2000 [ 40%] (Warmup) -#> Chain 1 Iteration: 900 / 2000 [ 45%] (Warmup) -#> Chain 1 Iteration: 1000 / 2000 [ 50%] (Warmup) -#> Chain 1 Iteration: 1001 / 2000 [ 50%] (Sampling) -#> Chain 1 Iteration: 1100 / 2000 [ 55%] (Sampling) -#> Chain 1 Iteration: 1200 / 2000 [ 60%] (Sampling) -#> Chain 1 Iteration: 1300 / 2000 [ 65%] (Sampling) -#> Chain 1 Iteration: 1400 / 2000 [ 70%] (Sampling) -#> Chain 1 Iteration: 1500 / 2000 [ 75%] (Sampling) -#> Chain 1 Iteration: 1600 / 2000 [ 80%] (Sampling) -#> Chain 1 Iteration: 1700 / 2000 [ 85%] (Sampling) -#> Chain 1 Iteration: 1800 / 2000 [ 90%] (Sampling) -#> Chain 1 Iteration: 1900 / 2000 [ 95%] (Sampling) -#> Chain 1 Iteration: 2000 / 2000 [100%] (Sampling) -#> Chain 2 Iteration: 1 / 2000 [ 0%] (Warmup) -#> Chain 2 Iteration: 100 / 2000 [ 5%] (Warmup) -#> Chain 2 Iteration: 200 / 2000 [ 10%] (Warmup) -#> Chain 2 Iteration: 300 / 2000 [ 15%] (Warmup) -#> Chain 2 Iteration: 400 / 2000 [ 20%] (Warmup) -#> Chain 2 Iteration: 500 / 2000 [ 25%] (Warmup) -#> Chain 2 Iteration: 600 / 2000 [ 30%] (Warmup) -#> Chain 2 Iteration: 700 / 2000 [ 35%] (Warmup) -#> Chain 2 Iteration: 800 / 2000 [ 40%] (Warmup) -#> Chain 2 Iteration: 900 / 2000 [ 45%] (Warmup) -#> Chain 2 Iteration: 1000 / 2000 [ 50%] (Warmup) -#> Chain 2 Iteration: 1001 / 2000 [ 50%] (Sampling) -#> Chain 2 Iteration: 1100 / 2000 [ 55%] (Sampling) -#> Chain 2 Iteration: 1200 / 2000 [ 60%] (Sampling) -#> Chain 2 Iteration: 1300 / 2000 [ 65%] (Sampling) -#> Chain 2 Iteration: 1400 / 2000 [ 70%] (Sampling) -#> Chain 2 Iteration: 1500 / 2000 [ 75%] (Sampling) -#> Chain 2 Iteration: 1600 / 2000 [ 80%] (Sampling) -#> Chain 2 Iteration: 1700 / 2000 [ 85%] (Sampling) -#> Chain 2 Iteration: 1800 / 2000 [ 90%] (Sampling) -#> Chain 2 Iteration: 1900 / 2000 [ 95%] (Sampling) -#> Chain 2 Iteration: 2000 / 2000 [100%] (Sampling) -#> Chain 1 finished in 0.0 seconds. -#> Chain 2 finished in 0.0 seconds. -#> -#> Both chains finished successfully. -#> Mean chain execution time: 0.0 seconds. -#> Total execution time: 0.2 seconds. -#>
-# Use 'posterior' package for summaries -fit_mcmc$summary() -
#> # A tibble: 2 × 10 -#> variable mean median sd mad q5 q95 rhat ess_bulk ess_tail -#> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> -#> 1 lp__ -7.30 -7.03 0.721 0.380 -8.82 -6.75 1.00 902. 1006. -#> 2 theta 0.247 0.233 0.122 0.129 0.0786 0.470 1.00 762. 712.
-# Get posterior draws -draws <- fit_mcmc$draws() -print(draws) -
#> # A draws_array: 1000 iterations, 2 chains, and 2 variables -#> , , variable = lp__ -#> -#> chain -#> iteration 1 2 -#> 1 -6.8 -6.8 -#> 2 -6.9 -6.8 -#> 3 -7.0 -7.0 -#> 4 -6.9 -7.1 -#> 5 -6.7 -7.0 -#> -#> , , variable = theta -#> -#> chain -#> iteration 1 2 -#> 1 0.28 0.21 -#> 2 0.19 0.20 -#> 3 0.16 0.17 -#> 4 0.20 0.36 -#> 5 0.25 0.34 -#> -#> # ... with 995 more iterations
-# Convert to data frame using posterior::as_draws_df -as_draws_df(draws) -
#> # A draws_df: 1000 iterations, 2 chains, and 2 variables -#> lp__ theta -#> 1 -6.8 0.28 -#> 2 -6.9 0.19 -#> 3 -7.0 0.16 -#> 4 -6.9 0.20 -#> 5 -6.7 0.25 -#> 6 -7.1 0.36 -#> 7 -9.0 0.55 -#> 8 -7.2 0.15 -#> 9 -6.8 0.23 -#> 10 -7.5 0.42 -#> # ... with 1990 more draws -#> # ... hidden reserved variables {'.chain', '.iteration', '.draw'}
-# Plot posterior using bayesplot (ggplot2) -mcmc_hist(fit_mcmc$draws("theta")) -
#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
-# Call CmdStan's diagnose and stansummary utilities -fit_mcmc$cmdstan_diagnose() -
#> Processing csv files: /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/bernoulli-202203181226-1-05e2b0.csv, /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/bernoulli-202203181226-2-05e2b0.csv -#> -#> Checking sampler transitions treedepth. -#> Treedepth satisfactory for all transitions. -#> -#> Checking sampler transitions for divergences. -#> No divergent transitions found. -#> -#> Checking E-BFMI - sampler transitions HMC potential energy. -#> E-BFMI satisfactory. -#> -#> Effective sample size satisfactory. -#> -#> Split R-hat values satisfactory all parameters. -#> -#> Processing complete, no problems detected.
fit_mcmc$cmdstan_summary() -
#> Inference for Stan model: bernoulli_model -#> 2 chains: each with iter=(1000,1000); warmup=(0,0); thin=(1,1); 2000 iterations saved. -#> -#> Warmup took (0.0050, 0.0050) seconds, 0.010 seconds total -#> Sampling took (0.015, 0.014) seconds, 0.029 seconds total -#> -#> Mean MCSE StdDev 5% 50% 95% N_Eff N_Eff/s R_hat -#> -#> lp__ -7.3 2.6e-02 0.72 -8.8 -7.0 -6.8 781 26932 1.0 -#> accept_stat__ 0.92 8.3e-03 0.13 0.64 0.97 1.0 2.3e+02 8.1e+03 1.0e+00 -#> stepsize__ 0.95 7.9e-02 0.079 0.87 1.0 1.0 1.0e+00 3.5e+01 2.0e+13 -#> treedepth__ 1.4 1.1e-02 0.48 1.0 1.0 2.0 1.9e+03 6.5e+04 1.0e+00 -#> n_leapfrog__ 2.5 1.4e-01 1.3 1.0 3.0 3.0 8.9e+01 3.1e+03 1.0e+00 -#> divergent__ 0.00 nan 0.00 0.00 0.00 0.00 nan nan nan -#> energy__ 7.8 3.6e-02 1.00 6.8 7.5 9.6 7.7e+02 2.7e+04 1.0e+00 -#> -#> theta 0.25 4.3e-03 0.12 0.079 0.23 0.47 796 27460 1.0 -#> -#> Samples were drawn using hmc with nuts. -#> For each parameter, N_Eff is a crude measure of effective sample size, -#> and R_hat is the potential scale reduction factor on split chains (at -#> convergence, R_hat=1).
-# For models fit using MCMC, if you like working with RStan's stanfit objects -# then you can create one with rstan::read_stan_csv() - -# stanfit <- rstan::read_stan_csv(fit_mcmc$output_files()) - - -# Run 'optimize' method to get a point estimate (default is Stan's LBFGS algorithm) -# and also demonstrate specifying data as a path to a file instead of a list -my_data_file <- file.path(cmdstan_path(), "examples/bernoulli/bernoulli.data.json") -fit_optim <- mod$optimize(data = my_data_file, seed = 123) -
#> Initial log joint probability = -9.51104 -#> Iter log prob ||dx|| ||grad|| alpha alpha0 # evals Notes -#> 6 -5.00402 0.000103557 2.55661e-07 1 1 9 -#> Optimization terminated normally: -#> Convergence detected: relative gradient magnitude is below tolerance -#> Finished in 0.1 seconds.
-fit_optim$summary() -
#> # A tibble: 2 × 2 -#> variable estimate -#> <chr> <dbl> -#> 1 lp__ -5.00 -#> 2 theta 0.2
- -# Run 'variational' method to approximate the posterior (default is meanfield ADVI) -fit_vb <- mod$variational(data = stan_data, seed = 123) -
#> ------------------------------------------------------------ -#> EXPERIMENTAL ALGORITHM: -#> This procedure has not been thoroughly tested and may be unstable -#> or buggy. The interface is subject to change. -#> ------------------------------------------------------------ -#> Gradient evaluation took 8e-06 seconds -#> 1000 transitions using 10 leapfrog steps per transition would take 0.08 seconds. -#> Adjust your expectations accordingly! -#> Begin eta adaptation. -#> Iteration: 1 / 250 [ 0%] (Adaptation) -#> Iteration: 50 / 250 [ 20%] (Adaptation) -#> Iteration: 100 / 250 [ 40%] (Adaptation) -#> Iteration: 150 / 250 [ 60%] (Adaptation) -#> Iteration: 200 / 250 [ 80%] (Adaptation) -#> Success! Found best value [eta = 1] earlier than expected. -#> Begin stochastic gradient ascent. -#> iter ELBO delta_ELBO_mean delta_ELBO_med notes -#> 100 -6.262 1.000 1.000 -#> 200 -6.263 0.500 1.000 -#> 300 -6.307 0.336 0.007 MEDIAN ELBO CONVERGED -#> Drawing a sample of size 1000 from the approximate posterior... -#> COMPLETED. -#> Finished in 0.1 seconds.
-fit_vb$summary() -
#> # A tibble: 3 × 7 -#> variable mean median sd mad q5 q95 -#> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> -#> 1 lp__ -7.18 -6.94 0.588 0.259 -8.36 -6.75 -#> 2 lp_approx__ -0.515 -0.221 0.692 0.303 -2.06 -0.00257 -#> 3 theta 0.263 0.246 0.115 0.113 0.106 0.481
-# Plot approximate posterior using bayesplot -mcmc_hist(fit_vb$draws("theta")) -
#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
- -# Specifying initial values as a function -fit_mcmc_w_init_fun <- mod$sample( - data = stan_data, - seed = 123, - chains = 2, - refresh = 0, - init = function() list(theta = runif(1)) -) -
#> Running MCMC with 2 sequential chains... -#> -#> Chain 1 finished in 0.0 seconds. -#> Chain 2 finished in 0.0 seconds. -#> -#> Both chains finished successfully. -#> Mean chain execution time: 0.0 seconds. -#> Total execution time: 0.3 seconds. -#>
fit_mcmc_w_init_fun_2 <- mod$sample( - data = stan_data, - seed = 123, - chains = 2, - refresh = 0, - init = function(chain_id) { - # silly but demonstrates optional use of chain_id - list(theta = 1 / (chain_id + 1)) - } -) -
#> Running MCMC with 2 sequential chains... -#> -#> Chain 1 finished in 0.0 seconds. -#> Chain 2 finished in 0.0 seconds. -#> -#> Both chains finished successfully. -#> Mean chain execution time: 0.0 seconds. -#> Total execution time: 0.3 seconds. -#>
fit_mcmc_w_init_fun_2$init() -
#> [[1]] -#> [[1]]$theta -#> [1] 0.5 -#> -#> -#> [[2]] -#> [[2]]$theta -#> [1] 0.3333333 -#> -#>
-# Specifying initial values as a list of lists -fit_mcmc_w_init_list <- mod$sample( - data = stan_data, - seed = 123, - chains = 2, - refresh = 0, - init = list( - list(theta = 0.75), # chain 1 - list(theta = 0.25) # chain 2 - ) -) -
#> Running MCMC with 2 sequential chains... -#> -#> Chain 1 finished in 0.0 seconds. -#> Chain 2 finished in 0.0 seconds. -#> -#> Both chains finished successfully. -#> Mean chain execution time: 0.0 seconds. -#> Total execution time: 0.3 seconds. -#>
fit_optim_w_init_list <- mod$optimize( - data = stan_data, - seed = 123, - init = list( - list(theta = 0.75) - ) -) -
#> Initial log joint probability = -11.6657 -#> Iter log prob ||dx|| ||grad|| alpha alpha0 # evals Notes -#> 6 -5.00402 0.000237915 9.55309e-07 1 1 9 -#> Optimization terminated normally: -#> Convergence detected: relative gradient magnitude is below tolerance -#> Finished in 0.3 seconds.
fit_optim_w_init_list$init() -
#> [[1]] -#> [[1]]$theta -#> [1] 0.75 -#> -#>
# } - -
+

The Stan and CmdStan documentation:

Other CmdStanModel methods: +model-method-check_syntax, +model-method-compile, +model-method-diagnose, +model-method-expose_functions, +model-method-format, +model-method-generate-quantities, +model-method-optimize, +model-method-sample_mpi, +model-method-variables, +model-method-variational

+
+ +
+

Examples

+
# \dontrun{
+library(cmdstanr)
+library(posterior)
+library(bayesplot)
+color_scheme_set("brightblue")
+
+# Set path to CmdStan
+# (Note: if you installed CmdStan via install_cmdstan() with default settings
+# then setting the path is unnecessary but the default below should still work.
+# Otherwise use the `path` argument to specify the location of your
+# CmdStan installation.)
+set_cmdstan_path(path = NULL)
+#> CmdStan path set to: /Users/jgabry/.cmdstan/cmdstan-2.32.2
+
+# Create a CmdStanModel object from a Stan program,
+# here using the example model that comes with CmdStan
+file <- file.path(cmdstan_path(), "examples/bernoulli/bernoulli.stan")
+mod <- cmdstan_model(file)
+mod$print()
+#> data {
+#>   int<lower=0> N;
+#>   array[N] int<lower=0,upper=1> y;
+#> }
+#> parameters {
+#>   real<lower=0,upper=1> theta;
+#> }
+#> model {
+#>   theta ~ beta(1,1);  // uniform prior on interval 0,1
+#>   y ~ bernoulli(theta);
+#> }
+
+# Data as a named list (like RStan)
+stan_data <- list(N = 10, y = c(0,1,0,0,0,0,0,0,0,1))
+
+# Run MCMC using the 'sample' method
+fit_mcmc <- mod$sample(
+  data = stan_data,
+  seed = 123,
+  chains = 2,
+  parallel_chains = 2
+)
+#> Running MCMC with 2 parallel chains...
+#> 
+#> Chain 1 Iteration:    1 / 2000 [  0%]  (Warmup) 
+#> Chain 1 Iteration:  100 / 2000 [  5%]  (Warmup) 
+#> Chain 1 Iteration:  200 / 2000 [ 10%]  (Warmup) 
+#> Chain 1 Iteration:  300 / 2000 [ 15%]  (Warmup) 
+#> Chain 1 Iteration:  400 / 2000 [ 20%]  (Warmup) 
+#> Chain 1 Iteration:  500 / 2000 [ 25%]  (Warmup) 
+#> Chain 1 Iteration:  600 / 2000 [ 30%]  (Warmup) 
+#> Chain 1 Iteration:  700 / 2000 [ 35%]  (Warmup) 
+#> Chain 1 Iteration:  800 / 2000 [ 40%]  (Warmup) 
+#> Chain 1 Iteration:  900 / 2000 [ 45%]  (Warmup) 
+#> Chain 1 Iteration: 1000 / 2000 [ 50%]  (Warmup) 
+#> Chain 1 Iteration: 1001 / 2000 [ 50%]  (Sampling) 
+#> Chain 1 Iteration: 1100 / 2000 [ 55%]  (Sampling) 
+#> Chain 1 Iteration: 1200 / 2000 [ 60%]  (Sampling) 
+#> Chain 1 Iteration: 1300 / 2000 [ 65%]  (Sampling) 
+#> Chain 1 Iteration: 1400 / 2000 [ 70%]  (Sampling) 
+#> Chain 1 Iteration: 1500 / 2000 [ 75%]  (Sampling) 
+#> Chain 1 Iteration: 1600 / 2000 [ 80%]  (Sampling) 
+#> Chain 1 Iteration: 1700 / 2000 [ 85%]  (Sampling) 
+#> Chain 1 Iteration: 1800 / 2000 [ 90%]  (Sampling) 
+#> Chain 1 Iteration: 1900 / 2000 [ 95%]  (Sampling) 
+#> Chain 1 Iteration: 2000 / 2000 [100%]  (Sampling) 
+#> Chain 2 Iteration:    1 / 2000 [  0%]  (Warmup) 
+#> Chain 2 Iteration:  100 / 2000 [  5%]  (Warmup) 
+#> Chain 2 Iteration:  200 / 2000 [ 10%]  (Warmup) 
+#> Chain 2 Iteration:  300 / 2000 [ 15%]  (Warmup) 
+#> Chain 2 Iteration:  400 / 2000 [ 20%]  (Warmup) 
+#> Chain 2 Iteration:  500 / 2000 [ 25%]  (Warmup) 
+#> Chain 2 Iteration:  600 / 2000 [ 30%]  (Warmup) 
+#> Chain 2 Iteration:  700 / 2000 [ 35%]  (Warmup) 
+#> Chain 2 Iteration:  800 / 2000 [ 40%]  (Warmup) 
+#> Chain 2 Iteration:  900 / 2000 [ 45%]  (Warmup) 
+#> Chain 2 Iteration: 1000 / 2000 [ 50%]  (Warmup) 
+#> Chain 2 Iteration: 1001 / 2000 [ 50%]  (Sampling) 
+#> Chain 2 Iteration: 1100 / 2000 [ 55%]  (Sampling) 
+#> Chain 2 Iteration: 1200 / 2000 [ 60%]  (Sampling) 
+#> Chain 2 Iteration: 1300 / 2000 [ 65%]  (Sampling) 
+#> Chain 2 Iteration: 1400 / 2000 [ 70%]  (Sampling) 
+#> Chain 2 Iteration: 1500 / 2000 [ 75%]  (Sampling) 
+#> Chain 2 Iteration: 1600 / 2000 [ 80%]  (Sampling) 
+#> Chain 2 Iteration: 1700 / 2000 [ 85%]  (Sampling) 
+#> Chain 2 Iteration: 1800 / 2000 [ 90%]  (Sampling) 
+#> Chain 2 Iteration: 1900 / 2000 [ 95%]  (Sampling) 
+#> Chain 2 Iteration: 2000 / 2000 [100%]  (Sampling) 
+#> Chain 1 finished in 0.0 seconds.
+#> Chain 2 finished in 0.0 seconds.
+#> 
+#> Both chains finished successfully.
+#> Mean chain execution time: 0.0 seconds.
+#> Total execution time: 0.2 seconds.
+#> 
+
+# Use 'posterior' package for summaries
+fit_mcmc$summary()
+#> # A tibble: 2 × 10
+#>   variable   mean median    sd   mad      q5    q95  rhat ess_bulk ess_tail
+#>   <chr>     <num>  <num> <num> <num>   <num>  <num> <num>    <num>    <num>
+#> 1 lp__     -7.30  -7.03  0.721 0.380 -8.82   -6.75   1.00     902.    1006.
+#> 2 theta     0.247  0.233 0.122 0.129  0.0786  0.470  1.00     762.     712.
+
+# Get posterior draws
+draws <- fit_mcmc$draws()
+print(draws)
+#> # A draws_array: 1000 iterations, 2 chains, and 2 variables
+#> , , variable = lp__
+#> 
+#>          chain
+#> iteration    1    2
+#>         1 -6.8 -6.8
+#>         2 -6.9 -6.8
+#>         3 -7.0 -7.0
+#>         4 -6.9 -7.1
+#>         5 -6.7 -7.0
+#> 
+#> , , variable = theta
+#> 
+#>          chain
+#> iteration    1    2
+#>         1 0.28 0.21
+#>         2 0.19 0.20
+#>         3 0.16 0.17
+#>         4 0.20 0.36
+#>         5 0.25 0.34
+#> 
+#> # ... with 995 more iterations
+
+# Convert to data frame using posterior::as_draws_df
+as_draws_df(draws)
+#> # A draws_df: 1000 iterations, 2 chains, and 2 variables
+#>    lp__ theta
+#> 1  -6.8  0.28
+#> 2  -6.9  0.19
+#> 3  -7.0  0.16
+#> 4  -6.9  0.20
+#> 5  -6.7  0.25
+#> 6  -7.1  0.36
+#> 7  -9.0  0.55
+#> 8  -7.2  0.15
+#> 9  -6.8  0.23
+#> 10 -7.5  0.42
+#> # ... with 1990 more draws
+#> # ... hidden reserved variables {'.chain', '.iteration', '.draw'}
+
+# Plot posterior using bayesplot (ggplot2)
+mcmc_hist(fit_mcmc$draws("theta"))
+#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
+
+
+# Call CmdStan's diagnose and stansummary utilities
+fit_mcmc$cmdstan_diagnose()
+#> Processing csv files: /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/bernoulli-202307251438-1-239737.csv, /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/bernoulli-202307251438-2-239737.csv
+#> 
+#> Checking sampler transitions treedepth.
+#> Treedepth satisfactory for all transitions.
+#> 
+#> Checking sampler transitions for divergences.
+#> No divergent transitions found.
+#> 
+#> Checking E-BFMI - sampler transitions HMC potential energy.
+#> E-BFMI satisfactory.
+#> 
+#> Effective sample size satisfactory.
+#> 
+#> Split R-hat values satisfactory all parameters.
+#> 
+#> Processing complete, no problems detected.
+fit_mcmc$cmdstan_summary()
+#> Inference for Stan model: bernoulli_model
+#> 2 chains: each with iter=(1000,1000); warmup=(0,0); thin=(1,1); 2000 iterations saved.
+#> 
+#> Warmup took (0.0040, 0.0040) seconds, 0.0080 seconds total
+#> Sampling took (0.011, 0.011) seconds, 0.022 seconds total
+#> 
+#>                 Mean     MCSE  StdDev     5%   50%   95%  N_Eff  N_Eff/s    R_hat
+#> 
+#> lp__            -7.3  2.6e-02    0.72   -8.8  -7.0  -6.8    781    35502      1.0
+#> accept_stat__   0.92  8.3e-03    0.13   0.64  0.97   1.0    235    10662  1.0e+00
+#> stepsize__      0.95  7.9e-02   0.079   0.87   1.0   1.0    1.0       46  2.0e+13
+#> treedepth__      1.4  1.1e-02    0.48    1.0   1.0   2.0   1874    85179  1.0e+00
+#> n_leapfrog__     2.5  1.4e-01     1.3    1.0   3.0   3.0     89     4050  1.0e+00
+#> divergent__     0.00      nan    0.00   0.00  0.00  0.00    nan      nan      nan
+#> energy__         7.8  3.6e-02    1.00    6.8   7.5   9.6    775    35215  1.0e+00
+#> 
+#> theta           0.25  4.3e-03    0.12  0.079  0.23  0.47    796    36197      1.0
+#> 
+#> Samples were drawn using hmc with nuts.
+#> For each parameter, N_Eff is a crude measure of effective sample size,
+#> and R_hat is the potential scale reduction factor on split chains (at 
+#> convergence, R_hat=1).
+
+# For models fit using MCMC, if you like working with RStan's stanfit objects
+# then you can create one with rstan::read_stan_csv()
+
+# stanfit <- rstan::read_stan_csv(fit_mcmc$output_files())
+
+
+# Run 'optimize' method to get a point estimate (default is Stan's LBFGS algorithm)
+# and also demonstrate specifying data as a path to a file instead of a list
+my_data_file <- file.path(cmdstan_path(), "examples/bernoulli/bernoulli.data.json")
+fit_optim <- mod$optimize(data = my_data_file, seed = 123)
+#> Initial log joint probability = -9.51104 
+#>     Iter      log prob        ||dx||      ||grad||       alpha      alpha0  # evals  Notes  
+#>        6      -5.00402   0.000103557   2.55661e-07           1           1        9    
+#> Optimization terminated normally:  
+#>   Convergence detected: relative gradient magnitude is below tolerance 
+#> Finished in  0.1 seconds.
+
+fit_optim$summary()
+#> # A tibble: 2 × 2
+#>   variable estimate
+#>   <chr>       <num>
+#> 1 lp__        -5.00
+#> 2 theta        0.2 
+
+
+# Run 'variational' method to approximate the posterior (default is meanfield ADVI)
+fit_vb <- mod$variational(data = stan_data, seed = 123)
+#> ------------------------------------------------------------ 
+#> EXPERIMENTAL ALGORITHM: 
+#>   This procedure has not been thoroughly tested and may be unstable 
+#>   or buggy. The interface is subject to change. 
+#> ------------------------------------------------------------ 
+#> Gradient evaluation took 9e-06 seconds 
+#> 1000 transitions using 10 leapfrog steps per transition would take 0.09 seconds. 
+#> Adjust your expectations accordingly! 
+#> Begin eta adaptation. 
+#> Iteration:   1 / 250 [  0%]  (Adaptation) 
+#> Iteration:  50 / 250 [ 20%]  (Adaptation) 
+#> Iteration: 100 / 250 [ 40%]  (Adaptation) 
+#> Iteration: 150 / 250 [ 60%]  (Adaptation) 
+#> Iteration: 200 / 250 [ 80%]  (Adaptation) 
+#> Success! Found best value [eta = 1] earlier than expected. 
+#> Begin stochastic gradient ascent. 
+#>   iter             ELBO   delta_ELBO_mean   delta_ELBO_med   notes  
+#>    100           -6.262             1.000            1.000 
+#>    200           -6.263             0.500            1.000 
+#>    300           -6.307             0.336            0.007   MEDIAN ELBO CONVERGED 
+#> Drawing a sample of size 1000 from the approximate posterior...  
+#> COMPLETED. 
+#> Finished in  0.1 seconds.
+
+fit_vb$summary()
+#> # A tibble: 3 × 7
+#>   variable      mean median    sd   mad     q5      q95
+#>   <chr>        <num>  <num> <num> <num>  <num>    <num>
+#> 1 lp__        -7.18  -6.94  0.588 0.259 -8.36  -6.75   
+#> 2 lp_approx__ -0.515 -0.221 0.692 0.303 -2.06  -0.00257
+#> 3 theta        0.263  0.246 0.115 0.113  0.106  0.481  
+
+# Plot approximate posterior using bayesplot
+mcmc_hist(fit_vb$draws("theta"))
+#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
+
+
+
+# Specifying initial values as a function
+fit_mcmc_w_init_fun <- mod$sample(
+  data = stan_data,
+  seed = 123,
+  chains = 2,
+  refresh = 0,
+  init = function() list(theta = runif(1))
+)
+#> Running MCMC with 2 sequential chains...
+#> 
+#> Chain 1 finished in 0.0 seconds.
+#> Chain 2 finished in 0.0 seconds.
+#> 
+#> Both chains finished successfully.
+#> Mean chain execution time: 0.0 seconds.
+#> Total execution time: 0.3 seconds.
+#> 
+fit_mcmc_w_init_fun_2 <- mod$sample(
+  data = stan_data,
+  seed = 123,
+  chains = 2,
+  refresh = 0,
+  init = function(chain_id) {
+    # silly but demonstrates optional use of chain_id
+    list(theta = 1 / (chain_id + 1))
+  }
+)
+#> Running MCMC with 2 sequential chains...
+#> 
+#> Chain 1 finished in 0.0 seconds.
+#> Chain 2 finished in 0.0 seconds.
+#> 
+#> Both chains finished successfully.
+#> Mean chain execution time: 0.0 seconds.
+#> Total execution time: 0.3 seconds.
+#> 
+fit_mcmc_w_init_fun_2$init()
+#> [[1]]
+#> [[1]]$theta
+#> [1] 0.5
+#> 
+#> 
+#> [[2]]
+#> [[2]]$theta
+#> [1] 0.3333333
+#> 
+#> 
+
+# Specifying initial values as a list of lists
+fit_mcmc_w_init_list <- mod$sample(
+  data = stan_data,
+  seed = 123,
+  chains = 2,
+  refresh = 0,
+  init = list(
+    list(theta = 0.75), # chain 1
+    list(theta = 0.25)  # chain 2
+  )
+)
+#> Running MCMC with 2 sequential chains...
+#> 
+#> Chain 1 finished in 0.0 seconds.
+#> Chain 2 finished in 0.0 seconds.
+#> 
+#> Both chains finished successfully.
+#> Mean chain execution time: 0.0 seconds.
+#> Total execution time: 0.3 seconds.
+#> 
+fit_optim_w_init_list <- mod$optimize(
+  data = stan_data,
+  seed = 123,
+  init = list(
+    list(theta = 0.75)
+  )
+)
+#> Initial log joint probability = -11.6657 
+#>     Iter      log prob        ||dx||      ||grad||       alpha      alpha0  # evals  Notes  
+#>        6      -5.00402   0.000237915   9.55309e-07           1           1        9    
+#> Optimization terminated normally:  
+#>   Convergence detected: relative gradient magnitude is below tolerance 
+#> Finished in  0.1 seconds.
+fit_optim_w_init_list$init()
+#> [[1]]
+#> [[1]]$theta
+#> [1] 0.75
+#> 
+#> 
+# }
+
+
+
+
-
- +
- - + + diff --git a/docs/reference/model-method-sample_mpi.html b/docs/reference/model-method-sample_mpi.html index 228dde82b..53d2eb1a3 100644 --- a/docs/reference/model-method-sample_mpi.html +++ b/docs/reference/model-method-sample_mpi.html @@ -1,53 +1,5 @@ - - - - - - - -Run Stan's MCMC algorithms with MPI — model-method-sample_mpi • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run Stan's MCMC algorithms with MPI — model-method-sample_mpi • cmdstanr - - + + - - -
-
- -
- -
+
-

The $sample_mpi() method of a CmdStanModel object is +

The $sample_mpi() method of a CmdStanModel object is identical to the $sample() method but with support for -MPI. The target audience for MPI are +MPI. The target audience for MPI are those with large computer clusters. For other users, the -$sample() method provides both parallelization of +$sample() method provides both parallelization of chains and threading support for within-chain parallelization.

In order to use MPI with Stan, an MPI implementation must be installed. For Unix systems the most commonly used implementations are MPICH and OpenMPI. The implementations provide an MPI C++ compiler wrapper (for example mpicxx), which is required to compile the model.

-

An example of compiling with MPI:

mpi_options = list(STAN_MPI=TRUE, CXX="mpicxx", TBB_CXX_TYPE="gcc")
-mod = cmdstan_model("model.stan", cpp_options = mpi_options)
-
- +

An example of compiling with MPI:

+

mpi_options = list(STAN_MPI=TRUE, CXX="mpicxx", TBB_CXX_TYPE="gcc")
+mod = cmdstan_model("model.stan", cpp_options = mpi_options)

The C++ options that must be supplied to the -compile call are:

    -
  • STAN_MPI: Enables the use of MPI with Stan if TRUE.

  • +compile call are:

    • STAN_MPI: Enables the use of MPI with Stan if TRUE.

    • CXX: The name of the MPI C++ compiler wrapper. Typically "mpicxx".

    • TBB_CXX_TYPE: The C++ compiler the MPI wrapper wraps. Typically "gcc" on Linux and "clang" on macOS.

    • -
    - -

    In the call to the $sample_mpi() method it is also possible to provide +

In the call to the $sample_mpi() method it is also possible to provide the name of the MPI launcher (mpi_cmd, defaulting to "mpiexec") and any other MPI launch arguments (mpi_args). In most cases, it is enough to only define the number of processes. To use n_procs processes specify mpi_args = list("n" = n_procs).

-
sample_mpi(
-  data = NULL,
-  mpi_cmd = "mpiexec",
-  mpi_args = NULL,
-  seed = NULL,
-  refresh = NULL,
-  init = NULL,
-  save_latent_dynamics = FALSE,
-  output_dir = NULL,
-  output_basename = NULL,
-  chains = 1,
-  chain_ids = seq_len(chains),
-  iter_warmup = NULL,
-  iter_sampling = NULL,
-  save_warmup = FALSE,
-  thin = NULL,
-  max_treedepth = NULL,
-  adapt_engaged = TRUE,
-  adapt_delta = NULL,
-  step_size = NULL,
-  metric = NULL,
-  metric_file = NULL,
-  inv_metric = NULL,
-  init_buffer = NULL,
-  term_buffer = NULL,
-  window = NULL,
-  fixed_param = FALSE,
-  sig_figs = NULL,
-  show_messages = TRUE,
-  diagnostics = c("divergences", "treedepth", "ebfmi"),
-  validate_csv = TRUE
-)
- -

Arguments

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
data

(multiple options) The data to use for the variables specified in -the data block of the Stan program. One of the following:

    -
  • A named list of R objects with the names corresponding to variables +

    +
    sample_mpi(
    +  data = NULL,
    +  mpi_cmd = "mpiexec",
    +  mpi_args = NULL,
    +  seed = NULL,
    +  refresh = NULL,
    +  init = NULL,
    +  save_latent_dynamics = FALSE,
    +  output_dir = NULL,
    +  output_basename = NULL,
    +  chains = 1,
    +  chain_ids = seq_len(chains),
    +  iter_warmup = NULL,
    +  iter_sampling = NULL,
    +  save_warmup = FALSE,
    +  thin = NULL,
    +  max_treedepth = NULL,
    +  adapt_engaged = TRUE,
    +  adapt_delta = NULL,
    +  step_size = NULL,
    +  metric = NULL,
    +  metric_file = NULL,
    +  inv_metric = NULL,
    +  init_buffer = NULL,
    +  term_buffer = NULL,
    +  window = NULL,
    +  fixed_param = FALSE,
    +  sig_figs = NULL,
    +  show_messages = TRUE,
    +  show_exceptions = TRUE,
    +  diagnostics = c("divergences", "treedepth", "ebfmi"),
    +  validate_csv = TRUE
    +)
    +
    + +
    +

    Arguments

    +
    data
    +

    (multiple options) The data to use for the variables specified in +the data block of the Stan program. One of the following:

    • A named list of R objects with the names corresponding to variables declared in the data block of the Stan program. Internally this list is then -written to JSON for CmdStan using write_stan_json(). See -write_stan_json() for details on the conversions performed on R objects +written to JSON for CmdStan using write_stan_json(). See +write_stan_json() for details on the conversions performed on R objects before they are passed to Stan.

    • A path to a data file compatible with CmdStan (JSON or R dump). See the appendices in the CmdStan guide for details on using these formats.

    • NULL or an empty list if the Stan program has no data block.

    • -
mpi_cmd

(string) The MPI launcher used for launching MPI -processes. The default launcher is "mpiexec".

mpi_args

(list) A list of arguments to use when launching MPI + + + +

mpi_cmd
+

(string) The MPI launcher used for launching MPI +processes. The default launcher is "mpiexec".

+ + +
mpi_args
+

(list) A list of arguments to use when launching MPI processes. For example, mpi_args = list("n" = 4) launches the executable as mpiexec -n 4 model_executable, followed by CmdStan arguments for the -model executable.

seed

(positive integer(s)) A seed for the (P)RNG to pass to CmdStan. +model executable.

+ + +
seed
+

(positive integer(s)) A seed for the (P)RNG to pass to CmdStan. In the case of multi-chain sampling the single seed will automatically be augmented by the the run (chain) ID so that each chain uses a different seed. The exception is the transformed data block, which defaults to @@ -303,25 +227,24 @@

Arg chains if RNG functions are used. The only time seed should be specified as a vector (one element per chain) is if RNG functions are used in transformed data and the goal is to generate different data for each -chain.

refresh

(non-negative integer) The number of iterations between +chain.

+ + +
refresh
+

(non-negative integer) The number of iterations between printed screen updates. If refresh = 0, only error messages will be -printed.

init

(multiple options) The initialization method to use for the +printed.

+ + +
init
+

(multiple options) The initialization method to use for the variables declared in the parameters block of the Stan program. One of -the following:

    -
  • A real number x>0. This initializes all parameters randomly between +the following:

    • A real number x>0. This initializes all parameters randomly between [-x,x] on the unconstrained parameter space.;

    • The number 0. This initializes all parameters to 0;

    • A character vector of paths (one per chain) to JSON or Rdump files containing initial values for all or some parameters. See -write_stan_json() to write R objects to JSON files compatible with +write_stan_json() to write R objects to JSON files compatible with CmdStan.

    • A list of lists containing initial values for all or some parameters. For MCMC the list should contain a sublist for each chain. For optimization and @@ -334,258 +257,264 @@

      Arg has argument chain_id it will be supplied with the chain id (from 1 to number of chains) when called to generate the initial values. See Examples.

    • -
save_latent_dynamics

(logical) Should auxiliary diagnostic information + + + +

save_latent_dynamics
+

(logical) Should auxiliary diagnostic information about the latent dynamics be written to temporary diagnostic CSV files? This argument replaces CmdStan's diagnostic_file argument and the content written to CSV is controlled by the user's CmdStan installation and not CmdStanR (for some algorithms no content may be written). The default is FALSE, which is appropriate for almost every use case. To save the temporary files created when save_latent_dynamics=TRUE see the -$save_latent_dynamics_files() -method.

output_dir

(string) A path to a directory where CmdStan should write +$save_latent_dynamics_files() +method.

+ + +
output_dir
+

(string) A path to a directory where CmdStan should write its output CSV files. For interactive use this can typically be left at NULL (temporary directory) since CmdStanR makes the CmdStan output (posterior draws and diagnostics) available in R via methods of the fitted -model objects. The behavior of output_dir is as follows:

    -
  • If NULL (the default), then the CSV files are written to a temporary +model objects. The behavior of output_dir is as follows:

    • If NULL (the default), then the CSV files are written to a temporary directory and only saved permanently if the user calls one of the $save_* methods of the fitted model object (e.g., -$save_output_files()). These temporary +$save_output_files()). These temporary files are removed when the fitted model object is -garbage collected (manually or automatically).

    • +garbage collected (manually or automatically).

    • If a path, then the files are created in output_dir with names corresponding to the defaults used by $save_output_files().

    • -
output_basename

(string) A string to use as a prefix for the names of + + + +

output_basename
+

(string) A string to use as a prefix for the names of the output CSV files of CmdStan. If NULL (the default), the basename of the output CSV files will be comprised from the model name, timestamp, and -5 random characters.

chains

(positive integer) The number of Markov chains to run. The -default is 4.

chain_ids

(integer vector) A vector of chain IDs. Must contain as many +5 random characters.

+ + +
chains
+

(positive integer) The number of Markov chains to run. The +default is 4.

+ + +
chain_ids
+

(integer vector) A vector of chain IDs. Must contain as many unique positive integers as the number of chains. If not set, the default -chain IDs are used (integers starting from 1).

iter_warmup

(positive integer) The number of warmup iterations to run +chain IDs are used (integers starting from 1).

+ + +
iter_warmup
+

(positive integer) The number of warmup iterations to run per chain. Note: in the CmdStan User's Guide this is referred to as -num_warmup.

iter_sampling

(positive integer) The number of post-warmup iterations +num_warmup.

+ + +
iter_sampling
+

(positive integer) The number of post-warmup iterations to run per chain. Note: in the CmdStan User's Guide this is referred to as -num_samples.

save_warmup

(logical) Should warmup iterations be saved? The default -is FALSE.

thin

(positive integer) The period between saved samples. This should -typically be left at its default (no thinning) unless memory is a problem.

max_treedepth

(positive integer) The maximum allowed tree depth for +num_samples.

+ + +
save_warmup
+

(logical) Should warmup iterations be saved? The default +is FALSE.

+ + +
thin
+

(positive integer) The period between saved samples. This should +typically be left at its default (no thinning) unless memory is a problem.

+ + +
max_treedepth
+

(positive integer) The maximum allowed tree depth for the NUTS engine. See the Tree Depth section of the CmdStan User's Guide -for more details.

adapt_engaged

(logical) Do warmup adaptation? The default is TRUE. +for more details.

+ + +
adapt_engaged
+

(logical) Do warmup adaptation? The default is TRUE. If a precomputed inverse metric is specified via the inv_metric argument (or metric_file) then, if adapt_engaged=TRUE, Stan will use the provided inverse metric just as an initial guess during adaptation. To turn off adaptation when using a precomputed inverse metric set -adapt_engaged=FALSE.

adapt_delta

(real in (0,1)) The adaptation target acceptance -statistic.

step_size

(positive real) The initial step size for the discrete +adapt_engaged=FALSE.

+ + +
adapt_delta
+

(real in (0,1)) The adaptation target acceptance +statistic.

+ + +
step_size
+

(positive real) The initial step size for the discrete approximation to continuous Hamiltonian dynamics. This is further tuned -during warmup.

metric

(string) One of "diag_e", "dense_e", or "unit_e", +during warmup.

+ + +
metric
+

(string) One of "diag_e", "dense_e", or "unit_e", specifying the geometry of the base manifold. See the Euclidean Metric section of the CmdStan User's Guide for more details. To specify a -precomputed (inverse) metric, see the inv_metric argument below.

metric_file

(character vector) The paths to JSON or +precomputed (inverse) metric, see the inv_metric argument below.

+ + +
metric_file
+

(character vector) The paths to JSON or Rdump files (one per chain) compatible with CmdStan that contain precomputed inverse metrics. The metric_file argument is inherited from CmdStan but is confusing in that the entry in JSON or Rdump file(s) must be named inv_metric, referring to the inverse metric. We recommend instead using CmdStanR's inv_metric argument (see below) to specify an inverse -metric directly using a vector or matrix from your R session.

inv_metric

(vector, matrix) A vector (if metric='diag_e') or a +metric directly using a vector or matrix from your R session.

+ + +
inv_metric
+

(vector, matrix) A vector (if metric='diag_e') or a matrix (if metric='dense_e') for initializing the inverse metric. This can be used as an alternative to the metric_file argument. A vector is interpreted as a diagonal metric. The inverse metric is usually set to an estimate of the posterior covariance. See the adapt_engaged argument above for details about (and control over) how specifying a precomputed -inverse metric interacts with adaptation.

init_buffer

(nonnegative integer) Width of initial fast timestep -adaptation interval during warmup.

term_buffer

(nonnegative integer) Width of final fast timestep -adaptation interval during warmup.

window

(nonnegative integer) Initial width of slow timestep/metric -adaptation interval.

fixed_param

(logical) When TRUE, call CmdStan with argument +inverse metric interacts with adaptation.

+ + +
init_buffer
+

(nonnegative integer) Width of initial fast timestep +adaptation interval during warmup.

+ + +
term_buffer
+

(nonnegative integer) Width of final fast timestep +adaptation interval during warmup.

+ + +
window
+

(nonnegative integer) Initial width of slow timestep/metric +adaptation interval.

+ + +
fixed_param
+

(logical) When TRUE, call CmdStan with argument "algorithm=fixed_param". The default is FALSE. The fixed parameter sampler generates a new sample without changing the current state of the Markov chain; only generated quantities may change. This can be useful when, for example, trying to generate pseudo-data using the generated quantities block. If the parameters block is empty then using fixed_param=TRUE is mandatory. When fixed_param=TRUE the chains and -parallel_chains arguments will be set to 1.

sig_figs

(positive integer) The number of significant figures used +parallel_chains arguments will be set to 1.

+ + +
sig_figs
+

(positive integer) The number of significant figures used when storing the output values. By default, CmdStan represent the output values with 6 significant figures. The upper limit for sig_figs is 18. Increasing this value will result in larger output CSV files and thus an -increased usage of disk space.

show_messages

(logical) When TRUE (the default), prints all +increased usage of disk space.

+ + +
show_messages
+

(logical) When TRUE (the default), prints all +output during the sampling process, such as iteration numbers and elapsed times. +If the output is silenced then the $output() method of +the resulting fit object can be used to display the silenced messages.

+ + +
show_exceptions
+

(logical) When TRUE (the default), prints all informational messages, for example rejection of the current proposal. Disable if you wish to silence these messages, but this is not usually recommended unless you are very confident that the model is correct up to numerical error. If the messages are silenced then the -$output() method of the resulting fit object can be -used to display the silenced messages.

diagnostics

(character vector) The diagnostics to automatically check +$output() method of the resulting fit object can be +used to display the silenced messages.

+ + +
diagnostics
+

(character vector) The diagnostics to automatically check and warn about after sampling. Setting this to an empty string "" or NULL can be used to prevent CmdStanR from automatically reading in the sampler diagnostics from CSV if you wish to manually read in the results -and validate them yourself, for example using read_cmdstan_csv(). The +and validate them yourself, for example using read_cmdstan_csv(). The currently available diagnostics are "divergences", "treedepth", and "ebfmi" (the default is to check all of them).

These diagnostics are also available after fitting. The -$sampler_diagnostics() method provides +$sampler_diagnostics() method provides access the diagnostic values for each iteration and the -$diagnostic_summary() method provides +$diagnostic_summary() method provides summaries of the diagnostics and can regenerate the warning messages.

Diagnostics like R-hat and effective sample size are not currently available via the diagnostics argument but can be checked after fitting -using the $summary() method.

validate_csv

Deprecated and will be removed in a future release.

+using the $summary() method.

-

Value

-

A CmdStanMCMC object.

-

See also

+
validate_csv
+

Deprecated. Use diagnostics instead.

-

The CmdStanR website -(mc-stan.org/cmdstanr) for online -documentation and tutorials.

-

The Stan and CmdStan documentation:

+
+
+

Value

+ -

The Stan Math Library's MPI documentation -(mc-stan.org/math/mpi) for more +

A CmdStanMCMC object.

+
+
+

See also

+

The CmdStanR website +(mc-stan.org/cmdstanr) for online +documentation and tutorials.

+

The Stan and CmdStan documentation:

The Stan Math Library's MPI documentation +(mc-stan.org/math/mpi) for more details on MPI support in Stan.

Other CmdStanModel methods: -model-method-check_syntax, -model-method-compile, -model-method-diagnose, -model-method-format, -model-method-generate-quantities, -model-method-optimize, -model-method-sample, -model-method-variables, -model-method-variational

- -

Examples

-
# \dontrun{ -# mpi_options <- list(STAN_MPI=TRUE, CXX="mpicxx", TBB_CXX_TYPE="gcc") -# mod <- cmdstan_model("model.stan", cpp_options = mpi_options) -# fit <- mod$sample_mpi(..., mpi_args = list("n" = 4)) -# } - -
+model-method-check_syntax, +model-method-compile, +model-method-diagnose, +model-method-expose_functions, +model-method-format, +model-method-generate-quantities, +model-method-optimize, +model-method-sample, +model-method-variables, +model-method-variational

+
+ +
+

Examples

+
# \dontrun{
+# mpi_options <- list(STAN_MPI=TRUE, CXX="mpicxx", TBB_CXX_TYPE="gcc")
+# mod <- cmdstan_model("model.stan", cpp_options = mpi_options)
+# fit <- mod$sample_mpi(..., mpi_args = list("n" = 4))
+# }
+
+
+
+
+
-
- +
- - + + diff --git a/docs/reference/model-method-variables.html b/docs/reference/model-method-variables.html index bf4a9d265..f26828ae3 100644 --- a/docs/reference/model-method-variables.html +++ b/docs/reference/model-method-variables.html @@ -1,82 +1,19 @@ - - - - - - - -Input and output variables of a Stan program — model-method-variables • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Input and output variables of a Stan program — model-method-variables • cmdstanr - - - - - - - - - - + + - - - - -
-
- -
- -
+
-

The $variables() method of a CmdStanModel object returns +

The $variables() method of a CmdStanModel object returns a list, each element representing a Stan model block: data, parameters, transformed_parameters and generated_quantities.

Each element contains a list of variables, with each variables represented @@ -193,99 +121,104 @@

Input and output variables of a Stan program

part of the model's input or output.

-
variables()
- +
+
variables()
+
-

Value

+
+

Value

+ -

The $variables() returns a list with information on input and +

The $variables() returns a list with information on input and output variables for each of the Stan model blocks.

-

See also

- - - -

Examples

-
# \dontrun{ -file <- file.path(cmdstan_path(), "examples/bernoulli/bernoulli.stan") - -# create a `CmdStanModel` object, compiling the model is not required -mod <- cmdstan_model(file, compile = FALSE) - -mod$variables() -
#> $parameters -#> $parameters$theta -#> $parameters$theta$type -#> [1] "real" -#> -#> $parameters$theta$dimensions -#> [1] 0 -#> -#> -#> -#> $included_files -#> list() -#> -#> $data -#> $data$N -#> $data$N$type -#> [1] "int" -#> -#> $data$N$dimensions -#> [1] 0 -#> -#> -#> $data$y -#> $data$y$type -#> [1] "int" -#> -#> $data$y$dimensions -#> [1] 1 -#> -#> -#> -#> $transformed_parameters -#> named list() -#> -#> $generated_quantities -#> named list() -#>
-# } +
+ -
+
+

Examples

+
# \dontrun{
+file <- file.path(cmdstan_path(), "examples/bernoulli/bernoulli.stan")
+
+# create a `CmdStanModel` object, compiling the model is not required
+mod <- cmdstan_model(file, compile = FALSE)
+
+mod$variables()
+#> $parameters
+#> $parameters$theta
+#> $parameters$theta$type
+#> [1] "real"
+#> 
+#> $parameters$theta$dimensions
+#> [1] 0
+#> 
+#> 
+#> 
+#> $included_files
+#> list()
+#> 
+#> $data
+#> $data$N
+#> $data$N$type
+#> [1] "int"
+#> 
+#> $data$N$dimensions
+#> [1] 0
+#> 
+#> 
+#> $data$y
+#> $data$y$type
+#> [1] "int"
+#> 
+#> $data$y$dimensions
+#> [1] 1
+#> 
+#> 
+#> 
+#> $transformed_parameters
+#> named list()
+#> 
+#> $generated_quantities
+#> named list()
+#> 
+
+# }
+
+
+
+
-
- +
- - + + diff --git a/docs/reference/model-method-variational-1.png b/docs/reference/model-method-variational-1.png index d7b8b97f8c19824bd7f4936ec52513cc8fae745f..27fd88217456b4a7d0da11a09599ea685749e06d 100644 GIT binary patch literal 15795 zcmeHu2UJtp+IGN#j)ie-BOr{@Y!pF2YOo9#5KyYrpfn{ykPaaPE90P|AR=8wL;|73 z&;kTSsRDx#Is~Ky2oPElNJ#ki!I^c}x7NRIzw5jATQ`fW6HZRq=Pl3sJn!DQf5Fsn z+jnB$!CKDfQHN+A?_Ee23`BFc8_N~X-M8I^%$xx$Wtq&!(VF}v-MIJmm5mR%TrqH zBa!fLZ0GfZTs=H8Pj46R)9)=h4&OU?izRd|@y(4K*+Lg!J@u?$U7d-cUhnYx-mvN!BbtBUKM; zhncpex%fmTzR9YMma?HP9}LFfDD?Zz$9sEw)zVrBqQ4Z7$@b~3Z_9GU7sVtLd%L>c z7I{ItL43s4zsBRYZ{Hqv^3)v?iDZXF7VB*)C@7elJn84C*b3Pn_Pysdk6Gc_!2J>$ zERv`<`x;H!Sku@m6I^g)(%{TWBrY?Qy>|oGV-(OIw zKc0&x*x)!xl%dZFOTKAC;4+n^!+)E?2YAS`)nW^~wQ^}0DcSg)@o*}#O_LJ6{q zmg`SS`y8hzVDOtc@~r9GH}Z((&B2x|4VpHA+QAVAcfY(d_@xwZ8=VhYFUI1at$+?PG(Tf{q1lM%p|dV4!o?dZ!mQ{f#?iC?)nJtwHH8 zQrO_|ovPj*g84alDI3C8&iVl^U&?xasgp7orO?J?i-<^96-jo}doeGLDPb$0*Uy2* zpZ{XWY4!)`Q$*)qK$Sm0$+8!mS;d;(|8SB4mk>nH1zFQs#58RNW-GV~2DQZ8Dik5L zz(6|Ytu8fDD{C*+;Z`$5QK%l4E*N`Nh0Lt5{)<>!i)d?nWqun+#zy;OZs_WZN!J0( zI0*3aw*nZvBW6SOuY%Xh=YEEU>F-?#VgKI@g?|kC??lo+PG5Uw%q~jA92tK%Sv%*!G0ai>eORRSV z^HeVTp=jei2=_OY!)9&e(gD`sjMTBBU{BRgCG}!p`wv%uKgRtJKK4I&`kK`?m*q~9 z&1zY392>6Ws1Xe}rm78|F!<_vr-%*7&Dr6@y=~lwXfvMVD5*n&3KDMc)DvOYp2bo_ zV6#QtPt?lg^h$ZiDg){__d1`Ne(R|S_0Yd6^6(_`21hS~0_l2z~eh4W*6{)E3>+l2p1y4JmF{FK1&GODcEhDF)Y z@+Y@%-%d>a%#$2eZ7RbPyR}(+)w3l<8F%{ObTY;&QppsBX4=xymGz-&DfST0DC?oo zm>7vmb$~d4N^F*vG#zqU^W@35%VEz^;w9Gu0!Y?2HU!brIRrxgl1w|G zY28z`rg!%}Xw1|Ja?}8pZyQ@!{=myYiVNR!R!^c{SO2VWiWnbRA84tzpCTy5im6#q zw_&iKl)DViwFabcuAD7h8Sqq3+FX9Nq|0nSiV4@S1;z5Or=b7MwZEIa|1X)&iv}Fb zvEas@~!R=$z~g4FOAmo(Yd znHg`IbQS4jhx%KLBf7?K6e?nDTYf%s@0FZT*^wDHTl>?=K7DFPc5n!smw ze@?tBr6Gwcl-oBCqz5?|K34JLVT1IGYE8>bGoW<8LQ0oO0oeIFw)YefQc_ZYAO(0{ zU0t0jf3P*I(%$rz2)CW33qw=8Cv2yu_b=*hT=(w(qiRq<`YQ< zXFHwS%#&OPi-1AdAo`)z)?#%WKHXloAtvPUV#?kJkcbHsLSe(;qFPZ{u7x zrCU*Ww-G5#NtK4BU!sUZ&0q`~P(R5BwaOy5ajALN*T$uD61s13;0bNGHan9>5ZktR zwma6AD#d@xJPZ)c8**}ALfj2%@Qa(p6Wml_g_+cU5j6FH^o0$w%5ptdOR`qyD&nBQ zYjA1+9|Puvs*ZCF<`Cbuvbb?d2>K^I6t?GUui z&O%@+1O&Q&mCdOiONjub7eAOwfXn@-)$6|zZ~xBRgj!i~adCf;-8{qe))yXbC5dnF zWtEx0^GR)zhhy{Ym~Ax^&56Ga!5mDy!yXLpDk0G&tgupcJB z2s5v%+jqP{PtPB2aqQd{YJJc6k`V0KONMu)0V!AZ=gxqEs2!v8visbL301~-qWJ9v zY=Iy502E64P@8Ux2Gxq%3BStdp2&yeP9|89hBe@j%7;DsdC<*AKx@0fpT`YMU><0A zCgNKN9No1huV_M5=$oM@y#q)3NE*CeuTl+^vG>hZ$P)5vdsGG*TI~Xk2OKL z^iQ9lSrb_>+p_p*3cmu8=T~0;j=(JqGDGz(>TZTr%|q3xiWC;+D_A;8A@wtV+OqV8 zhO@)bl~MuIgjId{c7Q|jd!8zjtyP0cY0j>kOULic#F`1i@*SX};3M58L`nLwi3dva z;Iz*_VeUe4`2_p?-q{{yI-f1jx$y;BYLAa)n3 zV^Jn;?N|K=ipaUy%VD5N;-H?UF-in=eda@$US9X-ykE98ec~NwemZv?bUm&$<8YpJ z73&nq<4ATl4}I-s5E_k!`bb4yC@^1w$D5j(PR`Ee)9;r|O|%u^0|8lbo*nrvLIcB| z0*pKb*eR{Bpx~lcZ-+n-PD`&kT?C4ON`j>o_5J&sqVm7w7Zq7E7>wKA{$W>KT!yJP z#>$fAHbdV2Tj$ySi$;G!BS;T}_P^V5jiDETIxbTO&ffh=yWXS&a@jvUL;p%z<;jzbC}sftPUBs+U&w`KjpQSTD-EF`MQjpg zu3L~2IFrKp+0hW02d|QKV5i>+l&4BAx4ssddCaV}VoEK3EBag0s(3IpD=?MATxqra z*4NhG_}`w}Up?jh=Tq_c$5t#@6krIg1^8PCQq?M&DY!k7%i!IF2QfLa2R1)m@`^aP zX@l3PhXq^ZEk{TCOD+V8GLsqB8EO8O*x@Yh@S_C3Dz za$nAO$U87|apm=tT|ewtScoy6VS96UwKqH-JCw+fi+QCO9d~cv(ta$BK}>6@WG;lv zU}$I%HZNYR2eA)c8)UyB>!CwJ0OJA0JVnwVgKfkF{@KWT z<*AU<34I0V~6V81Zzw9`CEQ|hri5xAL##X=Ae+5mzN7IzH#(fE@>c;76`_k z^}3=$w{3j>5yJ8a-;-6zX0zKpNpjZfcB&={nPm25*99^?*jClT1KmXX;2*O3{r&xS zz3B)YpESB+WgBt$RM7US*N5w*Que93yNWpuw91I=_rE|ij=-v<_~sqVwq)a;{C00c zd6EX&+p_m7wQqw{CsC#+ff_vaD*XAv-?_RQ2x!|iRCrc;p;v7k|<*N6AowEYkKmsL%v1lu@ zF`{NCMEoyYO((vT)Ra%??rt|{PbQeu=MH_zrtN^SZ$jRVIQ){RFyTFv-4|o!1G@^t z0onv!-x)y@uHfto!fQJsZvF60MeKSCo%LtqZ}VCs^S_sXa`9hj3r}<))bi0sb!l2Q z3@a67TB8DGF`aD}8}BdNGxrQU08`Lk^P&u*awRr3Z0N~=d;IYO#c2hywaxoI1NXs9 z)^ZdUBcpv3;bHGPb)YHNHB37)CLk#$yjxNKhc!gWPx3ts0_5EbJFmbEFv6#UD9Hb? z4b%_JdME(fFJ{XsO&y}&WbJQKbaP-77psxi!`M&O;zaI!)rG=IoHh}>lN=kI0+w== z^j~iJ7SvB;O8e_?*)}P-BU(293r7U_ocfH^fj#gc0_S=j}aoskeK}=vb22)TC4_(2%WpUcGdrw zM0(41UrY4-yzs&TUGhDn*m<)1^`ja5jP)6LdD2wRfYZ_1HwG?*_Mo=qT%XLA4O#hA z-`mN{eme4SA@U2=9jCgyR-*JTZ`~Tbf}yTcO|pESvzfN=Rf9zbZ;kwCSIg(cDwB|Vlb`1NfEcQ zw#svK+Tt*&6P|&GF#(^Ghx+DHo0=4FBYgTN_m#46Wl4@TcUI_{NxtWbH6-P}q4EU} zl1${H+^UBG@#sF6fOv2W{VE?n3q{vI>_GEyBsQ8qa_X=G!A9jm^E7Ef@= zMCU6useSYbaDBzG&b{H`HbUDU_ayq=yTbRvQ%uh&Ci7uUe$8XrdA&A6kBUV) z_0X{E5cW~q5B#Vr7i1k%xkpzn_DLt_0=PrNxWIczOvFhmb1LuM%<+T=<&`4#VK`B% zSi7h+mj_N~rgCI5_DDXtWXwRGu|y%%2#zkR#+~15ix@baA>>fOJ$+(|d^;A4z3(kd zRn<|nHyU!&t*uPv8;#H%iyU?GQ{;qM;cVojuJr{)*=U@MW=Upu-1%IijF?A{_(|~e%R=aNiG(EctP^|mJ3UF3 z*{qN)S9#8bFY^>l)XtOCRgMsf@6zoN2C0n+DNVUon1PltsgLSY=&u25Nqf{i)Km9M z{lK0yFY+cH8K*okA)zUcwmL(7vXf{XiY+ER-1?-KU!w3qFmU|&=c{vKk$7ojzk+}} zlPyEE8-Lyxi-gM=w(OV;2)`hjzSl8DL2uIEP&T3aE04UXcBJZpxnlI^-jh4hv0gD- zMa`Obhbl-*yLh}?^0U3eukbrGaTPTkqMS{7Vy4x;kX*O}JIxkeJf(d^8b|K610LEc zud5LL=y*4e?4X#r_+@tXKAY53;@&59oBEpgDM~`ZdwSu8>+70FMIB}C61v`o(cLd6 z>%>I~eIl~;r~2zrcELA37-U&z6ZXz}_q@v*XzDNl%Miyt@3U3$ad!R*i&aQ%_+Y$U zZ)tFY&Z}p5hJrtOswIVf_lCRAKZ;0&`816B zdXntaz5BYRe4S6bHzy~6rKWU|T{Yma+FS7^N$R9_@%PH9;I+tRYrzlwlA!AGhD^p# zBzwOyzb!mePQCYF&}94dD}x4@nNqs%Xq=54VvmB|(=Cc6FY0%{|M(zW=51W2{>_V^ zqr99=;bzO!?=X~j5{;d5G0EK|XMi+rb-3|qcXy$iaT%GsP}+jc?H;YVGmbi(h{~%_ zH`8TV#*E;za~r0*+pe?Zze6DHj{&;Ot9WBu?N05cX-dnT$uO^cBU6xwnM?ON3y*oqMdM{1(u$D4M=-j0f;BQaCgEFQrHOAaBUao5mkm!3Jc z6v5uagmR+c{0TF^iH!J}f(n`CaYJ}wteIX2g|Xq#D}%HsHj6cSYl~uCRh53T9&aic zCs-CSSJXd1CFc<=kCaXoHWmg>_vj9U58d56_CU3{iy129WHPjF0APn`*x}8i96Svo5Eve0V?eT+B)>ZpBbqW6O(-6I_SIu_SbJ4+#aGpk=fD zf&^;@gQ@rXZQL+ZfdtM)6G9E^j*#XcA7(3<;zH?{W?B9jr}xDPsMo8lrJp%<(N>yt2k6_-!DnJd>gCgt-$5=jSd2D<^ZjF71uMZ#bz z{cPj*4mltRH21fU!rfZJCu|U(oY`I)6)YYx1yH! zAh1WNeD=d@(gx+Y6R&V9eRRFz&RzH1I|nl^WNmMA6AG zpQwu3aOkbUA}RgUYeWlaIvq@t476>MNrsWbBUj2r<9 zo>ufczEnla!O_~I_Vwu=%$9aqZ`Wgt9NM)?&ptx1ULfH zhEwumi&FSp)LNxEe$7khyzIkCDHO@hI_J_8aqp4?i1`6dr3MK0-r>n=n1y2nuP2Q^ z<*^U6KR_K>0AF(4imkG#GWDI6Y*N^;IPF|a-;LV+WAqJg%7J~zxSs3fBxzI4(WiZ( z3<6Y91W&grAGj+iNo{R?vSG^}nSD6nMMKFD8H6wR;fI->JSjR750u_@^E}cUJ3LA3VvG96WfFm1mwEkrKqBR>C6Y&Kh;w9QK_Oo} zh)Rd*f7paEa&3qrlEHw5VKwJI?)2kMWO}r|`Wds;)sQa6V})UGJ;KkoPf|N)Dm~}2 zn|N29&N-K5(L)qq7;9!Fdpte5`Ju+Z^W8_SU4e<0ms@bDAbv(($C@^PimeK!ZtkIX zDp#1?-|?;6+4kgq@fwHtmp7;)o)rT2?;jZWhDcNe-tY|6gu#CM(v#!}?!QuIl<{Q> z{5;~t_YXij)cFf`Of?O1qtilSClG))cE2$Qhjwf<<6EKsy8md#-mcG7@<_b9!K`#E}w?HPxPe z2l9Xx(%r(OtP1*YtNi5^Iy@~Btjz|i;_`y0?rjsFZw{(dMRnvr2UYTB`mmh-HRY_XMt!D7cI zv-3NnaaKW67j`wiQLruZbFwwm!Q3AWz8UiFP$W;{`o#f24a4ql-<#M_6&x*@s!Ek27 zsY`&3V2<_i$rK*>de6IS*Dn_VN(u3_b1`A8Y-H1PG0iE`Llg#cLI7o5^;&#?liiUx zb|}S@lnAAQ)N-96M53M=WdPkU_9{xTArihaB(rY|CMXExnMZGtm*!M{^*s2g6qGC1 z&}cJI>mZN=V5FLv8tNG{0@&U;l3hPtEU#=5FC%?m5fo?DpqV~!(Rang^tb7c8Ylt= zW$eyQQ!p$5(a-DJfa7@Q!I1PDwOH*IkaKkh*dn-D5k$;>?Lb#>TNgNz=x$=2>yRK* zI#(mE>QeK-MyJR@kK%n%YmFO?e9mwNmb6cC7$6nUy&P;SvM6%9RM}yP-Mu++`lhK&YOvOT9qatWCjK zG(dL9u_ekG$167dy8Ecuymt8PZK(%$$vCzL?itW^fzjy?gVMBs!^GZ0RycncjpOyk z%7ARYP#stt^0i6%E<30ibD`pL53uT~YeB#?3(he;^FUUwQOy(jf;eEVq z+qRAVc1F|$08r)1s1noSAyg+~MjoQWTmThhFO>`pU5)~)gn#pat{~U{GEy?p)%6ZT zpy;EX8dSk>On~FUV@Bp1m83Y~5K#iM_&JDY)#j5fX`VXZNn>QPZStB22L~m4k(FT~ zTpo{u5(iT56=d`CWkHn-DK0dnOZh(mbsCUl{xUsXnzk~g5i6rX3-i-k84{(_;j1A) z145ende>vhQWT{Q1a+(oa=F1q1tcsMKL;h5O5uxMAoJdrgK$H{ynp{*hdZ8bTjqaF z4@fDHR+@+yz@(eQz->?5fdUc1DeJ6IEbjAN<6<%hk{toXlTYzCpCL0Vp$v>du3QNp z)(DpdwG8}i*>kK86xw*-(qtU37}p3OlU-U91aw6yxMl2v^&f$pH3Ndf#>QpP22Kqlhy)q9aAu03s+TBE8I5Lsbxwjs;PWUIL*6b=6S>G%)l~R73&+ zDFGn_a2Uae1T`dpkOU3I5FipwkPwplo;dfP-#&Zq&W^kH?%v;dFt5*f&-=dL`uUb~ zt{-tYr1kekP$B|R>xBaR5PZ!sG zyY$Y;fz7#*dk$-_(NNH;x%Fzv^+l~`G)^7evOi`2zU2Mi9X+~v+qQ4F-r^Wvjj?ZL zF`rY1;#NO7@xzVyvka0!B9+hTDK&BKmNdPLA0HYoTO_CJ3;t}jMy0YzRrqA}#Dr3O zM})*pzIlGJPZ{Td*>U>Xlm_{Y3fuvng8YBxxh+CyI6vjID+XQJS)ES^iQdQi3ZBwl z;(a2br^TsfwK8v>fHJ>XJu!;HOYaF+gUO_Ii}Wu16sU|BHF#8Ii$pklN%;nNN6YmW zmG}NSO2#`*5xsX!;YcpT05Z(y=44w27$E4!ubSm!@e*%%Oggei4<4<{(ELf(ezmju;_-;a+5|Yx|kM2UQFK?P>*fM9``G@z$ ze^M!LiQ#x~j?;FPZsg5}V90R|!c}04>_5Fzg>%HGth(hDShrI}Jz@CP#m>;s zNQnwwDk>$STBJpIDPFkZKc5eaYMm%cCb-%~?CKvtOKs@Wc5Jq4C!Ws=mP^(_3v60V zb`kyxh^L7U&;z6)`5lj5xK4#Mc+b4-s20Kkj4|Hnwit~6y+D7{#{*y((D2Klm>>zg zc*2RNTFSlJG~b@p#IIukF+5BK`ddNl>q8}m_oAP0MJPNTA7~Da@ZAA4yk_#5H@()e z9@xNg^<%2K9#!Dz6Fy+?B_6u?Xn)CIGwQV!1hq8^{N;N8yY>GC%tzmd^NFU1;pMn? z1}c^ULfftb=CWTz2}dg@x(F!v&N^V8n(<@dbmB^&iuqY}B5c0afz-dzO#dL6|J>z5 z!gA=I@rmO>AubC;4V~4(Ozmr3`1WEUjJ3n*z>3Z9(T@;S@H?mKy?0Of)^j(431g*2 zdTpH#*{%uGHoy{DkG!JBAO5!F?W!;1?f+akd|{~iUq$>eHX7KkZ4cR;wLy$72GIC2 zN~jk??kD%bz^ShesD1b{wMm>3{GjzbnR8Niy)e*4m?n3J4_g2#AEU4A!>{+^eWyO< z>mpQV4FbTnyaeF;hzn`Z#lt`m26|`D8aN#P?RfsbN=Uyq82w))Ud&hwB?+VW4+A#f z3tA0R2@Q5`DK1@dut++z6&T9+*$VvViKw7fA@)4qY7GeFNuEGbp_S3~_+al~@~PK? zPM76f3>{!6YAFVPCD8v%$`%M`^MEtP#IicBssMNq!i!GZ$NL8Mi2RiomDToPsuCmU zbT$!=sZiV5Z)4u9iWk|qSkV?cs;Rh;V@u@#3Q;e&t@Iy$6-*b|E#@y&%0oIt?XpW> z2X6(He)I1nv@ety{!1Fnza#JRPy@v~wY(P_C%!Kd-k=G+=y^W8CWaZviLF3pmDIiK z_*9Tfg7_3~3vF8E7}KZTTLH5E8lFn2p}Be$h7Efu!U|RD+4%eF2YQ1Va4htr*uZ8} zwPW(wcHvui-`ZWhQzuDqp53nt@9aPJERkL+a<9sco=@a~SQc6jD}(wx(I+aZRe0k( z{1C50BT(*fU#fih%}C|hHsr83wX=tQM9&iw)jSxj2%@kSm~VToTA5ntMdx`9Y6DiD zuK)trQb6*I3M&Ovu|aJC68wI1@TB!m3sd;yL4qqFG2$)O5T^7G7g)bh`1jUl|I*7r zaj8GrQO@C~y0kLUo!2|WcAu-`3p+1nnar0|PR#DS&`_{zD%2%vPaQB>pr8BS#^eyE z2zWh9I{Han1FK5RkCSTzdRUhK`1cjJ|I)(y|HS`K6}A5y$xnDF0ehFS-_*dFUu=}5 zmf_)0OLS>qp+U9-8Z1fnpuYmO-Bela(td(Seh^Z}+U@rMPd^e>hi|Ri4nVkQ3;2P~ z-e=>*b39O2$H|H&6y1~|-}V1sPk}332y#=?O)KGv0%SS{|!};z7MASud!7 z+G63HDk;s+M9oT1Bs5E|oXXTb?ZPyxz#mvhZ~>)Z+iSQdm2^nZSnfjdAh^cYjUEwJ z@nIMUmHvb2|97rT|3O99XLB_UQ#2Y9Oh@?z*I0&YeI@^WllvZ6tvAS#r3MAg9!PPmf@W&*3K zn(77t>_54K2g$?mu19A;6#qNAnqS6);jH5IqnX#Ac!msT0xJLQ6;P{z%a^)@r5F`P zlD?TfDQ|c}ZJaeRM*X8qe2@2eP>-QPTz6cP*JF@x3wXBv#Id06PwU1i1Ih4uXe_8B z7IuCpDILy6!1aamq5qTF#vfEV+zE%Eya4}le1~}ALqkVZJ-}O&W5O*}%NF{Qz539L zq4-yDPMdUawW~|=0eT6JVSAt1;$wKz#Z}~?mm^B|qc2x-uY!{H${)MBbLyA{su5(F zR+bN5vvOxU)S2JKDD-=7QLlr~f`LvPdUEH-!5Im^4G8OPV z1pU<)1br0`Dt($op)?3V106~mZGY)Ma$#F>Z}rJ@OzZ4dyHC8U zjNNblcfwM-P?6_$Yptl_*pF8O1 zw3mYV3T{bif9_?t+k8%zUpRgJxp$oD1X~6K)n#0gzcMH)S@#)x{`wXHOQUB2O|OJWFzO4gJr89g1j z!Nr>8Qp0wyt{Ul{m9&RP&`gZYtJ6lEIwY(pQY)b(RStGVmaIoJqSTUJ<6-@2U`eRXu*nR>2@)@~OpqU6m6 z!dZrq)GS=O@4QO%?#)QcW&6@$yWAXyg62l@mtG4@U*^CtDIjtSz=&DmmmJ{5z*5op3KRQZ?yB5aarJy?8UDY}HGl%O&f1V** zKev%N&FP$$@^Lq1t*9Dw?VrP_F(cF!ocwCk2rB%hj68U2=BF?jscb=(8T9ngE8B@| zhcWW{?$IFQWdTpv-P!(wJnd(T`LFC}t7*T+gEc(nGYP%gQvA zGe%6b=YB+Q>?%*B-*dK++8~3g46V+Y_H16BCCH*t?&5Mozz(-^C0A<12l>jm)ZK^e zcj{>LJfO&Q4NuPQ{tKPB+)lD6|bR=dbax+1ooZS2owWkwa=%_ohZ^#}*;j!KPi- z8h!W9YEqN|*@v|U+|x@-#+>c_H{N4h*oiZ5V8oXpl#FoxMc7R?f+_b16yPW}(xhhx zPFEyr>2#VJJzp|%CnLU+tE&|nr9J0B*x2)|IX&lfmk2w=ip=1YY2?}JDVL6<-mg{Z ztbIl4qjjBVRc#$gZm{Tlt{5wE{_1pmnk9@YNztax{_m+;oY;f#yMD;}viI#MPgZnB zU)>{fN{?3T>? z_ABNlqhN_-VU{g>dH(}gu*0LixiVvS#5fKm4W_vzU9YR0H%$?LtEi+E`{5^_(_U1Q z@%+GabB)slYl{f=7X}1Z5qgbpZ|F#;$g`~ZQu}d*>^*&+5#27xXrIu>OAAv^yC>c5 ze|WOJ3+uV=gRcHnQ+v4h21xwzzYTLRe08*iWI0KTxND$vJVX4_=^5|%@#8JMk?WI? zb#---?B3p9UI4)-#B^obz3nByzD}#+g7a~>go6a(4&>SNdl@yYG;VVcyCtDP$-u}u@20@GZg9%d zkYW@-aP&EG;!(uHd4<>h86PH7Rn01M3JRoLcOJ1ML(eO5ZZw2VLh)a%IkmW=j24-6 zG8czixPtJR7NQGTO;J2Q0|SG;UU#Faii)8Dt6M>5bd!*~CL6<|qebHZ1omM;GIA#} z97zxob#!#tLyZyRwpVfLMT!SwRm5+VTVqTq7ZICWj~~~ZKBJVBz6&244OZsV*48%I z+uKj^h3E!qPmip3XlO`nbf9;Mh- zwExEcWHiaqRzPv*l{W+pMh`AlGJjzf`R;`f$jV0W5dp}`DJ--yo-ADI>zN{k<{j(k3nGtDF!WjF;F=H<;luI7pOY?(DyNfTMsM+)$I ztl)koqqCS4J@tBsCuBu4qxw`m&O!Nx2Y2;ElbEgEHUl(v$hC0gbHD6g*G!|)^bTX) zc|pjDYMwg!U9qeWBd&985&WE$UseriK6yCa5j0p&xWH@@j&Uvso=9JHW0Gn+04vJM z$}%tQQDU5El1s4Cwl-6YD`1l2X0IX+S$;Po1tJJprK8hUmi^PE1_n9-o8i<#WQfx+ z5>A&JIrDU8W@e>{^JxXU8z*~G;5}6NlUJRd`7Ml=I_l_KuS}VM^(4KZJ(@|hG*k%P zyHR8wH_JrHj$uE{`?SOz-lgC$037dXaYnccw%46+N;C zK(ty}Sz*}d&PC^vk3J^?V;e-1S(6fpq^Htqi!~|5w;;g_Gk1g_ycFCpFGc9t?oJ;$ zU6O&Kc6T$Q#n%-asQZBh*bL+&a1P@y!uERD0dYP5d<3O2tTR=$PqWeY?Ab9z-p1uc zL02vMre6~S0R~)jdZwqS{U_^k#fSoCt-qrd#a8UY^0sN574xcOB{?}cr61Ac*4rah z40kKqRJ1B>(N?2x{NHPu^!qrd`sbw}oor%9R;4c0*QP!ldKB1KS=Ol*H^~NzHUT4B zAE6sszj4Ad?%j*xhD@i#(}{`F;p_EFjcr#26)Ze+ZK>ftH6}8AJb__~0K2#8g$Z+A zKGL;-4H1H$Kri{b@IA+?Rh6H?duKznCLlL>#!eRjz+%Tw9qWiqNn>?|{U~wJg#n=FFU~>SG>h|H@ z+J4;zmjVfx+>t9pM!BPbUK=v!Cxe)@rY><*AfXV4V-8`&%!GN-!aKVZAlQQzMu3%; zij43#zx?tG#+-Q*3NpIXSf75T{rj}7_puiq5FMT&)uB$qOR=JMWKDB(^Vy3YHjP!S z&9m$7F3QJV-xf1IHkNp6WG!+hX{KXSLq#>kV7?1gK!GKY%AT z0?rF38$D!ZR#u$W>-D~i6oU$Id3hv4hM?G;m**{hl~sWH*yKfuw%3?zL=+Yj7Rn@R z!WXYPmb+Tt&I~mjAEZ6X){311Nx|~;GhtyfrRkDH05`!v%RZLTg%X4y$>}P~h}E8jTMbO@Sv*zM)F%`8I-y_G?O3vkZ?A zvTT(!rp@gfmO9)GG`QRpM~z5tJ_RT&e)8lA2`kyJJ$mDZE0dR%Ec=n+!B~3$csSwB zrTW~fhCMLQ0x)j5bw+a`&|2+-aroUEv)ZVOwcYw@=M`e^00QD>r@e9u3)x2l$tIM- zND{L>IXStoikOH29v?8e^S=t-f74uO{Wdt!NK&xDYH7tfV3oCEkIFvR7TIwg*hA^P zQjYX2Ncq7Py4?nAbsa8!7`^9B!41TK!SK8x#g*!tN}N3ZNhn{}!RW%OSW?9p>=<>} z;^RoLv8`&2i=oaW8K-LkJc7jHPv;A_nc4L3=iHsFoB^7_QnIpwg&fNvO)CQQKr0YWU@V7jkT7n|W0ju<})lxLmp)j9?2yqm|x$OwD z1&rtL__G+SId@NOx2Rzt>x?aCG6&H*B$FNrfBP2xY!52>IW>bg3t(~UQvPLRq824Y zYao~Y_M@O;ecd4&R(If}OoUMHTAK`jLhT(N{Az>OR5Z|qD6lEt=A_bX<*6NNxT|eTl_E=uJgy{S{ zTA!jN?&4QeOKlfMS1z9fH8bx%kd&{=M~84yLSQ^U`H)5HSauYDQqRiDx7kreD7mjN zxawIwc0{WdZOs39cZ7r)V`%q(ptDc*I&(uSjOM1Je%eCY$A*=IG-AE=R%LIpcC1WIpXKG zBO{$|YYcihhZ~oH#umrd!vFp1nwZ`XU46T#Gc{yQia$1fFVZM2iv-N?Ae;$rSbo>| z@@(bZ0$F!@f8zE)A3fBOdYyF1N!c7Ptrj#dZr%hIniQsgW7BPB;RtDAod5K?o}(xe zpy!J!3)OPSxVuzYKEVa_7o+)scnIl+4EBg7YEHK|!?s9h7 z0~PBZDk0{wVkM@JTGJnwOkP3m1U~3vIcB)mPng?SXculwNkB@CDUJna>$evCJaTto zmsRG-cd^aCGV@2Qv|_hWLNo_LFZIdEf-U}k@^YZbmM1Q+;nolR_ync{dB9fZ diff --git a/docs/reference/model-method-variational-2.png b/docs/reference/model-method-variational-2.png index 093449f41694c87ed4f6a948f6425a8e02c8a550..4ed9fe5c527f0931750caf802c560ea60a2989a0 100644 GIT binary patch literal 16009 zcmeHu2~<<(y7oqjv<}c#1(B&%Dk=ghqRhc#72`k@1!Sg`83bfbfCQzLDgrVn%3M(p z0z~F91d4!w5CN0O7?dGEAYn=Zge3Rdc>1q@{r8?*?>#;D{%5U|71j>fdw=`e@B2Q_ z`@HYBbLXO|$<|G~HbD@y6?x`+GYFChfgtf8Ki>$x8F={X9N299@tn!`U<+O=Cu?zF z^M&sjD}M-5jDr8f;>PElA?O9V09x@qQKFma%k$;w-$$B!$Vzr?d4%x@R@JMEQQoBW_zaiZc)Cj-A5R>dnhN0X7ndoK>DKSaUqq``PlG4*r zh_xRIX-ulWBO#~PJv}4C!kp6Fe9F$wPTT%7K84L=&X2ZomZo~GHIfS%4fe#UjrsXC z_4P%Ii;FGMjv{-UfTM>%5SUCR^|B*jW8?`#%+mAx{D&RSTA|pU(bhQ6;;V0)o0|*k zMN3Od)SEPuqp$&>pZeSML&V;Zc(TM*>Ogjme9Pz$7jns@`g*0ee!9YUndn1(RNC;> zS+pEDdJwfiv%zrw99=ID$0xZKx`w@4iWC{KEQQ=qPIEPR92h^M7TBJ3r#Z(`H9H@% z_?(lFnoh{C7e(fe=g=^401j@3N9kdkUyxe%;r@&Z{t|p?zhCrf7ubHfZ~ji#{*BY0 zzt`}oqqAwgRlO%08s)ZZR9@M^eMTpvJG~F>eCzwp(@@;LT9((uU{ra26Wb9*2*(gJ z_>f5laQG|W@Ze;be&&!+cfpi>V{s)c`M9*??95C7=d;+?A+`?^&O3z8mSdJ*a5lYD zq!}yJwmF$4wms!+ar^ODD#hy<7(GQU<}~L`vysWP2F(~xnWnZ5xsMR*>gsxR&Ky;c z@-)h%t*oH0A4{eB>wMcWUQnU!Z8++W=FV6V>1=Cqgk=$!eP7>WFuR^;&#e6XaX%|d zOUoG9MxkNITvkz0kw>*{MaG6u&WBykr_oPq>gv2ez_P(4E%4@c4i5Bbes1qnVH~ly zp|;Pg)nN3- zPu9PSQiLJxQC`EjL2Qrj98w;$(a?h4cC7&IkQ?>ceJh0Z@g$ze_}EYxte z8$G2l0U!EreR*khE>5KgFpx$v%wg$iX>a|i3pkh|%%&N05*@eF#p!gp9Nqk6{@Zt? zJ}-;Z&Iu~bIC$mxK>EXoala|k&Thb{n&O1b`doJ+%d%bC#n!=rHa@<)m09$M>xD~t&^uli1pkJ2V0#F?F>_y!)zJZc_Fvgy3nH1 zNQ6T9h@`TGuA;Btyah?c|ACnJJHfTpMjARZr%BQ!(6NjcqV_c*KXSUF&@!xsQ;~0J zj^J@hQ>3JVXKI+`8Ss2EJAR;TiV&YyuGcDLULd$gu2oL-o}xIt!8GUE6yPh&IYeHR zw$4cAZr!DeQs4wl1>bx~=U|+xxr3f3@q-H;Tg$mcW}^@VDGGCY-W;cU5#e!-GR3i? z?eHfk^YlMPcKw}}`p2C9{0CTc7JA{QeFO{Ht4-0Cf)t*o^580dF&MX6Bb;}r3wc)g z1q6+43lWRRrd-Ek*@6>>X%^|R4xB=seV;lp)SOexuJ#fKM(om(fJP?MFXRtDsKaW2*oinfuJvic_3aA|1dU)Z6*CkPKix{5R+v2KHGly=X;1{W-(b4duN*fmD`FsH zB+ZG`YudW_UfatM zf|lC~Yw{6#Y#M^!;?CTE9J3hq1_N|t15tHugK<`K&GZu{jUa3+<0Q$0+k|!dAP&g* zpHjBsv8zbtj^q5MTyvb?Fa}fr4T6bJG~gd8|Nr8x{K<94?^nNFYh+BI4RCgke8a&Q zG7u0Usda}`UtDHpmu2h&hM2;hII+1s>RqDrjl-p-rFO#x3T2YgN@W=hYHt@8r4+tN z?re1iHAbQ;3P?k;vtBwiK<_#bnUBZ}?M$)_Il`r7wAfQ7mg;p3-{%#CXWPNl#xfOW zQz+&@_pMX7}uDVa#jn zqjN4ofn*V^k)NS%Lx5x8)!07; z-@WxsK0eImdFl*K?H(D~vN1Alt>28q)>eq%KcO+Ji#}w9FZZ{uv>%q=vat&n8`}zn zur$=mXw0G2Dt%&WCu4D)+5qyY+dPis)ilwi8*cjZjFeJ~raPm55TyDbybQ-LhfkH~ zlSH!Cgpn`L?@dfOzZaIVrF{i1rB<+vbvv3LB`wWQkq8?9y|(5gY=RnY+IZy)N8Bl- zRSxx>cSWB?VQoHXg#x2a8wgqhAZRV|=7DyV9iSyJ1yr_DoM*KyHK_J_jdQ7-g*iX& zE;Qm@VIHVgwCca^x7uWLlBg-4+5BXqhA7sIL??7lqKD{S$I9&q@__wP&+i4FJWKn^ z)(dg8uemubFc_oy?Ngw=DS<_J-dns1VE-U3t#&Bp3c4mlsR0i3tzfar_q9# ztxY5K9{jJr4l4mopy}IPUDuB8ikWVVlr-n8#V9ct3|KCMN&#*Y{hz*2V@E@+J%QO* z>bl+#z^+vRezvo<9h~N)fSwKa5^dN9$JHly$bRR!e<~RMN!`JJ-TR+bEjLj?N{djQ zsxVJx+B4-c-H*JZz8W|MK`C(78;Mx!C1g@?LPR1}%cxh@v}Tn;S_H>IkO>NuAQ9pV zs>uR9IdkG+A5ci5lFiw+7`_J7u=`8+?1p=i<|tEZLX}lz;li*T6wx%|91KVKANGS` zg=!{P2+rlm`{33z-U13UD6-Z-2lPHsSQwU^F(A+U8cwpO6q-kxQ9Vg(|*TIS?{Uj`amqBDhDSDa7cy2=*j0zs>`d+s;&>-g#Jg6R%vI3=*_E|)KC{0`zys-f~X5~*rN zeL475s!gFKI2u1r42N&*&-07j@bc6Y+>vH2eEH@)iHqEJ<|412i4156ZyQ*6C6TdY0wZh29)N)B9Pi*)DN{ zzBZ2%q^}N2poN1n(KU4jgPw1_wepi1Lec1z1!lL~QhWpdJw5W;4L?6Ka0NiWHmIA# zU7!j4MV*qk>H%B~!S!u>G^l#((I#!@rp2PmAFH>WUBOvOp2xt8w&nswl+sEv6-= zUKFrik)D8aTN35rk%dJ0pG&H)EKJmv`8Jt3`Fz#?8{ z{u66zk9Qa-ETK|kHL!TPJYznOYG+PArvhX7sLGt5@34XLTL%Fz4nW~N(Vij;=nURB z^5}~?g|tQK;cEW4qEJBkmH z0?PLW*2#Mb>HbR2!Cb+VO==846c z<69#@UEbT<3&bn$ZR7l~RyeZ$5Vmlb!-fPH`jibVSYf%I$sB3nnmNenAEUD> z_?Yr%!-5hwddwrUe z)Rop8TeTl;4ip|r&)X4w^vS+6M|RxVu{ZKB^WXk7V)N!pMfLBEH#n8Hu`-7IS<2_Q zPn?doO{9f)C59PkJsz6TW$?mK8U7h`|9UhRUDI=UjGaeK%)?&dKK^wqG>)?`M9gi! z1mHsGa=t}E_JnNukACDWsspzZ_PD4nVxmp8s$)nRdSZ~|w~UXi_I)1@hm4W?;dT%N zojv|yP=4xzb@Fj|IL}0eS8`tDe2bw;}%&@w|{I{efR8>Z{~kxi2U00NOFduzCa+D zwf#&o3w`aulRZ$~Uq4VG5{XtXvT`T)y*XxRXlV7q@kIAw#};!uWr@Ri zW`V!JoR2wut-r(Dvr+%pv4_RQ#X%ak#4i%pyWmw6E*` z4VC{D>;8uUtL53WZD?iYw(w{Q9CeOFvjC7)A!wh31pCAU%fw@)Yft&>!X4>Oew@?Y zV3h@evJ|%0N&d?6@EiQ$RPLj}-ji)jHgJH0S2|huZ=vJg-EvJdy!Zu4M!IOByA%COyqmR+ZEAxDSb!SlCa{O>0E z{|9*fYOa9Wzjlv3e(xdV%SyxMa0xzMI=z&;_*-AhlWb_a>AFQ!kki+Y-?h~ZpY6W1 z*IfCW68%yeA?V7EI_T0mGmyK@k+8j*$Aa#ukcKY>Y>Mc5ukgtnF?322_S`$0PFK?K zLT~-xqFeTxgO~HJB#6+jeeDfg3nuq9h<%(&Qp?=rGR@`~=NaD2>tWu#d*A6#KUia1 zO3Nrp=rpV|SVWI5>xGjks(b%lUXyBqi$9qs{?6gkF+;HnfTt57-tD%hPuF_CUQ3dP zU1vaG(D#ngAAP5O?8rk~QMOgJ(4_Qk?2%`*wMvW;Z^HF%tk{g?dKxf})=mZX8hazf z3eFsiHz*EA?QD^-6o8y?6|7cXN4N}o4FY4aEMxR!)8{Q zm70#pPO!G@M(#a+G{s=~`?y;?XdP0J&KXX?cbfWjliL&JcOtP1%qN#;thCzR3)-S5 zWB}3;IE;a+WQLScl_Gr6h>vLck8`>PiNASvsQSyQj)U8zZnk~ShQa7U{1fz*tHdSa4V>n?#5uLr3= ze%5?zXnLeH8J-7pXvfDr|49<|6EwH!mBZ2VKJfY0HJy1adL^@yHD z+iizn?;F~B4`-gMvT@_F2h+4H0@8Xe&Q-kI9o}|nG1~NSb*6!?@HA|Pkr6YdX)K}) z7&z2rUtd}I^u;4;6qPl28j?AOxmO5-*7_E3I} z`f>(yfmNU?uDF_VzJ*TDR;;gQ)>4BdT@|oFnSLfje}}}jWq#<>CK}Iek9*LvQA-i| zOMNEt8I1Fzy(^i!cXd9E@9L@=?E~LOwbDAoWi!kp2NOG;M`Jm}KQa#v*52IfB)Yvid$nG#gh3&8_} z;N@;uQ7GY)-F-&>Hv8&;NrJjKNMhF6y4Wk$q9uDxEf@ZoBe@mu>xG3Uzt`3^NV$SX0=Q^)zg~_nF3nu@ zSsB#L>hsF!-X}bSKT^O>&qkswdxjeIjGQICB5P`Da?->%GDrP`Eu#qR z_r*>RIYjzi{_A(hmR+NyQ*Z8ahA7(g**&qkS=*VRDpQ(`t}U2oYOsDM^PIg-?c{cT z5gzYJvKPgi&eqyIeDmhbEz;7Jn2<>~Aggr8?w?#(>P5K*1e8tc9Lio@T|MI3m8Q}* zGU6D-8np8L_K_8kOHoP~w~Ffn598ydghR*OBJKFb$RkIOCe031%BFqpGWH=+&-^~TbngreQ1uh(KSf=%QLh6YfD=${#47VQNvplo=r$YPdv7& z@Um*W<2dnHT<5A_xfRjnYP9%RrA>Z#?smb|;wK~DA6h&>wtwGg(9k$h+^W>!oNV_{ z1>LM>AJ41j5hYY_J+37A8(Uh^$_Vb%g;H;?zLM{FbQ~_h$4DheJ$qC=+c&K*y4W|e$xBXP;Vg}(t}hT zuUqUom!J^%_EMpeQiN2{OmQn1PBkOs$3}PP5mFP=9lduV!m@thfkdvD2Tj&+iWT>nR&Lf&r3!TUc3a|G{*Li&4EwQ{X?Ptxw#pb1ILE~F0<QGV1LM;~oBE z@g@~ha?l~W*}-5@qcrw@T=>j2tKuI|bs6#oWxm^(Wo~UK3D(RCY$`P>hk|Ud+|tZv z1cD}fi^Hqb$_XA$#2c8~GBR?>{a9*e9_s~qaUyK;q;flp74+K|s$&Zsny6r&J?Evm z;^qjh=Xel57a?%hs9*jt6#GC$SvVI}>eQAXXy0tiEc2&_J34+NYwLRg#F;<0&y}&Z zNT$=Ppt6g2Mg*XQa~jnusmHGO&(6x)hy2i`GkVXR@pI%*l7tUX`1@pnFPcjH#@hichKY~w@JMwa~8e3vmq1tv{I8R;SyvXupHahpBHuR>)GYLx@>$GpxYqy_c6*Al~N zQESR;Ba*%Cn~XinJ?R2IU4-?nnaZ&ZdH=I6=j~-4VjrYV1Jfv~Wt}}Dl$QquB)L{F z=uhrU(e~WiBEcPcD&bSw_Zo#=NK|QKuXV9!xJGciC5-(VrIg~g`=j?bL3}`3rU?o+ zUVe3Xm|%gQJ$D}J&$8pQ$Oen&HEL%{?nHZTc!TagEV)hq+pFH3PR#f!l+T?-CV<8r zC_-nsMzzB;afaM?Nt@l*?*(5u0OA>k7@w^i^gEX@R!#_?t$+Dh*4F-F_ORPg*fUF9 z?nKWy%?r=W+%H^(tn(H98;ZVNme3420Rl5A)w^atcoYleR9Vj{%(KX?W2r(~PapU)f2D~H#HkMcGzdDtRS|eKEou_)9p_jT%{F}BOhtavo{!tEc^RQji zptQ8KtCN#crEEQVZN4>81x7%Q?HRS!4OxQz;vw&2sa8ZxU=fkquhRC|HRJIPHH#VU z*&1kjF1S7!CtSRD@1B!jm7}}(S_?N?aXLF*Wo03mlt#dE@W_NzpZdNPwAiM%(_}HS zU@Nh$sPabp{@k(K^4_mb)7<5~=e2A)yVG7A_L-RFS4S?|=F|AS`?; zQ#)NiHYAVrdlEXoP))nfEUMLDhcWaY)Iy5S75OaSP|yP*&AZYFVycgq<)CH{j>5&f zD}JvJx2mj&ay^%?*G@!&hZxxY_Kt%|BTs9hSE75}Rep3^bv_-hADWr-`QR0HZ;C1_+t+33a22>_^LwvxCL% z(x!zjeI?Gw1Rv~TDjyb72P^lade z3==RN$e{6)Fuw;wE3`?L_o+J!T29+e9eTk&(8&;bzx6g)dUJARE(%dMF!1o8RYJ68 z{qk{PF0s$cG|hoIjVE-)n<(kd7DM|i)Fxm=)d^;OP$dlfyoObY3Qowt4L@0eX5uWc zQt#5El(9O>t8b$G{+gG3?0g}v4L~9cO>h@&b8~ZxEqDw3N-Ak3b&bUqdT-7YQ?T7j zeATa^8QRyeutLTe9Ul(4#;Rsyz=>*H6NffM2$l}o*M(I6JX5sjDhLWTNC(p~1=C^J z-wZ}EECYn6BD%WU$zo8_IdHLSvATO{cENTQ1pD+rCUxABv}!J+VfzTC<&I=c^6n^w z9xmfE$r3}Qk9{m-SHIuXK2g>DaohAiEr+tQX9laa%B|JG8#r1`5A=)z%2=Qe2Q~QM zK_kxu=o~ZO&p<0zi*-43^$KvLJzzH((0O%!1?o4r%yh8@a-V3=p4=1IaUVQ1{vS4U zv?kyL1Wq?vh>uf2W?-iC-g=aS_h2ZSSQ~ymyZaT0({)e1IVs(lrt1$A>e?bg~o^y*Mk$!TZv)OS*DZQrp>h!gVj)&@Kkl!E0$R8KBkbQ_8>L7+$xY8hLbRW3Y8IW6V z*K#s$C3ywtVqsk-J(wO|&93J!0p0|3r)Ng62my3K*K8#{!?UP*FUpW}Wmn8;(Dq#HBV&&tOKyy|ge_$& zhYyctge|nC`Tq7rU)2o|YZH%Pi-IPsoVXBQUfpl8!N%rf#aJ+oP0az;o1wyjn-az0{&u3zD)^rVnkn%z%1|5W*COZowA*dQzXete$d+@H57aDO8gEI!gR)p%=fF(XI!J5h zO!cOos3t8VnBB1fWBqcwR8|cR&^os-aes=sq{1zIR%B+pzhg=tp}DVu&X_W z^cxDKIdfuV3=6F>E}qFP}ZrAl+KBlyx_qbCJF0QQd6r+ zA1b_Zz^W#|9hP^JN+FIUKOoAz1}fC!5W)~8Fk!FZI$gXaAwwr&Cj|AM0uC{5ot~W? zVzkcad2kygmCqMiq%PEh2dR-jGCmBKP9D1{sq{(}vC*{N=i;9&N%C`szw)Faa`AG zZoelF?FF|bVa!YIGf@r?IOaY0XuKoY6$tO^RxLxpbi+$5;Z&y39Tqo3O4rv0F9QNG z)?e=mOD4hD1(^V%v+{b!G7Tr7sUUGUTv7e%G!pgQJOFd0Iv^euc>GOoWB1sSjrcPv zqYO$okOZnk`sAdW6k=@-aK_pINibmK95(rDRDud2q*<+pLMb0;jfsh=h8J(H=Yj}v zY*EB6zel#j`KGfZy7n&S94GEKQMmDa!WfW(=}XvT2P_&!4ycsUZnVhpljf^NW6veP z!V}2#T1DJ=`-48<^Rf&urx|s)Gp5Cg@d+D!$=fWeaUT5ku){R(4N%}fZ+apVVAak> zlS3Eq4uS(8VQf?3)h3BpZY;2^K7w2T>~t6utwXu@;A$yhesc|xX~%8{As4SACnwh? zE^Tlh*pjg=bNTxTa%QH=3PH50$ruH(t`0Nm>#A#UhR5Kd1Qf!VD(**jsVj=c5>Z`> z!GrODp~8SJ?2NWwdU6F%0q=vhRfjAc!UOXu9!9)svNNDfe%d^TfD4BUs_*19e~Hui z@C&F}U~z0tz?gg2&Q=VDjK*w}Mf0anxD=1_6j*wwhi8CQHFv!vkO;)z!b(oGLS_JP znt^(r4cC?MQT|jb*Ks>G#&V)FwbEgfexp@!1@_S(nvo9hY*pff90uhR11=drP1Os) zR~#39FjKgcdl^qD!EmP2{Mz@cV}ii)2fQi)7D&`{-QX?s2`hvDX^Q)^hY%okc!*B! TDKcAs_5^v#^!uW}INtg<4VB|G literal 12652 zcmeHt2Ut^CyY5z0MnM_J89_mr5=2y_NRh5%!GM6m4818$X+c`(MEw;V1ayZYCCM-t zG7cgN0!9eIf=sAlfPfG{2~8w{P(lbKXYF{}bDs16^WSsl{`a1H+|Q#cthT@PeeYM- zzJAKqa^r^W8z2bUh(2-D9)i}!K#XLNrc`+1u1C+!>b$$x2{|T$ zf!W8mad$ZVxwc$Ra*`m)Jj^H{iig3r35jE3(i$mQf8u|*)yyNy>=IN)t!SBmnmw}Y zCf!`6ki=mBYNBpr5hI6m)IY3HGLw$rWGl9tLAdYq+8xX#r!oeOjFWF0F*%Dn!RR8i z#uMkmc`p~6l!Wq9q75hQD;wEThSJIySOtb#kx~CVn4*>L`LLIp#2-!T*bDlHVm^;q zm0qZ>x{c;tff?K!111ms`k1jDdEp_Ai;775b7sAil2cYgYmvWqt4*&)+RQJI=@4YK zz7}a9@)}R1!P&3YLfTKuKd}zM!6(@K!&Rm;a1MfcjFa`sh{ieX8N>@-TZK6+V!k+f zP98|)B~bby6Vut4Y{Tf;_+|~4lSQoHD!Oeq!%JOi0&I5!%{Pcy>fl_DC~^v3$inP0 z6j+vlrQWE3f2i^!C&6uX^1LmXTfV#8HohaJ*W|=Pcaf7yDAppD^8?HoBnnewr}H*e zMQ#Q3C8%Fi95T0IRA3kIaskJ+dV?{^bC=>xZsV1)uw^@{Ib_8GHlpgp$$-iIvS4ye zn19ytkmd2Ro)1A7wRr6Dvd0#xw3`L&ZM1hQr7Xt0Tago(TTcs_taJcBz_QE#6YQa5 zkt_t=nCq+*itx)X#&-yO%*Ip)W0K+`<~9Kw#D7)`)n7L#n~h**(zgMBb8o9qh)TAI z1FIgG0Z)KKsV3_JWI5H+`$P<g?^c9W@h9SA=RN~2M-~N8snDu7)){`w-P|IM;m^XT848Xgkd4s> z@0>nWn%%b}1~VlGeAOYXe+-E4c8#xs>M!Sx`Q9=Wb|{XLcGCRt^O?;>hJY-U06E6_O6kzb6iuo72!Cff&u+s#?M8D&%Yc0DnD^$X&mvojrjm{4UWy6{x;C7S+Jl0 zfkO#m0_F|+!ho(JOYdz3!elxb%xoCdei5R!&y1?uaOAD_hd ze_o9Ln<)6_<%nk2Kc8Q;o^3c#J)2*IMZ_02x5o3}Xxl(j!~D0&x;6~GIKo4GNXWb} z#R*~|A@kQ4)_rt5ntzZ@yQb}gTJP5#OvZEzdpk@v9k7cvogM!QDp)gHaFUVXk$6U& z)!~M8&sUBWCo2J}p!7@ia;o(SH%Tp-T4@6pc3)7$DKPZZCXGn8{0U@oyRZg@prR2> zv>dV|o{X-VtH--x;WBWn)j0gSCLxC}?AU7{TB?Sz(Fnn~qVJ}kZFbh=ii3+rvbn2= zVq8!5iSllvm>`;g!d_G@P9gCN1f@uGg-`iE!i!I}kH22`3Dl1R97=E=HA0uiy_1{0 z^3=h=Rh^PuWC=o^BcP@<^x}50ua!Bq;&+pxYLIH32Kgy;@H7aNK=KOWr%6fvhjt_j zd-Xjs`>0Xn$^C>KAcCq6-6ax92cFqS(U1GWQ?b^c}Kz~5H} z`{+S`ZWbp9F6fLXlAajQjiOuM7HfDV%~w+}H$b6o`T^o5>#=@V30plv95{YcG@Fa^ z+HSTQ8ajh$8%~!0d=OtS@cPK$!Wd_-TVjX~RNsNH3nyD%aUwb!Nw?0MfdHdE#mAbC zK@tjR$n$?fVXhL?Mv>y>j(d1!Gm4>@Jk&m>wTT$i0;t%7R`S->;N)pfi=yCc3%iqa#j3n z%ZAHWxOtYHD3lt*chC0Mhf=0*YoGrOemn7K{h7Rz1lz(#YWRak8n}T!RB!wK{KaB} z+x!h0J%?`GTK??Wv#Rdb+?DwZTKQjkN<7Z<*b!y(!j^uc0D&nNt12)IpvQBKKyh&Q zT4`ikf6e}5P58#IGsQ?zq`rv#y+=WI9>HzUsVvx_H8(5IZBt$8@{dd-$a$M|k$lfX zVZ(V1VW~fUUs-0Y&h<-*-bZ&Mj?_EN{h=B)%!8>BCt7}5yafuY`VxWsgX1ro-pN2q z4gc)vk7r(zGRFI;#z+7A|87TT3=_%tao^a7k1Pz{)jDtdGI!sj@NuqTmX-lQ##>2x zaGYgl9!otok!jR+r}Ab7N=Pk^faGPQ?3%t-stju?>JfgaHmS>3Az+Nx)=!_3ay{d= zlJ%~X$C^reZPX#9{h{T^eJZ5=isELMcGv5Tga_&*VY>8JksF2*3K3%m9dGj41viES z8Xv=82T1)EEM(~Ic0^`>^Y#BiU|{WpbZW+~#;x!b+wzsGOLfH+`vSfZ=3wb$)1Jsp zL;W8`yfohPefcT;%)?sp#6DW&`?KrK9Qk#q4W3G8HXtg7Gj}u0Hl5@bJIqBdo(pe$ zTkHU>4E?WDaP(E@j!R+(sVE8p(s%OOG84jk1_#V^a-!kh;)pq29b%aZPmgdmR+*)aRVPoV%#ozX z9WtH&E+7B!n~<0>McCx(QvW-=f!9s<@WTN4H9_avlZ#b9vS{q?#z}bQ8_gJ1BF6Y> zQz=GGnWYbqFazJHN53p6`X+HbqIJ*%mH()Ze@#K5`iW5!#@a1tICmr6N!ga!H*=+U zOIY2&K4Alwa^D551^S%^1B>qBso^oY=Ba2DZ# z8j}oX0`Y+-Y#=`7%tMYQgJ(b>=j2)bWVM#(Vn1ED>Vi51ZI*ruu<7?`;&1;==%9b*MiV+j2B~E{3Twbmw6>Up4i4AajZH`*Rx# z4&R-juF!5sSbeUGYl#zXSAt~-V&TuWu1)^&t2bgKLWJtHOOK#XkRXny7FgsJsibV=qi z8}9cE;)WXAX({Yz&md>Xy6JmijIFiwg}2HVGX?zM!*yb zCt||){=`9R4Ye)$v7v!tFIbe<#%z8lbSJ>i)r7~HE^&K$Z{;yiUgwOhw8*}0Hbgkj z4k5v{qVN&_gX?SqoIsy2HOq2$gE5_Xm%+{>Plcv6k91jyi3;R53=xJ><~Uk4JBzwu3&t;M}L03;|j1Vfj8-Xvz zRsI;X5~eYtm9fKQq1q;3mG@Mpz4({zrBoju9};rRKYGS~DQIn)iWXT~YhX$%ZPkoi zt%P=^j*}jug(=ZMulWTF!PHHMB7`~HPPVWk&`3%-2RtroFp^^i? z`z%D)th_*Zl~kHXMMp2(@1m^z*=rrU_d`E5qH%F?(T?R>wuhW>VY0iFS3C1kIYZzx z7-k+=8rg97?p?1Fe6lTNHaDcN%EQ3Oh+5SB<;RVS%k{TtXvdSb) zhL&0{>}y>*UnwUi=QUUv#7dRDrHYF{2vDSr9~(w*Lb+5wco62OPJpzXFRMr>#l`mv z^75WU1qTNwQ<&6PfB#WRF@+-7gFO@F7^&SATAi%N$btJ09yl=j#Gx8f-RFf4@2Cpt zBR+x^eLtQ)b~)J!w(D~Bq9uwJ+!R#J`;Fq}#`VdW7PkCOR0O)JrKQDG?^@YfT$b{j zPJ9hJ$qx29Q680)BwjDONo8^2y@SjHS3phQ)IuLztIiOEqtfhoGAk9o9Eb@jHQa@! zFk^WNTEAiJ%BNlx9+8|Ym9jl{S<-6Xl+oVSmNfcO8DpBnv@z6dX=@Xc0KW=Qa_C*w z8d@KCPEb8niK8Q$XL(6#?VDD}nTaK>>klPw3|vNdMF0IPRTMR{e{QgREia1YfjzG= z@&?toz#EjLslGW}GC$!vqadj4SA;Hiwd=&U6V0}eGy5nM3eP;TSG*!pP#2znBaI2_ zWyS}g5?#P+b`2IY9%;;by!5`rPHPi%uIJ~M5`X|aIg`c?!S2BpO0qR$8XFr)IjG8R zH+&~EM-^x}rl!I!c4V&?)vt8nBdP}K5=GAdvqKL)-{UoI%l4K1`OIZge^P$FNI=eH zaoIK16-#%ZIp)_dC1&vpCs9T->1hgWfFGr*E*DiF1wVBQqU}OkX<+wNE^i?%zDU?w zmVbM=F@xt^lDJCSc}1l{z-9LtF_Yh0Yve>xNJeAz&|JgM>AgS{?b-IBuJ73@kRImq zVae0WvdMcGFS#ka$s;Gd*AF+Bp0bJ!hdW*A5m&poC&Q0v_=#MnL^<6{h&LrWq=wn_9NQB#@1H+ zhRT(}i6;b$^mqaHq3dLdwFbSPat)F{L~oSP;ssT3?PJl~DRO3f8Fe(zi&#*QkU(Jy zWzk~K()sM@nkgRSO!jLZvf-b?8b@D^>Q+N*j9k=5^;{+}zxhY&S*R@%gA_2|tHkD}GTISW4G3F%cnSTT(4Vpm$ja z%*FzWF8R%g_P*VGsUu^jsbD-T$&H~OgW=g4lFn47!gsm?HDd|chd&^EOx1}G4dv3v znTC&hSJzLEk1bm0>(399Gp~bP-IkO#<5rCeW+XBSrqjP~)CXvyM=kMJM1sN7Rzeaw ze0gyuhZN;Kw0W=5Wx)$VE9s3-EV^7D0mJ>bb&%4%i|M^J(Nl3DrSlG|qMkOFUc}^)31(*tj>e+Jv0h3nb%2@bQNn%gP!hKyzarvqOR8p4m6S z0c%;Vk|0>I)3xkiO6?(*)%~aO@6tz|v?>z<0|Sp>7u=*4Q;Lx7oZDvLB<1!^$0{l+ zB!2qaR*lnF-H?=`wpg3mDp~8E4)S0y)FJub0Y)tHP_whM)>|KwGeu9B@$KL43Cr`7 z8vvx#;1hHien4N@Wb1q3e%K|hR7drH)u{nw88RXQ{Qb=zbn-oFqRqJXF0Fp$lxQxN zWC7-tcYepRo==&rhQ9Px#HHTn=_3R3)yl*`A2%2lI z&*-(*AfR$dB;LO2{ZLSG*|218ZmtyA#gfW8Az3SN;tFMdA3&%xOtRwxx^nv*bCuhI z{K$K`Zz?A%$(fRyoJu?%uZo7LR4TXyDzv3U%mb4{k6bdS!Sa$?`uqF6P`&O}v4;ip z!()%MpuCQ|52sA~x|9QmxfM%O_rfQ{Zj9LHhk4#EU8nuXGn>=1EnDK4XL1=!4F(q+ zyOECqUfoew&kZp?s$kbP?GHYA0vRp@<;~tfk*q=9c~eb3!T@~M^cN81;C8uZae~l0 z`&MGUP0jiK;LPK&+$paD&L~O&C8VR1cBLBnn&2twLPK<2F6SvqvX{|5l49Lo(OPAe z%9^0*Gj4H*+iP-FFwzV%!&Rcw?Byls44STj6CR6ZCNjKu4-?V+HdJzE!|N*K;E~uG zx>fj$k$?XC`xROYGCR?3m#~XFW|2LT8h{)fcPsLjdo-T>WWnwjo*h30outmF+P9VB zR^j}LxI5Nx-@_FXe1fTk`y*SFQ9qm8y*%Ap)$G?7(==NbetkrM&GG1)-3yNWBR^XQ zg03F+cxs#vFIS^5w&4$IS_@HSCVqqx+dh9wxLRG9rbZl&*=pU7qV8f0S~LeMs0n?s zORZ|zz*8h1&X@uc=t6Qj`O9q^Sbfzm#_GbFmeZNpv>FpyX`|RYwrP3Zta~CW%h7xq;<2q>G8@|m{0W5ha)R(=gLwIZh9BspE=vcE3^UPi-ZyJB6o%8mHWd;y@P zed<1_=hSOEw{EMYwGedaQD2FS9I99-sv08z|0tpy;2fuq6lT1YQSe31z|YPnapN ziuojf{3}^00O!21PxLPv8LW&^K1i??F$W%z-AO=G1;k@jW04d^6m|NMUn$Bda*Qol z4dE`HmO{CVs4G#ZVV0tkXm%pWFbW$vCOHqwprbjQ3)5tmeHRC_@qW`*6@(|t8F27; zo5g;HEUdyyO0d~#JQ6T zcksyOZWE45>_CbL6!Z^_yT(bmJm57;6Yp6 jhb<9ELGSrG diff --git a/docs/reference/model-method-variational.html b/docs/reference/model-method-variational.html index ce353cf1f..e5fdeb91e 100644 --- a/docs/reference/model-method-variational.html +++ b/docs/reference/model-method-variational.html @@ -1,80 +1,17 @@ - - - - - - - -Run Stan's variational approximation algorithms — model-method-variational • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run Stan's variational approximation algorithms — model-method-variational • cmdstanr - - - - - - - - - - + + - - - - -
-
- -
- -
+
-

The $variational() method of a CmdStanModel object runs +

The $variational() method of a CmdStanModel object runs Stan's variational Bayes (ADVI) algorithms.

Any argument left as NULL will default to the default value used by the installed version of CmdStan. See the -CmdStan User’s Guide +CmdStan User’s Guide for more details.

-
variational(
-  data = NULL,
-  seed = NULL,
-  refresh = NULL,
-  init = NULL,
-  save_latent_dynamics = FALSE,
-  output_dir = NULL,
-  output_basename = NULL,
-  sig_figs = NULL,
-  threads = NULL,
-  opencl_ids = NULL,
-  algorithm = NULL,
-  iter = NULL,
-  grad_samples = NULL,
-  elbo_samples = NULL,
-  eta = NULL,
-  adapt_engaged = NULL,
-  adapt_iter = NULL,
-  tol_rel_obj = NULL,
-  eval_elbo = NULL,
-  output_samples = NULL
-)
- -

Arguments

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
data

(multiple options) The data to use for the variables specified in -the data block of the Stan program. One of the following:

    -
  • A named list of R objects with the names corresponding to variables +

    +
    variational(
    +  data = NULL,
    +  seed = NULL,
    +  refresh = NULL,
    +  init = NULL,
    +  save_latent_dynamics = FALSE,
    +  output_dir = NULL,
    +  output_basename = NULL,
    +  sig_figs = NULL,
    +  threads = NULL,
    +  opencl_ids = NULL,
    +  algorithm = NULL,
    +  iter = NULL,
    +  grad_samples = NULL,
    +  elbo_samples = NULL,
    +  eta = NULL,
    +  adapt_engaged = NULL,
    +  adapt_iter = NULL,
    +  tol_rel_obj = NULL,
    +  eval_elbo = NULL,
    +  output_samples = NULL
    +)
    +
    + +
    +

    Arguments

    +
    data
    +

    (multiple options) The data to use for the variables specified in +the data block of the Stan program. One of the following:

    • A named list of R objects with the names corresponding to variables declared in the data block of the Stan program. Internally this list is then -written to JSON for CmdStan using write_stan_json(). See -write_stan_json() for details on the conversions performed on R objects +written to JSON for CmdStan using write_stan_json(). See +write_stan_json() for details on the conversions performed on R objects before they are passed to Stan.

    • A path to a data file compatible with CmdStan (JSON or R dump). See the appendices in the CmdStan guide for details on using these formats.

    • NULL or an empty list if the Stan program has no data block.

    • -
seed

(positive integer(s)) A seed for the (P)RNG to pass to CmdStan. + + + +

seed
+

(positive integer(s)) A seed for the (P)RNG to pass to CmdStan. In the case of multi-chain sampling the single seed will automatically be augmented by the the run (chain) ID so that each chain uses a different seed. The exception is the transformed data block, which defaults to @@ -239,25 +166,24 @@

Arg chains if RNG functions are used. The only time seed should be specified as a vector (one element per chain) is if RNG functions are used in transformed data and the goal is to generate different data for each -chain.

refresh

(non-negative integer) The number of iterations between +chain.

+ + +
refresh
+

(non-negative integer) The number of iterations between printed screen updates. If refresh = 0, only error messages will be -printed.

init

(multiple options) The initialization method to use for the +printed.

+ + +
init
+

(multiple options) The initialization method to use for the variables declared in the parameters block of the Stan program. One of -the following:

    -
  • A real number x>0. This initializes all parameters randomly between +the following:

    • A real number x>0. This initializes all parameters randomly between [-x,x] on the unconstrained parameter space.;

    • The number 0. This initializes all parameters to 0;

    • A character vector of paths (one per chain) to JSON or Rdump files containing initial values for all or some parameters. See -write_stan_json() to write R objects to JSON files compatible with +write_stan_json() to write R objects to JSON files compatible with CmdStan.

    • A list of lists containing initial values for all or some parameters. For MCMC the list should contain a sublist for each chain. For optimization and @@ -270,500 +196,521 @@

      Arg has argument chain_id it will be supplied with the chain id (from 1 to number of chains) when called to generate the initial values. See Examples.

    • -
save_latent_dynamics

(logical) Should auxiliary diagnostic information + + + +

save_latent_dynamics
+

(logical) Should auxiliary diagnostic information about the latent dynamics be written to temporary diagnostic CSV files? This argument replaces CmdStan's diagnostic_file argument and the content written to CSV is controlled by the user's CmdStan installation and not CmdStanR (for some algorithms no content may be written). The default is FALSE, which is appropriate for almost every use case. To save the temporary files created when save_latent_dynamics=TRUE see the -$save_latent_dynamics_files() -method.

output_dir

(string) A path to a directory where CmdStan should write +$save_latent_dynamics_files() +method.

+ + +
output_dir
+

(string) A path to a directory where CmdStan should write its output CSV files. For interactive use this can typically be left at NULL (temporary directory) since CmdStanR makes the CmdStan output (posterior draws and diagnostics) available in R via methods of the fitted -model objects. The behavior of output_dir is as follows:

    -
  • If NULL (the default), then the CSV files are written to a temporary +model objects. The behavior of output_dir is as follows:

    • If NULL (the default), then the CSV files are written to a temporary directory and only saved permanently if the user calls one of the $save_* methods of the fitted model object (e.g., -$save_output_files()). These temporary +$save_output_files()). These temporary files are removed when the fitted model object is -garbage collected (manually or automatically).

    • +garbage collected (manually or automatically).

    • If a path, then the files are created in output_dir with names corresponding to the defaults used by $save_output_files().

    • -
output_basename

(string) A string to use as a prefix for the names of + + + +

output_basename
+

(string) A string to use as a prefix for the names of the output CSV files of CmdStan. If NULL (the default), the basename of the output CSV files will be comprised from the model name, timestamp, and -5 random characters.

sig_figs

(positive integer) The number of significant figures used +5 random characters.

+ + +
sig_figs
+

(positive integer) The number of significant figures used when storing the output values. By default, CmdStan represent the output values with 6 significant figures. The upper limit for sig_figs is 18. Increasing this value will result in larger output CSV files and thus an -increased usage of disk space.

threads

(positive integer) If the model was -compiled with threading support, the number of +increased usage of disk space.

+ + +
threads
+

(positive integer) If the model was +compiled with threading support, the number of threads to use in parallelized sections (e.g., when using the Stan -functions reduce_sum() or map_rect()).

opencl_ids

(integer vector of length 2) The platform and +functions reduce_sum() or map_rect()).

+ + +
opencl_ids
+

(integer vector of length 2) The platform and device IDs of the OpenCL device to use for fitting. The model must be compiled with cpp_options = list(stan_opencl = TRUE) for this -argument to have an effect.

algorithm

(string) The algorithm. Either "meanfield" or -"fullrank".

iter

(positive integer) The maximum number of iterations.

grad_samples

(positive integer) The number of samples for Monte Carlo -estimate of gradients.

elbo_samples

(positive integer) The number of samples for Monte Carlo -estimate of ELBO (objective function).

eta

(positive real) The step size weighting parameter for adaptive -step size sequence.

adapt_engaged

(logical) Do warmup adaptation?

adapt_iter

(positive integer) The maximum number of adaptation -iterations.

tol_rel_obj

(positive real) Convergence tolerance on the relative norm -of the objective.

eval_elbo

(positive integer) Evaluate ELBO every Nth iteration.

output_samples

(positive integer) Number of approximate posterior -samples to draw and save.

- -

Value

- -

A CmdStanVB object.

-

Details

+argument to have an effect.

+ + +
algorithm
+

(string) The algorithm. Either "meanfield" or +"fullrank".

+ + +
iter
+

(positive integer) The maximum number of iterations.

+ + +
grad_samples
+

(positive integer) The number of samples for Monte Carlo +estimate of gradients.

+ + +
elbo_samples
+

(positive integer) The number of samples for Monte Carlo +estimate of ELBO (objective function).

+ + +
eta
+

(positive real) The step size weighting parameter for adaptive +step size sequence.

+ +
adapt_engaged
+

(logical) Do warmup adaptation?

+ + +
adapt_iter
+

(positive integer) The maximum number of adaptation +iterations.

+ + +
tol_rel_obj
+

(positive real) Convergence tolerance on the relative norm +of the objective.

+ + +
eval_elbo
+

(positive integer) Evaluate ELBO every Nth iteration.

+ + +
output_samples
+

(positive integer) Number of approximate posterior +samples to draw and save.

+ +
+
+

Value

+ + +

A CmdStanVB object.

+
+
+

Details

CmdStan can fit a variational approximation to the posterior. The approximation is a Gaussian in the unconstrained variable space. Stan implements two variational algorithms. The algorithm="meanfield" option uses a fully factorized Gaussian for the approximation. The algorithm="fullrank" option uses a Gaussian with a full-rank covariance matrix for the approximation.

-

-- CmdStan Interface User's Guide

-

See also

- -

The CmdStanR website -(mc-stan.org/cmdstanr) for online +

-- CmdStan Interface User's Guide

+
+
+

See also

+

The CmdStanR website +(mc-stan.org/cmdstanr) for online documentation and tutorials.

-

The Stan and CmdStan documentation:

- -

Other CmdStanModel methods: -model-method-check_syntax, -model-method-compile, -model-method-diagnose, -model-method-format, -model-method-generate-quantities, -model-method-optimize, -model-method-sample_mpi, -model-method-sample, -model-method-variables

- -

Examples

-
# \dontrun{ -library(cmdstanr) -library(posterior) -library(bayesplot) -color_scheme_set("brightblue") - -# Set path to CmdStan -# (Note: if you installed CmdStan via install_cmdstan() with default settings -# then setting the path is unnecessary but the default below should still work. -# Otherwise use the `path` argument to specify the location of your -# CmdStan installation.) -set_cmdstan_path(path = NULL) -
#> CmdStan path set to: /Users/jgabry/.cmdstan/cmdstan-2.29.1
-# Create a CmdStanModel object from a Stan program, -# here using the example model that comes with CmdStan -file <- file.path(cmdstan_path(), "examples/bernoulli/bernoulli.stan") -mod <- cmdstan_model(file) -mod$print() -
#> data { -#> int<lower=0> N; -#> array[N] int<lower=0,upper=1> y; // or int<lower=0,upper=1> y[N]; -#> } -#> parameters { -#> real<lower=0,upper=1> theta; -#> } -#> model { -#> theta ~ beta(1,1); // uniform prior on interval 0,1 -#> y ~ bernoulli(theta); -#> }
-# Data as a named list (like RStan) -stan_data <- list(N = 10, y = c(0,1,0,0,0,0,0,0,0,1)) - -# Run MCMC using the 'sample' method -fit_mcmc <- mod$sample( - data = stan_data, - seed = 123, - chains = 2, - parallel_chains = 2 -) -
#> Running MCMC with 2 parallel chains... -#> -#> Chain 1 Iteration: 1 / 2000 [ 0%] (Warmup) -#> Chain 1 Iteration: 100 / 2000 [ 5%] (Warmup) -#> Chain 1 Iteration: 200 / 2000 [ 10%] (Warmup) -#> Chain 1 Iteration: 300 / 2000 [ 15%] (Warmup) -#> Chain 1 Iteration: 400 / 2000 [ 20%] (Warmup) -#> Chain 1 Iteration: 500 / 2000 [ 25%] (Warmup) -#> Chain 1 Iteration: 600 / 2000 [ 30%] (Warmup) -#> Chain 1 Iteration: 700 / 2000 [ 35%] (Warmup) -#> Chain 1 Iteration: 800 / 2000 [ 40%] (Warmup) -#> Chain 1 Iteration: 900 / 2000 [ 45%] (Warmup) -#> Chain 1 Iteration: 1000 / 2000 [ 50%] (Warmup) -#> Chain 1 Iteration: 1001 / 2000 [ 50%] (Sampling) -#> Chain 1 Iteration: 1100 / 2000 [ 55%] (Sampling) -#> Chain 1 Iteration: 1200 / 2000 [ 60%] (Sampling) -#> Chain 1 Iteration: 1300 / 2000 [ 65%] (Sampling) -#> Chain 1 Iteration: 1400 / 2000 [ 70%] (Sampling) -#> Chain 1 Iteration: 1500 / 2000 [ 75%] (Sampling) -#> Chain 1 Iteration: 1600 / 2000 [ 80%] (Sampling) -#> Chain 1 Iteration: 1700 / 2000 [ 85%] (Sampling) -#> Chain 1 Iteration: 1800 / 2000 [ 90%] (Sampling) -#> Chain 1 Iteration: 1900 / 2000 [ 95%] (Sampling) -#> Chain 1 Iteration: 2000 / 2000 [100%] (Sampling) -#> Chain 2 Iteration: 1 / 2000 [ 0%] (Warmup) -#> Chain 2 Iteration: 100 / 2000 [ 5%] (Warmup) -#> Chain 2 Iteration: 200 / 2000 [ 10%] (Warmup) -#> Chain 2 Iteration: 300 / 2000 [ 15%] (Warmup) -#> Chain 2 Iteration: 400 / 2000 [ 20%] (Warmup) -#> Chain 2 Iteration: 500 / 2000 [ 25%] (Warmup) -#> Chain 2 Iteration: 600 / 2000 [ 30%] (Warmup) -#> Chain 2 Iteration: 700 / 2000 [ 35%] (Warmup) -#> Chain 2 Iteration: 800 / 2000 [ 40%] (Warmup) -#> Chain 2 Iteration: 900 / 2000 [ 45%] (Warmup) -#> Chain 2 Iteration: 1000 / 2000 [ 50%] (Warmup) -#> Chain 2 Iteration: 1001 / 2000 [ 50%] (Sampling) -#> Chain 2 Iteration: 1100 / 2000 [ 55%] (Sampling) -#> Chain 2 Iteration: 1200 / 2000 [ 60%] (Sampling) -#> Chain 2 Iteration: 1300 / 2000 [ 65%] (Sampling) -#> Chain 2 Iteration: 1400 / 2000 [ 70%] (Sampling) -#> Chain 2 Iteration: 1500 / 2000 [ 75%] (Sampling) -#> Chain 2 Iteration: 1600 / 2000 [ 80%] (Sampling) -#> Chain 2 Iteration: 1700 / 2000 [ 85%] (Sampling) -#> Chain 2 Iteration: 1800 / 2000 [ 90%] (Sampling) -#> Chain 2 Iteration: 1900 / 2000 [ 95%] (Sampling) -#> Chain 2 Iteration: 2000 / 2000 [100%] (Sampling) -#> Chain 1 finished in 0.0 seconds. -#> Chain 2 finished in 0.0 seconds. -#> -#> Both chains finished successfully. -#> Mean chain execution time: 0.0 seconds. -#> Total execution time: 0.2 seconds. -#>
-# Use 'posterior' package for summaries -fit_mcmc$summary() -
#> # A tibble: 2 × 10 -#> variable mean median sd mad q5 q95 rhat ess_bulk ess_tail -#> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> -#> 1 lp__ -7.30 -7.03 0.721 0.380 -8.82 -6.75 1.00 902. 1006. -#> 2 theta 0.247 0.233 0.122 0.129 0.0786 0.470 1.00 762. 712.
-# Get posterior draws -draws <- fit_mcmc$draws() -print(draws) -
#> # A draws_array: 1000 iterations, 2 chains, and 2 variables -#> , , variable = lp__ -#> -#> chain -#> iteration 1 2 -#> 1 -6.8 -6.8 -#> 2 -6.9 -6.8 -#> 3 -7.0 -7.0 -#> 4 -6.9 -7.1 -#> 5 -6.7 -7.0 -#> -#> , , variable = theta -#> -#> chain -#> iteration 1 2 -#> 1 0.28 0.21 -#> 2 0.19 0.20 -#> 3 0.16 0.17 -#> 4 0.20 0.36 -#> 5 0.25 0.34 -#> -#> # ... with 995 more iterations
-# Convert to data frame using posterior::as_draws_df -as_draws_df(draws) -
#> # A draws_df: 1000 iterations, 2 chains, and 2 variables -#> lp__ theta -#> 1 -6.8 0.28 -#> 2 -6.9 0.19 -#> 3 -7.0 0.16 -#> 4 -6.9 0.20 -#> 5 -6.7 0.25 -#> 6 -7.1 0.36 -#> 7 -9.0 0.55 -#> 8 -7.2 0.15 -#> 9 -6.8 0.23 -#> 10 -7.5 0.42 -#> # ... with 1990 more draws -#> # ... hidden reserved variables {'.chain', '.iteration', '.draw'}
-# Plot posterior using bayesplot (ggplot2) -mcmc_hist(fit_mcmc$draws("theta")) -
#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
-# Call CmdStan's diagnose and stansummary utilities -fit_mcmc$cmdstan_diagnose() -
#> Processing csv files: /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/bernoulli-202203181227-1-1c6def.csv, /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/bernoulli-202203181227-2-1c6def.csv -#> -#> Checking sampler transitions treedepth. -#> Treedepth satisfactory for all transitions. -#> -#> Checking sampler transitions for divergences. -#> No divergent transitions found. -#> -#> Checking E-BFMI - sampler transitions HMC potential energy. -#> E-BFMI satisfactory. -#> -#> Effective sample size satisfactory. -#> -#> Split R-hat values satisfactory all parameters. -#> -#> Processing complete, no problems detected.
fit_mcmc$cmdstan_summary() -
#> Inference for Stan model: bernoulli_model -#> 2 chains: each with iter=(1000,1000); warmup=(0,0); thin=(1,1); 2000 iterations saved. -#> -#> Warmup took (0.0050, 0.0050) seconds, 0.010 seconds total -#> Sampling took (0.019, 0.016) seconds, 0.035 seconds total -#> -#> Mean MCSE StdDev 5% 50% 95% N_Eff N_Eff/s R_hat -#> -#> lp__ -7.3 2.6e-02 0.72 -8.8 -7.0 -6.8 781 22315 1.0 -#> accept_stat__ 0.92 8.3e-03 0.13 0.64 0.97 1.0 2.3e+02 6.7e+03 1.0e+00 -#> stepsize__ 0.95 7.9e-02 0.079 0.87 1.0 1.0 1.0e+00 2.9e+01 2.0e+13 -#> treedepth__ 1.4 1.1e-02 0.48 1.0 1.0 2.0 1.9e+03 5.4e+04 1.0e+00 -#> n_leapfrog__ 2.5 1.4e-01 1.3 1.0 3.0 3.0 8.9e+01 2.5e+03 1.0e+00 -#> divergent__ 0.00 nan 0.00 0.00 0.00 0.00 nan nan nan -#> energy__ 7.8 3.6e-02 1.00 6.8 7.5 9.6 7.7e+02 2.2e+04 1.0e+00 -#> -#> theta 0.25 4.3e-03 0.12 0.079 0.23 0.47 796 22752 1.0 -#> -#> Samples were drawn using hmc with nuts. -#> For each parameter, N_Eff is a crude measure of effective sample size, -#> and R_hat is the potential scale reduction factor on split chains (at -#> convergence, R_hat=1).
-# For models fit using MCMC, if you like working with RStan's stanfit objects -# then you can create one with rstan::read_stan_csv() - -# stanfit <- rstan::read_stan_csv(fit_mcmc$output_files()) - - -# Run 'optimize' method to get a point estimate (default is Stan's LBFGS algorithm) -# and also demonstrate specifying data as a path to a file instead of a list -my_data_file <- file.path(cmdstan_path(), "examples/bernoulli/bernoulli.data.json") -fit_optim <- mod$optimize(data = my_data_file, seed = 123) -
#> Initial log joint probability = -9.51104 -#> Iter log prob ||dx|| ||grad|| alpha alpha0 # evals Notes -#> 6 -5.00402 0.000103557 2.55661e-07 1 1 9 -#> Optimization terminated normally: -#> Convergence detected: relative gradient magnitude is below tolerance -#> Finished in 0.1 seconds.
-fit_optim$summary() -
#> # A tibble: 2 × 2 -#> variable estimate -#> <chr> <dbl> -#> 1 lp__ -5.00 -#> 2 theta 0.2
- -# Run 'variational' method to approximate the posterior (default is meanfield ADVI) -fit_vb <- mod$variational(data = stan_data, seed = 123) -
#> ------------------------------------------------------------ -#> EXPERIMENTAL ALGORITHM: -#> This procedure has not been thoroughly tested and may be unstable -#> or buggy. The interface is subject to change. -#> ------------------------------------------------------------ -#> Gradient evaluation took 9e-06 seconds -#> 1000 transitions using 10 leapfrog steps per transition would take 0.09 seconds. -#> Adjust your expectations accordingly! -#> Begin eta adaptation. -#> Iteration: 1 / 250 [ 0%] (Adaptation) -#> Iteration: 50 / 250 [ 20%] (Adaptation) -#> Iteration: 100 / 250 [ 40%] (Adaptation) -#> Iteration: 150 / 250 [ 60%] (Adaptation) -#> Iteration: 200 / 250 [ 80%] (Adaptation) -#> Success! Found best value [eta = 1] earlier than expected. -#> Begin stochastic gradient ascent. -#> iter ELBO delta_ELBO_mean delta_ELBO_med notes -#> 100 -6.262 1.000 1.000 -#> 200 -6.263 0.500 1.000 -#> 300 -6.307 0.336 0.007 MEDIAN ELBO CONVERGED -#> Drawing a sample of size 1000 from the approximate posterior... -#> COMPLETED. -#> Finished in 0.1 seconds.
-fit_vb$summary() -
#> # A tibble: 3 × 7 -#> variable mean median sd mad q5 q95 -#> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> -#> 1 lp__ -7.18 -6.94 0.588 0.259 -8.36 -6.75 -#> 2 lp_approx__ -0.515 -0.221 0.692 0.303 -2.06 -0.00257 -#> 3 theta 0.263 0.246 0.115 0.113 0.106 0.481
-# Plot approximate posterior using bayesplot -mcmc_hist(fit_vb$draws("theta")) -
#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
- -# Specifying initial values as a function -fit_mcmc_w_init_fun <- mod$sample( - data = stan_data, - seed = 123, - chains = 2, - refresh = 0, - init = function() list(theta = runif(1)) -) -
#> Running MCMC with 2 sequential chains... -#> -#> Chain 1 finished in 0.0 seconds. -#> Chain 2 finished in 0.0 seconds. -#> -#> Both chains finished successfully. -#> Mean chain execution time: 0.0 seconds. -#> Total execution time: 0.3 seconds. -#>
fit_mcmc_w_init_fun_2 <- mod$sample( - data = stan_data, - seed = 123, - chains = 2, - refresh = 0, - init = function(chain_id) { - # silly but demonstrates optional use of chain_id - list(theta = 1 / (chain_id + 1)) - } -) -
#> Running MCMC with 2 sequential chains... -#> -#> Chain 1 finished in 0.0 seconds. -#> Chain 2 finished in 0.0 seconds. -#> -#> Both chains finished successfully. -#> Mean chain execution time: 0.0 seconds. -#> Total execution time: 0.3 seconds. -#>
fit_mcmc_w_init_fun_2$init() -
#> [[1]] -#> [[1]]$theta -#> [1] 0.5 -#> -#> -#> [[2]] -#> [[2]]$theta -#> [1] 0.3333333 -#> -#>
-# Specifying initial values as a list of lists -fit_mcmc_w_init_list <- mod$sample( - data = stan_data, - seed = 123, - chains = 2, - refresh = 0, - init = list( - list(theta = 0.75), # chain 1 - list(theta = 0.25) # chain 2 - ) -) -
#> Running MCMC with 2 sequential chains... -#> -#> Chain 1 finished in 0.0 seconds. -#> Chain 2 finished in 0.0 seconds. -#> -#> Both chains finished successfully. -#> Mean chain execution time: 0.0 seconds. -#> Total execution time: 0.3 seconds. -#>
fit_optim_w_init_list <- mod$optimize( - data = stan_data, - seed = 123, - init = list( - list(theta = 0.75) - ) -) -
#> Initial log joint probability = -11.6657 -#> Iter log prob ||dx|| ||grad|| alpha alpha0 # evals Notes -#> 6 -5.00402 0.000237915 9.55309e-07 1 1 9 -#> Optimization terminated normally: -#> Convergence detected: relative gradient magnitude is below tolerance -#> Finished in 0.1 seconds.
fit_optim_w_init_list$init() -
#> [[1]] -#> [[1]]$theta -#> [1] 0.75 -#> -#>
# } - -
+

The Stan and CmdStan documentation:

Other CmdStanModel methods: +model-method-check_syntax, +model-method-compile, +model-method-diagnose, +model-method-expose_functions, +model-method-format, +model-method-generate-quantities, +model-method-optimize, +model-method-sample_mpi, +model-method-sample, +model-method-variables

+
+ +
+

Examples

+
# \dontrun{
+library(cmdstanr)
+library(posterior)
+library(bayesplot)
+color_scheme_set("brightblue")
+
+# Set path to CmdStan
+# (Note: if you installed CmdStan via install_cmdstan() with default settings
+# then setting the path is unnecessary but the default below should still work.
+# Otherwise use the `path` argument to specify the location of your
+# CmdStan installation.)
+set_cmdstan_path(path = NULL)
+#> CmdStan path set to: /Users/jgabry/.cmdstan/cmdstan-2.32.2
+
+# Create a CmdStanModel object from a Stan program,
+# here using the example model that comes with CmdStan
+file <- file.path(cmdstan_path(), "examples/bernoulli/bernoulli.stan")
+mod <- cmdstan_model(file)
+mod$print()
+#> data {
+#>   int<lower=0> N;
+#>   array[N] int<lower=0,upper=1> y;
+#> }
+#> parameters {
+#>   real<lower=0,upper=1> theta;
+#> }
+#> model {
+#>   theta ~ beta(1,1);  // uniform prior on interval 0,1
+#>   y ~ bernoulli(theta);
+#> }
+
+# Data as a named list (like RStan)
+stan_data <- list(N = 10, y = c(0,1,0,0,0,0,0,0,0,1))
+
+# Run MCMC using the 'sample' method
+fit_mcmc <- mod$sample(
+  data = stan_data,
+  seed = 123,
+  chains = 2,
+  parallel_chains = 2
+)
+#> Running MCMC with 2 parallel chains...
+#> 
+#> Chain 1 Iteration:    1 / 2000 [  0%]  (Warmup) 
+#> Chain 1 Iteration:  100 / 2000 [  5%]  (Warmup) 
+#> Chain 1 Iteration:  200 / 2000 [ 10%]  (Warmup) 
+#> Chain 1 Iteration:  300 / 2000 [ 15%]  (Warmup) 
+#> Chain 1 Iteration:  400 / 2000 [ 20%]  (Warmup) 
+#> Chain 1 Iteration:  500 / 2000 [ 25%]  (Warmup) 
+#> Chain 1 Iteration:  600 / 2000 [ 30%]  (Warmup) 
+#> Chain 1 Iteration:  700 / 2000 [ 35%]  (Warmup) 
+#> Chain 1 Iteration:  800 / 2000 [ 40%]  (Warmup) 
+#> Chain 1 Iteration:  900 / 2000 [ 45%]  (Warmup) 
+#> Chain 1 Iteration: 1000 / 2000 [ 50%]  (Warmup) 
+#> Chain 1 Iteration: 1001 / 2000 [ 50%]  (Sampling) 
+#> Chain 1 Iteration: 1100 / 2000 [ 55%]  (Sampling) 
+#> Chain 1 Iteration: 1200 / 2000 [ 60%]  (Sampling) 
+#> Chain 1 Iteration: 1300 / 2000 [ 65%]  (Sampling) 
+#> Chain 1 Iteration: 1400 / 2000 [ 70%]  (Sampling) 
+#> Chain 1 Iteration: 1500 / 2000 [ 75%]  (Sampling) 
+#> Chain 1 Iteration: 1600 / 2000 [ 80%]  (Sampling) 
+#> Chain 1 Iteration: 1700 / 2000 [ 85%]  (Sampling) 
+#> Chain 1 Iteration: 1800 / 2000 [ 90%]  (Sampling) 
+#> Chain 1 Iteration: 1900 / 2000 [ 95%]  (Sampling) 
+#> Chain 1 Iteration: 2000 / 2000 [100%]  (Sampling) 
+#> Chain 2 Iteration:    1 / 2000 [  0%]  (Warmup) 
+#> Chain 2 Iteration:  100 / 2000 [  5%]  (Warmup) 
+#> Chain 2 Iteration:  200 / 2000 [ 10%]  (Warmup) 
+#> Chain 2 Iteration:  300 / 2000 [ 15%]  (Warmup) 
+#> Chain 2 Iteration:  400 / 2000 [ 20%]  (Warmup) 
+#> Chain 2 Iteration:  500 / 2000 [ 25%]  (Warmup) 
+#> Chain 2 Iteration:  600 / 2000 [ 30%]  (Warmup) 
+#> Chain 2 Iteration:  700 / 2000 [ 35%]  (Warmup) 
+#> Chain 2 Iteration:  800 / 2000 [ 40%]  (Warmup) 
+#> Chain 2 Iteration:  900 / 2000 [ 45%]  (Warmup) 
+#> Chain 2 Iteration: 1000 / 2000 [ 50%]  (Warmup) 
+#> Chain 2 Iteration: 1001 / 2000 [ 50%]  (Sampling) 
+#> Chain 2 Iteration: 1100 / 2000 [ 55%]  (Sampling) 
+#> Chain 2 Iteration: 1200 / 2000 [ 60%]  (Sampling) 
+#> Chain 2 Iteration: 1300 / 2000 [ 65%]  (Sampling) 
+#> Chain 2 Iteration: 1400 / 2000 [ 70%]  (Sampling) 
+#> Chain 2 Iteration: 1500 / 2000 [ 75%]  (Sampling) 
+#> Chain 2 Iteration: 1600 / 2000 [ 80%]  (Sampling) 
+#> Chain 2 Iteration: 1700 / 2000 [ 85%]  (Sampling) 
+#> Chain 2 Iteration: 1800 / 2000 [ 90%]  (Sampling) 
+#> Chain 2 Iteration: 1900 / 2000 [ 95%]  (Sampling) 
+#> Chain 2 Iteration: 2000 / 2000 [100%]  (Sampling) 
+#> Chain 1 finished in 0.0 seconds.
+#> Chain 2 finished in 0.0 seconds.
+#> 
+#> Both chains finished successfully.
+#> Mean chain execution time: 0.0 seconds.
+#> Total execution time: 0.2 seconds.
+#> 
+
+# Use 'posterior' package for summaries
+fit_mcmc$summary()
+#> # A tibble: 2 × 10
+#>   variable   mean median    sd   mad      q5    q95  rhat ess_bulk ess_tail
+#>   <chr>     <num>  <num> <num> <num>   <num>  <num> <num>    <num>    <num>
+#> 1 lp__     -7.30  -7.03  0.721 0.380 -8.82   -6.75   1.00     902.    1006.
+#> 2 theta     0.247  0.233 0.122 0.129  0.0786  0.470  1.00     762.     712.
+
+# Get posterior draws
+draws <- fit_mcmc$draws()
+print(draws)
+#> # A draws_array: 1000 iterations, 2 chains, and 2 variables
+#> , , variable = lp__
+#> 
+#>          chain
+#> iteration    1    2
+#>         1 -6.8 -6.8
+#>         2 -6.9 -6.8
+#>         3 -7.0 -7.0
+#>         4 -6.9 -7.1
+#>         5 -6.7 -7.0
+#> 
+#> , , variable = theta
+#> 
+#>          chain
+#> iteration    1    2
+#>         1 0.28 0.21
+#>         2 0.19 0.20
+#>         3 0.16 0.17
+#>         4 0.20 0.36
+#>         5 0.25 0.34
+#> 
+#> # ... with 995 more iterations
+
+# Convert to data frame using posterior::as_draws_df
+as_draws_df(draws)
+#> # A draws_df: 1000 iterations, 2 chains, and 2 variables
+#>    lp__ theta
+#> 1  -6.8  0.28
+#> 2  -6.9  0.19
+#> 3  -7.0  0.16
+#> 4  -6.9  0.20
+#> 5  -6.7  0.25
+#> 6  -7.1  0.36
+#> 7  -9.0  0.55
+#> 8  -7.2  0.15
+#> 9  -6.8  0.23
+#> 10 -7.5  0.42
+#> # ... with 1990 more draws
+#> # ... hidden reserved variables {'.chain', '.iteration', '.draw'}
+
+# Plot posterior using bayesplot (ggplot2)
+mcmc_hist(fit_mcmc$draws("theta"))
+#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
+
+
+# Call CmdStan's diagnose and stansummary utilities
+fit_mcmc$cmdstan_diagnose()
+#> Processing csv files: /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/bernoulli-202307251438-1-4ea737.csv, /var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/bernoulli-202307251438-2-4ea737.csv
+#> 
+#> Checking sampler transitions treedepth.
+#> Treedepth satisfactory for all transitions.
+#> 
+#> Checking sampler transitions for divergences.
+#> No divergent transitions found.
+#> 
+#> Checking E-BFMI - sampler transitions HMC potential energy.
+#> E-BFMI satisfactory.
+#> 
+#> Effective sample size satisfactory.
+#> 
+#> Split R-hat values satisfactory all parameters.
+#> 
+#> Processing complete, no problems detected.
+fit_mcmc$cmdstan_summary()
+#> Inference for Stan model: bernoulli_model
+#> 2 chains: each with iter=(1000,1000); warmup=(0,0); thin=(1,1); 2000 iterations saved.
+#> 
+#> Warmup took (0.0040, 0.0040) seconds, 0.0080 seconds total
+#> Sampling took (0.011, 0.011) seconds, 0.022 seconds total
+#> 
+#>                 Mean     MCSE  StdDev     5%   50%   95%  N_Eff  N_Eff/s    R_hat
+#> 
+#> lp__            -7.3  2.6e-02    0.72   -8.8  -7.0  -6.8    781    35502      1.0
+#> accept_stat__   0.92  8.3e-03    0.13   0.64  0.97   1.0    235    10662  1.0e+00
+#> stepsize__      0.95  7.9e-02   0.079   0.87   1.0   1.0    1.0       46  2.0e+13
+#> treedepth__      1.4  1.1e-02    0.48    1.0   1.0   2.0   1874    85179  1.0e+00
+#> n_leapfrog__     2.5  1.4e-01     1.3    1.0   3.0   3.0     89     4050  1.0e+00
+#> divergent__     0.00      nan    0.00   0.00  0.00  0.00    nan      nan      nan
+#> energy__         7.8  3.6e-02    1.00    6.8   7.5   9.6    775    35215  1.0e+00
+#> 
+#> theta           0.25  4.3e-03    0.12  0.079  0.23  0.47    796    36197      1.0
+#> 
+#> Samples were drawn using hmc with nuts.
+#> For each parameter, N_Eff is a crude measure of effective sample size,
+#> and R_hat is the potential scale reduction factor on split chains (at 
+#> convergence, R_hat=1).
+
+# For models fit using MCMC, if you like working with RStan's stanfit objects
+# then you can create one with rstan::read_stan_csv()
+
+# stanfit <- rstan::read_stan_csv(fit_mcmc$output_files())
+
+
+# Run 'optimize' method to get a point estimate (default is Stan's LBFGS algorithm)
+# and also demonstrate specifying data as a path to a file instead of a list
+my_data_file <- file.path(cmdstan_path(), "examples/bernoulli/bernoulli.data.json")
+fit_optim <- mod$optimize(data = my_data_file, seed = 123)
+#> Initial log joint probability = -9.51104 
+#>     Iter      log prob        ||dx||      ||grad||       alpha      alpha0  # evals  Notes  
+#>        6      -5.00402   0.000103557   2.55661e-07           1           1        9    
+#> Optimization terminated normally:  
+#>   Convergence detected: relative gradient magnitude is below tolerance 
+#> Finished in  0.1 seconds.
+
+fit_optim$summary()
+#> # A tibble: 2 × 2
+#>   variable estimate
+#>   <chr>       <num>
+#> 1 lp__        -5.00
+#> 2 theta        0.2 
+
+
+# Run 'variational' method to approximate the posterior (default is meanfield ADVI)
+fit_vb <- mod$variational(data = stan_data, seed = 123)
+#> ------------------------------------------------------------ 
+#> EXPERIMENTAL ALGORITHM: 
+#>   This procedure has not been thoroughly tested and may be unstable 
+#>   or buggy. The interface is subject to change. 
+#> ------------------------------------------------------------ 
+#> Gradient evaluation took 9e-06 seconds 
+#> 1000 transitions using 10 leapfrog steps per transition would take 0.09 seconds. 
+#> Adjust your expectations accordingly! 
+#> Begin eta adaptation. 
+#> Iteration:   1 / 250 [  0%]  (Adaptation) 
+#> Iteration:  50 / 250 [ 20%]  (Adaptation) 
+#> Iteration: 100 / 250 [ 40%]  (Adaptation) 
+#> Iteration: 150 / 250 [ 60%]  (Adaptation) 
+#> Iteration: 200 / 250 [ 80%]  (Adaptation) 
+#> Success! Found best value [eta = 1] earlier than expected. 
+#> Begin stochastic gradient ascent. 
+#>   iter             ELBO   delta_ELBO_mean   delta_ELBO_med   notes  
+#>    100           -6.262             1.000            1.000 
+#>    200           -6.263             0.500            1.000 
+#>    300           -6.307             0.336            0.007   MEDIAN ELBO CONVERGED 
+#> Drawing a sample of size 1000 from the approximate posterior...  
+#> COMPLETED. 
+#> Finished in  0.1 seconds.
+
+fit_vb$summary()
+#> # A tibble: 3 × 7
+#>   variable      mean median    sd   mad     q5      q95
+#>   <chr>        <num>  <num> <num> <num>  <num>    <num>
+#> 1 lp__        -7.18  -6.94  0.588 0.259 -8.36  -6.75   
+#> 2 lp_approx__ -0.515 -0.221 0.692 0.303 -2.06  -0.00257
+#> 3 theta        0.263  0.246 0.115 0.113  0.106  0.481  
+
+# Plot approximate posterior using bayesplot
+mcmc_hist(fit_vb$draws("theta"))
+#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
+
+
+
+# Specifying initial values as a function
+fit_mcmc_w_init_fun <- mod$sample(
+  data = stan_data,
+  seed = 123,
+  chains = 2,
+  refresh = 0,
+  init = function() list(theta = runif(1))
+)
+#> Running MCMC with 2 sequential chains...
+#> 
+#> Chain 1 finished in 0.0 seconds.
+#> Chain 2 finished in 0.0 seconds.
+#> 
+#> Both chains finished successfully.
+#> Mean chain execution time: 0.0 seconds.
+#> Total execution time: 0.3 seconds.
+#> 
+fit_mcmc_w_init_fun_2 <- mod$sample(
+  data = stan_data,
+  seed = 123,
+  chains = 2,
+  refresh = 0,
+  init = function(chain_id) {
+    # silly but demonstrates optional use of chain_id
+    list(theta = 1 / (chain_id + 1))
+  }
+)
+#> Running MCMC with 2 sequential chains...
+#> 
+#> Chain 1 finished in 0.0 seconds.
+#> Chain 2 finished in 0.0 seconds.
+#> 
+#> Both chains finished successfully.
+#> Mean chain execution time: 0.0 seconds.
+#> Total execution time: 0.3 seconds.
+#> 
+fit_mcmc_w_init_fun_2$init()
+#> [[1]]
+#> [[1]]$theta
+#> [1] 0.5
+#> 
+#> 
+#> [[2]]
+#> [[2]]$theta
+#> [1] 0.3333333
+#> 
+#> 
+
+# Specifying initial values as a list of lists
+fit_mcmc_w_init_list <- mod$sample(
+  data = stan_data,
+  seed = 123,
+  chains = 2,
+  refresh = 0,
+  init = list(
+    list(theta = 0.75), # chain 1
+    list(theta = 0.25)  # chain 2
+  )
+)
+#> Running MCMC with 2 sequential chains...
+#> 
+#> Chain 1 finished in 0.0 seconds.
+#> Chain 2 finished in 0.0 seconds.
+#> 
+#> Both chains finished successfully.
+#> Mean chain execution time: 0.0 seconds.
+#> Total execution time: 0.3 seconds.
+#> 
+fit_optim_w_init_list <- mod$optimize(
+  data = stan_data,
+  seed = 123,
+  init = list(
+    list(theta = 0.75)
+  )
+)
+#> Initial log joint probability = -11.6657 
+#>     Iter      log prob        ||dx||      ||grad||       alpha      alpha0  # evals  Notes  
+#>        6      -5.00402   0.000237915   9.55309e-07           1           1        9    
+#> Optimization terminated normally:  
+#>   Convergence detected: relative gradient magnitude is below tolerance 
+#> Finished in  0.1 seconds.
+fit_optim_w_init_list$init()
+#> [[1]]
+#> [[1]]$theta
+#> [1] 0.75
+#> 
+#> 
+# }
+
+
+
+
-
- +
- - + + diff --git a/docs/reference/read_cmdstan_csv.html b/docs/reference/read_cmdstan_csv.html index ea17d8efc..2106577ef 100644 --- a/docs/reference/read_cmdstan_csv.html +++ b/docs/reference/read_cmdstan_csv.html @@ -1,80 +1,17 @@ - - - - - - - -Read CmdStan CSV files into R — read_cmdstan_csv • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Read CmdStan CSV files into R — read_cmdstan_csv • cmdstanr - - - - - - - - - - - + + - - - -
-
- -
- -
+

read_cmdstan_csv() is used internally by CmdStanR to read CmdStan's output CSV files into R. It can also be used by CmdStan users as -a more flexible and efficient alternative to rstan::read_stan_csv(). See +a more flexible and efficient alternative to rstan::read_stan_csv(). See the Value section for details on the structure of the returned list.

It is also possible to create CmdStanR's fitted model objects directly from CmdStan CSV files using the as_cmdstan_fit() function.

-
read_cmdstan_csv(
-  files,
-  variables = NULL,
-  sampler_diagnostics = NULL,
-  format = getOption("cmdstanr_draws_format", NULL)
-)
+    
+
read_cmdstan_csv(
+  files,
+  variables = NULL,
+  sampler_diagnostics = NULL,
+  format = getOption("cmdstanr_draws_format", NULL)
+)
+
+as_cmdstan_fit(
+  files,
+  check_diagnostics = TRUE,
+  format = getOption("cmdstanr_draws_format")
+)
+
+ +
+

Arguments

+
files
+

(character vector) The paths to the CmdStan CSV files. These can +be files generated by running CmdStanR or running CmdStan directly.

-as_cmdstan_fit( - files, - check_diagnostics = TRUE, - format = getOption("cmdstanr_draws_format") -)
-

Arguments

- - - - - - - - - - - - - - - - - - - - - - -
files

(character vector) The paths to the CmdStan CSV files. These can -be files generated by running CmdStanR or running CmdStan directly.

variables

(character vector) Optionally, the names of the variables -(parameters, transformed parameters, and generated quantities) to read in.

    -
  • If NULL (the default) then all variables are included.

  • +
    variables
    +

    (character vector) Optionally, the names of the variables +(parameters, transformed parameters, and generated quantities) to read in.

    • If NULL (the default) then all variables are included.

    • If an empty string (variables="") then none are included.

    • -
    • For non-scalar variables all elements or specific elements can be selected:

        -
      • variables = "theta" selects all elements of theta;

      • +
      • For non-scalar variables all elements or specific elements can be selected:

        • variables = "theta" selects all elements of theta;

        • variables = c("theta[1]", "theta[3]") selects only the 1st and 3rd elements.

      • -
sampler_diagnostics

(character vector) Works the same way as + + + +

sampler_diagnostics
+

(character vector) Works the same way as variables but for sampler diagnostic variables (e.g., "treedepth__", -"accept_stat__", etc.). Ignored if the model was not fit using MCMC.

format

(string) The format for storing the draws or point estimates. +"accept_stat__", etc.). Ignored if the model was not fit using MCMC.

+ + +
format
+

(string) The format for storing the draws or point estimates. The default depends on the method used to fit the model. See -draws for details, in particular the note about speed -and memory for models with many parameters.

check_diagnostics

(logical) For models fit using MCMC, should +draws for details, in particular the note about speed +and memory for models with many parameters.

+ + +
check_diagnostics
+

(logical) For models fit using MCMC, should diagnostic checks be performed after reading in the files? The default is TRUE but set to FALSE to avoid checking for problems with divergences -and treedepth.

+and treedepth.

-

Value

+
+
+

Value

+ -

as_cmdstan_fit() returns a CmdStanMCMC, CmdStanMLE, or -CmdStanVB object. Some methods typically defined for those objects will not -work (e.g. save_data_file()) but the important methods like $summary(), +

as_cmdstan_fit() returns a CmdStanMCMC, CmdStanMLE, or +CmdStanVB object. Some methods typically defined for those objects will not +work (e.g. save_data_file()) but the important methods like $summary(), $draws(), $sampler_diagnostics() and others will work fine.

-

read_cmdstan_csv() returns a named list with the following components:

    -
  • metadata: A list of the meta information from the run that produced the -CSV file(s). See Examples below.

  • -
-

The other components in the returned list depend on the method that produced + +

read_cmdstan_csv() returns a named list with the following components:

  • metadata: A list of the meta information from the run that produced the +CSV file(s). See Examples below.

  • +

The other components in the returned list depend on the method that produced the CSV file(s).

-

For sampling the returned list also includes the -following components:

    -
  • time: Run time information for the individual chains. The returned object -is the same as for the $time() method except the total run + + +

    For sampling the returned list also includes the +following components:

    • time: Run time information for the individual chains. The returned object +is the same as for the $time() method except the total run time can't be inferred from the CSV files (the chains may have been run in parallel) and is therefore NA.

    • inv_metric: A list (one element per chain) of inverse mass matrices or their diagonals, depending on the type of metric used.

    • step_size: A list (one element per chain) of the step sizes used.

    • warmup_draws: If save_warmup was TRUE when fitting the model then a -draws_array (or different format if format is +draws_array (or different format if format is specified) of warmup draws.

    • -
    • post_warmup_draws: A draws_array (or +

    • post_warmup_draws: A draws_array (or different format if format is specified) of post-warmup draws.

    • warmup_sampler_diagnostics: If save_warmup was TRUE when fitting the -model then a draws_array (or different format if +model then a draws_array (or different format if format is specified) of warmup draws of the sampler diagnostic variables.

    • post_warmup_sampler_diagnostics: A -draws_array (or different format if format is +draws_array (or different format if format is specified) of post-warmup draws of the sampler diagnostic variables.

    • -
    - -

    For optimization the returned list also includes the -following components:

      -
    • point_estimates: Point estimates for the model parameters.

    • -
    - -

    For variational inference the returned list also -includes the following components:

    For optimization the returned list also includes the +following components:

    • point_estimates: Point estimates for the model parameters.

    • +

    For variational inference the returned list also +includes the following components:

    • draws: A draws_matrix (or different format if format is specified) of draws from the approximate posterior distribution.

    • -
    - -

    For standalone generated quantities the -returned list also includes the following components:

    For standalone generated quantities the +returned list also includes the following components:

    • generated_quantities: A draws_array of the generated quantities.

    • -
    - - -

    Examples

    -
    # \dontrun{ -# Generate some CSV files to use for demonstration -fit1 <- cmdstanr_example("logistic", method = "sample", save_warmup = TRUE) -csv_files <- fit1$output_files() -print(csv_files) -
    #> [1] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/logistic-202203181227-1-726257.csv" -#> [2] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/logistic-202203181227-2-726257.csv" -#> [3] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/logistic-202203181227-3-726257.csv" -#> [4] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/logistic-202203181227-4-726257.csv"
    -# Creating fitting model objects - -# Create a CmdStanMCMC object from the CSV files -fit2 <- as_cmdstan_fit(csv_files) -fit2$print("beta") -
    #> variable mean median sd mad q5 q95 rhat ess_bulk ess_tail -#> beta[1] -0.67 -0.66 0.24 0.24 -1.08 -0.28 1.00 4045 3169 -#> beta[2] -0.27 -0.27 0.22 0.22 -0.64 0.08 1.00 3894 2721 -#> beta[3] 0.69 0.68 0.26 0.26 0.27 1.13 1.00 3754 2922
    -# Using read_cmdstan_csv -# -# Read in everything -x <- read_cmdstan_csv(csv_files) -str(x) -
    #> List of 8 -#> $ metadata :List of 40 -#> ..$ stan_version_major : num 2 -#> ..$ stan_version_minor : num 29 -#> ..$ stan_version_patch : num 1 -#> ..$ start_datetime : chr "2022-03-18 18:27:08 UTC" -#> ..$ method : chr "sample" -#> ..$ save_warmup : num 1 -#> ..$ thin : num 1 -#> ..$ gamma : num 0.05 -#> ..$ kappa : num 0.75 -#> ..$ t0 : num 10 -#> ..$ init_buffer : num 75 -#> ..$ term_buffer : num 50 -#> ..$ window : num 25 -#> ..$ algorithm : chr "hmc" -#> ..$ engine : chr "nuts" -#> ..$ metric : chr "diag_e" -#> ..$ stepsize_jitter : num 0 -#> ..$ num_chains : num 1 -#> ..$ id : num [1:4] 1 2 3 4 -#> ..$ init : num [1:4] 2 2 2 2 -#> ..$ seed : num 27467875 -#> ..$ refresh : num 100 -#> ..$ sig_figs : num -1 -#> ..$ profile_file : chr "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpmzUYEz/logistic-profile-202203181227-1-051c26.csv" -#> ..$ stanc_version : chr "stanc3 v2.29.1" -#> ..$ sampler_diagnostics : chr [1:6] "accept_stat__" "stepsize__" "treedepth__" "n_leapfrog__" ... -#> ..$ variables : chr [1:105] "lp__" "alpha" "beta[1]" "beta[2]" ... -#> ..$ step_size_adaptation: num [1:4] 0.729 0.767 0.747 0.752 -#> ..$ model_name : chr "logistic_model" -#> ..$ adapt_engaged : num 1 -#> ..$ adapt_delta : num 0.8 -#> ..$ max_treedepth : num 10 -#> ..$ step_size : num [1:4] 1 1 1 1 -#> ..$ iter_warmup : num 1000 -#> ..$ iter_sampling : num 1000 -#> ..$ threads_per_chain : num 1 -#> ..$ time :'data.frame': 4 obs. of 4 variables: -#> .. ..$ chain_id: num [1:4] 1 2 3 4 -#> .. ..$ warmup : num [1:4] 0.093 0.087 0.149 0.092 -#> .. ..$ sampling: num [1:4] 0.081 0.096 0.1 0.087 -#> .. ..$ total : num [1:4] 0.174 0.183 0.249 0.179 -#> ..$ stan_variable_sizes :List of 4 -#> .. ..$ lp__ : num 1 -#> .. ..$ alpha : num 1 -#> .. ..$ beta : num 3 -#> .. ..$ log_lik: num 100 -#> ..$ stan_variables : chr [1:4] "lp__" "alpha" "beta" "log_lik" -#> ..$ model_params : chr [1:105] "lp__" "alpha" "beta[1]" "beta[2]" ... -#> $ time :List of 2 -#> ..$ total : int NA -#> ..$ chains:'data.frame': 4 obs. of 4 variables: -#> .. ..$ chain_id: num [1:4] 1 2 3 4 -#> .. ..$ warmup : num [1:4] 0.093 0.087 0.149 0.092 -#> .. ..$ sampling: num [1:4] 0.081 0.096 0.1 0.087 -#> .. ..$ total : num [1:4] 0.174 0.183 0.249 0.179 -#> $ inv_metric :List of 4 -#> ..$ 1: num [1:4] 0.046 0.0637 0.0532 0.0736 -#> ..$ 2: num [1:4] 0.0421 0.0566 0.0523 0.0756 -#> ..$ 3: num [1:4] 0.0493 0.0528 0.0523 0.0753 -#> ..$ 4: num [1:4] 0.0365 0.0565 0.0397 0.0632 -#> $ step_size :List of 4 -#> ..$ 1: num 0.729 -#> ..$ 2: num 0.767 -#> ..$ 3: num 0.747 -#> ..$ 4: num 0.752 -#> $ warmup_draws : 'draws_array' num [1:1000, 1:4, 1:105] -66.8 -66.8 -66.8 -65.8 -66.3 ... -#> ..- attr(*, "dimnames")=List of 3 -#> .. ..$ iteration: chr [1:1000] "1" "2" "3" "4" ... -#> .. ..$ chain : chr [1:4] "1" "2" "3" "4" -#> .. ..$ variable : chr [1:105] "lp__" "alpha" "beta[1]" "beta[2]" ... -#> $ post_warmup_draws : 'draws_array' num [1:1000, 1:4, 1:105] -65 -65.7 -64.4 -64.2 -65.3 ... -#> ..- attr(*, "dimnames")=List of 3 -#> .. ..$ iteration: chr [1:1000] "1" "2" "3" "4" ... -#> .. ..$ chain : chr [1:4] "1" "2" "3" "4" -#> .. ..$ variable : chr [1:105] "lp__" "alpha" "beta[1]" "beta[2]" ... -#> $ warmup_sampler_diagnostics : 'draws_array' num [1:1000, 1:4, 1:6] 1 0 0 0.941 0.933 ... -#> ..- attr(*, "dimnames")=List of 3 -#> .. ..$ iteration: chr [1:1000] "1" "2" "3" "4" ... -#> .. ..$ chain : chr [1:4] "1" "2" "3" "4" -#> .. ..$ variable : chr [1:6] "accept_stat__" "stepsize__" "treedepth__" "n_leapfrog__" ... -#> $ post_warmup_sampler_diagnostics: 'draws_array' num [1:1000, 1:4, 1:6] 1 0.916 0.998 0.972 0.911 ... -#> ..- attr(*, "dimnames")=List of 3 -#> .. ..$ iteration: chr [1:1000] "1" "2" "3" "4" ... -#> .. ..$ chain : chr [1:4] "1" "2" "3" "4" -#> .. ..$ variable : chr [1:6] "accept_stat__" "stepsize__" "treedepth__" "n_leapfrog__" ...
    -# Don't read in any of the sampler diagnostic variables -x <- read_cmdstan_csv(csv_files, sampler_diagnostics = "") - -# Don't read in any of the parameters or generated quantities -x <- read_cmdstan_csv(csv_files, variables = "") - -# Read in only specific parameters and sampler diagnostics -x <- read_cmdstan_csv( - csv_files, - variables = c("alpha", "beta[2]"), - sampler_diagnostics = c("n_leapfrog__", "accept_stat__") -) - -# For non-scalar parameters all elements can be selected or only some elements, -# e.g. all of the vector "beta" but only one element of the vector "log_lik" -x <- read_cmdstan_csv( - csv_files, - variables = c("beta", "log_lik[3]") -) -# } - -
    +
+ +
+

Examples

+
# \dontrun{
+# Generate some CSV files to use for demonstration
+fit1 <- cmdstanr_example("logistic", method = "sample", save_warmup = TRUE)
+csv_files <- fit1$output_files()
+print(csv_files)
+#> [1] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/logistic-202307251438-1-0afc76.csv"
+#> [2] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/logistic-202307251438-2-0afc76.csv"
+#> [3] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/logistic-202307251438-3-0afc76.csv"
+#> [4] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/logistic-202307251438-4-0afc76.csv"
+
+# Creating fitting model objects
+
+# Create a CmdStanMCMC object from the CSV files
+fit2 <- as_cmdstan_fit(csv_files)
+fit2$print("beta")
+#>  variable  mean median   sd  mad    q5   q95 rhat ess_bulk ess_tail
+#>   beta[1] -0.67  -0.66 0.25 0.25 -1.09 -0.26 1.00     4467     2955
+#>   beta[2] -0.27  -0.27 0.22 0.22 -0.63  0.09 1.00     4244     3209
+#>   beta[3]  0.68   0.68 0.26 0.26  0.25  1.12 1.00     4340     3315
+
+# Using read_cmdstan_csv
+#
+# Read in everything
+x <- read_cmdstan_csv(csv_files)
+str(x)
+#> List of 8
+#>  $ metadata                       :List of 40
+#>   ..$ stan_version_major  : num 2
+#>   ..$ stan_version_minor  : num 32
+#>   ..$ stan_version_patch  : num 2
+#>   ..$ start_datetime      : chr "2023-07-25 20:38:31 UTC"
+#>   ..$ method              : chr "sample"
+#>   ..$ save_warmup         : num 1
+#>   ..$ thin                : num 1
+#>   ..$ gamma               : num 0.05
+#>   ..$ kappa               : num 0.75
+#>   ..$ t0                  : num 10
+#>   ..$ init_buffer         : num 75
+#>   ..$ term_buffer         : num 50
+#>   ..$ window              : num 25
+#>   ..$ algorithm           : chr "hmc"
+#>   ..$ engine              : chr "nuts"
+#>   ..$ metric              : chr "diag_e"
+#>   ..$ stepsize_jitter     : num 0
+#>   ..$ num_chains          : num 1
+#>   ..$ id                  : num [1:4] 1 2 3 4
+#>   ..$ init                : num [1:4] 2 2 2 2
+#>   ..$ seed                : num 1.15e+09
+#>   ..$ refresh             : num 100
+#>   ..$ sig_figs            : num -1
+#>   ..$ profile_file        : chr "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/logistic-profile-202307251438-1-5569d9.csv"
+#>   ..$ stanc_version       : chr "stanc3 v2.32.2"
+#>   ..$ sampler_diagnostics : chr [1:6] "accept_stat__" "stepsize__" "treedepth__" "n_leapfrog__" ...
+#>   ..$ variables           : chr [1:105] "lp__" "alpha" "beta[1]" "beta[2]" ...
+#>   ..$ step_size_adaptation: num [1:4] 0.666 0.702 0.658 0.727
+#>   ..$ model_name          : chr "logistic_model"
+#>   ..$ adapt_engaged       : num 1
+#>   ..$ adapt_delta         : num 0.8
+#>   ..$ max_treedepth       : num 10
+#>   ..$ step_size           : num [1:4] 1 1 1 1
+#>   ..$ iter_warmup         : num 1000
+#>   ..$ iter_sampling       : num 1000
+#>   ..$ threads_per_chain   : num 1
+#>   ..$ time                :'data.frame':	4 obs. of  4 variables:
+#>   .. ..$ chain_id: num [1:4] 1 2 3 4
+#>   .. ..$ warmup  : num [1:4] 0.07 0.081 0.077 0.071
+#>   .. ..$ sampling: num [1:4] 0.068 0.075 0.065 0.062
+#>   .. ..$ total   : num [1:4] 0.138 0.156 0.142 0.133
+#>   ..$ stan_variable_sizes :List of 4
+#>   .. ..$ lp__   : num 1
+#>   .. ..$ alpha  : num 1
+#>   .. ..$ beta   : num 3
+#>   .. ..$ log_lik: num 100
+#>   ..$ stan_variables      : chr [1:4] "lp__" "alpha" "beta" "log_lik"
+#>   ..$ model_params        : chr [1:105] "lp__" "alpha" "beta[1]" "beta[2]" ...
+#>  $ time                           :List of 2
+#>   ..$ total : int NA
+#>   ..$ chains:'data.frame':	4 obs. of  4 variables:
+#>   .. ..$ chain_id: num [1:4] 1 2 3 4
+#>   .. ..$ warmup  : num [1:4] 0.07 0.081 0.077 0.071
+#>   .. ..$ sampling: num [1:4] 0.068 0.075 0.065 0.062
+#>   .. ..$ total   : num [1:4] 0.138 0.156 0.142 0.133
+#>  $ inv_metric                     :List of 4
+#>   ..$ 1: num [1:4] 0.0426 0.0631 0.0525 0.0739
+#>   ..$ 2: num [1:4] 0.0483 0.0658 0.0426 0.065
+#>   ..$ 3: num [1:4] 0.0473 0.0591 0.0532 0.0814
+#>   ..$ 4: num [1:4] 0.0485 0.0583 0.05 0.0707
+#>  $ step_size                      :List of 4
+#>   ..$ 1: num 0.666
+#>   ..$ 2: num 0.702
+#>   ..$ 3: num 0.658
+#>   ..$ 4: num 0.727
+#>  $ warmup_draws                   : 'draws_array' num [1:1000, 1:4, 1:105] -105.5 -105.5 -105.5 -70.7 -66.2 ...
+#>   ..- attr(*, "dimnames")=List of 3
+#>   .. ..$ iteration: chr [1:1000] "1" "2" "3" "4" ...
+#>   .. ..$ chain    : chr [1:4] "1" "2" "3" "4"
+#>   .. ..$ variable : chr [1:105] "lp__" "alpha" "beta[1]" "beta[2]" ...
+#>  $ post_warmup_draws              : 'draws_array' num [1:1000, 1:4, 1:105] -65.2 -64.4 -65.4 -64.4 -70.3 ...
+#>   ..- attr(*, "dimnames")=List of 3
+#>   .. ..$ iteration: chr [1:1000] "1" "2" "3" "4" ...
+#>   .. ..$ chain    : chr [1:4] "1" "2" "3" "4"
+#>   .. ..$ variable : chr [1:105] "lp__" "alpha" "beta[1]" "beta[2]" ...
+#>  $ warmup_sampler_diagnostics     : 'draws_array' num [1:1000, 1:4, 1:6] 6.68e-01 0.00 1.27e-204 9.99e-01 9.89e-01 ...
+#>   ..- attr(*, "dimnames")=List of 3
+#>   .. ..$ iteration: chr [1:1000] "1" "2" "3" "4" ...
+#>   .. ..$ chain    : chr [1:4] "1" "2" "3" "4"
+#>   .. ..$ variable : chr [1:6] "accept_stat__" "stepsize__" "treedepth__" "n_leapfrog__" ...
+#>  $ post_warmup_sampler_diagnostics: 'draws_array' num [1:1000, 1:4, 1:6] 0.997 0.935 0.852 0.98 0.644 ...
+#>   ..- attr(*, "dimnames")=List of 3
+#>   .. ..$ iteration: chr [1:1000] "1" "2" "3" "4" ...
+#>   .. ..$ chain    : chr [1:4] "1" "2" "3" "4"
+#>   .. ..$ variable : chr [1:6] "accept_stat__" "stepsize__" "treedepth__" "n_leapfrog__" ...
+
+# Don't read in any of the sampler diagnostic variables
+x <- read_cmdstan_csv(csv_files, sampler_diagnostics = "")
+
+# Don't read in any of the parameters or generated quantities
+x <- read_cmdstan_csv(csv_files, variables = "")
+
+# Read in only specific parameters and sampler diagnostics
+x <- read_cmdstan_csv(
+  csv_files,
+  variables = c("alpha", "beta[2]"),
+  sampler_diagnostics = c("n_leapfrog__", "accept_stat__")
+)
+
+# For non-scalar parameters all elements can be selected or only some elements,
+# e.g. all of the vector "beta" but only one element of the vector "log_lik"
+x <- read_cmdstan_csv(
+  csv_files,
+  variables = c("beta", "log_lik[3]")
+)
+# }
+
+
+
+
-
- +
- - + + diff --git a/docs/reference/read_sample_csv.html b/docs/reference/read_sample_csv.html index e06b05c61..af34b60aa 100644 --- a/docs/reference/read_sample_csv.html +++ b/docs/reference/read_sample_csv.html @@ -1,75 +1,12 @@ - - - - - - - -Read CmdStan CSV files from sampling into R — read_sample_csv • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Read CmdStan CSV files from sampling into R — read_sample_csv • cmdstanr - - - - + + -
-
- -
- -
+
-

Deprecated. Use read_cmdstan_csv() instead.

+

Deprecated. Use read_cmdstan_csv() instead.

-
read_sample_csv(files, variables = NULL, sampler_diagnostics = NULL)
+
+
read_sample_csv(files, variables = NULL, sampler_diagnostics = NULL)
+
-

Arguments

- - - - - - -
files, variables, sampler_diagnostics

Deprecated. Use -read_cmdstan_csv() instead.

+
+

Arguments

+
files, variables, sampler_diagnostics
+

Deprecated. Use +read_cmdstan_csv() instead.

+
+
-
- +
- - + + diff --git a/docs/reference/register_knitr_engine.html b/docs/reference/register_knitr_engine.html index 10533e5c4..1e4517702 100644 --- a/docs/reference/register_knitr_engine.html +++ b/docs/reference/register_knitr_engine.html @@ -1,78 +1,15 @@ - - - - - - - -Register CmdStanR's knitr engine for Stan — register_knitr_engine • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Register CmdStanR's knitr engine for Stan — register_knitr_engine • cmdstanr - - - - - - - - - - - - - - + + -
-
- -
- -
+
-

Registers CmdStanR's knitr engine eng_cmdstan() for processing Stan chunks. +

Registers CmdStanR's knitr engine eng_cmdstan() for processing Stan chunks. Refer to the vignette -R Markdown CmdStan Engine +R Markdown CmdStan Engine for a demonstration.

-
register_knitr_engine(override = TRUE)
- -

Arguments

- - - - - - -
override

(logical) Override knitr's built-in, RStan-based engine for -Stan? The default is TRUE. See Details.

+
+
register_knitr_engine(override = TRUE)
+
-

Details

+
+

Arguments

+
override
+

(logical) Override knitr's built-in, RStan-based engine for +Stan? The default is TRUE. See Details.

+
+
+

Details

If override = TRUE (default), this registers CmdStanR's knitr engine as the engine for stan chunks, replacing knitr's built-in, RStan-based engine. If override = FALSE, this registers a cmdstan engine so that both engines @@ -206,10 +133,10 @@

Details highlighting for the Stan language, the cmdstan chunks will have stan syntax highlighting applied to them.

See the vignette -R Markdown CmdStan Engine +R Markdown CmdStan Engine for an example.

Note: When running chunks interactively in RStudio (e.g. when using -R Notebooks), it has +R Notebooks), it has been observed that the built-in, RStan-based engine is used for stan chunks even when CmdStanR's engine has been registered in the session. When the R Markdown document is knit/rendered, the correct engine is used. As a @@ -218,40 +145,35 @@

Details

If you would like to keep stan chunks as stan chunks, it is possible to specify engine = "cmdstan" in the chunk options after registering the cmdstan engine with override = FALSE.

-

References

- +
+
+
-
- +
- - + + diff --git a/docs/reference/set_cmdstan_path.html b/docs/reference/set_cmdstan_path.html index 891803ca4..a91b01e82 100644 --- a/docs/reference/set_cmdstan_path.html +++ b/docs/reference/set_cmdstan_path.html @@ -1,79 +1,16 @@ - - - - - - - -Get or set the file path to the CmdStan installation — set_cmdstan_path • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Get or set the file path to the CmdStan installation — set_cmdstan_path • cmdstanr - - - - - - - - - - + + - - - - -
-
- -
- -
+
@@ -187,80 +115,82 @@

Get or set the file path to the CmdStan installation

for how to avoid manually setting the path in each R session.

-
set_cmdstan_path(path = NULL)
+    
+
set_cmdstan_path(path = NULL)
+
+cmdstan_path()
+
+cmdstan_version(error_on_NA = TRUE)
+
-cmdstan_path() +
+

Arguments

+
path
+

(string) The full file path to the CmdStan installation. If +NULL (the default) then the path is set to the default path used by +install_cmdstan() if it exists.

-cmdstan_version(error_on_NA = TRUE)
-

Arguments

- - - - - - - - - - -
path

(string) The full file path to the CmdStan installation. If -NULL (the default) then the path is set to the default path used by -install_cmdstan() if it exists.

error_on_NA

(logical) Should an error be thrown if CmdStan is not +

error_on_NA
+

(logical) Should an error be thrown if CmdStan is not found. The default is TRUE. If FALSE, cmdstan_version() returns -NULL.

+NULL.

-

Value

+
+
+

Value

+ -

A string. Either the file path to the CmdStan installation or the +

A string. Either the file path to the CmdStan installation or the CmdStan version number.

+ +

CmdStan version string if available. If CmdStan is not found and error_on_NA is FALSE, cmdstan_version() returns NULL.

-

Details

- +
+
+

Details

Before the package can be used it needs to know where the CmdStan installation is located. When the package is loaded it tries to help automate -this to avoid having to manually set the path every session:

    -
  • If the environment variable "CMDSTAN" exists at load time +this to avoid having to manually set the path every session:

    • If the environment variable "CMDSTAN" exists at load time then its value will be automatically set as the default path to CmdStan for -the R session.

    • +the R session. If the environment variable "CMDSTAN" is set, but a valid +CmdStan is not found in the supplied path, the path is treated as a top +folder that contains CmdStan installations. In that case, the CmdStan +installation with the largest version number will be set as the path to +CmdStan for the R session.

    • If no environment variable is found when loaded but any directory in the form ".cmdstan/cmdstan-[version]" (e.g., ".cmdstan/cmdstan-2.23.0"), -exists in the user's home directory (Sys.getenv("HOME"), not the current +exists in the user's home directory (Sys.getenv("HOME"), not the current working directory) then the path to the cmdstan with the largest version number will be set as the path to CmdStan for the R session. This is the -same as the default directory that install_cmdstan() would use to install +same as the default directory that install_cmdstan() would use to install the latest version of CmdStan.

    • -
    - -

    It is always possible to change the path after loading the package using +

It is always possible to change the path after loading the package using set_cmdstan_path(path).

+
+
-
- +
- - + + diff --git a/docs/reference/stan_threads.html b/docs/reference/stan_threads.html index 633442c4a..eeeb82fae 100644 --- a/docs/reference/stan_threads.html +++ b/docs/reference/stan_threads.html @@ -1,75 +1,12 @@ - - - - - - - -Set or get the number of threads used to execute Stan models — stan_threads • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Set or get the number of threads used to execute Stan models — stan_threads • cmdstanr - + + - - - -
-
- -
- -
+
@@ -179,48 +107,46 @@

Set or get the number of threads used to execute Stan models

DEPRECATED. Please use the threads_per_chain argument when fitting the model.

-
num_threads()
-
-set_num_threads(num_threads)
+
+
num_threads()
+
+set_num_threads(num_threads)
+
-

Arguments

- - - - - - -
num_threads

(positive integer) The number of threads to set.

+
+

Arguments

+
num_threads
+

(positive integer) The number of threads to set.

-

Value

+
+
+

Value

+ -

The value of the environment variable STAN_NUM_THREADS.

+

The value of the environment variable STAN_NUM_THREADS.

+
+
-
- +
- - + + diff --git a/docs/reference/write_stan_file.html b/docs/reference/write_stan_file.html index dae2b825b..9b772e61c 100644 --- a/docs/reference/write_stan_file.html +++ b/docs/reference/write_stan_file.html @@ -1,82 +1,19 @@ - - - - - - - -Write Stan code to a file — write_stan_file • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Write Stan code to a file — write_stan_file • cmdstanr - - - - - - - - - - + + - - - - -
-
- -
- -
+

Convenience function for writing Stan code to a (possibly -temporary) file with a .stan extension. By default, the -file name is chosen deterministically based on a hash +temporary) file with a .stan extension. By default, the +file name is chosen deterministically based on a 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 @@ -193,121 +121,125 @@

Write Stan code to a file

should ensure thread-safety in the rare cases when it is needed.

-
write_stan_file(
-  code,
-  dir = getOption("cmdstanr_write_stan_file_dir", tempdir()),
-  basename = NULL,
-  force_overwrite = FALSE,
-  hash_salt = ""
-)
+
+
write_stan_file(
+  code,
+  dir = getOption("cmdstanr_write_stan_file_dir", tempdir()),
+  basename = NULL,
+  force_overwrite = FALSE,
+  hash_salt = ""
+)
+
-

Arguments

- - - - - - - - - - - - - - - - - - - - - - -
code

(character vector) The Stan code to write to the file. This can +

+

Arguments

+
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.

dir

(string) An optional path to the directory where the file will be +Stan program.

+ + +
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 -is used.

basename

(string) If dir is specified, optionally the basename to +used. If the global options is not set, temporary directory +is used.

+ + +
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 the code.

force_overwrite

(logical) If set to TRUE the file will always be -overwritten and thus the resulting model will always be recompiled.

hash_salt

(string) Text to add to the model code prior to hashing to -determine the file name if basename is not set.

+from hashing the code.

+ -

Value

+
force_overwrite
+

(logical) If set to TRUE the file will always be +overwritten and thus the resulting model will always be recompiled.

-

The path to the file.

-

Examples

-
# stan program as a single string -stan_program <- " -data { - int<lower=0> N; - int<lower=0,upper=1> y[N]; -} -parameters { - real<lower=0,upper=1> theta; -} -model { - y ~ bernoulli(theta); -} -" +
hash_salt
+

(string) Text to add to the model code prior to hashing to +determine the file name if basename is not set.

-f <- write_stan_file(stan_program) -print(f) -
#> [1] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T//RtmpmzUYEz/model_08f9e456ca04f3d3244db00f16ea5748.stan"
-lines <- readLines(f) -print(lines) -
#> [1] "" "data {" -#> [3] " int<lower=0> N;" " int<lower=0,upper=1> y[N];" -#> [5] "}" "parameters {" -#> [7] " real<lower=0,upper=1> theta;" "}" -#> [9] "model {" " y ~ bernoulli(theta);" -#> [11] "}" ""
cat(lines, sep = "\n") -
#> -#> data { -#> int<lower=0> N; -#> int<lower=0,upper=1> y[N]; -#> } -#> parameters { -#> real<lower=0,upper=1> theta; -#> } -#> model { -#> y ~ bernoulli(theta); -#> } -#>
-# stan program as character vector of lines -f2 <- write_stan_file(lines) -identical(readLines(f), readLines(f2)) -
#> [1] TRUE
-
+
+
+

Value

+ + +

The path to the file.

+
+ +
+

Examples

+
# stan program as a single string
+stan_program <- "
+data {
+  int<lower=0> N;
+  int<lower=0,upper=1> y[N];
+}
+parameters {
+  real<lower=0,upper=1> theta;
+}
+model {
+  y ~ bernoulli(theta);
+}
+"
+
+f <- write_stan_file(stan_program)
+print(f)
+#> [1] "/var/folders/s0/zfzm55px2nd2v__zlw5xfj2h0000gn/T/RtmpFBtN6X/model_08f9e456ca04f3d3244db00f16ea5748.stan"
+
+lines <- readLines(f)
+print(lines)
+#>  [1] ""                               "data {"                        
+#>  [3] "  int<lower=0> N;"              "  int<lower=0,upper=1> y[N];"  
+#>  [5] "}"                              "parameters {"                  
+#>  [7] "  real<lower=0,upper=1> theta;" "}"                             
+#>  [9] "model {"                        "  y ~ bernoulli(theta);"       
+#> [11] "}"                              ""                              
+cat(lines, sep = "\n")
+#> 
+#> data {
+#>   int<lower=0> N;
+#>   int<lower=0,upper=1> y[N];
+#> }
+#> parameters {
+#>   real<lower=0,upper=1> theta;
+#> }
+#> model {
+#>   y ~ bernoulli(theta);
+#> }
+#> 
+
+# stan program as character vector of lines
+f2 <- write_stan_file(lines)
+identical(readLines(f), readLines(f2))
+#> [1] TRUE
+
+
+
+
-
- +
- - + + diff --git a/docs/reference/write_stan_json.html b/docs/reference/write_stan_json.html index 653081d79..a241a6d9f 100644 --- a/docs/reference/write_stan_json.html +++ b/docs/reference/write_stan_json.html @@ -1,75 +1,12 @@ - - - - - - - -Write data to a JSON file readable by CmdStan — write_stan_json • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Write data to a JSON file readable by CmdStan — write_stan_json • cmdstanr - - + + - - -
-
- -
- -
+
@@ -179,120 +107,114 @@

Write data to a JSON file readable by CmdStan

Write data to a JSON file readable by CmdStan

-
write_stan_json(data, file, always_decimal = FALSE)
+
+
write_stan_json(data, file, always_decimal = FALSE)
+
+ +
+

Arguments

+
data
+

(list) A named list of R objects.

+ + +
file
+

(string) The path to where the data file should be written.

+ -

Arguments

- - - - - - - - - - - - - - -
data

(list) A named list of R objects.

file

(string) The path to where the data file should be written.

always_decimal

(logical) Force generate non-integers with decimal +

always_decimal
+

(logical) Force generate non-integers with decimal points to better distinguish between integers and floating point values. If TRUE all R objects in data intended for integers must be of integer -type.

- -

Details

+type.

+
+
+

Details

write_stan_json() performs several conversions before writing the JSON -file:

    -
  • logical -> integer (TRUE -> 1, FALSE -> 0)

  • -
  • data.frame -> matrix (via data.matrix())

  • +file:

    • logical -> integer (TRUE -> 1, FALSE -> 0)

    • +
    • data.frame -> matrix (via data.matrix())

    • list -> array

    • table -> vector, matrix, or array (depending on dimensions of table)

    • -
    - -

    The list to array conversion is intended to make it easier to prepare -the data for certain Stan declarations involving arrays:

      -
    • vector[J] v[K] (or equivalently array[K] vector[J] v as of Stan 2.27) +

    The list to array conversion is intended to make it easier to prepare +the data for certain Stan declarations involving arrays:

    • vector[J] v[K] (or equivalently array[K] vector[J] v as of Stan 2.27) can be constructed in R as a list with K elements where each element a vector of length J

    • matrix[I,J] v[K] (or equivalently array[K] matrix[I,J] m as of Stan 2.27 ) can be constructed in R as a list with K elements where each element an IxJ matrix

    • -
    - -

    These can also be passed in from R as arrays instead of lists but the list +

These can also be passed in from R as arrays instead of lists but the list option is provided for convenience. Unfortunately for arrays with more than one dimension, e.g., vector[J] v[K,L] (or equivalently array[K,L] vector[J] v as of Stan 2.27) it is not possible to use an R list and an array must be used instead. For this example the array in R should have dimensions KxLxJ.

+
-

Examples

-
x <- matrix(rnorm(10), 5, 2) -y <- rpois(nrow(x), lambda = 10) -z <- c(TRUE, FALSE) -data <- list(N = nrow(x), K = ncol(x), x = x, y = y, z = z) - -# write data to json file -file <- tempfile(fileext = ".json") -write_stan_json(data, file) - -# check the contents of the file -cat(readLines(file), sep = "\n") -
#> { -#> "N": 5, -#> "K": 2, -#> "x": [ -#> [0.552235993548325, 0.721685253131368], -#> [1.40374671287315, -0.278162254251497], -#> [0.512051509623765, -0.524699374531002], -#> [0.660479109910809, 0.0625388737657775], -#> [-0.519175154088263, -0.450598871694098] -#> ], -#> "y": [16, 11, 7, 7, 6], -#> "z": [1, 0] -#> }
- -# demonstrating list to array conversion -# suppose x is declared as `vector[3] x[2]` (or equivalently `array[2] vector[3] x`) -# we can use a list of length 2 where each element is a vector of length 3 -data <- list(x = list(1:3, 4:6)) -file <- tempfile(fileext = ".json") -write_stan_json(data, file) -cat(readLines(file), sep = "\n") -
#> { -#> "x": [ -#> [1, 2, 3], -#> [4, 5, 6] -#> ] -#> }
-
+
+

Examples

+
x <- matrix(rnorm(10), 5, 2)
+y <- rpois(nrow(x), lambda = 10)
+z <- c(TRUE, FALSE)
+data <- list(N = nrow(x), K = ncol(x), x = x, y = y, z = z)
+
+# write data to json file
+file <- tempfile(fileext = ".json")
+write_stan_json(data, file)
+
+# check the contents of the file
+cat(readLines(file), sep = "\n")
+#> {
+#>   "N": 5,
+#>   "K": 2,
+#>   "x": [
+#>     [1.39067866394794, 0.962441316104017],
+#>     [-0.473566508639385, -0.892862153643971],
+#>     [-2.10865772647623, 0.757598190570521],
+#>     [-0.366087824635297, -0.120402278774405],
+#>     [1.44942517823716, -0.444483690720062]
+#>   ],
+#>   "y": [5, 11, 1, 9, 11],
+#>   "z": [1, 0]
+#> }
+
+
+# demonstrating list to array conversion
+# suppose x is declared as `vector[3] x[2]` (or equivalently `array[2] vector[3] x`)
+# we can use a list of length 2 where each element is a vector of length 3
+data <- list(x = list(1:3, 4:6))
+file <- tempfile(fileext = ".json")
+write_stan_json(data, file)
+cat(readLines(file), sep = "\n")
+#> {
+#>   "x": [
+#>     [1, 2, 3],
+#>     [4, 5, 6]
+#>   ]
+#> }
+
+
+
+
-
- +
- - + + diff --git a/docs/reference/write_stan_tempfile.html b/docs/reference/write_stan_tempfile.html index fd650e821..4e9c4ac10 100644 --- a/docs/reference/write_stan_tempfile.html +++ b/docs/reference/write_stan_tempfile.html @@ -1,75 +1,12 @@ - - - - - - - -Write Stan code to a temporary file — write_stan_tempfile • cmdstanr - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Write Stan code to a temporary file — write_stan_tempfile • cmdstanr - + + - - - -
-
- -
- -
+
-

This function is deprecated. Please use write_stan_file() instead.

+

This function is deprecated. Please use write_stan_file() instead.

-
write_stan_tempfile(code, dir = tempdir())
+
+
write_stan_tempfile(code, dir = tempdir())
+
-

Arguments

- - - - - - - - - - -
code

(character vector) The Stan code to write to the file. This can +

+

Arguments

+
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.

dir

(string) An optional path to the directory where the file will be +Stan program.

+ + +
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 -is used.

+used. If the global options is not set, temporary directory +is used.

+
+
-
- +
- - + + From 300030c4fe46a623b59e787c7c4940d11eecc953 Mon Sep 17 00:00:00 2001 From: rok-cesnovar Date: Wed, 26 Jul 2023 19:57:41 +0200 Subject: [PATCH 14/16] update opencl vignette --- .../articles/articles-online-only/opencl.html | 151 ++++++++++-------- .../header-attrs-2.13/header-attrs.js | 12 ++ 2 files changed, 95 insertions(+), 68 deletions(-) create mode 100644 docs/articles/articles-online-only/opencl_files/header-attrs-2.13/header-attrs.js diff --git a/docs/articles/articles-online-only/opencl.html b/docs/articles/articles-online-only/opencl.html index 274f8275e..c2af01ec9 100644 --- a/docs/articles/articles-online-only/opencl.html +++ b/docs/articles/articles-online-only/opencl.html @@ -26,8 +26,6 @@ - -
+
-
-

Introduction -

+
+

+Introduction

This vignette demonstrates how to use the OpenCL capabilities of CmdStan with CmdStanR. The functionality described in this vignette requires CmdStan 2.26.1 or newer.

@@ -162,13 +160,13 @@

Introductionprofiling, which was introduced in Stan version 2.26.0.

-
-

OpenCL runtime -

+
+

+OpenCL runtime

OpenCL is supported on most modern CPUs and GPUs. In order to use OpenCL in CmdStanR, an OpenCL runtime for the target device must be installed. A guide for the most common devices is available in the -CmdStan manual’s chapter +CmdStan manual’s chapter on parallelization.

In case of using Windows, CmdStan requires the OpenCL.lib to compile the model. If you experience issue @@ -177,17 +175,17 @@

OpenCL runtimeOpenCL.lib file on your system. If you are using CUDA, the path should be similar to the one listed here.

-path_to_opencl_lib <- "C:/Program Files/NVIDIA GPU Computing Toolkit/CUDA/v11.5/lib/x64"
-cpp_options = list(
-  paste0("LDFLAGS+= -L\"",path_to_opencl_lib,"\" -lOpenCL")
-)
-
-cmdstanr::cmdstan_make_local(cpp_options = cpp_options)
-cmdstanr::rebuild_cmdstan()
+path_to_opencl_lib <- "C:/Program Files/NVIDIA GPU Computing Toolkit/CUDA/v11.5/lib/x64" +cpp_options = list( + paste0("LDFLAGS+= -L\"",path_to_opencl_lib,"\" -lOpenCL") +) + +cmdstanr::cmdstan_make_local(cpp_options = cpp_options) +cmdstanr::rebuild_cmdstan()

-
-

Compiling a model with OpenCL -

+
+

+Compiling a model with OpenCL

By default, models in CmdStanR are compiled without OpenCL support. Once OpenCL support is enabled, a CmdStan model will make use of OpenCL if the functions in the model support it. Technically no @@ -215,30 +213,30 @@

Compiling a model with OpenCL
-library(cmdstanr)
-
-# Generate some fake data
-n <- 250000
-k <- 20
-X <- matrix(rnorm(n * k), ncol = k)
-y <- rbinom(n, size = 1, prob = plogis(3 * X[,1] - 2 * X[,2] + 1))
-mdata <- list(k = k, n = n, y = y, X = X)

+library(cmdstanr) + +# Generate some fake data +n <- 250000 +k <- 20 +X <- matrix(rnorm(n * k), ncol = k) +y <- rbinom(n, size = 1, prob = plogis(3 * X[,1] - 2 * X[,2] + 1)) +mdata <- list(k = k, n = n, y = y, X = X)

In this model, most of the computation will be handled by the bernoulli_logit_glm_lpmf function. Because this is a supported GPU function, it should be possible to accelerate it with -OpenCL. Check here for a +OpenCL. Check here for a list of functions with OpenCL support.

To build the model with OpenCL support, add cpp_options = list(stan_opencl = TRUE) at the compilation step.

-# Compile the model with STAN_OPENCL=TRUE
-mod_cl <- cmdstan_model("opencl-files/bernoulli_logit_glm.stan",
-                        cpp_options = list(stan_opencl = TRUE))
+# Compile the model with STAN_OPENCL=TRUE +mod_cl <- cmdstan_model("opencl-files/bernoulli_logit_glm.stan", + cpp_options = list(stan_opencl = TRUE))
-
-

Running models with OpenCL -

+ +
Running MCMC with 4 parallel chains...
+
+Chain 4 finished in 96.7 seconds.
+Chain 1 finished in 97.9 seconds.
+Chain 2 finished in 98.6 seconds.
+Chain 3 finished in 98.8 seconds.
+
+All 4 chains finished successfully.
+Mean chain execution time: 98.0 seconds.
+Total execution time: 103.0 seconds.

We’ll also run a version without OpenCL and compare the run times.

-
-# no OpenCL version
-mod <- cmdstan_model("opencl-files/bernoulli_logit_glm.stan", force_recompile = TRUE)
-fit_cpu <- mod$sample(data = mdata, chains = 4, parallel_chains = 4, refresh = 0)
-

The speedup of the OpenCL model is:

-fit_cpu$time()$total / fit_cl$time()$total
+# no OpenCL version +mod <- cmdstan_model("opencl-files/bernoulli_logit_glm.stan", force_recompile = TRUE) +fit_cpu <- mod$sample(data = mdata, chains = 4, parallel_chains = 4, refresh = 0)
+
Running MCMC with 4 parallel chains...
+
+Chain 3 finished in 487.9 seconds.
+Chain 2 finished in 491.8 seconds.
+Chain 1 finished in 514.9 seconds.
+Chain 4 finished in 518.4 seconds.
+
+All 4 chains finished successfully.
+Mean chain execution time: 503.2 seconds.
+Total execution time: 521.9 seconds.
+

The speedup of the OpenCL model is:

+
+fit_cpu$time()$total / fit_cl$time()$total
+
[1] 5.065968

This speedup will be determined by the particular GPU/CPU used, the input problem sizes (data as well as parameters) and if the model uses functions that can be run on the GPU or other OpenCL devices.

@@ -286,13 +305,11 @@

Running models with OpenCL
-

-

Site built with pkgdown 2.0.7.

+

Site built with pkgdown 1.6.1.

@@ -301,7 +318,5 @@

Running models with OpenCL diff --git a/docs/articles/articles-online-only/opencl_files/header-attrs-2.13/header-attrs.js b/docs/articles/articles-online-only/opencl_files/header-attrs-2.13/header-attrs.js new file mode 100644 index 000000000..dd57d92e0 --- /dev/null +++ b/docs/articles/articles-online-only/opencl_files/header-attrs-2.13/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); From ae25ca4402232960bf8e1ae74e118c628ea814f7 Mon Sep 17 00:00:00 2001 From: jgabry Date: Wed, 26 Jul 2023 12:00:39 -0600 Subject: [PATCH 15/16] Update .gitignore --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 8dc61d80a..cce013141 100644 --- a/.gitignore +++ b/.gitignore @@ -7,3 +7,4 @@ design-questions/* inst/doc dev-helpers.R +release-prep.R From 7d15ab4a244830dbb785e9c892d9e4fecd0cd50a Mon Sep 17 00:00:00 2001 From: jgabry Date: Wed, 26 Jul 2023 12:06:04 -0600 Subject: [PATCH 16/16] update Rbuildignore --- .Rbuildignore | 2 +- .gitignore | 1 - 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/.Rbuildignore b/.Rbuildignore index 691c7f148..8c1f77aae 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -7,8 +7,8 @@ ^docs$ ^pkgdown$ ^man-roxygen$ -^dev-helpers\.R$ ^LICENSE\.md$ ^\.appveyor\.yml$ ^\.github$ ^vignettes/articles-online-only$ +^release-prep\.R$ diff --git a/.gitignore b/.gitignore index cce013141..db3f1c32c 100644 --- a/.gitignore +++ b/.gitignore @@ -4,7 +4,6 @@ .Ruserdata .vscode/* -design-questions/* inst/doc dev-helpers.R release-prep.R