Skip to content

Commit 98ece20

Browse files
committed
add generate_quantities timing
1 parent 5809552 commit 98ece20

6 files changed

Lines changed: 122 additions & 0 deletions

File tree

R/csv.R

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -453,6 +453,7 @@ read_cmdstan_csv <- function(files,
453453
}
454454
list(
455455
metadata = metadata,
456+
time = list(total = NA_integer_, chains = metadata$time),
456457
generated_quantities = draws
457458
)
458459
} else if (metadata$method == "pathfinder") {
@@ -783,6 +784,10 @@ read_csv_metadata <- function(csv_file) {
783784
tmp <- gsub("seconds (Total)", "", tmp, fixed = TRUE)
784785
tmp <- trimws(gsub(" Elapsed Time: ", "", tmp, fixed = TRUE))
785786
total_time <- as.numeric(tmp)
787+
} else if (grepl("(Generated Quantities)", tmp, fixed = TRUE)) {
788+
tmp <- gsub("seconds (Generated Quantities)", "", tmp, fixed = TRUE)
789+
tmp <- trimws(gsub("Elapsed Time:", "", tmp, fixed = TRUE))
790+
total_time <- as.numeric(tmp)
786791
}
787792
if (!is.null(csv_file_info$method) &&
788793
csv_file_info$method == "diagnose" &&
@@ -824,6 +829,11 @@ read_csv_metadata <- function(csv_file) {
824829
sampling = sampling_time,
825830
total = total_time
826831
)
832+
} else if (csv_file_info$method == "generate_quantities") {
833+
csv_file_info$time <- data.frame(
834+
chain_id = csv_file_info$id,
835+
total = total_time
836+
)
827837
}
828838
csv_file_info$model <- NULL
829839
csv_file_info$engaged <- NULL

R/run.R

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1135,6 +1135,8 @@ CmdStanGQProcs <- R6::R6Class(
11351135
if (self$is_still_working(id) && !self$is_queued(id) && !self$is_alive(id)) {
11361136
# if the process just finished make sure we process all
11371137
# input and mark the process finished
1138+
self$process_output(id)
1139+
self$process_error_output(id)
11381140
if (self$get_proc(id)$get_exit_status() == 0) {
11391141
self$set_proc_state(id = id, new_state = 5) # mark_proc_stop will mark this process successful
11401142
} else {
@@ -1156,6 +1158,8 @@ CmdStanGQProcs <- R6::R6Class(
11561158
if (nzchar(line)) {
11571159
if (self$proc_state(id) == 1 && grepl("refresh = ", line, perl = TRUE)) {
11581160
self$set_proc_state(id, new_state = 1.5)
1161+
} else if (grepl("Elapsed Time:", line, fixed = TRUE)) {
1162+
private$proc_total_time_[[id]] <- as.double(trimws(sub("Elapsed Time:", "", sub("seconds (Generated Quantities)", "", line, fixed = TRUE), fixed = TRUE)))
11591163
} else if (self$proc_state(id) >= 2 && private$show_stdout_messages_) {
11601164
cat("Chain", id, line, "\n")
11611165
}
Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,26 @@
1+
# stan_version_major = 2
2+
# stan_version_minor = 39
3+
# stan_version_patch = 0
4+
# model = bernoulli_ppc_model
5+
# method = generate_quantities
6+
# generate_quantities
7+
# fitted_params = /tmp/RtmpCvOIQ1/fittedParams-202006271227-1-b85b52.csv
8+
# id = 1
9+
# data
10+
# file = /home/rok/.cmdstanr/cmdstan-2.23.0/examples/bernoulli/bernoulli.data.json
11+
# init = 2 (Default)
12+
# random
13+
# seed = 123
14+
# output
15+
# file = /tmp/RtmpCvOIQ1/bernoulli_ppc-202006271227-1-986540.csv
16+
# diagnostic_file = (Default)
17+
# refresh = 250
18+
y_rep.1,y_rep.2,y_rep.3,y_rep.4,y_rep.5,y_rep.6,y_rep.7,y_rep.8,y_rep.9,y_rep.10
19+
0,0,0,0,0,0,0,0,0,0
20+
0,1,1,0,1,0,1,1,0,0
21+
0,0,0,0,0,0,0,0,0,0
22+
0,0,0,0,0,1,0,0,0,1
23+
1,0,0,0,0,0,0,0,0,0
24+
#
25+
# Elapsed Time: 0.123 seconds (Generated Quantities)
26+
#
Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,26 @@
1+
# stan_version_major = 2
2+
# stan_version_minor = 39
3+
# stan_version_patch = 0
4+
# model = bernoulli_ppc_model
5+
# method = generate_quantities
6+
# generate_quantities
7+
# fitted_params = /tmp/RtmpCvOIQ1/fittedParams-202006271227-2-b85b52.csv
8+
# id = 2
9+
# data
10+
# file = /home/rok/.cmdstanr/cmdstan-2.23.0/examples/bernoulli/bernoulli.data.json
11+
# init = 2 (Default)
12+
# random
13+
# seed = 456
14+
# output
15+
# file = /tmp/RtmpCvOIQ1/bernoulli_ppc-202006271227-2-986540.csv
16+
# diagnostic_file = (Default)
17+
# refresh = 250
18+
y_rep.1,y_rep.2,y_rep.3,y_rep.4,y_rep.5,y_rep.6,y_rep.7,y_rep.8,y_rep.9,y_rep.10
19+
1,0,1,0,0,0,1,0,0,1
20+
0,1,0,0,1,0,0,1,0,0
21+
1,0,0,0,0,1,0,0,0,0
22+
0,0,1,0,0,0,0,1,0,0
23+
0,1,0,0,0,0,0,0,1,0
24+
#
25+
# Elapsed Time: 0.456 seconds (Generated Quantities)
26+
#

tests/testthat/test-csv.R

Lines changed: 52 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -525,6 +525,58 @@ test_that("time from read_cmdstan_csv matches time from fit$time()", {
525525
)
526526
})
527527

528+
test_that("returning time works for gq read_cmdstan_csv from static CSV", {
529+
csv_files <- test_path("resources", "csv", "bernoulli_ppc-1-gq-with-timing.csv")
530+
csv_data <- read_cmdstan_csv(csv_files)
531+
expect_equal(csv_data$time$total, NA_integer_)
532+
expect_equal(csv_data$time$chains, data.frame(
533+
chain_id = 1,
534+
total = 0.123
535+
))
536+
537+
csv_files <- c(
538+
test_path("resources", "csv", "bernoulli_ppc-1-gq-with-timing.csv"),
539+
test_path("resources", "csv", "bernoulli_ppc-2-gq-with-timing.csv")
540+
)
541+
csv_data <- read_cmdstan_csv(csv_files)
542+
expect_equal(csv_data$time$total, NA_integer_)
543+
expect_equal(csv_data$time$chains, data.frame(
544+
chain_id = c(1, 2),
545+
total = c(0.123, 0.456)
546+
))
547+
})
548+
549+
test_that("returning time works for gq read_cmdstan_csv from fit object", {
550+
gq_csv <- read_cmdstan_csv(fit_gq$output_files())
551+
expect_equal(gq_csv$time$total, NA_integer_)
552+
checkmate::expect_data_frame(
553+
gq_csv$time$chains,
554+
any.missing = FALSE,
555+
types = c("numeric", "numeric"),
556+
nrows = fit_gq$num_chains(),
557+
ncols = 2
558+
)
559+
expect_named(gq_csv$time$chains, c("chain_id", "total"))
560+
expect_true(all(gq_csv$time$chains$total > 0))
561+
})
562+
563+
test_that("gq time from read_cmdstan_csv matches time from fit_gq$time()", {
564+
expect_equivalent(
565+
read_cmdstan_csv(fit_gq$output_files())$time$chains,
566+
fit_gq$time()$chains
567+
)
568+
})
569+
570+
test_that("returning time is NULL for gq CSV without timing", {
571+
csv_files <- test_path("resources", "csv", "bernoulli_ppc-1-gq.csv")
572+
csv_data <- read_cmdstan_csv(csv_files)
573+
expect_equal(csv_data$time$total, NA_integer_)
574+
expect_equal(csv_data$time$chains, data.frame(
575+
chain_id = 1,
576+
total = 0
577+
))
578+
})
579+
528580
test_that("read_cmdstan_csv reads seed correctly", {
529581
opt <- read_cmdstan_csv(fit_bernoulli_optimize$output_files())
530582
vi <- read_cmdstan_csv(fit_bernoulli_variational$output_files())

tests/testthat/test-fit-gq.R

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -118,6 +118,10 @@ test_that("time() works after gq", {
118118
nrows = fit_gq$runset$num_procs(),
119119
ncols = 2
120120
)
121+
expect_named(run_times$chains, c("chain_id", "total"))
122+
# per-chain times should be non-zero (parsed from CmdStan timing output)
123+
expect_true(all(run_times$chains$total > 0))
124+
expect_true(run_times$total > 0)
121125
})
122126

123127
test_that("fitted_params_files() works", {

0 commit comments

Comments
 (0)