From e0cb5ac604ae98ac6f1b5254948050b468b729f3 Mon Sep 17 00:00:00 2001 From: VisruthSK Date: Sat, 6 Jun 2026 16:58:33 -0700 Subject: [PATCH 1/5] Passed cores through --- R/loo_subsample.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/loo_subsample.R b/R/loo_subsample.R index bcac4b17..b9698216 100644 --- a/R/loo_subsample.R +++ b/R/loo_subsample.R @@ -536,7 +536,7 @@ elpd_loo_approximation <- function(.llfun, data, draws, cores, loo_approximation if (loo_approximation %in% c("tis", "sis")) { draws <- .thin_draws(draws, loo_approximation_draws) - is_values <- suppressWarnings(loo.function(.llfun, data = data, draws = draws, is_method = loo_approximation)) + is_values <- suppressWarnings(loo.function(.llfun, data = data, draws = draws, is_method = loo_approximation, cores = cores)) return(is_values$pointwise[, "elpd_loo"]) } From b1f9d933ce820bc00f4158e9a158d974834e119c Mon Sep 17 00:00:00 2001 From: VisruthSK Date: Sat, 6 Jun 2026 17:02:53 -0700 Subject: [PATCH 2/5] Fixed ap_psis.array() --- R/psis_approximate_posterior.R | 4 +--- tests/testthat/test_psis_approximate_posterior.R | 15 +++++++++++++++ 2 files changed, 16 insertions(+), 3 deletions(-) diff --git a/R/psis_approximate_posterior.R b/R/psis_approximate_posterior.R index ebd9b4a4..974e3ea9 100644 --- a/R/psis_approximate_posterior.R +++ b/R/psis_approximate_posterior.R @@ -97,11 +97,10 @@ ap_psis.array <- log_ratios <- validate_ll(log_ratios) log_ratios <- llarray_to_matrix(log_ratios) - r_eff <- prepare_psis_r_eff(r_eff, len = ncol(log_ratios)) ap_psis.matrix(log_ratios = log_ratios, log_p = log_p, log_g = log_g, - cores = 1) + cores = cores) } #' @export @@ -132,4 +131,3 @@ ap_psis.default <- function(log_ratios, log_p, log_g, ...) { ap_psis.matrix(as.matrix(log_ratios), log_p, log_g, cores = 1) } - diff --git a/tests/testthat/test_psis_approximate_posterior.R b/tests/testthat/test_psis_approximate_posterior.R index 8d0ffe70..85e26f67 100644 --- a/tests/testthat/test_psis_approximate_posterior.R +++ b/tests/testthat/test_psis_approximate_posterior.R @@ -325,3 +325,18 @@ test_that("Deprecation of log_q argument", { expect_s3_class(psis_lap, "psis") expect_lt(pareto_k_values(psis_lap), 0.7) }) + +test_that("ap_psis.array works as ap_psis.matrix", { + log_p <- test_data_psis_approximate_posterior$laplace_independent$log_p + log_g <- test_data_psis_approximate_posterior$laplace_independent$log_q + ll <- test_data_psis_approximate_posterior$laplace_independent$log_liks + ll_array <- array(ll, dim = c(nrow(ll) / 2, 2, ncol(ll))) + ll_matrix <- loo:::llarray_to_matrix(ll_array) + + expect_silent( + psis_array <- ap_psis(log_ratios = -ll_array, log_p = log_p, log_g = log_g) + ) + psis_matrix <- ap_psis(log_ratios = -ll_matrix, log_p = log_p, log_g = log_g) + + expect_equal(psis_array, psis_matrix) +}) From abc6e5b73ecdce85505ff4b966ac69dd48215ad4 Mon Sep 17 00:00:00 2001 From: VisruthSK Date: Sat, 6 Jun 2026 17:12:27 -0700 Subject: [PATCH 3/5] Updated waic to use same parallelization as everything else --- R/waic.R | 60 ++++++++++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 50 insertions(+), 10 deletions(-) diff --git a/R/waic.R b/R/waic.R index 2dac6456..e16625ac 100644 --- a/R/waic.R +++ b/R/waic.R @@ -100,20 +100,53 @@ waic.function <- function(x, ..., data = NULL, - draws = NULL) { + draws = NULL, + cores = getOption("mc.cores", 1)) { + cores <- loo_cores(cores) stopifnot(is.data.frame(data) || is.matrix(data), !is.null(draws)) .llfun <- validate_llfun(x) N <- dim(data)[1] S <- length(as.vector(.llfun(data_i = data[1,, drop=FALSE], draws = draws, ...))) - waic_list <- lapply(seq_len(N), FUN = function(i) { - ll_i <- .llfun(data_i = data[i,, drop=FALSE], draws = draws, ...) - ll_i <- as.vector(ll_i) - lpd_i <- logMeanExp(ll_i) - p_waic_i <- var(ll_i) - elpd_waic_i <- lpd_i - p_waic_i - c(elpd_waic = elpd_waic_i, p_waic = p_waic_i) - }) + if (cores == 1) { + waic_list <- + lapply( + X = seq_len(N), + FUN = .waic_i, + llfun = .llfun, + data = data, + draws = draws, + ... + ) + } else { + if (!os_is_windows()) { + # On Mac or Linux use mclapply() for multiple cores + waic_list <- + parallel::mclapply( + mc.cores = cores, + X = seq_len(N), + FUN = .waic_i, + llfun = .llfun, + data = data, + draws = draws, + ... + ) + } else { + # On Windows use makePSOCKcluster() and parLapply() for multiple cores + cl <- parallel::makePSOCKcluster(cores) + on.exit(parallel::stopCluster(cl)) + waic_list <- + parallel::parLapply( + cl = cl, + X = seq_len(N), + fun = .waic_i, + llfun = .llfun, + data = data, + draws = draws, + ... + ) + } + } pointwise <- do.call(rbind, waic_list) pointwise <- cbind(pointwise, waic = -2 * pointwise[, "elpd_waic"]) @@ -121,6 +154,14 @@ waic.function <- waic_object(pointwise, dims = c(S, N)) } +.waic_i <- function(i, llfun, data, draws, ...) { + ll_i <- llfun(data_i = data[i,, drop=FALSE], draws = draws, ...) + ll_i <- as.vector(ll_i) + lpd_i <- logMeanExp(ll_i) + p_waic_i <- var(ll_i) + elpd_waic_i <- lpd_i - p_waic_i + c(elpd_waic = elpd_waic_i, p_waic = p_waic_i) +} #' @export dim.waic <- function(x) { @@ -164,4 +205,3 @@ throw_pwaic_warnings <- function(p, digits = 1, warn = TRUE) { } invisible(NULL) } - From eba8027acf29cf1cdc5162ec157d99440688ce5a Mon Sep 17 00:00:00 2001 From: VisruthSK Date: Sat, 6 Jun 2026 17:17:59 -0700 Subject: [PATCH 4/5] Updated waic docs --- .Rbuildignore | 2 +- man/waic.Rd | 16 +++++++++++++++- 2 files changed, 16 insertions(+), 2 deletions(-) diff --git a/.Rbuildignore b/.Rbuildignore index 3feaccf9..3577bc14 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -19,7 +19,7 @@ vignettes/loo2-non-factorized_cache/* .vscode/* ^\.github$ ^vignettes/online-only$ - +^\.git-blame-ignore-revs$ ^CRAN-SUBMISSION$ ^release-prep\.R$ ^_pkgdown\.yml$ diff --git a/man/waic.Rd b/man/waic.Rd index 345bd638..cb72da0d 100644 --- a/man/waic.Rd +++ b/man/waic.Rd @@ -14,7 +14,7 @@ waic(x, ...) \method{waic}{matrix}(x, ...) -\method{waic}{`function`}(x, ..., data = NULL, draws = NULL) +\method{waic}{`function`}(x, ..., data = NULL, draws = NULL, cores = getOption("mc.cores", 1)) is.waic(x) } @@ -25,6 +25,20 @@ each method.} \item{draws, data, ...}{For the function method only. See the \strong{Methods (by class)} section below for details on these arguments.} + +\item{cores}{The number of cores to use for parallelization. This defaults to +the option \code{mc.cores} which can be set for an entire R session by +\code{options(mc.cores = NUMBER)}. The old option \code{loo.cores} is now +deprecated but will be given precedence over \code{mc.cores} until +\code{loo.cores} is removed in a future release. \strong{As of version +2.0.0 the default is now 1 core if \code{mc.cores} is not set}, but we +recommend using as many (or close to as many) cores as possible. +\itemize{ +\item Note for Windows 10 users: it is \strong{strongly} +\href{https://github.com/stan-dev/loo/issues/94}{recommended} to avoid using +the \code{.Rprofile} file to set \code{mc.cores} (using the \code{cores} argument or +setting \code{mc.cores} interactively or in a script is fine). +}} } \value{ A named list (of class \code{c("waic", "loo")}) with components: From c43d0f5456b4f30a3956022c1323549184218466 Mon Sep 17 00:00:00 2001 From: VisruthSK Date: Sat, 6 Jun 2026 17:24:03 -0700 Subject: [PATCH 5/5] Test waic.function core support --- tests/testthat/test_loo_and_waic.R | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/tests/testthat/test_loo_and_waic.R b/tests/testthat/test_loo_and_waic.R index 5cdc823e..1f5a2db9 100644 --- a/tests/testthat/test_loo_and_waic.R +++ b/tests/testthat/test_loo_and_waic.R @@ -223,6 +223,22 @@ test_that("loo.function runs with multiple cores", { expect_identical(loo_with_fn2$estimates, loo_with_fn1$estimates) }) +test_that("waic.function runs with multiple cores", { + waic_with_fn1 <- waic( + llfun, + data = data, + draws = draws, + cores = 1 + ) + waic_with_fn2 <- waic( + llfun, + data = data, + draws = draws, + cores = 2 + ) + expect_identical(waic_with_fn2$estimates, waic_with_fn1$estimates) +}) + test_that("save_psis option to loo.function makes correct psis object", { loo_with_fn2 <- loo.function( llfun,