Skip to content

Commit c92acc9

Browse files
WardBrianWardBrian
committed
Format
1 parent 7b72623 commit c92acc9

File tree

21 files changed

+1713
-971
lines changed

21 files changed

+1713
-971
lines changed

‎clients/R/R/compile.R‎

Lines changed: 94 additions & 62 deletions
Original file line numberDiff line numberDiff line change
@@ -3,26 +3,36 @@ MAKE <- Sys.getenv("MAKE", "make")
33

44

55
verify_tinystan_path <- function(path) {
6-
suppressWarnings({
7-
folder <- normalizePath(path)
8-
})
9-
if (!dir.exists(folder)) {
10-
stop(paste0("TinyStan folder '", folder, "' does not exist!\n", "If you need to set a different location, call 'set_tinystan_path()'"))
11-
}
12-
makefile <- file.path(folder, "Makefile")
13-
if (!file.exists(makefile)) {
14-
stop(paste0("TinyStan folder '", folder, "' does not contain file 'Makefile',",
15-
" please ensure it is built properly!\n", "If you need to set a different location, call 'set_tinystan_path()'"))
16-
}
6+
suppressWarnings({
7+
folder <- normalizePath(path)
8+
})
9+
if (!dir.exists(folder)) {
10+
stop(paste0(
11+
"TinyStan folder '",
12+
folder,
13+
"' does not exist!\n",
14+
"If you need to set a different location, call 'set_tinystan_path()'"
15+
))
16+
}
17+
makefile <- file.path(folder, "Makefile")
18+
if (!file.exists(makefile)) {
19+
stop(paste0(
20+
"TinyStan folder '",
21+
folder,
22+
"' does not contain file 'Makefile',",
23+
" please ensure it is built properly!\n",
24+
"If you need to set a different location, call 'set_tinystan_path()'"
25+
))
26+
}
1727
}
1828

1929
#' @title Function `set_tinystan_path()`
2030
#' @description Set the path to TinyStan.
2131
#' @details This should point to the top-level folder of the repository.
2232
#' @export
2333
set_tinystan_path <- function(path) {
24-
verify_tinystan_path(path)
25-
Sys.setenv(TINYSTAN = normalizePath(path))
34+
verify_tinystan_path(path)
35+
Sys.setenv(TINYSTAN = normalizePath(path))
2636
}
2737

2838
#' Get the path to TinyStan.
@@ -36,21 +46,28 @@ set_tinystan_path <- function(path) {
3646
#'
3747
#' @seealso [set_tinystan_path]
3848
get_tinystan_path <- function() {
39-
# try to get from environment
40-
path <- Sys.getenv("TINYSTAN", unset = "")
41-
if (path == "") {
42-
path <- CURRENT_TINYSTAN
43-
tryCatch({
44-
verify_tinystan_path(path)
45-
}, error = function(e) {
46-
print(paste0("TinyStan not found at location specified by $TINYSTAN ",
47-
"environment variable, downloading version ", packageVersion("tinystan"),
48-
" to ", path))
49-
get_tinystan_src()
50-
})
51-
}
49+
# try to get from environment
50+
path <- Sys.getenv("TINYSTAN", unset = "")
51+
if (path == "") {
52+
path <- CURRENT_TINYSTAN
53+
tryCatch(
54+
{
55+
verify_tinystan_path(path)
56+
},
57+
error = function(e) {
58+
print(paste0(
59+
"TinyStan not found at location specified by $TINYSTAN ",
60+
"environment variable, downloading version ",
61+
packageVersion("tinystan"),
62+
" to ",
63+
path
64+
))
65+
get_tinystan_src()
66+
}
67+
)
68+
}
5269

53-
return(path)
70+
return(path)
5471
}
5572

5673

@@ -73,52 +90,67 @@ get_tinystan_path <- function() {
7390
#' @seealso [tinystan::set_tinystan_path()]
7491
#' @export
7592
compile_model <- function(stan_file, stanc_args = NULL, make_args = NULL) {
76-
verify_tinystan_path(get_tinystan_path())
77-
suppressWarnings({
78-
file_path <- normalizePath(stan_file)
79-
})
80-
if (tools::file_ext(file_path) != "stan") {
81-
stop(paste0("File '", file_path, "' does not end with '.stan'"))
82-
}
83-
if (!file.exists(file_path)) {
84-
stop(paste0("File '", file_path, "' does not exist!"))
85-
}
93+
verify_tinystan_path(get_tinystan_path())
94+
suppressWarnings({
95+
file_path <- normalizePath(stan_file)
96+
})
97+
if (tools::file_ext(file_path) != "stan") {
98+
stop(paste0("File '", file_path, "' does not end with '.stan'"))
99+
}
100+
if (!file.exists(file_path)) {
101+
stop(paste0("File '", file_path, "' does not exist!"))
102+
}
86103

87-
output <- paste0(tools::file_path_sans_ext(file_path), "_model.so")
88-
stancflags <- paste("--include-paths=.", paste(stanc_args, collapse = " "))
104+
output <- paste0(tools::file_path_sans_ext(file_path), "_model.so")
105+
stancflags <- paste("--include-paths=.", paste(stanc_args, collapse = " "))
89106

90-
flags <- c(paste("-C", get_tinystan_path()), make_args, paste0("STANCFLAGS=\"",
91-
stancflags, "\""), output)
107+
flags <- c(
108+
paste("-C", get_tinystan_path()),
109+
make_args,
110+
paste0("STANCFLAGS=\"", stancflags, "\""),
111+
output
112+
)
92113

93-
suppressWarnings({
94-
res <- system2(MAKE, args = flags, stdout = TRUE, stderr = TRUE)
95-
})
96-
res_attrs <- attributes(res)
97-
if ("status" %in% names(res_attrs) && res_attrs$status != 0) {
98-
stop(paste0("Compilation failed with error code ", res_attrs$status, "\noutput:\n",
99-
paste(res, collapse = "\n")))
100-
}
114+
suppressWarnings({
115+
res <- system2(MAKE, args = flags, stdout = TRUE, stderr = TRUE)
116+
})
117+
res_attrs <- attributes(res)
118+
if ("status" %in% names(res_attrs) && res_attrs$status != 0) {
119+
stop(paste0(
120+
"Compilation failed with error code ",
121+
res_attrs$status,
122+
"\noutput:\n",
123+
paste(res, collapse = "\n")
124+
))
125+
}
101126

102-
return(output)
127+
return(output)
103128
}
104129

105130
tbb_found <- function() {
106-
suppressWarnings(out <- system2("where.exe", "tbb.dll", stdout = NULL, stderr = NULL))
107-
return(out == 0)
131+
suppressWarnings(
132+
out <- system2("where.exe", "tbb.dll", stdout = NULL, stderr = NULL)
133+
)
134+
return(out == 0)
108135
}
109136

110137
WINDOWS_PATH_SET <- FALSE
111138

112139
windows_dll_path_setup <- function() {
113-
if (.Platform$OS.type == "windows" && !WINDOWS_PATH_SET) {
114-
115-
if (tbb_found()) {
116-
assign("WINDOWS_PATH_SET", TRUE, envir = .GlobalEnv)
117-
} else {
118-
tbb_path <- file.path(get_tinystan_path(), "stan", "lib", "stan_math",
119-
"lib", "tbb")
120-
Sys.setenv(PATH = paste(tbb_path, Sys.getenv("PATH"), sep = ";"))
121-
assign("WINDOWS_PATH_SET", tbb_found(), envir = .GlobalEnv)
122-
}
140+
if (.Platform$OS.type == "windows" && !WINDOWS_PATH_SET) {
141+
if (tbb_found()) {
142+
assign("WINDOWS_PATH_SET", TRUE, envir = .GlobalEnv)
143+
} else {
144+
tbb_path <- file.path(
145+
get_tinystan_path(),
146+
"stan",
147+
"lib",
148+
"stan_math",
149+
"lib",
150+
"tbb"
151+
)
152+
Sys.setenv(PATH = paste(tbb_path, Sys.getenv("PATH"), sep = ";"))
153+
assign("WINDOWS_PATH_SET", tbb_found(), envir = .GlobalEnv)
123154
}
155+
}
124156
}

‎clients/R/R/download.R‎

Lines changed: 55 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -1,37 +1,65 @@
11
current_version <- packageVersion("tinystan")
2-
current_version_list <- list(major = current_version$major, minor = current_version$minor,
3-
patch = current_version$patch)
2+
current_version_list <- list(
3+
major = current_version$major,
4+
minor = current_version$minor,
5+
patch = current_version$patch
6+
)
47
HOME_TINYSTAN <- path.expand(file.path("~", ".tinystan"))
5-
CURRENT_TINYSTAN <- file.path(HOME_TINYSTAN, paste0("tinystan-", current_version))
8+
CURRENT_TINYSTAN <- file.path(
9+
HOME_TINYSTAN,
10+
paste0("tinystan-", current_version)
11+
)
612

713
RETRIES <- 5
814

915
get_tinystan_src <- function() {
10-
url <- paste0("https://github.com/WardBrian/tinystan/releases/download/", "v",
11-
current_version, "/tinystan-", current_version, ".tar.gz")
16+
url <- paste0(
17+
"https://github.com/WardBrian/tinystan/releases/download/",
18+
"v",
19+
current_version,
20+
"/tinystan-",
21+
current_version,
22+
".tar.gz"
23+
)
1224

13-
dir.create(HOME_TINYSTAN, showWarnings = FALSE, recursive = TRUE)
14-
temp <- tempfile()
15-
err_text <- paste("Failed to download TinyStan", current_version, "from github.com.")
16-
for (i in 1:RETRIES) {
17-
tryCatch({
18-
download.file(url, destfile = temp, mode = "wb", quiet = TRUE, method = "auto")
19-
}, error = function(e) {
20-
cat(err_text, "\n")
21-
if (i == RETRIES) {
22-
stop(err_text, call. = FALSE)
23-
} else {
24-
cat("Retrying (", i + 1, "/", RETRIES, ")...\n", sep = "")
25-
Sys.sleep(1)
26-
}
27-
})
28-
}
25+
dir.create(HOME_TINYSTAN, showWarnings = FALSE, recursive = TRUE)
26+
temp <- tempfile()
27+
err_text <- paste(
28+
"Failed to download TinyStan",
29+
current_version,
30+
"from github.com."
31+
)
32+
for (i in 1:RETRIES) {
33+
tryCatch(
34+
{
35+
download.file(
36+
url,
37+
destfile = temp,
38+
mode = "wb",
39+
quiet = TRUE,
40+
method = "auto"
41+
)
42+
},
43+
error = function(e) {
44+
cat(err_text, "\n")
45+
if (i == RETRIES) {
46+
stop(err_text, call. = FALSE)
47+
} else {
48+
cat("Retrying (", i + 1, "/", RETRIES, ")...\n", sep = "")
49+
Sys.sleep(1)
50+
}
51+
}
52+
)
53+
}
2954

30-
tryCatch({
31-
untar(temp, exdir = HOME_TINYSTAN)
32-
}, error = function(e) {
33-
stop(paste("Failed to unpack", url, "during installation"), call. = FALSE)
34-
})
55+
tryCatch(
56+
{
57+
untar(temp, exdir = HOME_TINYSTAN)
58+
},
59+
error = function(e) {
60+
stop(paste("Failed to unpack", url, "during installation"), call. = FALSE)
61+
}
62+
)
3563

36-
unlink(temp)
64+
unlink(temp)
3765
}

‎clients/R/R/output.R‎

Lines changed: 12 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -1,23 +1,22 @@
1-
21
# copied from cmdstanr, definitely doesn't handle tuples, but then neither does
32
# posterior
43
repair_variable_names <- function(names) {
5-
names <- sub("\\.", "[", names)
6-
names <- gsub("\\.", ",", names)
7-
names[grep("\\[", names)] <- paste0(names[grep("\\[", names)], "]")
8-
names
4+
names <- sub("\\.", "[", names)
5+
names <- gsub("\\.", ",", names)
6+
names[grep("\\[", names)] <- paste0(names[grep("\\[", names)], "]")
7+
names
98
}
109

1110

1211
output_as_rvars <- function(names, num_draws, num_chains, draws) {
13-
names <- repair_variable_names(names)
14-
num_params <- length(names)
15-
dims <- c(num_params, num_draws, num_chains)
12+
names <- repair_variable_names(names)
13+
num_params <- length(names)
14+
dims <- c(num_params, num_draws, num_chains)
1615

17-
# all our outputs are row-major
18-
draws <- array(draws, dim = dims, dimnames = list(names, NULL, NULL))
19-
# so we need to rearrange. posterior likes draws x chains x params
20-
draws <- aperm(draws, c(2, 3, 1))
16+
# all our outputs are row-major
17+
draws <- array(draws, dim = dims, dimnames = list(names, NULL, NULL))
18+
# so we need to rearrange. posterior likes draws x chains x params
19+
draws <- aperm(draws, c(2, 3, 1))
2120

22-
posterior::as_draws_rvars(draws)
21+
posterior::as_draws_rvars(draws)
2322
}

0 commit comments

Comments
 (0)