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
|
exposeStanClass <- function(stanc_ret,
fields = character(),
field_access = c("none", "read_only", "read_write"),
where = tempdir(),
compile = interactive(),
...) {
field_access <- match.arg(field_access)
if (field_access != "none" && length(fields) == 0L) {
public <- grep("^public:", stanc_ret$cppcode)
if (length(public) == 1L) public <- c(grep("^private:", stanc_ret$cppcode), public)
if (diff(public) > 1L) {
public[1] <- public[1] + 1L
public[2] <- public[2] - 1L
fields <- sub("^.* (.*);$", "\\1", stanc_ret$cppcode[public[1]:public[2]])
} else fields <- NULL
}
if (identical("src", where)) {
tf <- paste0(stanc_ret$model_cppname, "Module.cc")
header <- paste0(stanc_ret$model_cppname, ".hpp")
} else {
tf <- tempfile(tmpdir = where, fileext = "Module.cc")
header <- sub("Module\\.cc$", ".hpp", tf)
}
if (any(grepl("ctor_body", stanc_ret$cppcode))) {
ctor <- list("rstan::io::rlist_ref_var_context")
} else ctor <- list(c("SEXP", "SEXP", "SEXP"))
writeLines(stanc_ret$cppcode, con = header)
meth <- names(stanc_ret$methods)
Rmeth <- meth
names(Rmeth) <- sub("_$", "", names(stanc_ret$methods))
FQ <- options()$useFancyQuotes
options(useFancyQuotes = FALSE)
on.exit(options(useFancyQuotes = FQ))
Rcpp::exposeClass(class = stanc_ret$model_name,
constructors = ctor,
fields = fields,
methods = meth,
file = tf,
header = c("// [[Rcpp::depends(rstan)]]",
"// [[Rcpp::plugins(cpp14)]]",
"#include <RcppEigen.h>",
paste0('#include "', header, '"')),
CppClass = "stan_model",
readOnly = if (field_access == "read_only") fields else character(),
rename = Rmeth,
Rfile = FALSE)
if (compile) {
Rcpp::sourceCpp(file = tf, ...)
# Rcpp::loadRcppClass(Class = stanc_ret$model_name,
# module = paste0("class_", stanc_ret$model_name),
# where = if (interactive()) .GlobalEnv)
g <- get(stanc_ret$model_name, envir = .GlobalEnv)@generator
return(g)
}
return(invisible(NULL))
}
|
