From 843ec668402de6c459d50af6e3a49b2105a90c6c Mon Sep 17 00:00:00 2001 From: ishaan-arora-1 Date: Sun, 22 Feb 2026 02:41:38 +0530 Subject: [PATCH 1/8] Fix bug in IS method error message and documentation typos Fix missing parentheses on `implemented_is_methods` in the error message inside `assert_importance_sampling_method_is_implemented()`, which caused the function object to be pasted instead of the actual method names. Also fix several typos across roxygen comments and the corresponding generated .Rd man pages: - "dependend" -> "dependent" (diagnostics.R) - "k-ht" -> "k-hat" (diagnostics.R) - "The pages provides definitions to" -> "The page provides definitions of" (loo-glossary.R) - "log-likeliood" -> "log-likelihood" (split_moment_matching.R) - "subampled" -> "subsampled" (loo_subsample.R) - "comaprison" -> "comparison" (loo_compare.psis_loo_ss_list.R) - "matrices or , one" -> "matrices, one" (loo_model_weights.R) - "widely application" -> "widely applicable" (loo-package.R) Fixes #325 --- R/diagnostics.R | 4 ++-- R/importance_sampling.R | 2 +- R/loo-glossary.R | 2 +- R/loo-package.R | 2 +- R/loo_compare.psis_loo_ss_list.R | 2 +- R/loo_model_weights.R | 2 +- R/loo_subsample.R | 2 +- R/split_moment_matching.R | 2 +- man/loo-glossary.Rd | 2 +- man/loo-package.Rd | 2 +- man/loo_model_weights.Rd | 2 +- man/loo_moment_match_split.Rd | 2 +- man/obs_idx.Rd | 2 +- man/pareto-k-diagnostic.Rd | 2 +- man/waic.Rd | 2 +- 15 files changed, 16 insertions(+), 16 deletions(-) diff --git a/R/diagnostics.R b/R/diagnostics.R index 77b4eb43..3d12bdb4 100644 --- a/R/diagnostics.R +++ b/R/diagnostics.R @@ -11,7 +11,7 @@ #' @name pareto-k-diagnostic #' @param x An object created by [loo()] or [psis()]. #' @param threshold For `pareto_k_ids()`, `threshold` is the minimum \eqn{k} -#' value to flag (default is a sample size `S` dependend threshold +#' value to flag (default is a sample size `S` dependent threshold #' `1 - 1 / log10(S)`). For `mcse_loo()`, if any \eqn{k} estimates are #' greater than `threshold` the MCSE estimate is returned as `NA` #' See **Details** for the motivation behind these defaults. @@ -430,7 +430,7 @@ min_n_eff_by_k <- function(n_eff, kcut) { #' with bigger sample size S we can achieve estimates with small #' probability of large error, it is difficult to get accurate MCSE #' estimates as the bias starts to dominate when k > 0.7 (see Section 3.2.3). -#' Thus the sample size dependend k-ht threshold is capped at 0.7. +#' Thus the sample size dependent k-hat threshold is capped at 0.7. #' @param S sample size #' @param ... unused #' @return threshold diff --git a/R/importance_sampling.R b/R/importance_sampling.R index 80ec5c8a..f8dfd4d3 100644 --- a/R/importance_sampling.R +++ b/R/importance_sampling.R @@ -114,7 +114,7 @@ assert_importance_sampling_method_is_implemented <- function(x){ stop("Importance sampling method '", x, "' is not implemented. Implemented methods: '", - paste0(implemented_is_methods, collapse = "', '"), + paste0(implemented_is_methods(), collapse = "', '"), "'") } } diff --git a/R/loo-glossary.R b/R/loo-glossary.R index 06ba5ce6..7ed0e7c6 100644 --- a/R/loo-glossary.R +++ b/R/loo-glossary.R @@ -7,7 +7,7 @@ #' @template bayesvis-reference #' #' @description -#' The pages provides definitions to key terms. Also see the +#' The page provides definitions of key terms. Also see the #' [FAQ page](https://mc-stan.org/loo/articles/online-only/faq.html) on #' the __loo__ website for answers to frequently asked questions. #' diff --git a/R/loo-package.R b/R/loo-package.R index 12a39200..70e58047 100644 --- a/R/loo-package.R +++ b/R/loo-package.R @@ -82,7 +82,7 @@ #' . #' #' Watanabe, S. (2010). Asymptotic equivalence of Bayes cross validation and -#' widely application information criterion in singular learning theory. +#' widely applicable information criterion in singular learning theory. #' *Journal of Machine Learning Research* **11**, 3571-3594. #' #' Zhang, J., and Stephens, M. A. (2009). A new and efficient estimation method diff --git a/R/loo_compare.psis_loo_ss_list.R b/R/loo_compare.psis_loo_ss_list.R index acd0690b..626f7428 100644 --- a/R/loo_compare.psis_loo_ss_list.R +++ b/R/loo_compare.psis_loo_ss_list.R @@ -31,7 +31,7 @@ loo_compare.psis_loo_ss_list <- function(x, ...) { return(comp) } -#' Compare a reference loo object with a comaprison loo object +#' Compare a reference loo object with a comparison loo object #' @noRd #' @param ref_loo A named list with a `psis_loo_ss` object. #' @param compare_loo A named list with a `psis_loo_ss` object. diff --git a/R/loo_model_weights.R b/R/loo_model_weights.R index 449e8feb..946dc7c3 100644 --- a/R/loo_model_weights.R +++ b/R/loo_model_weights.R @@ -7,7 +7,7 @@ #' #' @export #' @param x A list of `"psis_loo"` objects (objects returned by [loo()]) or -#' pointwise log-likelihood matrices or , one for each model. If the list +#' pointwise log-likelihood matrices, one for each model. If the list #' elements are named the names will be used to label the models in the #' results. Each matrix/object should have dimensions \eqn{S} by \eqn{N}, #' where \eqn{S} is the size of the posterior sample (with all chains merged) diff --git a/R/loo_subsample.R b/R/loo_subsample.R index a12e8a79..cfff0999 100644 --- a/R/loo_subsample.R +++ b/R/loo_subsample.R @@ -417,7 +417,7 @@ update.psis_loo_ss <- function(object, ..., #' @param rep If sampling with replacement is used, an observation can have #' multiple samples and these are then repeated in the returned object if #' `rep=TRUE` (e.g., a vector `c(1,1,2)` indicates that observation 1 has been -#' subampled two times). If `rep=FALSE` only the unique indices are returned. +#' subsampled two times). If `rep=FALSE` only the unique indices are returned. #' #' @return An integer vector. #' diff --git a/R/split_moment_matching.R b/R/split_moment_matching.R index b7bdb111..8ae5c91f 100644 --- a/R/split_moment_matching.R +++ b/R/split_moment_matching.R @@ -21,7 +21,7 @@ #' returns a matrix of log-posterior density values of the unconstrained #' posterior draws passed via `upars`. #' @param log_lik_i_upars A function that takes arguments `x`, `upars`, and `i` -#' and returns a vector of log-likeliood draws of the `i`th observation based +#' and returns a vector of log-likelihood draws of the `i`th observation based #' on the unconstrained posterior draws passed via `upars`. #' @param r_eff_i MCMC relative effective sample size of the `i`'th log #' likelihood draws. diff --git a/man/loo-glossary.Rd b/man/loo-glossary.Rd index 7aa19639..5dbf1670 100644 --- a/man/loo-glossary.Rd +++ b/man/loo-glossary.Rd @@ -4,7 +4,7 @@ \alias{loo-glossary} \title{LOO package glossary} \description{ -The pages provides definitions to key terms. Also see the +The page provides definitions of key terms. Also see the \href{https://mc-stan.org/loo/articles/online-only/faq.html}{FAQ page} on the \strong{loo} website for answers to frequently asked questions. diff --git a/man/loo-package.Rd b/man/loo-package.Rd index e126f4a3..3b77ed7c 100644 --- a/man/loo-package.Rd +++ b/man/loo-package.Rd @@ -101,7 +101,7 @@ Stan Development Team (2018). RStan: the R interface to Stan, Version 2.17.3. \url{https://mc-stan.org}. Watanabe, S. (2010). Asymptotic equivalence of Bayes cross validation and -widely application information criterion in singular learning theory. +widely applicable information criterion in singular learning theory. \emph{Journal of Machine Learning Research} \strong{11}, 3571-3594. Zhang, J., and Stephens, M. A. (2009). A new and efficient estimation method diff --git a/man/loo_model_weights.Rd b/man/loo_model_weights.Rd index fbcba94c..e7323912 100644 --- a/man/loo_model_weights.Rd +++ b/man/loo_model_weights.Rd @@ -28,7 +28,7 @@ pseudobma_weights(lpd_point, BB = TRUE, BB_n = 1000, alpha = 1) } \arguments{ \item{x}{A list of \code{"psis_loo"} objects (objects returned by \code{\link[=loo]{loo()}}) or -pointwise log-likelihood matrices or , one for each model. If the list +pointwise log-likelihood matrices, one for each model. If the list elements are named the names will be used to label the models in the results. Each matrix/object should have dimensions \eqn{S} by \eqn{N}, where \eqn{S} is the size of the posterior sample (with all chains merged) diff --git a/man/loo_moment_match_split.Rd b/man/loo_moment_match_split.Rd index db69ad6f..91a6d826 100644 --- a/man/loo_moment_match_split.Rd +++ b/man/loo_moment_match_split.Rd @@ -46,7 +46,7 @@ returns a matrix of log-posterior density values of the unconstrained posterior draws passed via \code{upars}.} \item{log_lik_i_upars}{A function that takes arguments \code{x}, \code{upars}, and \code{i} -and returns a vector of log-likeliood draws of the \code{i}th observation based +and returns a vector of log-likelihood draws of the \code{i}th observation based on the unconstrained posterior draws passed via \code{upars}.} \item{r_eff_i}{MCMC relative effective sample size of the \code{i}'th log diff --git a/man/obs_idx.Rd b/man/obs_idx.Rd index da349e7e..d087f64f 100644 --- a/man/obs_idx.Rd +++ b/man/obs_idx.Rd @@ -12,7 +12,7 @@ obs_idx(x, rep = TRUE) \item{rep}{If sampling with replacement is used, an observation can have multiple samples and these are then repeated in the returned object if \code{rep=TRUE} (e.g., a vector \code{c(1,1,2)} indicates that observation 1 has been -subampled two times). If \code{rep=FALSE} only the unique indices are returned.} +subsampled two times). If \code{rep=FALSE} only the unique indices are returned.} } \value{ An integer vector. diff --git a/man/pareto-k-diagnostic.Rd b/man/pareto-k-diagnostic.Rd index bb659f79..fcb2db6f 100644 --- a/man/pareto-k-diagnostic.Rd +++ b/man/pareto-k-diagnostic.Rd @@ -45,7 +45,7 @@ mcse_loo(x, threshold = NULL) \item{x}{An object created by \code{\link[=loo]{loo()}} or \code{\link[=psis]{psis()}}.} \item{threshold}{For \code{pareto_k_ids()}, \code{threshold} is the minimum \eqn{k} -value to flag (default is a sample size \code{S} dependend threshold +value to flag (default is a sample size \code{S} dependent threshold \code{1 - 1 / log10(S)}). For \code{mcse_loo()}, if any \eqn{k} estimates are greater than \code{threshold} the MCSE estimate is returned as \code{NA} See \strong{Details} for the motivation behind these defaults.} diff --git a/man/waic.Rd b/man/waic.Rd index 73db9d8f..345bd638 100644 --- a/man/waic.Rd +++ b/man/waic.Rd @@ -116,7 +116,7 @@ print(compare(waic1, waic2), digits = 2) } \references{ Watanabe, S. (2010). Asymptotic equivalence of Bayes cross validation and -widely application information criterion in singular learning theory. +widely applicable information criterion in singular learning theory. \emph{Journal of Machine Learning Research} \strong{11}, 3571-3594. Vehtari, A., Gelman, A., and Gabry, J. (2017). Practical Bayesian model From 0331a56e052ead15ee791898033990f7fe505626 Mon Sep 17 00:00:00 2001 From: VisruthSK <67435125+VisruthSK@users.noreply.github.com> Date: Mon, 23 Feb 2026 11:29:37 -0800 Subject: [PATCH 2/8] Fixed typo in WAIC reference; changed wording slightly --- R/loo-glossary.R | 2 +- R/waic.R | 334 +++++++++++++++++++++++------------------------ 2 files changed, 168 insertions(+), 168 deletions(-) diff --git a/R/loo-glossary.R b/R/loo-glossary.R index 7ed0e7c6..804bd58c 100644 --- a/R/loo-glossary.R +++ b/R/loo-glossary.R @@ -7,7 +7,7 @@ #' @template bayesvis-reference #' #' @description -#' The page provides definitions of key terms. Also see the +#' This page provides definitions of key terms. Also see the #' [FAQ page](https://mc-stan.org/loo/articles/online-only/faq.html) on #' the __loo__ website for answers to frequently asked questions. #' diff --git a/R/waic.R b/R/waic.R index b225ba7e..5f025205 100644 --- a/R/waic.R +++ b/R/waic.R @@ -1,167 +1,167 @@ -#' Widely applicable information criterion (WAIC) -#' -#' The `waic()` methods can be used to compute WAIC from the pointwise -#' log-likelihood. However, we recommend LOO-CV using PSIS (as implemented by -#' the [loo()] function) because PSIS provides useful diagnostics as well as -#' effective sample size and Monte Carlo estimates. -#' -#' @export waic waic.array waic.matrix waic.function -#' @inheritParams loo -#' -#' @return A named list (of class `c("waic", "loo")`) with components: -#' -#' \describe{ -#' \item{`estimates`}{ -#' A matrix with two columns (`"Estimate"`, `"SE"`) and three -#' rows (`"elpd_waic"`, `"p_waic"`, `"waic"`). This contains -#' point estimates and standard errors of the expected log pointwise predictive -#' density (`elpd_waic`), the effective number of parameters -#' (`p_waic`) and the information criterion `waic` (which is just -#' `-2 * elpd_waic`, i.e., converted to deviance scale). -#' } -#' \item{`pointwise`}{ -#' A matrix with three columns (and number of rows equal to the number of -#' observations) containing the pointwise contributions of each of the above -#' measures (`elpd_waic`, `p_waic`, `waic`). -#' } -#' } -#' -#' @seealso -#' * The __loo__ package [vignettes](https://mc-stan.org/loo/articles/) and -#' Vehtari, Gelman, and Gabry (2017) and Vehtari, Simpson, Gelman, Yao, -#' and Gabry (2024) for more details on why we prefer `loo()` to `waic()`. -#' * [loo_compare()] for comparing models on approximate LOO-CV or WAIC. -#' -#' @references -#' Watanabe, S. (2010). Asymptotic equivalence of Bayes cross validation and -#' widely application information criterion in singular learning theory. -#' *Journal of Machine Learning Research* **11**, 3571-3594. -#' -#' @template loo-and-psis-references -#' -#' @examples -#' ### Array and matrix methods -#' LLarr <- example_loglik_array() -#' dim(LLarr) -#' -#' LLmat <- example_loglik_matrix() -#' dim(LLmat) -#' -#' waic_arr <- waic(LLarr) -#' waic_mat <- waic(LLmat) -#' identical(waic_arr, waic_mat) -#' -#' -#' \dontrun{ -#' log_lik1 <- extract_log_lik(stanfit1) -#' log_lik2 <- extract_log_lik(stanfit2) -#' (waic1 <- waic(log_lik1)) -#' (waic2 <- waic(log_lik2)) -#' print(compare(waic1, waic2), digits = 2) -#' } -#' -waic <- function(x, ...) { - UseMethod("waic") -} - -#' @export -#' @templateVar fn waic -#' @template array -#' -waic.array <- function(x, ...) { - waic.matrix(llarray_to_matrix(x), ...) -} - -#' @export -#' @templateVar fn waic -#' @template matrix -#' -waic.matrix <- function(x, ...) { - ll <- validate_ll(x) - lldim <- dim(ll) - lpd <- matrixStats::colLogSumExps(ll) - log(nrow(ll)) # colLogMeanExps - p_waic <- matrixStats::colVars(ll) - elpd_waic <- lpd - p_waic - waic <- -2 * elpd_waic - pointwise <- cbind(elpd_waic, p_waic, waic) - - throw_pwaic_warnings(pointwise[, "p_waic"], digits = 1) - return(waic_object(pointwise, dims = lldim)) -} - - -#' @export -#' @templateVar fn waic -#' @template function -#' @param draws,data,... For the function method only. See the -#' **Methods (by class)** section below for details on these arguments. -#' -waic.function <- - function(x, - ..., - data = NULL, - draws = NULL) { - 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) - }) - pointwise <- do.call(rbind, waic_list) - pointwise <- cbind(pointwise, waic = -2 * pointwise[, "elpd_waic"]) - - throw_pwaic_warnings(pointwise[, "p_waic"], digits = 1) - waic_object(pointwise, dims = c(S, N)) - } - - -#' @export -dim.waic <- function(x) { - attr(x, "dims") -} - -#' @rdname waic -#' @export -is.waic <- function(x) { - inherits(x, "waic") && is.loo(x) -} - - -# internal ---------------------------------------------------------------- - -# structure the object returned by the waic methods -waic_object <- function(pointwise, dims) { - estimates <- table_of_estimates(pointwise) - out <- nlist(estimates, pointwise) - # maintain backwards compatibility - old_nms <- c("elpd_waic", "p_waic", "waic", "se_elpd_waic", "se_p_waic", "se_waic") - out <- c(out, setNames(as.list(estimates), old_nms)) - structure( - out, - dims = dims, - class = c("waic", "loo") - ) -} - -# waic warnings -# @param p 'p_waic' estimates -throw_pwaic_warnings <- function(p, digits = 1, warn = TRUE) { - badp <- p > 0.4 - if (any(badp)) { - count <- sum(badp) - prop <- count / length(badp) - msg <- paste0("\n", count, " (", .fr(100 * prop, digits), - "%) p_waic estimates greater than 0.4. ", - "We recommend trying loo instead.") - if (warn) .warn(msg) else cat(msg, "\n") - } - invisible(NULL) -} - +#' Widely applicable information criterion (WAIC) +#' +#' The `waic()` methods can be used to compute WAIC from the pointwise +#' log-likelihood. However, we recommend LOO-CV using PSIS (as implemented by +#' the [loo()] function) because PSIS provides useful diagnostics as well as +#' effective sample size and Monte Carlo estimates. +#' +#' @export waic waic.array waic.matrix waic.function +#' @inheritParams loo +#' +#' @return A named list (of class `c("waic", "loo")`) with components: +#' +#' \describe{ +#' \item{`estimates`}{ +#' A matrix with two columns (`"Estimate"`, `"SE"`) and three +#' rows (`"elpd_waic"`, `"p_waic"`, `"waic"`). This contains +#' point estimates and standard errors of the expected log pointwise predictive +#' density (`elpd_waic`), the effective number of parameters +#' (`p_waic`) and the information criterion `waic` (which is just +#' `-2 * elpd_waic`, i.e., converted to deviance scale). +#' } +#' \item{`pointwise`}{ +#' A matrix with three columns (and number of rows equal to the number of +#' observations) containing the pointwise contributions of each of the above +#' measures (`elpd_waic`, `p_waic`, `waic`). +#' } +#' } +#' +#' @seealso +#' * The __loo__ package [vignettes](https://mc-stan.org/loo/articles/) and +#' Vehtari, Gelman, and Gabry (2017) and Vehtari, Simpson, Gelman, Yao, +#' and Gabry (2024) for more details on why we prefer `loo()` to `waic()`. +#' * [loo_compare()] for comparing models on approximate LOO-CV or WAIC. +#' +#' @references +#' Watanabe, S. (2010). Asymptotic equivalence of Bayes cross validation and +#' widely applicable information criterion in singular learning theory. +#' *Journal of Machine Learning Research* **11**, 3571-3594. +#' +#' @template loo-and-psis-references +#' +#' @examples +#' ### Array and matrix methods +#' LLarr <- example_loglik_array() +#' dim(LLarr) +#' +#' LLmat <- example_loglik_matrix() +#' dim(LLmat) +#' +#' waic_arr <- waic(LLarr) +#' waic_mat <- waic(LLmat) +#' identical(waic_arr, waic_mat) +#' +#' +#' \dontrun{ +#' log_lik1 <- extract_log_lik(stanfit1) +#' log_lik2 <- extract_log_lik(stanfit2) +#' (waic1 <- waic(log_lik1)) +#' (waic2 <- waic(log_lik2)) +#' print(compare(waic1, waic2), digits = 2) +#' } +#' +waic <- function(x, ...) { + UseMethod("waic") +} + +#' @export +#' @templateVar fn waic +#' @template array +#' +waic.array <- function(x, ...) { + waic.matrix(llarray_to_matrix(x), ...) +} + +#' @export +#' @templateVar fn waic +#' @template matrix +#' +waic.matrix <- function(x, ...) { + ll <- validate_ll(x) + lldim <- dim(ll) + lpd <- matrixStats::colLogSumExps(ll) - log(nrow(ll)) # colLogMeanExps + p_waic <- matrixStats::colVars(ll) + elpd_waic <- lpd - p_waic + waic <- -2 * elpd_waic + pointwise <- cbind(elpd_waic, p_waic, waic) + + throw_pwaic_warnings(pointwise[, "p_waic"], digits = 1) + return(waic_object(pointwise, dims = lldim)) +} + + +#' @export +#' @templateVar fn waic +#' @template function +#' @param draws,data,... For the function method only. See the +#' **Methods (by class)** section below for details on these arguments. +#' +waic.function <- + function(x, + ..., + data = NULL, + draws = NULL) { + 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) + }) + pointwise <- do.call(rbind, waic_list) + pointwise <- cbind(pointwise, waic = -2 * pointwise[, "elpd_waic"]) + + throw_pwaic_warnings(pointwise[, "p_waic"], digits = 1) + waic_object(pointwise, dims = c(S, N)) + } + + +#' @export +dim.waic <- function(x) { + attr(x, "dims") +} + +#' @rdname waic +#' @export +is.waic <- function(x) { + inherits(x, "waic") && is.loo(x) +} + + +# internal ---------------------------------------------------------------- + +# structure the object returned by the waic methods +waic_object <- function(pointwise, dims) { + estimates <- table_of_estimates(pointwise) + out <- nlist(estimates, pointwise) + # maintain backwards compatibility + old_nms <- c("elpd_waic", "p_waic", "waic", "se_elpd_waic", "se_p_waic", "se_waic") + out <- c(out, setNames(as.list(estimates), old_nms)) + structure( + out, + dims = dims, + class = c("waic", "loo") + ) +} + +# waic warnings +# @param p 'p_waic' estimates +throw_pwaic_warnings <- function(p, digits = 1, warn = TRUE) { + badp <- p > 0.4 + if (any(badp)) { + count <- sum(badp) + prop <- count / length(badp) + msg <- paste0("\n", count, " (", .fr(100 * prop, digits), + "%) p_waic estimates greater than 0.4. ", + "We recommend trying loo instead.") + if (warn) .warn(msg) else cat(msg, "\n") + } + invisible(NULL) +} + From 2bb5bc2bee09c50a5d230d4946765d0bdd6b1af0 Mon Sep 17 00:00:00 2001 From: VisruthSK <67435125+VisruthSK@users.noreply.github.com> Date: Mon, 23 Feb 2026 11:30:00 -0800 Subject: [PATCH 3/8] Redoc --- man/loo-glossary.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/loo-glossary.Rd b/man/loo-glossary.Rd index 5dbf1670..250f2e29 100644 --- a/man/loo-glossary.Rd +++ b/man/loo-glossary.Rd @@ -4,7 +4,7 @@ \alias{loo-glossary} \title{LOO package glossary} \description{ -The page provides definitions of key terms. Also see the +This page provides definitions of key terms. Also see the \href{https://mc-stan.org/loo/articles/online-only/faq.html}{FAQ page} on the \strong{loo} website for answers to frequently asked questions. From cb64cf13afe42e91b5391fc8acd90fba3b726a70 Mon Sep 17 00:00:00 2001 From: VisruthSK <67435125+VisruthSK@users.noreply.github.com> Date: Thu, 26 Feb 2026 16:26:22 -0800 Subject: [PATCH 4/8] Swapped to lf, changed .gitattributes --- .gitattributes | 4 +- R/sysdata.rda | Bin 233479 -> 233476 bytes R/waic.R | 334 ++++++++++++++++++++++++------------------------- 3 files changed, 169 insertions(+), 169 deletions(-) diff --git a/.gitattributes b/.gitattributes index fce2bdcc..e2746a56 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1,4 +1,4 @@ * text=auto data/* binary -src/* text=lf -R/* text=lf +src/* text eol=lf +R/* text eol=lf diff --git a/R/sysdata.rda b/R/sysdata.rda index b6f9aab836c56d4a223225eb1f903dc35e131471..96ff6ec9c6d72f7c9e085cbf1dd886c3ed7daa5d 100644 GIT binary patch delta 31 ncmZo)z}K>Xuc3u;3)6M3?KilXE??Zf<_?ob{`Rll%t9^z+G7oi delta 37 qcmZo!z}LQjuc3u;3)6KjM&9k$xtK0r1k$VSFnQzy=}+FwLM{Les12_G diff --git a/R/waic.R b/R/waic.R index 5f025205..2dac6456 100644 --- a/R/waic.R +++ b/R/waic.R @@ -1,167 +1,167 @@ -#' Widely applicable information criterion (WAIC) -#' -#' The `waic()` methods can be used to compute WAIC from the pointwise -#' log-likelihood. However, we recommend LOO-CV using PSIS (as implemented by -#' the [loo()] function) because PSIS provides useful diagnostics as well as -#' effective sample size and Monte Carlo estimates. -#' -#' @export waic waic.array waic.matrix waic.function -#' @inheritParams loo -#' -#' @return A named list (of class `c("waic", "loo")`) with components: -#' -#' \describe{ -#' \item{`estimates`}{ -#' A matrix with two columns (`"Estimate"`, `"SE"`) and three -#' rows (`"elpd_waic"`, `"p_waic"`, `"waic"`). This contains -#' point estimates and standard errors of the expected log pointwise predictive -#' density (`elpd_waic`), the effective number of parameters -#' (`p_waic`) and the information criterion `waic` (which is just -#' `-2 * elpd_waic`, i.e., converted to deviance scale). -#' } -#' \item{`pointwise`}{ -#' A matrix with three columns (and number of rows equal to the number of -#' observations) containing the pointwise contributions of each of the above -#' measures (`elpd_waic`, `p_waic`, `waic`). -#' } -#' } -#' -#' @seealso -#' * The __loo__ package [vignettes](https://mc-stan.org/loo/articles/) and -#' Vehtari, Gelman, and Gabry (2017) and Vehtari, Simpson, Gelman, Yao, -#' and Gabry (2024) for more details on why we prefer `loo()` to `waic()`. -#' * [loo_compare()] for comparing models on approximate LOO-CV or WAIC. -#' -#' @references -#' Watanabe, S. (2010). Asymptotic equivalence of Bayes cross validation and -#' widely applicable information criterion in singular learning theory. -#' *Journal of Machine Learning Research* **11**, 3571-3594. -#' -#' @template loo-and-psis-references -#' -#' @examples -#' ### Array and matrix methods -#' LLarr <- example_loglik_array() -#' dim(LLarr) -#' -#' LLmat <- example_loglik_matrix() -#' dim(LLmat) -#' -#' waic_arr <- waic(LLarr) -#' waic_mat <- waic(LLmat) -#' identical(waic_arr, waic_mat) -#' -#' -#' \dontrun{ -#' log_lik1 <- extract_log_lik(stanfit1) -#' log_lik2 <- extract_log_lik(stanfit2) -#' (waic1 <- waic(log_lik1)) -#' (waic2 <- waic(log_lik2)) -#' print(compare(waic1, waic2), digits = 2) -#' } -#' -waic <- function(x, ...) { - UseMethod("waic") -} - -#' @export -#' @templateVar fn waic -#' @template array -#' -waic.array <- function(x, ...) { - waic.matrix(llarray_to_matrix(x), ...) -} - -#' @export -#' @templateVar fn waic -#' @template matrix -#' -waic.matrix <- function(x, ...) { - ll <- validate_ll(x) - lldim <- dim(ll) - lpd <- matrixStats::colLogSumExps(ll) - log(nrow(ll)) # colLogMeanExps - p_waic <- matrixStats::colVars(ll) - elpd_waic <- lpd - p_waic - waic <- -2 * elpd_waic - pointwise <- cbind(elpd_waic, p_waic, waic) - - throw_pwaic_warnings(pointwise[, "p_waic"], digits = 1) - return(waic_object(pointwise, dims = lldim)) -} - - -#' @export -#' @templateVar fn waic -#' @template function -#' @param draws,data,... For the function method only. See the -#' **Methods (by class)** section below for details on these arguments. -#' -waic.function <- - function(x, - ..., - data = NULL, - draws = NULL) { - 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) - }) - pointwise <- do.call(rbind, waic_list) - pointwise <- cbind(pointwise, waic = -2 * pointwise[, "elpd_waic"]) - - throw_pwaic_warnings(pointwise[, "p_waic"], digits = 1) - waic_object(pointwise, dims = c(S, N)) - } - - -#' @export -dim.waic <- function(x) { - attr(x, "dims") -} - -#' @rdname waic -#' @export -is.waic <- function(x) { - inherits(x, "waic") && is.loo(x) -} - - -# internal ---------------------------------------------------------------- - -# structure the object returned by the waic methods -waic_object <- function(pointwise, dims) { - estimates <- table_of_estimates(pointwise) - out <- nlist(estimates, pointwise) - # maintain backwards compatibility - old_nms <- c("elpd_waic", "p_waic", "waic", "se_elpd_waic", "se_p_waic", "se_waic") - out <- c(out, setNames(as.list(estimates), old_nms)) - structure( - out, - dims = dims, - class = c("waic", "loo") - ) -} - -# waic warnings -# @param p 'p_waic' estimates -throw_pwaic_warnings <- function(p, digits = 1, warn = TRUE) { - badp <- p > 0.4 - if (any(badp)) { - count <- sum(badp) - prop <- count / length(badp) - msg <- paste0("\n", count, " (", .fr(100 * prop, digits), - "%) p_waic estimates greater than 0.4. ", - "We recommend trying loo instead.") - if (warn) .warn(msg) else cat(msg, "\n") - } - invisible(NULL) -} - +#' Widely applicable information criterion (WAIC) +#' +#' The `waic()` methods can be used to compute WAIC from the pointwise +#' log-likelihood. However, we recommend LOO-CV using PSIS (as implemented by +#' the [loo()] function) because PSIS provides useful diagnostics as well as +#' effective sample size and Monte Carlo estimates. +#' +#' @export waic waic.array waic.matrix waic.function +#' @inheritParams loo +#' +#' @return A named list (of class `c("waic", "loo")`) with components: +#' +#' \describe{ +#' \item{`estimates`}{ +#' A matrix with two columns (`"Estimate"`, `"SE"`) and three +#' rows (`"elpd_waic"`, `"p_waic"`, `"waic"`). This contains +#' point estimates and standard errors of the expected log pointwise predictive +#' density (`elpd_waic`), the effective number of parameters +#' (`p_waic`) and the information criterion `waic` (which is just +#' `-2 * elpd_waic`, i.e., converted to deviance scale). +#' } +#' \item{`pointwise`}{ +#' A matrix with three columns (and number of rows equal to the number of +#' observations) containing the pointwise contributions of each of the above +#' measures (`elpd_waic`, `p_waic`, `waic`). +#' } +#' } +#' +#' @seealso +#' * The __loo__ package [vignettes](https://mc-stan.org/loo/articles/) and +#' Vehtari, Gelman, and Gabry (2017) and Vehtari, Simpson, Gelman, Yao, +#' and Gabry (2024) for more details on why we prefer `loo()` to `waic()`. +#' * [loo_compare()] for comparing models on approximate LOO-CV or WAIC. +#' +#' @references +#' Watanabe, S. (2010). Asymptotic equivalence of Bayes cross validation and +#' widely applicable information criterion in singular learning theory. +#' *Journal of Machine Learning Research* **11**, 3571-3594. +#' +#' @template loo-and-psis-references +#' +#' @examples +#' ### Array and matrix methods +#' LLarr <- example_loglik_array() +#' dim(LLarr) +#' +#' LLmat <- example_loglik_matrix() +#' dim(LLmat) +#' +#' waic_arr <- waic(LLarr) +#' waic_mat <- waic(LLmat) +#' identical(waic_arr, waic_mat) +#' +#' +#' \dontrun{ +#' log_lik1 <- extract_log_lik(stanfit1) +#' log_lik2 <- extract_log_lik(stanfit2) +#' (waic1 <- waic(log_lik1)) +#' (waic2 <- waic(log_lik2)) +#' print(compare(waic1, waic2), digits = 2) +#' } +#' +waic <- function(x, ...) { + UseMethod("waic") +} + +#' @export +#' @templateVar fn waic +#' @template array +#' +waic.array <- function(x, ...) { + waic.matrix(llarray_to_matrix(x), ...) +} + +#' @export +#' @templateVar fn waic +#' @template matrix +#' +waic.matrix <- function(x, ...) { + ll <- validate_ll(x) + lldim <- dim(ll) + lpd <- matrixStats::colLogSumExps(ll) - log(nrow(ll)) # colLogMeanExps + p_waic <- matrixStats::colVars(ll) + elpd_waic <- lpd - p_waic + waic <- -2 * elpd_waic + pointwise <- cbind(elpd_waic, p_waic, waic) + + throw_pwaic_warnings(pointwise[, "p_waic"], digits = 1) + return(waic_object(pointwise, dims = lldim)) +} + + +#' @export +#' @templateVar fn waic +#' @template function +#' @param draws,data,... For the function method only. See the +#' **Methods (by class)** section below for details on these arguments. +#' +waic.function <- + function(x, + ..., + data = NULL, + draws = NULL) { + 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) + }) + pointwise <- do.call(rbind, waic_list) + pointwise <- cbind(pointwise, waic = -2 * pointwise[, "elpd_waic"]) + + throw_pwaic_warnings(pointwise[, "p_waic"], digits = 1) + waic_object(pointwise, dims = c(S, N)) + } + + +#' @export +dim.waic <- function(x) { + attr(x, "dims") +} + +#' @rdname waic +#' @export +is.waic <- function(x) { + inherits(x, "waic") && is.loo(x) +} + + +# internal ---------------------------------------------------------------- + +# structure the object returned by the waic methods +waic_object <- function(pointwise, dims) { + estimates <- table_of_estimates(pointwise) + out <- nlist(estimates, pointwise) + # maintain backwards compatibility + old_nms <- c("elpd_waic", "p_waic", "waic", "se_elpd_waic", "se_p_waic", "se_waic") + out <- c(out, setNames(as.list(estimates), old_nms)) + structure( + out, + dims = dims, + class = c("waic", "loo") + ) +} + +# waic warnings +# @param p 'p_waic' estimates +throw_pwaic_warnings <- function(p, digits = 1, warn = TRUE) { + badp <- p > 0.4 + if (any(badp)) { + count <- sum(badp) + prop <- count / length(badp) + msg <- paste0("\n", count, " (", .fr(100 * prop, digits), + "%) p_waic estimates greater than 0.4. ", + "We recommend trying loo instead.") + if (warn) .warn(msg) else cat(msg, "\n") + } + invisible(NULL) +} + From 62be68d65f7ba5c2641956ce94472a2747a20856 Mon Sep 17 00:00:00 2001 From: Visruth Srimath Kandali <67435125+VisruthSK@users.noreply.github.com> Date: Thu, 26 Feb 2026 16:28:43 -0800 Subject: [PATCH 5/8] Update .gitattributes [no ci] --- .gitattributes | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitattributes b/.gitattributes index e2746a56..f9159d6d 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1,4 +1,4 @@ * text=auto data/* binary src/* text eol=lf -R/* text eol=lf +R/* text eol=lf From ec6080c85010d61f077291e4cb02e9fbbc9c9a92 Mon Sep 17 00:00:00 2001 From: VisruthSK <67435125+VisruthSK@users.noreply.github.com> Date: Thu, 26 Feb 2026 16:31:54 -0800 Subject: [PATCH 6/8] Revert "Update .gitattributes [no ci]" This reverts commit 62be68d65f7ba5c2641956ce94472a2747a20856. --- .gitattributes | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitattributes b/.gitattributes index f9159d6d..e2746a56 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1,4 +1,4 @@ * text=auto data/* binary src/* text eol=lf -R/* text eol=lf +R/* text eol=lf From 53ecde47fd2c4815e7a339983571dc8dd90208af Mon Sep 17 00:00:00 2001 From: VisruthSK <67435125+VisruthSK@users.noreply.github.com> Date: Thu, 26 Feb 2026 16:31:54 -0800 Subject: [PATCH 7/8] Revert "Swapped to lf, changed .gitattributes" This reverts commit cb64cf13afe42e91b5391fc8acd90fba3b726a70. --- .gitattributes | 4 +- R/sysdata.rda | Bin 233476 -> 233479 bytes R/waic.R | 334 ++++++++++++++++++++++++------------------------- 3 files changed, 169 insertions(+), 169 deletions(-) diff --git a/.gitattributes b/.gitattributes index e2746a56..fce2bdcc 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1,4 +1,4 @@ * text=auto data/* binary -src/* text eol=lf -R/* text eol=lf +src/* text=lf +R/* text=lf diff --git a/R/sysdata.rda b/R/sysdata.rda index 96ff6ec9c6d72f7c9e085cbf1dd886c3ed7daa5d..b6f9aab836c56d4a223225eb1f903dc35e131471 100644 GIT binary patch delta 37 qcmZo!z}LQjuc3u;3)6KjM&9k$xtK0r1k$VSFnQzy=}+FwLM{Les12_G delta 31 ncmZo)z}K>Xuc3u;3)6M3?KilXE??Zf<_?ob{`Rll%t9^z+G7oi diff --git a/R/waic.R b/R/waic.R index 2dac6456..5f025205 100644 --- a/R/waic.R +++ b/R/waic.R @@ -1,167 +1,167 @@ -#' Widely applicable information criterion (WAIC) -#' -#' The `waic()` methods can be used to compute WAIC from the pointwise -#' log-likelihood. However, we recommend LOO-CV using PSIS (as implemented by -#' the [loo()] function) because PSIS provides useful diagnostics as well as -#' effective sample size and Monte Carlo estimates. -#' -#' @export waic waic.array waic.matrix waic.function -#' @inheritParams loo -#' -#' @return A named list (of class `c("waic", "loo")`) with components: -#' -#' \describe{ -#' \item{`estimates`}{ -#' A matrix with two columns (`"Estimate"`, `"SE"`) and three -#' rows (`"elpd_waic"`, `"p_waic"`, `"waic"`). This contains -#' point estimates and standard errors of the expected log pointwise predictive -#' density (`elpd_waic`), the effective number of parameters -#' (`p_waic`) and the information criterion `waic` (which is just -#' `-2 * elpd_waic`, i.e., converted to deviance scale). -#' } -#' \item{`pointwise`}{ -#' A matrix with three columns (and number of rows equal to the number of -#' observations) containing the pointwise contributions of each of the above -#' measures (`elpd_waic`, `p_waic`, `waic`). -#' } -#' } -#' -#' @seealso -#' * The __loo__ package [vignettes](https://mc-stan.org/loo/articles/) and -#' Vehtari, Gelman, and Gabry (2017) and Vehtari, Simpson, Gelman, Yao, -#' and Gabry (2024) for more details on why we prefer `loo()` to `waic()`. -#' * [loo_compare()] for comparing models on approximate LOO-CV or WAIC. -#' -#' @references -#' Watanabe, S. (2010). Asymptotic equivalence of Bayes cross validation and -#' widely applicable information criterion in singular learning theory. -#' *Journal of Machine Learning Research* **11**, 3571-3594. -#' -#' @template loo-and-psis-references -#' -#' @examples -#' ### Array and matrix methods -#' LLarr <- example_loglik_array() -#' dim(LLarr) -#' -#' LLmat <- example_loglik_matrix() -#' dim(LLmat) -#' -#' waic_arr <- waic(LLarr) -#' waic_mat <- waic(LLmat) -#' identical(waic_arr, waic_mat) -#' -#' -#' \dontrun{ -#' log_lik1 <- extract_log_lik(stanfit1) -#' log_lik2 <- extract_log_lik(stanfit2) -#' (waic1 <- waic(log_lik1)) -#' (waic2 <- waic(log_lik2)) -#' print(compare(waic1, waic2), digits = 2) -#' } -#' -waic <- function(x, ...) { - UseMethod("waic") -} - -#' @export -#' @templateVar fn waic -#' @template array -#' -waic.array <- function(x, ...) { - waic.matrix(llarray_to_matrix(x), ...) -} - -#' @export -#' @templateVar fn waic -#' @template matrix -#' -waic.matrix <- function(x, ...) { - ll <- validate_ll(x) - lldim <- dim(ll) - lpd <- matrixStats::colLogSumExps(ll) - log(nrow(ll)) # colLogMeanExps - p_waic <- matrixStats::colVars(ll) - elpd_waic <- lpd - p_waic - waic <- -2 * elpd_waic - pointwise <- cbind(elpd_waic, p_waic, waic) - - throw_pwaic_warnings(pointwise[, "p_waic"], digits = 1) - return(waic_object(pointwise, dims = lldim)) -} - - -#' @export -#' @templateVar fn waic -#' @template function -#' @param draws,data,... For the function method only. See the -#' **Methods (by class)** section below for details on these arguments. -#' -waic.function <- - function(x, - ..., - data = NULL, - draws = NULL) { - 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) - }) - pointwise <- do.call(rbind, waic_list) - pointwise <- cbind(pointwise, waic = -2 * pointwise[, "elpd_waic"]) - - throw_pwaic_warnings(pointwise[, "p_waic"], digits = 1) - waic_object(pointwise, dims = c(S, N)) - } - - -#' @export -dim.waic <- function(x) { - attr(x, "dims") -} - -#' @rdname waic -#' @export -is.waic <- function(x) { - inherits(x, "waic") && is.loo(x) -} - - -# internal ---------------------------------------------------------------- - -# structure the object returned by the waic methods -waic_object <- function(pointwise, dims) { - estimates <- table_of_estimates(pointwise) - out <- nlist(estimates, pointwise) - # maintain backwards compatibility - old_nms <- c("elpd_waic", "p_waic", "waic", "se_elpd_waic", "se_p_waic", "se_waic") - out <- c(out, setNames(as.list(estimates), old_nms)) - structure( - out, - dims = dims, - class = c("waic", "loo") - ) -} - -# waic warnings -# @param p 'p_waic' estimates -throw_pwaic_warnings <- function(p, digits = 1, warn = TRUE) { - badp <- p > 0.4 - if (any(badp)) { - count <- sum(badp) - prop <- count / length(badp) - msg <- paste0("\n", count, " (", .fr(100 * prop, digits), - "%) p_waic estimates greater than 0.4. ", - "We recommend trying loo instead.") - if (warn) .warn(msg) else cat(msg, "\n") - } - invisible(NULL) -} - +#' Widely applicable information criterion (WAIC) +#' +#' The `waic()` methods can be used to compute WAIC from the pointwise +#' log-likelihood. However, we recommend LOO-CV using PSIS (as implemented by +#' the [loo()] function) because PSIS provides useful diagnostics as well as +#' effective sample size and Monte Carlo estimates. +#' +#' @export waic waic.array waic.matrix waic.function +#' @inheritParams loo +#' +#' @return A named list (of class `c("waic", "loo")`) with components: +#' +#' \describe{ +#' \item{`estimates`}{ +#' A matrix with two columns (`"Estimate"`, `"SE"`) and three +#' rows (`"elpd_waic"`, `"p_waic"`, `"waic"`). This contains +#' point estimates and standard errors of the expected log pointwise predictive +#' density (`elpd_waic`), the effective number of parameters +#' (`p_waic`) and the information criterion `waic` (which is just +#' `-2 * elpd_waic`, i.e., converted to deviance scale). +#' } +#' \item{`pointwise`}{ +#' A matrix with three columns (and number of rows equal to the number of +#' observations) containing the pointwise contributions of each of the above +#' measures (`elpd_waic`, `p_waic`, `waic`). +#' } +#' } +#' +#' @seealso +#' * The __loo__ package [vignettes](https://mc-stan.org/loo/articles/) and +#' Vehtari, Gelman, and Gabry (2017) and Vehtari, Simpson, Gelman, Yao, +#' and Gabry (2024) for more details on why we prefer `loo()` to `waic()`. +#' * [loo_compare()] for comparing models on approximate LOO-CV or WAIC. +#' +#' @references +#' Watanabe, S. (2010). Asymptotic equivalence of Bayes cross validation and +#' widely applicable information criterion in singular learning theory. +#' *Journal of Machine Learning Research* **11**, 3571-3594. +#' +#' @template loo-and-psis-references +#' +#' @examples +#' ### Array and matrix methods +#' LLarr <- example_loglik_array() +#' dim(LLarr) +#' +#' LLmat <- example_loglik_matrix() +#' dim(LLmat) +#' +#' waic_arr <- waic(LLarr) +#' waic_mat <- waic(LLmat) +#' identical(waic_arr, waic_mat) +#' +#' +#' \dontrun{ +#' log_lik1 <- extract_log_lik(stanfit1) +#' log_lik2 <- extract_log_lik(stanfit2) +#' (waic1 <- waic(log_lik1)) +#' (waic2 <- waic(log_lik2)) +#' print(compare(waic1, waic2), digits = 2) +#' } +#' +waic <- function(x, ...) { + UseMethod("waic") +} + +#' @export +#' @templateVar fn waic +#' @template array +#' +waic.array <- function(x, ...) { + waic.matrix(llarray_to_matrix(x), ...) +} + +#' @export +#' @templateVar fn waic +#' @template matrix +#' +waic.matrix <- function(x, ...) { + ll <- validate_ll(x) + lldim <- dim(ll) + lpd <- matrixStats::colLogSumExps(ll) - log(nrow(ll)) # colLogMeanExps + p_waic <- matrixStats::colVars(ll) + elpd_waic <- lpd - p_waic + waic <- -2 * elpd_waic + pointwise <- cbind(elpd_waic, p_waic, waic) + + throw_pwaic_warnings(pointwise[, "p_waic"], digits = 1) + return(waic_object(pointwise, dims = lldim)) +} + + +#' @export +#' @templateVar fn waic +#' @template function +#' @param draws,data,... For the function method only. See the +#' **Methods (by class)** section below for details on these arguments. +#' +waic.function <- + function(x, + ..., + data = NULL, + draws = NULL) { + 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) + }) + pointwise <- do.call(rbind, waic_list) + pointwise <- cbind(pointwise, waic = -2 * pointwise[, "elpd_waic"]) + + throw_pwaic_warnings(pointwise[, "p_waic"], digits = 1) + waic_object(pointwise, dims = c(S, N)) + } + + +#' @export +dim.waic <- function(x) { + attr(x, "dims") +} + +#' @rdname waic +#' @export +is.waic <- function(x) { + inherits(x, "waic") && is.loo(x) +} + + +# internal ---------------------------------------------------------------- + +# structure the object returned by the waic methods +waic_object <- function(pointwise, dims) { + estimates <- table_of_estimates(pointwise) + out <- nlist(estimates, pointwise) + # maintain backwards compatibility + old_nms <- c("elpd_waic", "p_waic", "waic", "se_elpd_waic", "se_p_waic", "se_waic") + out <- c(out, setNames(as.list(estimates), old_nms)) + structure( + out, + dims = dims, + class = c("waic", "loo") + ) +} + +# waic warnings +# @param p 'p_waic' estimates +throw_pwaic_warnings <- function(p, digits = 1, warn = TRUE) { + badp <- p > 0.4 + if (any(badp)) { + count <- sum(badp) + prop <- count / length(badp) + msg <- paste0("\n", count, " (", .fr(100 * prop, digits), + "%) p_waic estimates greater than 0.4. ", + "We recommend trying loo instead.") + if (warn) .warn(msg) else cat(msg, "\n") + } + invisible(NULL) +} + From 2a916b1e1c349d54fa60a9ba17f83242e7b9930a Mon Sep 17 00:00:00 2001 From: VisruthSK <67435125+VisruthSK@users.noreply.github.com> Date: Thu, 26 Feb 2026 16:33:40 -0800 Subject: [PATCH 8/8] Swapped to lf properly --- .gitattributes | 6 +- R/waic.R | 334 ++++++++++++++++++++++++------------------------- 2 files changed, 171 insertions(+), 169 deletions(-) diff --git a/.gitattributes b/.gitattributes index fce2bdcc..5046e422 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1,4 +1,6 @@ * text=auto data/* binary -src/* text=lf -R/* text=lf +src/* text eol=lf +R/* text eol=lf +*.rda binary + diff --git a/R/waic.R b/R/waic.R index 5f025205..2dac6456 100644 --- a/R/waic.R +++ b/R/waic.R @@ -1,167 +1,167 @@ -#' Widely applicable information criterion (WAIC) -#' -#' The `waic()` methods can be used to compute WAIC from the pointwise -#' log-likelihood. However, we recommend LOO-CV using PSIS (as implemented by -#' the [loo()] function) because PSIS provides useful diagnostics as well as -#' effective sample size and Monte Carlo estimates. -#' -#' @export waic waic.array waic.matrix waic.function -#' @inheritParams loo -#' -#' @return A named list (of class `c("waic", "loo")`) with components: -#' -#' \describe{ -#' \item{`estimates`}{ -#' A matrix with two columns (`"Estimate"`, `"SE"`) and three -#' rows (`"elpd_waic"`, `"p_waic"`, `"waic"`). This contains -#' point estimates and standard errors of the expected log pointwise predictive -#' density (`elpd_waic`), the effective number of parameters -#' (`p_waic`) and the information criterion `waic` (which is just -#' `-2 * elpd_waic`, i.e., converted to deviance scale). -#' } -#' \item{`pointwise`}{ -#' A matrix with three columns (and number of rows equal to the number of -#' observations) containing the pointwise contributions of each of the above -#' measures (`elpd_waic`, `p_waic`, `waic`). -#' } -#' } -#' -#' @seealso -#' * The __loo__ package [vignettes](https://mc-stan.org/loo/articles/) and -#' Vehtari, Gelman, and Gabry (2017) and Vehtari, Simpson, Gelman, Yao, -#' and Gabry (2024) for more details on why we prefer `loo()` to `waic()`. -#' * [loo_compare()] for comparing models on approximate LOO-CV or WAIC. -#' -#' @references -#' Watanabe, S. (2010). Asymptotic equivalence of Bayes cross validation and -#' widely applicable information criterion in singular learning theory. -#' *Journal of Machine Learning Research* **11**, 3571-3594. -#' -#' @template loo-and-psis-references -#' -#' @examples -#' ### Array and matrix methods -#' LLarr <- example_loglik_array() -#' dim(LLarr) -#' -#' LLmat <- example_loglik_matrix() -#' dim(LLmat) -#' -#' waic_arr <- waic(LLarr) -#' waic_mat <- waic(LLmat) -#' identical(waic_arr, waic_mat) -#' -#' -#' \dontrun{ -#' log_lik1 <- extract_log_lik(stanfit1) -#' log_lik2 <- extract_log_lik(stanfit2) -#' (waic1 <- waic(log_lik1)) -#' (waic2 <- waic(log_lik2)) -#' print(compare(waic1, waic2), digits = 2) -#' } -#' -waic <- function(x, ...) { - UseMethod("waic") -} - -#' @export -#' @templateVar fn waic -#' @template array -#' -waic.array <- function(x, ...) { - waic.matrix(llarray_to_matrix(x), ...) -} - -#' @export -#' @templateVar fn waic -#' @template matrix -#' -waic.matrix <- function(x, ...) { - ll <- validate_ll(x) - lldim <- dim(ll) - lpd <- matrixStats::colLogSumExps(ll) - log(nrow(ll)) # colLogMeanExps - p_waic <- matrixStats::colVars(ll) - elpd_waic <- lpd - p_waic - waic <- -2 * elpd_waic - pointwise <- cbind(elpd_waic, p_waic, waic) - - throw_pwaic_warnings(pointwise[, "p_waic"], digits = 1) - return(waic_object(pointwise, dims = lldim)) -} - - -#' @export -#' @templateVar fn waic -#' @template function -#' @param draws,data,... For the function method only. See the -#' **Methods (by class)** section below for details on these arguments. -#' -waic.function <- - function(x, - ..., - data = NULL, - draws = NULL) { - 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) - }) - pointwise <- do.call(rbind, waic_list) - pointwise <- cbind(pointwise, waic = -2 * pointwise[, "elpd_waic"]) - - throw_pwaic_warnings(pointwise[, "p_waic"], digits = 1) - waic_object(pointwise, dims = c(S, N)) - } - - -#' @export -dim.waic <- function(x) { - attr(x, "dims") -} - -#' @rdname waic -#' @export -is.waic <- function(x) { - inherits(x, "waic") && is.loo(x) -} - - -# internal ---------------------------------------------------------------- - -# structure the object returned by the waic methods -waic_object <- function(pointwise, dims) { - estimates <- table_of_estimates(pointwise) - out <- nlist(estimates, pointwise) - # maintain backwards compatibility - old_nms <- c("elpd_waic", "p_waic", "waic", "se_elpd_waic", "se_p_waic", "se_waic") - out <- c(out, setNames(as.list(estimates), old_nms)) - structure( - out, - dims = dims, - class = c("waic", "loo") - ) -} - -# waic warnings -# @param p 'p_waic' estimates -throw_pwaic_warnings <- function(p, digits = 1, warn = TRUE) { - badp <- p > 0.4 - if (any(badp)) { - count <- sum(badp) - prop <- count / length(badp) - msg <- paste0("\n", count, " (", .fr(100 * prop, digits), - "%) p_waic estimates greater than 0.4. ", - "We recommend trying loo instead.") - if (warn) .warn(msg) else cat(msg, "\n") - } - invisible(NULL) -} - +#' Widely applicable information criterion (WAIC) +#' +#' The `waic()` methods can be used to compute WAIC from the pointwise +#' log-likelihood. However, we recommend LOO-CV using PSIS (as implemented by +#' the [loo()] function) because PSIS provides useful diagnostics as well as +#' effective sample size and Monte Carlo estimates. +#' +#' @export waic waic.array waic.matrix waic.function +#' @inheritParams loo +#' +#' @return A named list (of class `c("waic", "loo")`) with components: +#' +#' \describe{ +#' \item{`estimates`}{ +#' A matrix with two columns (`"Estimate"`, `"SE"`) and three +#' rows (`"elpd_waic"`, `"p_waic"`, `"waic"`). This contains +#' point estimates and standard errors of the expected log pointwise predictive +#' density (`elpd_waic`), the effective number of parameters +#' (`p_waic`) and the information criterion `waic` (which is just +#' `-2 * elpd_waic`, i.e., converted to deviance scale). +#' } +#' \item{`pointwise`}{ +#' A matrix with three columns (and number of rows equal to the number of +#' observations) containing the pointwise contributions of each of the above +#' measures (`elpd_waic`, `p_waic`, `waic`). +#' } +#' } +#' +#' @seealso +#' * The __loo__ package [vignettes](https://mc-stan.org/loo/articles/) and +#' Vehtari, Gelman, and Gabry (2017) and Vehtari, Simpson, Gelman, Yao, +#' and Gabry (2024) for more details on why we prefer `loo()` to `waic()`. +#' * [loo_compare()] for comparing models on approximate LOO-CV or WAIC. +#' +#' @references +#' Watanabe, S. (2010). Asymptotic equivalence of Bayes cross validation and +#' widely applicable information criterion in singular learning theory. +#' *Journal of Machine Learning Research* **11**, 3571-3594. +#' +#' @template loo-and-psis-references +#' +#' @examples +#' ### Array and matrix methods +#' LLarr <- example_loglik_array() +#' dim(LLarr) +#' +#' LLmat <- example_loglik_matrix() +#' dim(LLmat) +#' +#' waic_arr <- waic(LLarr) +#' waic_mat <- waic(LLmat) +#' identical(waic_arr, waic_mat) +#' +#' +#' \dontrun{ +#' log_lik1 <- extract_log_lik(stanfit1) +#' log_lik2 <- extract_log_lik(stanfit2) +#' (waic1 <- waic(log_lik1)) +#' (waic2 <- waic(log_lik2)) +#' print(compare(waic1, waic2), digits = 2) +#' } +#' +waic <- function(x, ...) { + UseMethod("waic") +} + +#' @export +#' @templateVar fn waic +#' @template array +#' +waic.array <- function(x, ...) { + waic.matrix(llarray_to_matrix(x), ...) +} + +#' @export +#' @templateVar fn waic +#' @template matrix +#' +waic.matrix <- function(x, ...) { + ll <- validate_ll(x) + lldim <- dim(ll) + lpd <- matrixStats::colLogSumExps(ll) - log(nrow(ll)) # colLogMeanExps + p_waic <- matrixStats::colVars(ll) + elpd_waic <- lpd - p_waic + waic <- -2 * elpd_waic + pointwise <- cbind(elpd_waic, p_waic, waic) + + throw_pwaic_warnings(pointwise[, "p_waic"], digits = 1) + return(waic_object(pointwise, dims = lldim)) +} + + +#' @export +#' @templateVar fn waic +#' @template function +#' @param draws,data,... For the function method only. See the +#' **Methods (by class)** section below for details on these arguments. +#' +waic.function <- + function(x, + ..., + data = NULL, + draws = NULL) { + 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) + }) + pointwise <- do.call(rbind, waic_list) + pointwise <- cbind(pointwise, waic = -2 * pointwise[, "elpd_waic"]) + + throw_pwaic_warnings(pointwise[, "p_waic"], digits = 1) + waic_object(pointwise, dims = c(S, N)) + } + + +#' @export +dim.waic <- function(x) { + attr(x, "dims") +} + +#' @rdname waic +#' @export +is.waic <- function(x) { + inherits(x, "waic") && is.loo(x) +} + + +# internal ---------------------------------------------------------------- + +# structure the object returned by the waic methods +waic_object <- function(pointwise, dims) { + estimates <- table_of_estimates(pointwise) + out <- nlist(estimates, pointwise) + # maintain backwards compatibility + old_nms <- c("elpd_waic", "p_waic", "waic", "se_elpd_waic", "se_p_waic", "se_waic") + out <- c(out, setNames(as.list(estimates), old_nms)) + structure( + out, + dims = dims, + class = c("waic", "loo") + ) +} + +# waic warnings +# @param p 'p_waic' estimates +throw_pwaic_warnings <- function(p, digits = 1, warn = TRUE) { + badp <- p > 0.4 + if (any(badp)) { + count <- sum(badp) + prop <- count / length(badp) + msg <- paste0("\n", count, " (", .fr(100 * prop, digits), + "%) p_waic estimates greater than 0.4. ", + "We recommend trying loo instead.") + if (warn) .warn(msg) else cat(msg, "\n") + } + invisible(NULL) +} +