-
-
Notifications
You must be signed in to change notification settings - Fork 62
/
Copy pathmodel.R
2416 lines (2349 loc) · 91 KB
/
model.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
#' Create a new CmdStanModel object
#'
#' @description \if{html}{\figure{logo.png}{options: width=25}}
#' Create a new [`CmdStanModel`] object from a file containing a Stan program
#' or from an existing Stan executable. The [`CmdStanModel`] object stores the
#' path to a Stan program and compiled executable (once created), and provides
#' methods for fitting the model using Stan's algorithms.
#'
#' See the `compile` and `...` arguments for control over whether and how
#' compilation happens.
#'
#' @export
#' @param stan_file (string) The path to a `.stan` file containing a Stan
#' program. The helper function [write_stan_file()] is provided for cases when
#' it is more convenient to specify the Stan program as a string. If
#' `stan_file` is not specified then `exe_file` must be specified.
#' @param exe_file (string) The path to an existing Stan model executable. Can
#' be provided instead of or in addition to `stan_file` (if `stan_file` is
#' omitted some `CmdStanModel` methods like `$code()` and `$print()` will not
#' work). This argument can only be used with CmdStan 2.27+.
#' @param compile (logical) Do compilation? The default is `TRUE`. If `FALSE`
#' compilation can be done later via the [`$compile()`][model-method-compile]
#' method.
#' @param ... Optionally, additional arguments to pass to the
#' [`$compile()`][model-method-compile] method if `compile=TRUE`. These
#' options include specifying the directory for saving the executable, turning
#' on pedantic mode, specifying include paths, configuring C++ options, and
#' more. See [`$compile()`][model-method-compile] for details.
#'
#' @return A [`CmdStanModel`] object.
#'
#' @seealso [install_cmdstan()], [`$compile()`][model-method-compile],
#' [`$check_syntax()`][model-method-check_syntax]
#'
#'
#' @template seealso-docs
#'
#' @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)
#'
#' # 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()
#' # Print with line numbers. This can be set globally using the
#' # `cmdstanr_print_line_numbers` option.
#' mod$print(line_numbers = TRUE)
#'
#' # 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
#' )
#'
#' # Use 'posterior' package for summaries
#' fit_mcmc$summary()
#'
#' # Check sampling diagnostics
#' fit_mcmc$diagnostic_summary()
#'
#' # Get posterior draws
#' draws <- fit_mcmc$draws()
#' print(draws)
#'
#' # Convert to data frame using posterior::as_draws_df
#' as_draws_df(draws)
#'
#' # Plot posterior using bayesplot (ggplot2)
#' mcmc_hist(fit_mcmc$draws("theta"))
#'
#' # 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)
#' fit_optim$summary()
#'
#' # Run 'optimize' again with 'jacobian=TRUE' and then draw from Laplace approximation
#' # to the posterior
#' fit_optim <- mod$optimize(data = my_data_file, jacobian = TRUE)
#' fit_laplace <- mod$laplace(data = my_data_file, mode = fit_optim, draws = 2000)
#' fit_laplace$summary()
#'
#' # Run 'variational' method to use ADVI to approximate posterior
#' fit_vb <- mod$variational(data = stan_data, seed = 123)
#' fit_vb$summary()
#' mcmc_hist(fit_vb$draws("theta"))
#'
#' # Run 'pathfinder' method, a new alternative to the variational method
#' fit_pf <- mod$pathfinder(data = stan_data, seed = 123)
#' fit_pf$summary()
#' mcmc_hist(fit_pf$draws("theta"))
#'
#' # Run 'pathfinder' again with more paths, fewer draws per path,
#' # better covariance approximation, and fewer LBFGSs iterations
#' fit_pf <- mod$pathfinder(data = stan_data, num_paths=10, single_path_draws=40,
#' history_size=50, max_lbfgs_iters=100)
#'
#' # 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))
#' )
#' 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))
#' }
#' )
#' fit_mcmc_w_init_fun_2$init()
#'
#' # 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
#' )
#' )
#' fit_optim_w_init_list <- mod$optimize(
#' data = stan_data,
#' seed = 123,
#' init = list(
#' list(theta = 0.75)
#' )
#' )
#' fit_optim_w_init_list$init()
#' }
#'
cmdstan_model <- function(stan_file = NULL, exe_file = NULL, compile = TRUE, ...) {
if (cmdstan_version() < "2.27.0" && !is.null(exe_file)) {
stop("'exe_file' argument is only supported with CmdStan 2.27 and newer.", call. = FALSE)
}
if (is.null(exe_file) && is.null(stan_file)) {
stop("Unable to create a `CmdStanModel` object. Both 'stan_file' and 'exe_file' are undefined.", call. = FALSE)
}
CmdStanModel$new(stan_file = stan_file, exe_file = exe_file, compile = compile, ...)
}
# CmdStanModel -----------------------------------------------------------------
#' CmdStanModel objects
#'
#' @name CmdStanModel
#' @description A `CmdStanModel` object is an [R6][R6::R6Class] object created
#' by the [cmdstan_model()] function. The object stores the path to a Stan
#' program and compiled executable (once created), and provides methods for
#' fitting the model using Stan's algorithms.
#'
#' @section Methods: `CmdStanModel` objects have the following associated
#' methods, many of which have their own (linked) documentation pages:
#'
#' ## Stan code
#'
#' |**Method**|**Description**|
#' |:----------|:---------------|
#' `$stan_file()` | Return the file path to the Stan program. |
#' `$code()` | Return Stan program as a character vector. |
#' `$print()`| Print readable version of Stan program. |
#' [`$check_syntax()`][model-method-check_syntax] | Check Stan syntax without having to compile. |
#' [`$format()`][model-method-format] | Format and canonicalize the Stan model code. |
#'
#' ## Compilation
#'
#' |**Method**|**Description**|
#' |:----------|:---------------|
#' [`$compile()`][model-method-compile] | Compile Stan program. |
#' [`$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. |
#'
#' ## Diagnostics
#'
#' |**Method**|**Description**|
#' |:----------|:---------------|
#' [`$diagnose()`][model-method-diagnose] | Run CmdStan's `"diagnose"` method to test gradients, return [`CmdStanDiagnose`] object. |
#'
#' ## Model fitting
#'
#' |**Method**|**Description**|
#' |:----------|:---------------|
#' [`$sample()`][model-method-sample] | Run CmdStan's `"sample"` method, return [`CmdStanMCMC`] object. |
#' [`$sample_mpi()`][model-method-sample_mpi] | Run CmdStan's `"sample"` method with [MPI](https://mc-stan.org/math/md_doxygen_2parallelism__support_2mpi__parallelism.html), return [`CmdStanMCMC`] object. |
#' [`$optimize()`][model-method-optimize] | Run CmdStan's `"optimize"` method, return [`CmdStanMLE`] object. |
#' [`$variational()`][model-method-variational] | Run CmdStan's `"variational"` method, return [`CmdStanVB`] object. |
#' [`$pathfinder()`][model-method-pathfinder] | Run CmdStan's `"pathfinder"` method, return [`CmdStanPathfinder`] object. |
#' [`$generate_quantities()`][model-method-generate-quantities] | Run CmdStan's `"generate quantities"` method, return [`CmdStanGQ`] object. |
#'
#' @template seealso-docs
#' @inherit cmdstan_model examples
#'
CmdStanModel <- R6::R6Class(
classname = "CmdStanModel",
private = list(
stan_file_ = character(),
stan_code_ = character(),
model_name_ = character(),
exe_file_ = character(),
hpp_file_ = character(),
model_methods_env_ = NULL,
dir_ = NULL,
cpp_options_ = list(),
stanc_options_ = list(),
include_paths_ = NULL,
using_user_header_ = FALSE,
precompile_cpp_options_ = NULL,
precompile_stanc_options_ = NULL,
precompile_include_paths_ = NULL,
variables_ = NULL
),
public = list(
functions = NULL,
initialize = function(stan_file = NULL, exe_file = NULL, compile, ...) {
args <- list(...)
private$dir_ <- args$dir
self$functions <- new.env()
self$functions$compiled <- FALSE
if (!is.null(stan_file)) {
assert_file_exists(stan_file, access = "r", extension = c("stan", "stanfunctions"))
checkmate::assert_flag(compile)
private$stan_file_ <- absolute_path(stan_file)
private$stan_code_ <- readLines(stan_file)
private$model_name_ <- sub(" ", "_", strip_ext(basename(private$stan_file_)))
private$precompile_cpp_options_ <- args$cpp_options %||% list()
private$precompile_stanc_options_ <- assert_valid_stanc_options(args$stanc_options) %||% list()
if (!is.null(args$user_header) || !is.null(args$cpp_options[["USER_HEADER"]]) ||
!is.null(args$cpp_options[["user_header"]])) {
private$using_user_header_ <- TRUE
}
if (is.null(args$include_paths) && any(grepl("#include" , private$stan_code_))) {
private$precompile_include_paths_ <- dirname(stan_file)
} else {
private$precompile_include_paths_ <- args$include_paths
}
}
if (!is.null(exe_file)) {
ext <- if (os_is_windows() && !os_is_wsl()) "exe" else ""
private$exe_file_ <- repair_path(absolute_path(exe_file))
if (is.null(stan_file)) {
assert_file_exists(private$exe_file_, access = "r", extension = ext)
private$model_name_ <- sub(" ", "_", strip_ext(basename(private$exe_file_)))
}
}
if (!is.null(stan_file) && compile) {
self$compile(...)
}
if (length(self$exe_file()) > 0 && file.exists(self$exe_file())) {
cpp_options <- model_compile_info(self$exe_file())
for (cpp_option_name in names(cpp_options)) {
if (cpp_option_name != "stan_version" &&
(!is.logical(cpp_options[[cpp_option_name]]) || isTRUE(cpp_options[[cpp_option_name]]))) {
private$cpp_options_[[cpp_option_name]] <- cpp_options[[cpp_option_name]]
}
}
}
invisible(self)
},
include_paths = function() {
if (length(self$exe_file()) > 0 && file.exists(self$exe_file())) {
return(private$include_paths_)
} else {
return(private$precompile_include_paths_)
}
},
code = function() {
if (length(private$stan_code_) == 0) {
warning("'$code()' will return NULL because the 'CmdStanModel' was not created with a Stan file.", call. = FALSE)
return(NULL)
}
private$stan_code_
},
print = function(line_numbers = getOption("cmdstanr_print_line_numbers", FALSE)) {
if (length(private$stan_code_) == 0) {
stop("'$print()' cannot be used because the 'CmdStanModel' was not created with a Stan file.", call. = FALSE)
}
lines <- self$code()
if (line_numbers) {
line_num_indent <- nchar(as.character(length(lines)))
line_nums <- vapply(seq_along(lines), function(y) {
paste0(
rep(" ", line_num_indent - nchar(as.character(y))), y, collapse = ""
)
}, character(1))
lines <- paste(paste(line_nums, lines, sep = ": "), collapse = "\n")
}
cat(lines, sep = "\n")
invisible(self)
},
stan_file = function() {
private$stan_file_
},
has_stan_file = function() {
length(self$stan_file()) > 0
},
model_name = function() {
private$model_name_
},
exe_file = function(path = NULL) {
if (!is.null(path)) {
private$exe_file_ <- path
}
private$exe_file_
},
cpp_options = function() {
private$cpp_options_
},
hpp_file = function() {
if (!length(private$hpp_file_)) {
stop("The .hpp file does not exists. Please (re)compile the model.", call. = FALSE)
}
private$hpp_file_
},
save_hpp_file = function(dir = NULL) {
if (is.null(dir)) {
dir <- dirname(private$stan_file_)
}
assert_dir_exists(dir, access = "r")
new_hpp_loc <- file.path(dir, paste0(strip_ext(basename(private$stan_file_)), ".hpp"))
file.copy(self$hpp_file(), new_hpp_loc, overwrite = TRUE)
file.remove(self$hpp_file())
message("Moved .hpp file and set internal path to new location:\n",
"- ", new_hpp_loc)
private$hpp_file_ <- new_hpp_loc
invisible(private$hpp_file_)
}
)
)
# CmdStanModel methods -----------------------------------
#' Compile a Stan program
#'
#' @name model-method-compile
#' @aliases compile
#' @family CmdStanModel methods
#'
#' @description 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()`][model-method-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
#' 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
#' `$hpp_file()` methods. The default is to create the executable in the same
#' directory as the Stan program and to write the generated C++ code in a
#' temporary directory. To save the C++ code to a non-temporary location use
#' `$save_hpp_file(dir)`.
#'
#' @param 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.
#' @param 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.
#' @param 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*
#' section](https://mc-stan.org/docs/stan-users-guide/pedantic-mode.html) 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()`][model-method-check_syntax] method can be used instead.
#' @param include_paths (character vector) Paths to directories where Stan
#' should look for files specified in `#include` directives in the Stan
#' program.
#' @param user_header (string) The path to a C++ file (with a .hpp extension)
#' to compile with the Stan model.
#' @param 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](https://mc-stan.org/users/documentation/case-studies/reduce_sum_tutorial.html).
#' @param 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.
#' @param 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.
#' @param compile_model_methods (logical) Compile additional model methods
#' (`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. This can also be done after
#' compilation using the
#' [`$expose_functions()`][model-method-expose_functions] method.
#' @param dry_run (logical) If `TRUE`, the code will do all checks before compilation,
#' but skip the actual C++ compilation. Used to speedup tests.
#'
#' @param threads Deprecated and will be removed in a future release. Please
#' turn on threading via `cpp_options = list(stan_threads = TRUE)` instead.
#'
#' @return 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.
#'
#' @seealso The [`$check_syntax()`][model-method-check_syntax] method to check
#' Stan syntax or enable pedantic model without compiling.
#' @template seealso-docs
#'
#' @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()
#'
#' # 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()
#'
#' # 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)
#'
#' }
#'
compile <- function(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_standalone = FALSE,
dry_run = FALSE,
#deprecated
compile_hessian_method = FALSE,
threads = FALSE) {
if (length(self$stan_file()) == 0) {
stop("'$compile()' cannot be used because the 'CmdStanModel' was not created with a Stan file.", call. = FALSE)
}
assert_stan_file_exists(self$stan_file())
if (length(cpp_options) == 0 && !is.null(private$precompile_cpp_options_)) {
cpp_options <- private$precompile_cpp_options_
}
if (length(stanc_options) == 0 && !is.null(private$precompile_stanc_options_)) {
stanc_options <- private$precompile_stanc_options_
}
stanc_options <- assert_valid_stanc_options(stanc_options)
if (is.null(include_paths) && !is.null(private$precompile_include_paths_)) {
include_paths <- private$precompile_include_paths_
}
private$include_paths_ <- include_paths
if (is.null(dir) && !is.null(private$dir_)) {
dir <- absolute_path(private$dir_)
} else if (!is.null(dir)) {
dir <- absolute_path(dir)
}
if (!is.null(dir)) {
dir <- repair_path(dir)
assert_dir_exists(dir, access = "rw")
if (length(self$exe_file()) != 0) {
private$exe_file_ <- file.path(dir, basename(self$exe_file()))
}
}
# temporary deprecation warnings
if (isTRUE(threads)) {
warning("'threads' is deprecated. Please use 'cpp_options = list(stan_threads = TRUE)' instead.")
cpp_options[["stan_threads"]] <- TRUE
}
# temporary deprecation warnings
if (isTRUE(compile_hessian_method)) {
warning("'compile_hessian_method' is deprecated. The hessian method is compiled with all models.")
}
if (length(self$exe_file()) == 0) {
if (is.null(dir)) {
exe_base <- self$stan_file()
} else {
exe_base <- file.path(dir, basename(self$stan_file()))
}
exe <- cmdstan_ext(strip_ext(exe_base))
if (dir.exists(exe)) {
stop("There is a subfolder matching the model name in the same folder as the model! Please remove or rename the subfolder and try again.", call. = FALSE)
}
} else {
exe <- self$exe_file()
}
# Resolve stanc and cpp options
if (pedantic) {
stanc_options[["warn-pedantic"]] <- TRUE
}
if (isTRUE(cpp_options$stan_opencl)) {
stanc_options[["use-opencl"]] <- TRUE
}
# Note that unlike cpp_options["USER_HEADER"], the user_header variable is deliberately
# not transformed with wsl_safe_path() as that breaks the check below on WSLv1
if (!is.null(user_header)) {
if (!is.null(cpp_options[["USER_HEADER"]]) || !is.null(cpp_options[["user_header"]])) {
warning("User header specified both via user_header argument and via cpp_options arguments")
}
cpp_options[["USER_HEADER"]] <- wsl_safe_path(absolute_path(user_header))
stanc_options[["allow-undefined"]] <- TRUE
private$using_user_header_ <- TRUE
} else if (!is.null(cpp_options[["USER_HEADER"]])) {
if (!is.null(cpp_options[["user_header"]])) {
warning('User header specified both via cpp_options[["USER_HEADER"]] and cpp_options[["user_header"]].', call. = FALSE)
}
user_header <- cpp_options[["USER_HEADER"]]
cpp_options[["USER_HEADER"]] <- wsl_safe_path(absolute_path(cpp_options[["USER_HEADER"]]))
private$using_user_header_ <- TRUE
} else if (!is.null(cpp_options[["user_header"]])) {
user_header <- cpp_options[["user_header"]]
cpp_options[["user_header"]] <- wsl_safe_path(absolute_path(cpp_options[["user_header"]]))
private$using_user_header_ <- TRUE
}
if (!is.null(user_header)) {
user_header <- absolute_path(user_header) # As mentioned above, just absolute, not wsl_safe_path()
if (!file.exists(user_header)) {
stop(paste0("User header file '", user_header, "' does not exist."), call. = FALSE)
}
}
# compile if:
# - the user forced compilation,
# - the executable does not exist
# - the stan model was changed since last compilation
# - a user header is used and the user header changed since last compilation (#813)
if (!file.exists(exe)) {
force_recompile <- TRUE
} else if (file.exists(self$stan_file())
&& file.mtime(exe) < file.mtime(self$stan_file())) {
force_recompile <- TRUE
} else if (!is.null(user_header)
&& file.exists(user_header)
&& file.mtime(exe) < file.mtime(user_header)) {
force_recompile <- TRUE
}
if (!force_recompile) {
if (rlang::is_interactive()) {
message("Model executable is up to date!")
}
private$cpp_options_ <- cpp_options
private$precompile_cpp_options_ <- NULL
private$precompile_stanc_options_ <- NULL
private$precompile_include_paths_ <- NULL
self$functions$existing_exe <- TRUE
self$exe_file(exe)
return(invisible(self))
} else {
if (rlang::is_interactive()) {
message("Compiling Stan program...")
}
}
if (os_is_wsl() && (compile_model_methods || compile_standalone)) {
warning("Additional model methods and standalone functions are not ",
"currently available with WSLv1 CmdStan and will not be compiled.",
call. = FALSE)
compile_model_methods <- FALSE
compile_standalone <- FALSE
compile_hessian_method <- FALSE
}
temp_stan_file <- tempfile(pattern = "model-", fileext = paste0(".", tools::file_ext(self$stan_file())))
file.copy(self$stan_file(), temp_stan_file, overwrite = TRUE)
temp_file_no_ext <- strip_ext(temp_stan_file)
tmp_exe <- cmdstan_ext(temp_file_no_ext) # adds .exe on Windows
if (os_is_windows() && !os_is_wsl()) {
tmp_exe <- utils::shortPathName(tmp_exe)
}
private$hpp_file_ <- paste0(temp_file_no_ext, ".hpp")
stancflags_val <- include_paths_stanc3_args(include_paths)
if (is.null(stanc_options[["name"]])) {
stanc_options[["name"]] <- paste0(self$model_name(), "_model")
}
stanc_built_options <- c()
for (i in seq_len(length(stanc_options))) {
option_name <- names(stanc_options)[i]
if (isTRUE(as.logical(stanc_options[[i]]))) {
stanc_built_options <- c(stanc_built_options, paste0("--", option_name))
} else if (is.null(option_name) || !nzchar(option_name)) {
stanc_built_options <- c(stanc_built_options, paste0("--", stanc_options[[i]]))
} else {
stanc_built_options <- c(stanc_built_options, paste0("--", option_name, "=", "'", stanc_options[[i]], "'"))
}
}
stancflags_combined <- stanc_built_options
stancflags_local <- get_cmdstan_flags("STANCFLAGS")
if (stancflags_local != "") {
stancflags_combined <- c(stancflags_combined, stancflags_local)
}
stanc_inc_paths <- include_paths_stanc3_args(include_paths, standalone_call = TRUE)
stancflags_standalone <- c("--standalone-functions", stanc_inc_paths, stancflags_combined)
self$functions$hpp_code <- get_standalone_hpp(temp_stan_file, stancflags_standalone)
private$model_methods_env_ <- new.env()
private$model_methods_env_$hpp_code_ <- get_standalone_hpp(temp_stan_file, c(stanc_inc_paths, stancflags_combined))
self$functions$external <- !is.null(user_header)
self$functions$existing_exe <- FALSE
stancflags_val <- paste0("STANCFLAGS += ", stancflags_val, paste0(" ", stancflags_combined, collapse = " "))
if (!dry_run) {
if (compile_standalone) {
expose_stan_functions(self$functions, !quiet)
}
withr::with_envvar(
c("HOME" = short_path(Sys.getenv("HOME"))),
withr::with_path(
c(
toolchain_PATH_env_var(),
tbb_path()
),
run_log <- wsl_compatible_run(
command = make_cmd(),
args = c(wsl_safe_path(repair_path(tmp_exe)),
cpp_options_to_compile_flags(cpp_options),
stancflags_val),
wd = cmdstan_path(),
echo = !quiet || is_verbose_mode(),
echo_cmd = is_verbose_mode(),
spinner = quiet && rlang::is_interactive() && !identical(Sys.getenv("IN_PKGDOWN"), "true"),
stderr_callback = function(x, p) {
if (!startsWith(x, paste0(make_cmd(), ": *** No rule to make target"))) {
message(x)
}
if (grepl("PCH file", x) || grepl("precompiled header", x) || grepl(".hpp.gch", x) ) {
warning(
"CmdStan's precompiled header (PCH) files may need to be rebuilt.\n",
"If your model failed to compile please run rebuild_cmdstan().\n",
"If the issue persists please open a bug report.",
call. = FALSE
)
}
if (grepl("No space left on device", x) || grepl("error in backend: IO failure on output stream", x)) {
warning(
"The C++ compiler ran out of disk space and was unable to build the executables for your model!\n",
"See the above error for more details.",
call. = FALSE
)
}
if (os_is_macos()) {
if (R.version$arch == "aarch64"
&& grepl("but the current translation unit is being compiled for target", x)) {
warning(
"The C++ compiler has errored due to incompatibility between the x86 and ",
"Apple Silicon architectures.\n",
"If you are running R inside an IDE (RStudio, VSCode, ...), ",
"make sure the IDE is a native Apple Silicon app.\n",
call. = FALSE
)
}
}
},
error_on_status = FALSE
)
)
)
if (is.na(run_log$status) || run_log$status != 0) {
err_msg <- "An error occured during compilation! See the message above for more information."
if (grepl("auto-format flag to stanc", run_log$stderr)) {
format_msg <- "\nTo fix deprecated or removed syntax please see ?cmdstanr::format for an example."
err_msg <- paste(err_msg, format_msg)
}
stop(err_msg, call. = FALSE)
}
if (file.exists(exe)) {
file.remove(exe)
}
file.copy(tmp_exe, exe, overwrite = TRUE)
if (os_is_wsl()) {
res <- processx::run(
command = "wsl",
args = c("chmod", "+x", wsl_safe_path(exe)),
error_on_status = FALSE
)
}
writeLines(private$model_methods_env_$hpp_code_,
con = wsl_safe_path(private$hpp_file_, revert = TRUE))
} # End - if(!dry_run)
private$exe_file_ <- exe
private$cpp_options_ <- cpp_options
private$precompile_cpp_options_ <- NULL
private$precompile_stanc_options_ <- NULL
private$precompile_include_paths_ <- NULL
if(!dry_run) {
if (compile_model_methods) {
expose_model_methods(env = private$model_methods_env_,
verbose = !quiet,
hessian = compile_hessian_method)
}
}
invisible(self)
}
CmdStanModel$set("public", name = "compile", value = compile)
#' Input and output variables of a Stan program
#'
#' @name model-method-variables
#' @aliases variables
#' @family CmdStanModel methods
#'
#' @description 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
#' as a list with infromation on its scalar type (`real` or `int`) and
#' number of dimensions.
#'
#' `transformed data` is not included, as variables in that block are not
#' part of the model's input or output.
#'
#' @return The `$variables()` returns a list with information on input and
#' output variables for each of the Stan model blocks.
#'
#' @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()
#'
#' }
#'
variables <- function() {
if (cmdstan_version() < "2.27.0") {
stop("$variables() is only supported for CmdStan 2.27 or newer.", call. = FALSE)
}
if (length(self$stan_file()) == 0) {
stop("'$variables()' cannot be used because the 'CmdStanModel' was not created with a Stan file.", call. = FALSE)
}
assert_stan_file_exists(self$stan_file())
if (is.null(private$variables_) && file.exists(self$stan_file())) {
private$variables_ <- model_variables(
stan_file = self$stan_file(),
include_paths = self$include_paths(),
allow_undefined = private$using_user_header_
)
}
private$variables_
}
CmdStanModel$set("public", name = "variables", value = variables)
#' Check syntax of a Stan program
#'
#' @name model-method-check_syntax
#' @aliases check_syntax
#' @family CmdStanModel methods
#'
#' @description 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.
#'
#' @param 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](https://mc-stan.org/docs/stan-users-guide/pedantic-mode.html) in
#' the Stan Reference Manual.
#' @param include_paths (character vector) Paths to directories where Stan
#' should look for files specified in `#include` directives in the Stan
#' program.
#' @param stanc_options (list) Any other Stan-to-C++ transpiler options to be
#' used when compiling the model. See the documentation for the
#' [`$compile()`][model-method-compile] method for details.
#' @param 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.
#'
#' @return The `$check_syntax()` method returns `TRUE` (invisibly) if the model
#' is valid.
#'
#' @template seealso-docs
#'
#' @examples
#' \dontrun{
#' file <- 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);
#' }
#' ")
#' mod <- cmdstan_model(file, compile = FALSE)
#'
#' # the program is syntactically correct, however...
#' mod$check_syntax()
#'
#' # pedantic mode will warn that lambda should be constrained to be positive
#' # and that lambda has no prior distribution
#' mod$check_syntax(pedantic = TRUE)
#' }
#'
check_syntax <- function(pedantic = FALSE,
include_paths = NULL,
stanc_options = list(),
quiet = FALSE) {
if (length(self$stan_file()) == 0) {
stop("'$check_syntax()' cannot be used because the 'CmdStanModel' was not created with a Stan file.", call. = FALSE)
}
assert_stan_file_exists(self$stan_file())
if (length(stanc_options) == 0 && !is.null(private$precompile_stanc_options_)) {
stanc_options <- private$precompile_stanc_options_
}
if (is.null(include_paths) && !is.null(self$include_paths())) {
include_paths <- self$include_paths()
}
temp_hpp_file <- tempfile(pattern = "model-", fileext = ".hpp")
stanc_options[["o"]] <- wsl_safe_path(temp_hpp_file)
if (pedantic) {
stanc_options[["warn-pedantic"]] <- TRUE
}
stancflags_val <- include_paths_stanc3_args(include_paths)
if (is.null(stanc_options[["name"]])) {
stanc_options[["name"]] <- paste0(self$model_name(), "_model")
}
stanc_built_options <- c()
for (i in seq_len(length(stanc_options))) {
option_name <- names(stanc_options)[i]
if (isTRUE(as.logical(stanc_options[[i]]))) {
stanc_built_options <- c(stanc_built_options, paste0("--", option_name))
} else if (is.null(option_name) || !nzchar(option_name)) {
stanc_built_options <- c(stanc_built_options, paste0("--", stanc_options[[i]]))
} else {
stanc_built_options <- c(stanc_built_options, paste0("--", option_name, "=", stanc_options[[i]]))
}
}
withr::with_path(
c(
toolchain_PATH_env_var(),
tbb_path()
),
run_log <- wsl_compatible_run(
command = stanc_cmd(),
args = c(wsl_safe_path(self$stan_file()), stanc_built_options, stancflags_val),
wd = cmdstan_path(),
echo = is_verbose_mode(),
echo_cmd = is_verbose_mode(),
spinner = quiet && rlang::is_interactive(),
stderr_callback = function(x, p) {
message(x)
},
error_on_status = FALSE
)
)
cat(run_log$stdout)
if (is.na(run_log$status) || run_log$status != 0) {
stop("Syntax error found! See the message above for more information.",
call. = FALSE)
}
if (!quiet) {
message("Stan program is syntactically correct")
}
invisible(TRUE)
}
CmdStanModel$set("public", name = "check_syntax", value = check_syntax)
#' Run stanc's auto-formatter on the model code.
#'
#' @name model-method-format
#' @aliases format
#' @family CmdStanModel methods
#'
#' @description 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.
#'
#' @param overwrite_file (logical) Should the formatted code be written back
#' to the input model file. The default is `FALSE`.
#' @param 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](https://mc-stan.org/docs/stan-users-guide/stanc-pretty-printing.html#canonicalizing)
#' for available canonicalization options.
#' @param 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`.
#' @param 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.
#' @param quiet (logical) Should informational messages be suppressed? The
#' default is `FALSE`.
#'
#' @return The `$format()` method returns `TRUE` (invisibly) if the model
#' is valid.
#'
#' @template seealso-docs
#'
#' @examples
#' \dontrun{
#'
#' # Example of removing unnecessary whitespace
#' file <- write_stan_file("
#' data {
#' int N;
#' array[N] int y;
#' }
#' parameters {
#' real lambda;
#' }
#' model {
#' target +=
#' poisson_lpmf(y | lambda);
#' }
#' ")
#'
#' # set compile=FALSE then call format to fix old syntax
#' mod <- cmdstan_model(file, compile = FALSE)
#' mod$format(canonicalize = list("deprecations"))
#'
#' # overwrite the original file instead of just printing it
#' mod$format(canonicalize = list("deprecations"), overwrite_file = TRUE)
#' mod$compile()
#' }
#'
format <- function(overwrite_file = FALSE,
canonicalize = FALSE,
backup = TRUE,
max_line_length = NULL,
quiet = FALSE) {
if (cmdstan_version() < "2.29.0" && !is.null(max_line_length)) {
stop(
"'max_line_length' is only supported with CmdStan 2.29.0 or newer.",
call. = FALSE
)